#!/usr/bin/perl -w # # Perl/Tk version of Tix4.1.0/demos/samples/DirTree.tcl # # Chris Dean 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 = cwd; 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; }