view release on metacpan or  search on metacpan

Tk/Dirlist.pm  view on Meta::CPAN

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

use vars qw($VERSION);
$VERSION = '4.004'; # $Id: //depot/Tkutf8/Tk/Dirlist.pm#5 $

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
    {