#!/usr/bin/perl -w
#
# Perl/Tk version of Tix4.1.0/demos/samples/DirTree.tcl
#
# Chris Dean <ctdean@cogit.com>
use lib "..";
use strict;
use Tk;
use Tk::DirTree;
use Cwd;
my $top = new MainWindow( -title => "DirTree" );
main( $top );
MainLoop();
sub main {
my( $top ) = @_;
my $current_dir = getcwd;
my $tree = $top->Scrolled( qw/DirTree
-width 35 -height 30
-selectmode browse -exportselection 1
-scrollbars osoe/ );
my $lab = $top->Label( -text => "Installation Directory:" );
my $ent = $top->Entry( -textvariable => \$current_dir );
my $ok = $top->Button( qw/-text Ok -underline 0 -width 6/ );
my $cancel = $top->Button( qw/-text Cancel -underline 0 -width 6/ );
$tree->configure( -browsecmd => sub { $current_dir = shift } );
$tree->configure( -command => sub { do_it( $current_dir ) } );
$ok->configure( -command => sub { do_it( $current_dir ) } );
$cancel->configure( -command => sub { exit } );
$tree->pack( qw/-expand yes -fill both -padx 10 -pady 10 -side top/ );
$lab->pack( qw/-anchor w/ );
$ent->pack( qw/-fill x/ );
$ok->pack( qw/-side left -padx 10 -pady 10/ );
$cancel->pack( qw/-side right -padx 10 -pady 10/ );
}
sub do_it {
my( $dir ) = @_;
print "Executing: $dir\n";
exit;
}