The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl -w
#
# Perl/Tk version of Tix4.1.0/demos/samples/DynTree.tcl.
#
# Chris Dean <ctdean@cogit.com>

use lib "..";

use strict;
use Tk;
use Tk::Tree;

my $top = new MainWindow( -title => "Tree (Dynamic)" );

my $tree = $top->ScrlTree( qw(-separator / -width 35 -height 25
                              -scrollbars osoe) );
$tree->pack( qw/-expand yes -fill both -padx 10 -pady 10 -side top/ );

$tree->configure( -opencmd => sub { dyntree_opendir( $tree, @_ ); } );

# Add the root directory the TixTree widget
dyntree_adddir( $tree, "/" );

# The / directory is added in the "open" mode. The user can open it
# and then browse its subdirectories ...

my $ok = $top->Button( qw/-text Ok -underline 0 -width 6/,
                       -command => sub { exit } );
my $cancel = $top->Button( qw/-text Cancel -underline 0 -width 6/,
                           -command => sub { exit } );

$ok->pack(     qw/-side left  -padx 10 -pady 10/ );
$cancel->pack( qw/-side right -padx 10 -pady 10/ );

MainLoop();

sub dyntree_adddir {
    my( $tree, $dir ) = @_;

    my $text = $dir;
    $text = (split( "/", $dir ))[-1] unless $text eq "/";

    $tree->add( $dir, -text => $text, -image => $tree->Getimage("folder") );
    $tree->setmode( $dir, -d $dir ? "open" : "none" );
}

# This command is called whenever the user presses the (+) indicator or
# double clicks on a directory whose mode is "open". It loads the files
# inside that directory into the Tree widget.
#
# Note we didn't specify the -closecmd option for the Tree widget, so it
# performs the default action when the user presses the (-) indicator or
# double clicks on a directory whose mode is "close": hide all of its child
# entries
#
sub dyntree_opendir {
    my( $tree, $dir ) = @_;

    if( my @kids = $tree->infoChildren( $dir ) ) {
	# We have already loaded this directory. Let's just
	# show all the child entries
	#
	# Note: since we load the directory only once, it will not be
	#       refreshed if the you add or remove files from this
	#	directory.
	#
	foreach my $kid (@kids) {
            $tree->show( -entry => $kid );
	}
	return;
    }

    my $image = $tree->Getimage("folder");

    opendir D, $dir or return;
    foreach my $file (sort readdir( D )) {
        next if $file =~ /^\./;
        my $path = "$dir/$file";
        $path = "/$file" if $dir eq "/";
        if( -d $path ) {
	    dyntree_adddir( $tree, $path );
	} else {
            $tree->add( $path, -text => $file, -image => $image );
	}
    }
    closedir D;
}