PerlTk - can't get DirTree -dircmd to work

Author

can't get DirTree -dircmd to work

perl coder

2004-08-03, 9:05 am

I saw that DirTree lets you specify a function to read directory
information from (with the -dircmd option) and I want to use that to
display a remote filesystem.

To start, I just wrote a small test program, but it seems to only work
halfway. My read_dir() function is being called, but DirTree seems to
be discarding all the directory names that don't exist on the local
filesystem (fro, go_here, baz). I thought the -dircmd option was to
ignore the local filesystem... I'm getting very

. I tried the
program on Linux (with 5.6.1) and Win32 (with 5.8.4) and it doesn't work
on either. Please help! :-)

#!/usr/bin/perl

use strict;
use warnings;
use Tk;
use Tk::DirTree;

my $mw = new MainWindow();

my $remotedir = '/';

my $tree = $mw->Scrolled('DirTree',
-width => 35,
-height => 25,
-scrollbars => 'osoe',
-selectmode => 'single',
-showhidden => 1,
-directory => $remotedir,
-dircmd => \&read_dir,
-browsecmd => \&browse
)->pack(-expand => 'yes', -fill => 'both');

read_dir($remotedir, 1);
MainLoop ();

# XXX the bogus dir names don't get displayed in the DirTree
sub read_dir {
my ($dir, $showhidden) = @_;
warn time, " read_dir($dir, $showhidden)\n";
warn "remotedir = $remotedir\n";
warn "selection = ", $tree->selectionGet;
# for now we just pretend these are being queried over the network...
return(qw|bin etc fro go_here baz home var|) if ($dir eq '/');
return(qw|bin lib go_here_again src|) if ($dir eq '/go_here');
return(qw|foo bar sna fu|) if ($dir eq '/go_here/go_here_again');
return();
}

# "display files in selected dir" (just skeleton code...)
sub browse {
my ($dir) = @_;
warn time, " browse($dir)\n";
$remotedir = $dir;
warn "set remotedir to: $remotedir\n";
warn "selection = ", $tree->selectionGet;
}

--
No crazy stuff in my email. ;-)

perl coder

2004-08-03, 9:05 am

I got it to work by changing two lines in DirTree.pm that were testing
for the existence of a local directory... This "fix" probably breaks
some other stuff though!

Oh, and it still doesn't work in Win32 unless I set $remotedir to '//'
instead of '/' (which gets automatically translated to C: and there's no
C: drive on the remote filesystem... it's a Unix machine).

$ diff -u /usr/lib/perl5/Tk/DirTree.pm ./Tk/DirTree.pm
--- /usr/lib/perl5/Tk/DirTree.pm Mon Aug 2 22:34:42 2004
+++ ./Tk/DirTree.pm Mon Aug 2 22:33:30 2004
@@ -114,7 +114,7 @@
foreach my $name ($w->dirnames( $parent )) {
next if ($name eq '.' || $name eq '..');
my $subdir = "$dir/$name";
- next unless -d $subdir;
+# next unless -d $subdir;
if( $w->infoExists( $subdir ) ) {
$w->show( -entry => $subdir );
} else {
@@ -151,7 +151,8 @@
foreach my $name ($w->dirnames( $dir )) {
next if ($name eq '.' || $name eq '..');
next if ($name =~ /^\.+$/);
- return( 1 ) if -d "$dir/$name";
+# return( 1 ) if -d "$dir/$name";
+ return( 1 ) if defined($name);
}
return( 0 );
}

--
No crazy stuff in my email. ;-)

Sponsored Links