Initial commit of OpenSPARC T2 design and verification files.

[OpenSPARC-T2-DV] / tools / perl-5.8.0 / lib / site_perl / 5.8.0 / sun4-solaris / Tk / Dirlist.pm

package Tk::Dirlist;
require Tk::Derived;
require Tk::HList;
require DirHandle;
use Cwd;

use vars qw($VERSION);
$VERSION = '3.009'; # $Id: //depot/Tk8/Tk/Dirlist.pm#9 $

use base  qw(Tk::Derived Tk::HList);
use strict;
Construct Tk::Widget 'Dirlist';

sub getimage
{
my ($w,$key) = @_;
unless (exists $w->{$key})
 {
  $w->{$key} = $w->Pixmap(-id => $key);
  unless ($w->{$key})
   {
    $w->{$key} = $w->Bitmap($key);
   }
 }
return $w->{$key};
}


sub Populate
{
my ($cw,$args) = @_;
$cw->configure(-separator => '/', -itemtype => 'imagetext');
$cw->ConfigSpecs(-directory => ['SETMETHOD','directory','Directory','.']);
}

sub fullpath
{
my ($path) = @_;
my $cwd = getcwd;
if (chdir($path))
 {
  $path = getcwd;
  chdir($cwd);
 }
else
 {
  warn "Cannot cd to $path:$!"
 }
print "$path\n";
return $path;
}

sub AddDir
{
my ($w,$dir) = @_;
my $path = '';
my $prefix = '';
my $first = 0;
my $name;
foreach $name (split m#/#,$dir)
 {
  $first++;
  if ($name eq '')
   {
    next unless ($first == 1);
    $path = '/';
    $name = '/';
   }
  else
   {
    $path .= $prefix;
    $path .= $name;
    $prefix = '/';
   }
  unless ($w->info('exists' => $path))
   {
    print "Add $path\n";
    $w->add($path,-image => $w->getimage('folder'), -text => $name);
   }
 }
}

sub choose_image
{
my ($w,$path) = @_;
return 'folder' if (-d $path);
return 'srcfile'  if ($path =~ /\.[ch]$/);
return 'textfile' if (-T $path);
return 'file';
}


sub directory
{
my ($w,$key,$val) = @_;
my $h = DirHandle->new($val);
$w->AddDir($val = fullpath($val));
my $f;
$w->entryconfigure($val,-image => $w->getimage('act_fold'));
foreach $f (sort $h->read)
 {
  next if ($f =~ /^\.+$/);
  my $path = "$val/$f";
  unless ($w->info('exists' => $path))
   {
    my $image = $w->getimage($w->choose_image($path));
    $w->add($path,-image => $image, -text => $f);
   }
 }
$h->close;
}

1;