#!/usr/bin/perl use strict; use warnings; use diagnostics; use Tk; require Tk::HList; my $top = MainWindow->new(-title=>"FileSelector"); my $h = $top->Scrolled('HList', -drawbranch => 1, -separator => '/', -indent => 15, -command => \&show_or_hide_dir, ) ->pack(-fill => 'both', -expand => 'y', ); my $xpm = <<'END'; /* XPM */ static char *test[]={ "32 32 11 1", ". c None", "# c #000000", "h c #004000", "g c #004040", "f c #404000", "e c #808080", "i c #a0a0a4", "c c #c0c000", "d c #ffff00", "b c #ffffc0", "a c #ffffff", "................................", "................................", "................................", "................................", ".............#....###...........", "............#a##.#aba##.........", "...........#aaaa#aaaaaa##.......", "..........#aaaa#aaaaaaaba##.....", ".........#aaaa#aaaaaaaaaaab##...", "........#aaba#aaaaaaabaabaaaa##.", ".......#aaba#baaaaa#baaaaaabaaa#", "......#aaaa#aaaaab#a##baaaaaaa#.", ".....#aaba#aacbba#aaaa##baaab#..", "....#bbaa#abaacc#aaaaaaa##aa#...", "...#bbbb#aaabaa#aaabaaaaaa##....", "..#bbbb#bacaaa#aaaaaaaabaaaa##..", ".#bbbb#bbaacc#aacaaaaaaaaaaaba#.", "#ddbb#bbbbba#aaaaccaaaaaaaaaaaa#", "#edddfgcbbbfaacaaaaccaaaaaaaaa#e", ".#hedddfhcfabaaccaaabccaaaaaa#e.", "...##edddhaacbbaaccbaaaccaab#i..", ".....##e#baaaccabaaccbaabaa#i...", "......##bacbaabccbaaaccabb#e....", "......#bbbbccaabbccaaaaab#i.....", ".....#bbbbbbbccabbaccaab#i......", ".....#ebbbbbbbbccbaabba#i.......", "......##ebbbbbbbbccaabhe........", "........##ebbbbbbbbbb#e.........", "..........##ibbbbbbbhe..........", "............##ebbbb#e...........", "..............#hee#i............", "................##i............."}; END my %icons; #$icons{"open"} = $top->Bitmap(-file => './open_folder.xbm'); #$icons{"closed"} = $top->Bitmap(-file => './folder.xbm'); $icons{"open"} = $top->Pixmap(-data => $xpm); $icons{"closed"} = $top->Pixmap(-data => $xpm); #show_or_hide_dir("c:\\programme"); show_or_hide_dir(@ARGV); #show_or_hide_dir("p:"); #show_or_hide_dir("/temp"); MainLoop(); #----------------------------------------------------------------------- sub show_or_hide_dir { my $path = $_[0]; print "PATH:".$path; return if (! -d $path); if ($h->info('exists', $path)) { my $next_entry = $h->info('next', $path); if (!$next_entry || (index ($next_entry, "$path/") == -1)) { $h->entryconfigure($path, '-image' => $icons{"open"}); add_dir_contents($path); my $path1 = $path; my $path2 = $path; my @du = ("du", "-b", "-h", $path1, $path2); my $dirSize = system(@du) == 0 or die "system @du failed: $?"; } else { $h->entryconfigure($path, '-image' => $icons{"closed"}); $h->delete('offsprings', $path); } } else { die "'$path' is not a directory\n" if (! -d $path); $h->add($path, -itemtype => 'imagetext', -image => $icons{"open"}, -text => $path, ); add_dir_contents($path); } } sub add_dir_contents { my $path = $_[0]; my $oldcursor = $top->cget('-cursor'); $top->configure(-cursor => 'watch'); $top->update(); my @files = <$path/*>; foreach my $file (@files) { $file =~ s|//|/|g; #$file =~ /^\s*$/; print "FILE:".$file."\n\n"; (my $text = $file) =~ s|^.*/||g; if (-d $file) { $h->add($file, -itemtype => 'imagetext', -image => $icons{"closed"}, -text => $text, ); } else { $h->add($file, -itemtype => 'text', -text => $text, ); } } $top->configure(-cursor => $oldcursor); } # sub add_dir_contents