1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
|
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
{
$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;
|
