Velocity Reviews - Tk- getOpenFile sticks on W2K server

On 25 Sep 2006 03:18:44 -0700, "MoshiachNow" <lev.weissman@creo.com>
wrote:

>HI,
>
>It works nicely on my XP,but sticks on W2K.
>
>Any suggestion for a better fileselct for Tk,or how to use getOpenFile
>on W2k ?
>
>Thanks

Did you look at the requirements for ActiveStatePerl ( assuming that
is what you are using)? W2k needs to be at Service Pack 5+.

You can always write your own, like:

#!/usr/bin/perl
use strict;
use Tk;
require Tk::DirTree;
require Tk::Adjuster;
require Tk::TList;

# The initial directory
my $initial_dir = '/';

# The main window...
my $main = new MainWindow( -title => 'Explorer)' );

# A frame for the tree, adjuster and tlist
my $tree_adj_tablist = $main->Frame();
$tree_adj_tablist->pack(
-expand => 'yes',
-fill => 'both',
-side => 'top'
);

# A scrolled directory tree
my $tree = $tree_adj_tablist->Scrolled(
'DirTree',
-width => 35,
-height => 25,
-scrollbars => 'osoe',
-background => 'White',
-selectmode => 'single',
-selectbackground => 'DarkBlue',
-selectforeground => 'White',
-showhidden => 1,
-directory => $initial_dir
);
$tree->pack(
-expand => 'yes',
-fill => 'both',
-padx => 2,
-pady => 2,
-side => 'left'
);

# An adjuster
my $adjuster = $tree_adj_tablist->Adjuster(
-widget => $tree,
-side => 'left'
);
$adjuster->pack( -side => 'left', -fill => 'y' );

# A scrolled tab_list widget
my $tab_list = $tree_adj_tablist->Scrolled(
'TList',
-background => 'White',
-orient => 'vertical',
-selectmode => 'extended',
-scrollbars => 'os'
);
$tab_list->pack(
-expand => 'yes',
-fill => 'both',
-padx => 2,
-pady => 2,
-side => 'right'
);

# Ok button
my $ok = $main->Button(
-text => 'Ok',
-underline => 0,
-width => 4,
-command => sub { my $selected = $tab_list->info('selection');
#print "@{$selected}\n";
foreach( @{$selected} ){
print $tab_list->entrycget($_, '-text'),"\n";
}
})->pack( -side => 'right', -padx => 10, -pady => 10 );

# A Quit button (will be suppressed???...)
my $quit = $main->Button(
-text => 'Quit',
-underline => 0,
-width => 6,
-command => sub { exit }
);
$quit->pack( -side => 'right', -padx => 10, -pady => 10 );

# Configuring tree and tab_list widgets...
$tree->configure( -browsecmd => sub { list_dir( $tab_list, @_ ); } );

# We list the content of the initial dir inside the tab_list
list_dir( $tab_list, $initial_dir );

MainLoop();

#----------------------------------------------------------------------------

# Displays Dirs and files in TList widget
sub list_dir {
my ( $tab_list, $path ) = @_;

# Erase the TList content
$tab_list->delete( 0, 'end' );

opendir MY_DIR, $path or return;

foreach my $file ( sort readdir(MY_DIR) ) {

# Do not display '.' and '..'
next if ( $file eq '.' or $file eq '..' );

# Insert the files in the TList
$tab_list->insert( 'end', -text => $file );
}
closedir MY_DIR;
}

__END__

--
I'm not really a human, but I play one on earth.
http://zentara.net/japh.html