The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/env perl
#
# This script generates a directory browser, which lists the working directory and allows you to open files or subdirectories
# by double-clicking.
#
# Tcl/Tk -> Perl translation by Stephen O. Lidie.  lusol@Lehigh.EDU  96/01/24

require 5.002;
use English;
use File::Basename;
use Tk;
use strict;
sub browse;

sub invokeself
{
 my @args = ($^X,__FILE__,@_);
 system(join(' ',@args));
}

my $MW = MainWindow->new;

# Create a scrollbar on the right side of the main window and a listbox on
# the left side.

my $scroll = $MW->Scrollbar();
$scroll->pack(-side => 'right', -fill => 'y');
my $list = $MW->Listbox(
    -yscrollcommand => ['set', $scroll],
    -relief => 'sunken',
    -width => 20,
    -height => 20,
    -setgrid => 'yes',
);
$list->pack(-side => 'left', -fill => 'both', -expand => 'yes');
$scroll->configure(-command => ['yview', $list]);
$MW->minsize(1, 1);

# Fill the listbox with a list of all the files in the directory.

my $dir;
if (scalar @ARGV > 0) {
    $dir = $ARGV[0];
} else {
    $dir = '.';
}
foreach (<${dir}/*>) {
    $list->insert('end', basename($::ARG));
}

# Set up bindings for the browser.

$list->bind('all', '<Control-c>' => \&exit);
$list->bind('<Double-Button-1>' => sub {
    my($listbox) = @_;
    foreach (split ' ', $listbox->get('active')) {
	browse $dir, $::ARG;
    }
});

MainLoop;


sub browse {

    # The procedure below is invoked to open a browser on a given file;
    # if the file is a directory then another instance of this program is
    # invoked; if the file is a regular file then an editor is invoked to
    # display the file.

    my($dir, $file) = @_;

    if ($dir ne '.') {
	$file = "$dir/$file";
    }
    if (-d $file) {
	invokeself("$file &");
    } else {
	if (-f $file) {
	    print STDOUT "Viewing file $file ...\n";
	    if (defined $ENV{'EDITOR'}) {
		system "$ENV{'EDITOR'} $file &";
	    } else {
		system "vi $file &";
	    }
	} else {
	    print STDOUT "\"$file\" isn't a directory or regular file\n";
	}
    } # ifend

} # end browse