home *** CD-ROM | disk | FTP | other *** search
/ CD Actual Thematic 7: Programming / CDAT7.iso / Share / Editores / Perl5 / perl / lib / site / Tk / Dirlist.pm < prev    next >
Encoding:
Perl POD Document  |  1997-08-10  |  1.8 KB  |  110 lines
  1. package Tk::Dirlist;
  2. require Tk::Derived;
  3. require Tk::HList;
  4. require DirHandle;
  5. use Cwd;
  6. @ISA = qw(Tk::Derived Tk::HList);
  7. use strict;
  8. Construct Tk::Widget 'Dirlist';
  9.  
  10. sub getimage
  11. {
  12.  my ($w,$key) = @_;
  13.  unless (exists $w->{$key})
  14.   {
  15.    $w->{$key} = $w->Pixmap(-id => $key);
  16.    unless ($w->{$key})
  17.     {
  18.      $w->{$key} = $w->Bitmap($key);
  19.     }
  20.   }
  21.  return $w->{$key}; 
  22. }
  23.  
  24.  
  25. sub Populate
  26. {
  27.  my ($cw,$args) = @_;
  28.  $cw->configure(-separator => '/', -itemtype => 'imagetext');
  29.  $cw->ConfigSpecs(-directory => ['SETMETHOD','directory','Directory','.']);
  30. }
  31.  
  32. sub fullpath
  33. {
  34.  my ($path) = @_;
  35.  my $cwd = getcwd;
  36.  if (chdir($path))
  37.   {
  38.    $path = getcwd;
  39.    chdir($cwd);
  40.   }
  41.  else
  42.   {
  43.    warn "Cannot cd to $path:$!"
  44.   }
  45.  print "$path\n";
  46.  return $path;
  47. }
  48.  
  49. sub AddDir
  50. {
  51.  my ($w,$dir) = @_;
  52.  my $path = "";
  53.  my $prefix = "";
  54.  my $first = 0;
  55.  my $name;
  56.  foreach $name (split m#/#,$dir)
  57.   {
  58.    $first++;
  59.    if ($name eq "")
  60.     {
  61.      next unless ($first == 1);
  62.      $path = '/';
  63.      $name = '/';
  64.     }
  65.    else
  66.     {
  67.      $path .= $prefix;
  68.      $path .= $name;
  69.      $prefix = '/';
  70.     }
  71.    unless ($w->info('exists' => $path))
  72.     {
  73.      print "Add $path\n";
  74.      $w->add($path,-image => $w->getimage('folder'), -text => $name);
  75.     }
  76.   }
  77. }
  78.  
  79. sub choose_image
  80. {
  81.  my ($w,$path) = @_;
  82.  return "folder" if (-d $path);
  83.  return "srcfile"  if ($path =~ /\.[ch]$/);
  84.  return "textfile" if (-T $path);
  85.  return "file";
  86. }
  87.  
  88.  
  89. sub directory
  90. {
  91.  my ($w,$key,$val) = @_;
  92.  my $h = DirHandle->new($val);
  93.  $w->AddDir($val = fullpath($val));
  94.  my $f;
  95.  $w->entryconfigure($val,-image => $w->getimage('act_fold'));
  96.  foreach $f (sort $h->read)
  97.   {
  98.    next if ($f =~ /^\.+$/);
  99.    my $path = "$val/$f";
  100.    unless ($w->info('exists' => $path))
  101.     {
  102.      my $image = $w->getimage($w->choose_image($path));
  103.      $w->add($path,-image => $image, -text => $f);
  104.     }
  105.   }
  106.  $h->close;
  107. }
  108.  
  109. 1;
  110.