#A model train registry database for rolling stock.
#This software copyright 1999 by Michael Bowler.
#This is free software.  Please redistribute!
#This software may be modified as you see fit, however this header must appear in all distributed copies.
#If you decide to make modifications, it would be appreciated if you let the original author know.
#Try Email (in order): mbowler@eradicator.org  mbowler@chat.carleton.ca  bowler@nortelnetworks.com
#(My email services are a little unstable so try to get through to one of them, thanks!)
#The author assumes no responsibility whatsoever for any damages caused through the use of this software.
#USE AT OWN RISK!!!

use tk;
use Cwd;
use strict;

#Global variables...
my ($MAIN,      #Main window widget path.
    $LIST,      #Listbox.
    $CURDIR,    #Current working directory.
    $CURFILE,   #Current working file.
    %VIEW,      #Options for view display.
    %OBJECTS,   #List of all objects.
    $MODCOUNT,  #Modification count.
    @SORTSTACK, #Stack of sort order selections.
    $SORTDIR,   #Direction of sort. 0 - Forward, 1 - Reverse
    $VERSION,   #Current version of code.
    $SORT);     #Current sort order selected.

$VERSION = '1.01';
$SORT = 'number';  #Default sort.
@SORTSTACK = qw(number mfgr class desc status couple);
$SORTDIR = 0;
$CURDIR = cwd;
$MODCOUNT = 0;
$MAIN = MainWindow->new;
$MAIN->title("Train Database Version $VERSION");

#Build the GUI...
my $menubar = $MAIN->Frame;
my $listframe = $MAIN->Frame;
$menubar->pack(-side => 'top', -fill => 'x');
$listframe->pack(-side => 'bottom', -fill => 'both', -expand => 1);

#Build the menubar.
my $filebut = $menubar->Menubutton(-text => 'File');
my $filemenu = $filebut->Menu(-tearoff => 1);
$filemenu->add('command', -label => 'New', -command => sub{&New});
$filemenu->add('command', -label => 'Open...', -command => sub{&Open});
$filemenu->add('command', -label => 'Save', -command => sub{&Save});
$filemenu->add('command', -label => 'Save As...', -command => sub{&SaveAs});
$filemenu->add('separator');
$filemenu->add('command', -label => 'Print...', -command => sub{&Print});
$filemenu->add('separator');
$filemenu->add('command', -label => 'Exit', -command => sub{&Exit});
$filebut->configure(-menu => $filemenu);

my $editbut = $menubar->Menubutton(-text => 'Edit');
my $editmenu = $editbut->Menu(-tearoff => 1);
$editmenu->add('command', -label => 'New Object...', -command => sub{&NewObject($MAIN)});
$editmenu->add('command', -label => 'Edit Object...', -command => sub{&EditObject});
$editmenu->add('command', -label => 'Copy Object...', -command => sub{&CopyObject});
$editmenu->add('command', -label => 'Delete Object...', -command => sub{&DeleteObject});
$editbut->configure(-menu => $editmenu);

my $viewbut = $menubar->Menubutton(-text => 'View');
my $viewmenu = $viewbut->Menu(-tearoff => 1);
my $vm1 = $viewmenu->Menu(-tearoff => 0);
$viewmenu->add('cascade', -label => 'Sort By', -menu => $vm1);
$vm1->add('radiobutton', -label => 'Road Name/Number', -variable => \$SORT, -value => 'number',
                         -command => sub{&AdjustSortStack; &UpdateDisplay});
$vm1->add('radiobutton', -label => 'Manufacturer', -variable => \$SORT, -value => 'mfgr',
                         -command => sub{&AdjustSortStack; &UpdateDisplay});
$vm1->add('radiobutton', -label => 'Class', -variable => \$SORT, -value => 'class',
                         -command => sub{&AdjustSortStack; &UpdateDisplay});
$vm1->add('radiobutton', -label => 'Description', -variable => \$SORT, -value => 'desc',
                         -command => sub{&AdjustSortStack; &UpdateDisplay});
$vm1->add('radiobutton', -label => 'Status', -variable => \$SORT, -value => 'status',
                         -command => sub{&AdjustSortStack; &UpdateDisplay});
$vm1->add('radiobutton', -label => 'Coupler', -variable => \$SORT, -value => 'couple',
                         -command => sub{&AdjustSortStack; &UpdateDisplay});
$vm1->add('separator');
$vm1->add('checkbutton', -label => 'Reverse Sort', -variable => \$SORTDIR, -command => sub{&UpdateDisplay});
$viewmenu->add('separator');
$viewmenu->add('checkbutton', -label => 'Manufacturer', -variable => \$VIEW{'mfgr'},
                              -command => sub{&UpdateDisplay});
$viewmenu->add('checkbutton', -label => 'Class', -variable => \$VIEW{'class'},
                              -command => sub{&UpdateDisplay});
$viewmenu->add('checkbutton', -label => 'Description', -variable => \$VIEW{'desc'},
                              -command => sub{&UpdateDisplay});
$viewmenu->add('checkbutton', -label => 'Status', -variable => \$VIEW{'status'},
                              -command => sub{&UpdateDisplay});
$viewmenu->add('checkbutton', -label => 'Coupler', -variable => \$VIEW{'couple'},
                              -command => sub{&UpdateDisplay});
$viewmenu->add('separator');
$viewmenu->add('command', -label => 'Select All', -command => sub{&SelectAll; &UpdateDisplay});
$viewmenu->add('command', -label => 'Deselect All', -command => sub{&DeselectAll; &UpdateDisplay});
$viewmenu->add('separator');
$viewmenu->add('command', -label => 'Refresh', -command => sub{&UpdateDisplay});
$viewbut->configure(-menu => $viewmenu);

$filebut->pack(-side => 'left');
$editbut->pack(-side => 'left');
$viewbut->pack(-side => 'left');

#Build the rest of the main window.
$LIST = $listframe->Listbox(-font => 'courier 8', -selectmode => 'extended');
my $xscroll = $listframe->Scrollbar(-orient => 'horizontal', -command => ['xview', $LIST]);
my $yscroll = $listframe->Scrollbar(-orient => 'vertical', -command => ['yview', $LIST]);
$LIST->configure(-xscrollcommand => ['set', $xscroll], -yscrollcommand => ['set', $yscroll]);
$LIST->grid(-row => 0, -column => 0, -sticky => 'news');
$xscroll->grid(-row => 1, -column => 0, -sticky => 'ew');
$yscroll->grid(-row => 0, -column => 1, -sticky => 'ns');
$listframe->gridRowconfigure(0, -weight => 1);
$listframe->gridColumnconfigure(0, -weight => 1);

#Bindings for main window.
$MAIN->protocol('WM_DELETE_WINDOW', sub{&Exit});
$LIST->bind('<Double-Button-1>', sub{&EditObject});

#Handles the print request from the file menu.
my (%P_Info);
sub Print {
   my ($w, $row, $command, $file, $file, $dir, $filter, $ret, $i);

   $P_Info{'ret_val'} = 999;
   if (exists($P_Info{'toplevel'})) {
      $w = $P_Info{'toplevel'};
   } else {
      $w = $P_Info{'toplevel'} = $MAIN->Toplevel;
      $w->withdraw;

      $row = 0;
      $P_Info{'commandlab'} = $w->Label(-text => 'Print Command:', -anchor => 'w');
      $P_Info{'commandlab'}->grid(-row => $row, -column => 0, -sticky => 'w', -padx => 3, -pady => 1);
      $P_Info{'command'} = $w->Entry;
      $P_Info{'command'}->grid(-row => $row, -column => 1, -columnspan => 2, -sticky => 'ew', -padx => 3, -pady => 1);
      $row++;
      $P_Info{'filelab'} = $w->Label(-text => 'Filename:', -anchor => 'w');
      $P_Info{'filelab'}->grid(-row => $row, -column => 0, -sticky => 'w', -padx => 3, -pady => 1);
      $P_Info{'file'} = $w->Entry;
      $P_Info{'file'}->grid(-row => $row, -column => 1, -sticky => 'ew', -padx => 3, -pady => 1);
      $P_Info{'filebut'} = $w->Button(-text => 'Browse', -command => sub{$P_Info{'ret_val'} = 1});
      $P_Info{'filebut'}->grid(-row => $row, -column => 2, -sticky => 'ew', -padx => 3, -pady => 1);
      $row++;
      $w->Label(-text => 'Print Option:', -anchor => 'w')
        ->grid(-row => $row, -column => 0, -sticky => 'w', -padx => 3, -pady => 1);
      $P_Info{'optionbut'} = $w->Optionmenu(-options => ['Printer', 'Text File', 'HTML File'],
                                            -command => sub{$P_Info{'ret_val'} = 2}, -variable => \$P_Info{'option'});
      $P_Info{'optionbut'}->grid(-row => $row, -column => 1, -columnspan => 2, -sticky => 'ew', -padx => 3, -pady => 1);
      $row++;
      $w->Frame(-height => 3, -relief => 'sunken', -bd => 1)
        ->grid(-row => $row, -column => 0, -columnspan => 3, -sticky => 'ew', -padx => 3, -pady => 5);
      $row++;
      $w->Button(-text => 'Cancel', -command => sub{$P_Info{'ret_val'} = -1})
        ->grid(-row => $row, -column => 0, -sticky => 'w', -padx => 3, -pady => 5);
      $w->Button(-text => '  Ok  ', -command => sub{$P_Info{'ret_val'} = 0})
        ->grid(-row => $row, -column => 1, -columnspan => 2, -sticky => 'e', -padx => 3, -pady => 5);

      $w->gridColumnconfigure(1, -weight => 1);
      $w->update;
      $w->minsize($w->reqwidth, $w->reqheight);
      $w->resizable(1, 0);
      $w->title('Print');
      $w->protocol('WM_DELETE_WINDOW', sub{$P_Info{'ret_val'} = -1});

      &PositionWin($w, $MAIN);
      $P_Info{'command'}->insert(0, $P_Info{'printcommand'} || "print");  #Default print command.
     #Lock the appropriate field depending on the setting of print option.
      if ($P_Info{'option'} eq 'Printer') {
         $P_Info{'command'}->configure(-state => 'normal');
         $P_Info{'file'}->configure(-state => 'disabled');
         $P_Info{'filebut'}->configure(-state => 'disabled');
      } else {
         $P_Info{'command'}->configure(-state => 'disabled');
         $P_Info{'file'}->configure(-state => 'normal');
         $P_Info{'filebut'}->configure(-state => 'normal');
      }

     #Init the filebrowsing parameters.
      $P_Info{'printdir'}   = $CURDIR;
      $P_Info{'htmlfilter'} = '*.html';
      $P_Info{'txtfilter'}  = '*.txt';
   }
  
   &LockWin($w, $MAIN);
   while ($P_Info{'ret_val'} == 999) {
      $w->waitVariable(\$P_Info{'ret_val'});
      if ($P_Info{'ret_val'} == 0) {        #Ok
         $command = $P_Info{'command'}->get;
         $file = $P_Info{'file'}->get;
         if (($P_Info{'option'} ne 'Printer') && ($file =~ /^\s*$/)) {
            &ErrorDialog($w, "Enter a filename to write.");
            $P_Info{'ret_val'} = 999;
            next;
         }
         if ($P_Info{'option'} eq 'Printer') {
            if ($command =~ /^\s*$/) {
               &ErrorDialog($w, "Enter a system command for printing.");
               $P_Info{'ret_val'} = 999;
               next;
            }
           #Find a unique filename for temporary writing.
            $i = 0;
            while (++$i) {
               $file = "${CURDIR}/train.tmp.${i}";
               $file =~ s/\/+/\//;
               last unless (-e $file);
            }
            unless (&PrintTextFile($w, $file)) {
               if (&PrintCmd($w, $command, $file)) {
                  $P_Info{'ret_val'} = 999;
               }
               unlink($file);  #Cleanup
            }
         } elsif ($P_Info{'option'} eq 'Text File') {
            if (&PrintTextFile($w, $file)) {
               $P_Info{'ret_val'} = 999;
            }
         } elsif (&PrintHTMLFile($w, $file)) {
            $P_Info{'ret_val'} = 999;
         }
      } elsif ($P_Info{'ret_val'} == 1) {   #File Browse
         $P_Info{'ret_val'} = 999;
         if ($P_Info{'option'} eq 'HTML File') {
            $filter = $P_Info{'htmlfilter'};
         } else {
            $filter = $P_Info{'txtfilter'};
         }
         ($ret, $file, $dir, $filter) = &FileBrowse($w, $P_Info{'printfile'}, $P_Info{'printdir'}, $filter);
         next if ($ret);
         $P_Info{'printfile'} = $file;
         $P_Info{'printdir'} = $dir;
         if ($P_Info{'option'} eq 'HTML File') {
            $P_Info{'htmlfilter'} = $filter;
         } else {
            $P_Info{'txtfilter'} = $filter;
         }
         $file = $dir.'/'.$file;
         $file =~ s/\/+/\//g;
         $P_Info{'file'}->delete(0, 'end');
         $P_Info{'file'}->insert(0, $file);
      } elsif ($P_Info{'ret_val'} == 2) {   #Print Option change
        #Lock the appropriate field depending on the setting of print option.
         if ($P_Info{'option'} eq 'Printer') {
            $P_Info{'command'}->configure(-state => 'normal');
            $P_Info{'file'}->configure(-state => 'disabled');
            $P_Info{'filebut'}->configure(-state => 'disabled');
         } else {
            $P_Info{'command'}->configure(-state => 'disabled');
            $P_Info{'file'}->configure(-state => 'normal');
            $P_Info{'filebut'}->configure(-state => 'normal');
         }
         $P_Info{'ret_val'} = 999;
      }
   }

   &UnlockWin($w, $MAIN);

   if (($P_Info{'ret_val'} == 0) && ($P_Info{'option'} ne 'Printer')) {
      &InfoDialog($MAIN, "Wrote database file: $file");
   }
   return $P_Info{'ret_val'};
} #end Print

#Executes the print command.  Returns non-zero if any failures.
#Args: Parent window, command, filename
sub PrintCmd {
   my ($parent, $command, $file) = @_;
   my ($rc);

  #Since we are running on win32, change the directory separators to backslashes!  This will not work on UNIX!  I am too
  #lazy to code some system cases here.
   $file =~ s/\//\\/g;

   if ($rc = system($command $file)) {
      &ErrorDialog("Cannot exec the command: $command $file");
   }
   return $rc
} #end PrintCmd

#Select all view options.
sub SelectAll {
   my ($key);

   foreach $key (keys(%VIEW)) {
      $VIEW{$key} = 1;
   }
} #end SelectAll

#Deselect all view options.
sub DeselectAll {
   my ($key);

   foreach $key (keys(%VIEW)) {
      $VIEW{$key} = 0;
   }
} #end DeselectAll

#Deletes objects from the database.
sub DeleteObject {
   my (@selected, $i, $item, $string, $flag);

   @selected = $LIST->curselection;
   unless (@selected) {
      &ErrorDialog($MAIN, "Select an object to delete.");
      return;
   }

  #Convert the selected indices into object keys.
   for ($i = 0; $i <= $#selected; $i++) {
      $item = $LIST->get($selected[$i]);
      $item =~ /^\s*(\S+)\s+(\S+)/;
      $selected[$i] = "${1}_${2}";
   }

   if ($#selected == 0) {
      $string = "Confirm deletion of object:";
   } else {
      $string = "Confirm deletion of objects:";
   }
   $flag = 1;
   foreach $item (@selected) {
      if ($flag) {
         $string .= " $OBJECTS{$item}{'name'} $OBJECTS{$item}{'number'}";
         $flag = 0;
      } else {
         $string .= ", $OBJECTS{$item}{'name'} $OBJECTS{$item}{'number'}";
      }
   }

   return if (&WarningDialog($MAIN, $string));
   foreach $item (@selected) {
      delete($OBJECTS{$item});
   }
   &UpdateDisplay;
} #end DeleteObject

#Adjusts the sort order stack.  Adjusts it so that the first element in the list is the currently selected
#value of $SORT
sub AdjustSortStack {
   my (@tmp, $i);

   @tmp = @SORTSTACK;
   @SORTSTACK = ();
   $SORTSTACK[0] = $SORT;
   for ($i = 0; $i <= $#tmp; $i++) {
      if ($tmp[$i] ne $SORT) {
         push(@SORTSTACK, $tmp[$i]);
      }
   }
} #end AdjustSortStack

#Handles creation of a new database.  Returns zero if successful, non-zero if user cancels.
sub New {
   my ($key);

   if (($MODCOUNT) && (&WarningDialog($MAIN, "Loaded database has not been saved.  Discard changes?"))) {
      return -1;
   } 
  #Clear all data pertinent to currently loaded database.
   $CURFILE = '';
   $MODCOUNT = 0;
   foreach $key (keys(%OBJECTS)) {
      delete($OBJECTS{$key});
   }
   &UpdateDisplay;

   return 0;
} #end New

#Handles the exit call.
sub Exit {
   if (($MODCOUNT > 0) && (&WarningDialog($MAIN, "Loaded database has not been saved, exit anyway?"))) {
      return;
   }
   exit 0;
} #end Exit

#Edits an object.
sub EditObject {
   my ($line, $obj, @selected);

   @selected = $LIST->curselection;
   if (@selected == 0) {
      &ErrorDialog($MAIN, "Select an object to edit.");
      return;
   }
   if (@selected > 1) {
      &ErrorDialog($MAIN, "Select a single object to edit.");
      return;
   }
   $line = $LIST->get($selected[0]);
   $line =~ /^\s*(\S+)\s+(\S+)/;
   $obj = "${1}_${2}";
   unless (&DataEntry($MAIN, "Edit Object: $OBJECTS{$obj}{'name'} $OBJECTS{$obj}{'number'}", $obj)) {
      &UpdateDisplay;
   }
} #end EditObject

#Copies an object.
sub CopyObject {
   my ($line, $obj, @selected);

   @selected = $LIST->curselection;
   if (@selected == 0) {
      &ErrorDialog($MAIN, "Select an object to copy.");
      return;
   }
   if (@selected > 1) {
      &ErrorDialog($MAIN, "Select a single object to copy.");
      return;
   }
   $line = $LIST->get($selected[0]);
   $line =~ /^\s*(\S+)\s+(\S+)/;
   $obj = "${1}_${2}";
   unless(&CopyDialog($MAIN, $obj)) {
      &UpdateDisplay;
   }

} #end CopyObject

#Creates a new object.
#Arg: Parent window
sub NewObject {
   my ($parent) = @_;

   unless (&DataEntry($parent, 'New Object')) {
      &UpdateDisplay;   
   }
} #end NewObject

#Creates the form for entering an objects information.
#Args: Parent window, Window title, Object key (optional)
my %DE_Info;
sub DataEntry {
   my ($parent, $title, $object) = @_;
   my ($w, $row, $f, $entry, @efields, @optionbuts, $ret_val, %info, $key);

   @efields = qw(name number class desc mfgr catnum couple length weight);
   @optionbuts = qw(name class desc mfgr couple);
   $ret_val = 999;
   
   if (exists($DE_Info{'toplevel'})) {
      $w = $DE_Info{'toplevel'};
   } else {
      $w = $DE_Info{'toplevel'} = $parent->Toplevel;
      $w->withdraw;

      foreach $entry (@optionbuts) {   #Initialize the option button lists
         @{$DE_Info{"${entry}list"}} = ();
         foreach $key (keys(%OBJECTS)) {
            if (&Occurs($OBJECTS{$key}{$entry}, $DE_Info{"${entry}list"}) < 0) {
                push(@{$DE_Info{"${entry}list"}}, $OBJECTS{$key}{$entry});
            }
         }
      }
      $row = 0;
      $DE_Info{'namebut'} = $w->Menubutton(-text => 'Road Name', -anchor => 'w', -relief => 'raised');
      $DE_Info{'name'} = $w->Entry;
      $DE_Info{'namebut'}->grid(-row => $row, -column => 0, -sticky => 'ew', -padx => 3, -pady => 1);
      $DE_Info{'name'}->grid(-row => $row, -column => 1, -sticky => 'ew', -padx => 3, -pady => 1);
      $row++;
      $w->Label(-text => 'Road Number', -anchor => 'w')
        ->grid(-row => $row, -column => 0, -sticky => 'ew', -padx => 3, -pady => 1);
      $DE_Info{'number'} = $w->Entry;
      $DE_Info{'number'}->grid(-row => $row, -column => 1, -sticky => 'ew', -padx => 3, -pady => 1);
      $row++;
      $DE_Info{'classbut'} = $w->Menubutton(-text => 'Class', -anchor => 'w', -relief => 'raised');
      $DE_Info{'class'} = $w->Entry;
      $DE_Info{'classbut'}->grid(-row => $row, -column => 0, -sticky => 'ew', -padx => 3, -pady => 1);
      $DE_Info{'class'}->grid(-row => $row, -column => 1, -sticky => 'ew', -padx => 3, -pady => 1);
      $row++;
      $DE_Info{'descbut'} = $w->Menubutton(-text => 'Description', -anchor => 'w', -relief => 'raised');
      $DE_Info{'desc'} = $w->Entry;
      $DE_Info{'descbut'}->grid(-row => $row, -column => 0, -sticky => 'ew', -padx => 3, -pady => 1);
      $DE_Info{'desc'}->grid(-row => $row, -column => 1, -sticky => 'ew', -padx => 3, -pady => 1);
      $row++;
      $DE_Info{'mfgrbut'} = $w->Menubutton(-text => 'Manufacturer', -anchor => 'w', -relief => 'raised');
      $DE_Info{'mfgr'} = $w->Entry;
      $DE_Info{'mfgrbut'}->grid(-row => $row, -column => 0, -sticky => 'ew', -padx => 3, -pady => 1);
      $DE_Info{'mfgr'}->grid(-row => $row, -column => 1, -sticky => 'ew', -padx => 3, -pady => 1);
      $row++;
      $w->Label(-text => 'Catalog Number', -anchor => 'w')
        ->grid(-row => $row, -column => 0, -sticky => 'ew', -padx => 3, -pady => 1);
      $DE_Info{'catnum'} = $w->Entry;
      $DE_Info{'catnum'}->grid(-row => $row, -column => 1, -sticky => 'ew', -padx => 3, -pady => 1);
      $row++;
      $DE_Info{'couplebut'} = $w->Menubutton(-text => 'Coupler', -anchor => 'w', -relief => 'raised');
      $DE_Info{'couple'} = $w->Entry;
      $DE_Info{'couplebut'}->grid(-row => $row, -column => 0, -sticky => 'ew', -padx => 3, -pady => 1);
      $DE_Info{'couple'}->grid(-row => $row, -column => 1, -sticky => 'ew', -padx => 3, -pady => 1);
      $row++;
      $w->Label(-text => 'Status', -anchor => 'w')
        ->grid(-row => $row, -column => 0, -sticky => 'ew', -padx => 3, -pady => 1);
      $DE_Info{'statusmenu'} = $w->Optionmenu(-variable => \$DE_Info{'status'},
                                              -options => ['Ready', 'Needs Repair', 'Under Construction']);
      $DE_Info{'statusmenu'}->grid(-row => $row, -column => 1, -sticky => 'ew', -padx => 3, -pady => 1);
      $row++;
      $w->Label(-text => 'Length', -anchor => 'w')
        ->grid(-row => $row, -column => 0, -sticky => 'ew', -padx => 3, -pady => 1);
      $DE_Info{'length'} = $w->Entry;
      $DE_Info{'length'}->grid(-row => $row, -column => 1, -sticky => 'ew', -padx => 3, -pady => 1);
      $row++;
      $w->Label(-text => 'Weight', -anchor => 'w')
        ->grid(-row => $row, -column => 0, -sticky => 'ew', -padx => 3, -pady => 1);
      $DE_Info{'weight'} = $w->Entry;
      $DE_Info{'weight'}->grid(-row => $row, -column => 1, -sticky => 'ew', -padx => 3, -pady => 1);
      $row++;
      $w->Frame(-height => 3, -relief => 'sunken', -bd => 1)
        ->grid(-row => $row, -column => 0, -columnspan => 2, -sticky => 'ew', -padx => 3, -pady => 5);
      $row++;
      $w->Label(-text => 'Comments:', -anchor => 'w')
        ->grid(-row => $row, -column => 0, -sticky => 'ew', -padx => 3, -pady => 1);
      $row++;
      $f = $w->Frame;
      $f->grid(-row => $row, -column => 0, -columnspan => 2, -sticky => 'news', -padx => 3);
      $DE_Info{'comments'} = $f->Text(-height => 4, -width => 40, -wrap => 'word');
      $DE_Info{'yscroll'} = $f->Scrollbar(-orient => 'vertical', -command => ['yview', $DE_Info{'comments'}]);
      $DE_Info{'comments'}->configure(-yscrollcommand => ['set', $DE_Info{'yscroll'}]);
      $DE_Info{'comments'}->grid(-row => 0, -column => 0, -sticky => 'news');
      $DE_Info{'yscroll'}->grid(-row => 0, -column => 1, -sticky => 'ns');
      $row++;
      $DE_Info{'cancel'} = $w->Button(-text => 'Cancel');
      $DE_Info{'ok'} = $w->Button(-text => '  Ok  ');
      $DE_Info{'cancel'}->grid(-row => $row, -column => 0, -sticky => 'w', -padx => 3, -pady => 5);
      $DE_Info{'ok'}->grid(-row => $row, -column => 1, -sticky => 'e', -padx => 3, -pady => 5);

      foreach $entry (@optionbuts) {   #Initialize the option buttons.
         $DE_Info{"${entry}menu"} = $DE_Info{"${entry}but"}->Menu(-tearoff => 0);
         foreach $key (@{$DE_Info{"${entry}list"}}) {
            $DE_Info{"${entry}menu"}->add('command', -label => $key,
                                          -command => sub{$DE_Info{$entry}->delete(0, 'end');
                                                          $DE_Info{$entry}->insert(0, $key)});
         }
         $DE_Info{"${entry}but"}->configure(-menu => $DE_Info{"${entry}menu"});
      }
      $w->resizable(0, 0);
      &PositionWin($w, $parent);
   }
   $w->title($title);

   $DE_Info{'name'}->configure(-state => 'normal');
   $DE_Info{'namebut'}->configure(-state => 'normal');
   $DE_Info{'number'}->configure(-state => 'normal');

  #Fill all entry field data...
   foreach $entry (@efields) {
      $DE_Info{$entry}->delete(0, 'end');
      if ($object) {
         $DE_Info{$entry}->insert(0, $OBJECTS{$object}{$entry});
      }
   }
   $DE_Info{'comments'}->delete('0.0', 'end');
   if ($object) {
      $DE_Info{'status'} = $OBJECTS{$object}{'status'};  
      $DE_Info{'comments'}->insert('0.0', $OBJECTS{$object}{'comments'});
   }

   $DE_Info{'ok'}->configure(-command => sub{$ret_val = 0});
   $DE_Info{'cancel'}->configure(-command => sub{$ret_val = -1});
   $w->protocol("WM_DELETE_WINDOW", sub{$ret_val = -1});

  #If in edit mode, lock the road name and number.
   if ($object) {
      $DE_Info{'name'}->configure(-state => 'disabled');
      $DE_Info{'namebut'}->configure(-state => 'disabled');
      $DE_Info{'number'}->configure(-state => 'disabled');
   }

   &LockWin($w, $parent);
   
   while ($ret_val == 999) {
      $w->waitVariable(\$ret_val);
      if ($ret_val == 0) {
         foreach $entry (@efields) {
            $info{$entry} = $DE_Info{$entry}->get;
         }
        #Verify that road name/number is unique.
         $key = "$info{'name'}_$info{'number'}";
         if (($info{'name'} =~ /^\s*$/) || ($info{'number'} =~ /^\s*$/)) {
            &ErrorDialog($w, "Road name and road number are required information.");
            $ret_val = 999;
         } elsif (exists($OBJECTS{$key}) && !($object)) {
            &ErrorDialog($w, "Please select a unique road name/number.");
            $ret_val = 999;
         } else {
            foreach $entry (@optionbuts) {   #Add this entry to the option buttons if unique.
               next if ($info{$entry} =~ /^\s*$/);
               if (&Occurs($info{$entry}, $DE_Info{"${entry}list"}) < 0) {
                  $DE_Info{"${entry}menu"}->add('command', -label => $info{$entry},
                                                -command => sub{$DE_Info{$entry}->delete(0, 'end');
                                                                $DE_Info{$entry}->insert(0, $info{$entry})});
                  push(@{$DE_Info{"${entry}list"}}, $info{$entry});
               }
            }
            foreach $entry (@efields) {
               $OBJECTS{$key}{$entry} = $info{$entry};
            }
            $OBJECTS{$key}{'status'} = $DE_Info{'status'};
            $OBJECTS{$key}{'comments'} = $DE_Info{'comments'}->get('0.0', 'end');
            chop($OBJECTS{$key}{'comments'});   #Remove the trailing newline.
            $MODCOUNT++;
         }
      }
   }

   &UnlockWin($w, $parent);
   return $ret_val;
} #end DataEntry

#Copy dialog for new key entry.  Returns zero if Ok, non-zero otherwise.
#Args: Parent window, object
my (%CD_Info);
sub CopyDialog {
   my ($parent, $obj) = @_;
   my ($w, $row, $menu1, $menu2, $item, $name, $number, $key, $newobj, @list1, @list2, @efields, $mfgr, $catnum);

   $CD_Info{'ret_val'} = 999;
   @efields = qw(name number mfgr catnum);

   if (exists($CD_Info{'toplevel'})) {
      $w = $CD_Info{'toplevel'};
   } else {
      $w = $CD_Info{'toplevel'} = $parent->Toplevel;
      $w->withdraw;
      $row = 0;
      $w->Label(-text => 'Enter new data...', -anchor => 'w')
        ->grid(-row => $row, -column => 0, -columnspan => 2, -sticky => 'ew', -padx => 5, -pady => 2);
      $row++;
      $CD_Info{'namebut'} = $w->Menubutton(-text => 'Road Name', -anchor => 'w', -relief => 'raised');
      $CD_Info{'name'} = $w->Entry;
      $CD_Info{'namebut'}->grid(-row => $row, -column => 0, -sticky => 'ew', -padx => 3, -pady => 1);
      $CD_Info{'name'}->grid(-row => $row, -column => 1, -sticky => 'ew', -padx => 3, -pady => 1);
      $row++;
      $w->Label(-text => 'Road Number', -anchor => 'w')
        ->grid(-row => $row, -column => 0, -sticky => 'ew', -padx => 3, -pady => 1);
      $CD_Info{'number'} = $w->Entry;
      $CD_Info{'number'}->grid(-row => $row, -column => 1, -sticky => 'ew', -padx => 3, -pady => 1);
      $row++;
      $CD_Info{'mfgrbut'} = $w->Menubutton(-text => 'Manufacturer', -anchor => 'w', -relief => 'raised');
      $CD_Info{'mfgr'} = $w->Entry;
      $CD_Info{'mfgrbut'}->grid(-row => $row, -column => 0, -sticky => 'ew', -padx => 3, -pady => 1);
      $CD_Info{'mfgr'}->grid(-row => $row, -column => 1, -sticky => 'ew', -padx => 3, -pady => 1);
      $row++;
      $w->Label(-text => 'Catalog Number', -anchor => 'w')
        ->grid(-row => $row, -column => 0, -sticky => 'ew', -padx => 3, -pady => 1);
      $CD_Info{'catnum'} = $w->Entry;
      $CD_Info{'catnum'}->grid(-row => $row, -column => 1, -sticky => 'ew', -padx => 3, -pady => 1);
      $row++;
      $w->Frame(-height => 3, -relief => 'sunken', -bd => 1)
        ->grid(-row => $row, -column => 0, -columnspan => 2, -sticky => 'ew', -padx => 3, -pady => 5);
      $row++;
      $CD_Info{'cancel'} = $w->Button(-text => 'Cancel', -command => sub{$CD_Info{'ret_val'} = -1});
      $CD_Info{'ok'} = $w->Button(-text => '  Ok  ', -command => sub{$CD_Info{'ret_val'} = 0});
      $CD_Info{'cancel'}->grid(-row => $row, -column => 0, -sticky => 'w', -padx => 3, -pady => 5);
      $CD_Info{'ok'}->grid(-row => $row, -column => 1, -sticky => 'e', -padx => 3, -pady => 5);

      $w->resizable(0, 0);
      $w->protocol('WM_DELETE_WINDOW', sub{$CD_Info{'ret_val'} = -1});
      &PositionWin($w, $parent);
   }
   $w->title("Copy object: $OBJECTS{$obj}{'name'} $OBJECTS{$obj}{'number'}");

   foreach $item (@efields) {
      $CD_Info{$item}->delete(0, 'end');
      $CD_Info{$item}->insert(0, $OBJECTS{$obj}{$item});
   }

  #Initialize the name and manufacturer menubuttons.
   $menu1 = $CD_Info{'namebut'}->Menu(-tearoff => 0);
   $menu2 = $CD_Info{'mfgrbut'}->Menu(-tearoff => 0);
   @list1 = @list2 = ();
   foreach $key (keys(%OBJECTS)) {
      my $name = $OBJECTS{$key}{'name'};
      my $mfgr = $OBJECTS{$key}{'mfgr'};
      if (&Occurs($name, \@list1) < 0) {
         push(@list1, $name);
         $menu1->add('command', -label => $name, -command => sub{$CD_Info{'name'}->delete(0, 'end');
                                                                 $CD_Info{'name'}->insert(0, $name)});
      }
      if (&Occurs($mfgr, \@list2) < 0) {
         push(@list2, $mfgr);
         $menu2->add('command', -label => $mfgr, -command => sub{$CD_Info{'mfgr'}->delete(0, 'end');
                                                                 $CD_Info{'mfgr'}->insert(0, $mfgr)});
      }
   }
   $CD_Info{'namebut'}->configure(-menu => $menu1);
   $CD_Info{'mfgrbut'}->configure(-menu => $menu2);

   &LockWin($w, $parent);
   while ($CD_Info{'ret_val'} == 999) {
      $w->waitVariable(\$CD_Info{'ret_val'});
      if ($CD_Info{'ret_val'} == 0) {
         $name   = $CD_Info{'name'}->get;
         $number = $CD_Info{'number'}->get;
         $mfgr   = $CD_Info{'mfgr'}->get;
         $catnum = $CD_Info{'catnum'}->get;
         $newobj = "${name}_${number}";
         if (($name =~ /^\s*$/) || ($number =~ /^\s*$/)) {
            &ErrorDialog($w, "Select a roadname and road number for the new object.");
            $CD_Info{'ret_val'} = 999;
         } elsif (exists($OBJECTS{$newobj})) {
            &ErrorDialog($w, "$name $number exists.  Select a unique road name/number.");
            $CD_Info{'ret_val'} = 999;
         } else {
           #Copy the object data.
            foreach $key (keys(%{$OBJECTS{$obj}})) {
               $OBJECTS{$newobj}{$key} = $OBJECTS{$obj}{$key}
            }
            $OBJECTS{$newobj}{'name'} = $name;
            $OBJECTS{$newobj}{'number'} = $number;
            $OBJECTS{$newobj}{'mfgr'} = $mfgr;
            $OBJECTS{$newobj}{'catnum'} = $catnum;

           #Update the roadname list if it is unique.  Yes this is a hack.
            if (exists($DE_Info{'toplevel'}) && (&Occurs($name, \@{$DE_Info{'namelist'}}) < 0)) {
               $DE_Info{'namemenu'}->add('command', -label => $name,
                                                    -command => sub{$DE_Info{'name'}->delete(0, 'end');
                                                                    $DE_Info{'name'}->insert(0, $name)});
               push(@{$DE_Info{'namelist'}}, $name);
            }
           #Update the manufacturer list if it is unique.  Yes this is another hack!
            if (exists($DE_Info{'toplevel'}) && (&Occurs($mfgr, \@{$DE_Info{'mfgrlist'}}) < 0)) {
               $DE_Info{'mfgrmenu'}->add('command', -label => $mfgr,
                                                    -command => sub{$DE_Info{'mfgr'}->delete(0, 'end');
                                                                    $DE_Info{'mfgr'}->insert(0, $mfgr)});
               push(@{$DE_Info{'mfgrlist'}}, $mfgr);
            }
            $MODCOUNT++;
         }
      }
   }

   &UnlockWin($w, $parent);
   return $CD_Info{'ret_val'};
} #end CopyDialog

#Returns the index of the first occurence of an element in an array.  Returns -1 if the element does not exist.
#Args: element, ref to array
sub Occurs {
   my ($element, $rarray) = @_;
   my ($i);

   $i = 0;
   foreach (@$rarray) {
      if ($element eq $_) {
         return $i
      }
      $i++;
   }
   return -1;
} #end Occurs

#Prints to an html file.  Returns non-zero if failure, zero otherwise.
#Args: parent window, filename
sub PrintHTMLFile {
   my ($parent, $file, @keys, $key, @headers, $cols, $header, $viewopt) = @_;

   if ((-e $file) && &WarningDialog($parent, "$file exists.  Overwrite?")) {
      return 1;
   }
   unless (open(OUT, ">$file")) {
      &ErrorDialog($parent, "Cannot write: $file");
      return -1;
   }
   @keys = &GetSortedKeys;
  #Get the headers.
   @headers = ('Road Name', 'Road Number');
   push (@headers, 'Manufacturer', 'Catalog Number') if ($VIEW{'mfgr'});
   push (@headers, 'Class') if ($VIEW{'class'});
   push (@headers, 'Description') if ($VIEW{'desc'});
   push (@headers, 'Status') if ($VIEW{'status'});
   push (@headers, 'Coupler Type') if ($VIEW{'couple'});
   $cols = @headers;

   print OUT "<html><head>\n";
   print OUT "<title>Rolling stock database: $CURFILE</title>\n";
   print OUT "</head>\n";
   print OUT "<body>\n";
   print OUT "\n";
   print OUT "<table cols=$cols width=\"100%\" border=1>\n";
   print OUT "  <tr>\n";
   foreach $header (@headers) {
      print OUT "    <th>$header\n";
   }
   print OUT "  </tr>\n";
   print OUT "\n";

   foreach $key (@keys) {
      print OUT "  <tr align=\"left\">\n";
      print OUT "    <td>$OBJECTS{$key}{'name'}\n";
      print OUT "    <td>$OBJECTS{$key}{'number'}\n";
      foreach $viewopt (qw(mfgr class desc status couple)) {
         if ($VIEW{$viewopt}) {
            if ($viewopt eq 'mfgr') {  #Manufacturer and catalog number go together.
               print OUT "    <td>$OBJECTS{$key}{'mfgr'}\n";
               print OUT "    <td>$OBJECTS{$key}{'catnum'}\n";
            } else {
               print OUT "    <td>$OBJECTS{$key}{$viewopt}\n";
            }
         }
      }
      print OUT "  </tr>\n";
      print OUT "\n";
   }      
   print OUT "</table>\n";

   print OUT "</body></html>\n";

   close(OUT);
   return 0;
} #end PrintHTMLFile

#Prints to a text file.  Returns non-zero if failure, zero otherwise.
#Arg: parent window, filename
sub PrintTextFile {
   my ($parent, $file) = @_;
   my ($string);

   if ((-e $file) && &WarningDialog($parent, "$file exists.  Overwrite?")) {
      return 1;
   }
   unless (open(OUT, ">$file")) {
      &ErrorDialog($parent, "Cannot write: $file");
      return -1;
   }
   foreach $string (&GetOutputStrings) {
      print OUT "$string\n";
   }

   close(OUT);
   return 0;
} #end PrintTextFile

#Returns a list of strings to be displayed for the current view options.
sub GetOutputStrings {
   my (@keys, $key, $viewopt, $len, $string, @strings, %fields);

   @keys = &GetSortedKeys;
  #Double pass through the data here.  Once to find the longest field required, and again to display the data.
   foreach $key (@keys) {
      foreach $viewopt (qw(name number mfgr catnum class desc status couple)) {
         $len = length($OBJECTS{$key}{$viewopt});
         if ($len > $fields{$viewopt}) {
            $fields{$viewopt} = $len;
         }
      }
   }
   foreach $key (@keys) {
      $string = sprintf "%-$fields{'name'}s %-$fields{'number'}d", $OBJECTS{$key}{'name'}, $OBJECTS{$key}{'number'};
      foreach $viewopt (qw(mfgr class desc status couple)) {
         if ($VIEW{$viewopt}) {
            if ($viewopt eq 'mfgr') {  #Manufacturer and catalog number go together.
               $string .= sprintf "  %-$fields{'mfgr'}s %-$fields{'catnum'}s", $OBJECTS{$key}{'mfgr'},
                                                                               $OBJECTS{$key}{'catnum'};
            } else {
               $string .= sprintf "  %-$fields{$viewopt}s", $OBJECTS{$key}{$viewopt};
            }
         }
      }
      push(@strings, $string);
   }      

   return @strings;
} #end GetOutputStrings

#Updates the display based on the sort key and the view options.
sub UpdateDisplay {
   my ($string);

   $LIST->delete(0, 'end');
   foreach $string (&GetOutputStrings) {
      $LIST->insert('end', $string);
   }
} #end UpdateDisplay

#Returns a list of sorted keys for the current sort stack.
sub GetSortedKeys {
   my (@list);

   @list = sort ComplexSort keys(%OBJECTS); 
   return @list;
} #end GetSortedKeys

#Sorting routine for the complex object sorting algorithm.
sub ComplexSort {
   my ($i, $j, $ret_val, @catnumA, @catnumB);

   $ret_val = 0;   #Default to two items equal (impossible)!
   for ($i = 0; $i <= $#SORTSTACK; $i++) {
      if ($SORTSTACK[$i] eq 'number') {   #This case is a double sort, all others are single.
         $ret_val = $OBJECTS{$a}{'name'} cmp $OBJECTS{$b}{'name'};
         unless ($ret_val) {
            $ret_val = $OBJECTS{$a}{'number'} <=> $OBJECTS{$b}{'number'};
         }
      } elsif ($SORTSTACK[$i] eq 'mfgr') {  #This case is also a double sort.  I lied earlier.
         $ret_val = $OBJECTS{$a}{'mfgr'} cmp $OBJECTS{$b}{'mfgr'};
         unless ($ret_val) {
           #Catalog numbers often have two parts, split up by any non-digit.
            @catnumA = split(/\D+/, $OBJECTS{$a}{'catnum'});
            @catnumB = split(/\D+/, $OBJECTS{$b}{'catnum'});
            for ($j = 0; ($j <= $#catnumA) || ($j <= $#catnumB); $j++) {
               $ret_val = $catnumA[$j] <=> $catnumB[$j];
               last if ($ret_val);
            }
         }
      } else {
         $ret_val = $OBJECTS{$a}{$SORTSTACK[$i]} cmp $OBJECTS{$b}{$SORTSTACK[$i]};
      }
      last if ($ret_val);  #Break out of the loop once we encounter a difference.
   }

   if ($SORTDIR) {   #Reverse sort, reverse the sign.
      $ret_val = -$ret_val;
   }
   return $ret_val;
} #end ComplexSort

#Handles the Save command from the file menu.
sub Save {
   if ($CURFILE) {
      &WriteTDB($CURFILE);
      &InfoDialog($MAIN, "Saved database: $CURFILE");
   } else {
      &SaveAs;
   }
} #end Save

#Handles the Save As command from the file menu.
my ($SaveFilter);
$SaveFilter = '*.tdb';
sub SaveAs {
   my ($ret_val, $file, $dir, $filter);

   if ($CURFILE) {
      $file = $CURFILE
   } else {
      $file = '';
   }
   while (1 == 1) {
      ($ret_val, $file, $dir, $filter) = &FileBrowse($MAIN, $file, $CURDIR, $SaveFilter, 'Save Current Database');
      return if ($ret_val);
      chdir($dir);
      $SaveFilter = $filter;
      if (((-e $file) && !(&WarningDialog($MAIN, "$file exists. Overwrite?"))) || !(-e $file)) {
         &WriteTDB($file);
         $CURDIR = $dir;
         $CURFILE = $file;
         &InfoDialog($MAIN, "Saved database: $CURFILE");
         last;
      } 
      chdir($CURDIR);
   }
} #end SaveAs

#Handles the Open command from the file menu.
my ($OpenFilter);
$OpenFilter = '*.tdb';
sub Open {
   my ($ret_val, $file, $dir, $filter, $selection);

   while (1 == 1) {
      ($ret_val, $file, $dir, $filter) = &FileBrowse($MAIN, $file, $CURDIR, $OpenFilter, 'Open Database');
      return if ($ret_val);
      chdir($dir);
      $OpenFilter = $filter;
      if (-e $file) {
         next if &New;
         &ReadTDB($file);
         last;
      } else {
         $selection = $dir/$file;
         $selection =~ s/\/+/\//g;  #Replace any multiple slashes in the path with single slashes.
         &ErrorDialog($MAIN, "File: $dir/$file does not exist.");
      }
      chdir($CURDIR);
   }
} #end Open

#Puts up a file browser window for selecting files and directories.  If cancelled, other data may not be relied
#upon.
#Returns a list: Return Value (0 if Ok, -1 if Cancel), filename, directory path, file filter
#Args: Parent window, initial filename, initial directory path, initial filter, window title
my (%FB_Info);
sub FileBrowse {
   my ($parent, $file, $dir, $filter, $title) = @_;
   my ($w, $f1, $f2, $f3, $row, $selection);

   $FB_Info{'ret_val'} = 999;

   if (exists($FB_Info{'toplevel'})) {
      $w = $FB_Info{'toplevel'};
   } else {
      $w = $FB_Info{'toplevel'} = $parent->Toplevel;
      $w->withdraw;

      $f1 = $w->Frame;
      $f2 = $w->Frame;
      $f3 = $w->Frame;
      $f1->pack(-side => 'top', -fill => 'both', -expand => 1);
      $f2->pack(-side => 'top', -fill => 'x');
      $w->Frame(-height => 3, -relief => 'sunken', -bd => 1)
        ->pack(-side => 'top', -fill => 'x', -padx => 3, -pady => 5);
      $f3->pack(-side => 'bottom', -fill => 'x');

     #Browser frame...
      $row = 0;
      $f1->Label(-text => 'Directories:', -width => 12, -anchor => 'w')
         ->grid(-row => $row, -column => 0, -sticky => 'w');
      $f1->Frame(-width => 5)->grid(-row => $row, -column => 3);
      $f1->Label(-text => 'Files:', -width => 12, -anchor => 'w')
         ->grid(-row => $row, -column => 4, -sticky => 'w');
      $row++;
      $FB_Info{'dirlist'} = $f1->Listbox;
      $FB_Info{'dirlist'}->grid(-row => $row, -column => 0, -columnspan => 2, -sticky => 'news');
      $FB_Info{'diryscroll'} = $f1->Scrollbar(-orient => 'vertical',
                                              -command => ['yview', $FB_Info{'dirlist'}]);
      $FB_Info{'diryscroll'}->grid(-row =>$row, -column => 2, -sticky => 'ns');
      $FB_Info{'filelist'} = $f1->Listbox;
      $FB_Info{'filelist'}->grid(-row => $row, -column => 4, -columnspan => 2, -sticky => 'news');
      $FB_Info{'fileyscroll'} = $f1->Scrollbar(-orient => 'vertical',
                                               -command => ['yview', $FB_Info{'filelist'}]);
      $FB_Info{'fileyscroll'}->grid(-row => $row, -column => 6, -sticky => 'ns');
      $f1->gridRowconfigure($row, -weight => 1);
      $f1->gridColumnconfigure(1, -weight => 1);
      $f1->gridColumnconfigure(5, -weight => 1);
      $row++;
      $FB_Info{'dirxscroll'} = $f1->Scrollbar(-orient => 'horizontal',
                                              -command => ['xview', $FB_Info{'dirlist'}]);
      $FB_Info{'dirxscroll'}->grid(-row => $row, -column => 0, -columnspan => 2, -sticky => 'ew');
      $FB_Info{'filexscroll'} = $f1->Scrollbar(-orient => 'horizontal',
                                               -command => ['xview', $FB_Info{'filelist'}]);
      $FB_Info{'filexscroll'}->grid(-row => $row, -column => 4, -columnspan => 2, -sticky => 'ew');
      $FB_Info{'dirlist'}->configure(-xscrollcommand => ['set', $FB_Info{'dirxscroll'}],
                                     -yscrollcommand => ['set', $FB_Info{'diryscroll'}]);
      $FB_Info{'filelist'}->configure(-xscrollcommand => ['set', $FB_Info{'filexscroll'}],
                                      -yscrollcommand => ['set', $FB_Info{'fileyscroll'}]);

     #Entry field frame...
      $row = 0;
      $f2->Frame(-height => 3)->grid(-row => $row, -column => 0);
      $row++;
      $f2->Label(-text => 'File:')
         ->grid(-row => $row, -column => 0, -sticky => 'w');
      $FB_Info{'file'} = $f2->Entry;
      $FB_Info{'file'}->grid(-row => $row, -column => 1, -columnspan => 2, -sticky => 'ew', -pady => 3);
      $row++;
      $f2->Label(-text => 'Directory:')
         ->grid(-row => $row, -column => 0, -sticky => 'w');
      $FB_Info{'dir'} = $f2->Entry;
      $FB_Info{'dir'}->grid(-row => $row, -column => 1, -columnspan => 2, -sticky => 'ew', -pady => 3);
      $row++;
      $f2->Label(-text => 'Filter:')
         ->grid(-row => $row, -column => 0, -sticky => 'w');
      $FB_Info{'filter'} = $f2->Entry;
      $FB_Info{'filter'}->grid(-row => $row, -column => 1, -sticky => 'ew', -pady => 2);
      $FB_Info{'filterbut'} = $f2->Button(-text => 'Apply', -command => sub{$FB_Info{'ret_val'} = 1});
      $FB_Info{'filterbut'}->grid(-row => $row, -column => 2, -padx => 3);

      $f2->gridColumnconfigure(1, -weight => 1);

     #Button frame...
      $FB_Info{'ok'} = $f3->Button(-text => '  Ok  ', -command => sub{$FB_Info{'ret_val'} = 0});
      $FB_Info{'cancel'} = $f3->Button(-text => 'Cancel', -command => sub{$FB_Info{'ret_val'} = -1});
      $FB_Info{'ok'}->pack(-side => 'right', -padx => 3, -pady => 5);
      $FB_Info{'cancel'}->pack(-side => 'left', -padx => 3, -pady => 5);

      $w->protocol('WM_DELETE_WINDOW', sub{$FB_Info{'ret_val'} = -1});
      $w->update;
      $w->minsize($w->reqwidth, $w->reqheight);

     #Bindings...
      $FB_Info{'dirlist'}->bind('<Double-1>', sub{$FB_Info{'ret_val'} = 2});
      $FB_Info{'filelist'}->bind('<1>', sub{$FB_Info{'ret_val'} = 3});
      $FB_Info{'filelist'}->bind('<Double-1>', sub{$FB_Info{'ok'}->invoke});
      $FB_Info{'file'}->bind('<Key-Return>', sub{$FB_Info{'ok'}->invoke});
      $FB_Info{'dir'}->bind('<Key-Return>', sub{$FB_Info{'ret_val'} = 1});
      $FB_Info{'filter'}->bind('<Key-Return>', sub{$FB_Info{'filterbut'}->invoke});
    
      &PositionWin($w, $parent);
   }

   &FB_Update($dir, $filter);   #Assume provided directory path is valid!
   $FB_Info{'file'}->delete(0, 'end');
   $FB_Info{'file'}->insert(0, $file);

   $w->title($title);
   &LockWin($w, $parent);
  
   while ($FB_Info{'ret_val'} == 999) {
      $w->waitVariable(\$FB_Info{'ret_val'});
      $file = $FB_Info{'file'}->get;
      $dir = &ResolvePath($FB_Info{'dir'}->get);
      $filter = $FB_Info{'filter'}->get;
      if ($FB_Info{'ret_val'} == 0) {       #Ok was pressed.
         if ($file =~ /^\s*$/) {
            &ErrorDialog($w, "Please select a filename.");
         } elsif (-d $dir) {
            $selection = "${dir}/${file}";
            if (-d $selection) {
               &ErrorDialog($w, "$file is a directory.");
            } else {
               last;
            }
         } else {
            &ErrorDialog($w, "Invalid directory selection: $dir");
         }
      } elsif (($FB_Info{'ret_val'} == 1) || ($FB_Info{'ret_val'} == 2)) {  #Filter apply, change dir.
         if ($filter =~ /^\s*$/) {
            $filter = '*';
         }
         if ($FB_Info{'ret_val'} == 2) {
            $dir .= '/'.$FB_Info{'dirlist'}->get($FB_Info{'dirlist'}->curselection);
            $dir = &ResolvePath($dir);
         }
         if (-d $dir) {
            &FB_Update($dir, $filter);
         } else {
            &ErrorDialog($w, "Invalid directory selection: $dir");
         }
      } elsif ($FB_Info{'ret_val'} == 3) {  #Select File.
         $file = $FB_Info{'filelist'}->get($FB_Info{'filelist'}->curselection);
         $FB_Info{'file'}->delete(0, 'end');
         $FB_Info{'file'}->insert(0, $file);
      }
      unless ($FB_Info{'ret_val'} < 0) {
         $FB_Info{'ret_val'} = 999;
      }
   }

   &UnlockWin($w, $parent);
   return ($FB_Info{'ret_val'}, $file, $dir, $filter);
} #end FileBrowse 

#Reads a .tdb file and creates the database.  Returns non-zero if there are any failures.
#Args: filepath, apply geometry flag (optional)
sub ReadTDB {
   my ($file, $geom) = @_;
   my ($cur_line, $viewflag, $dbflag, $obj, $key, $value, @lines, @data);

   $viewflag = $dbflag = 0;
   
   unless (open(IN, "$file")) {
      &ErrorDialog($MAIN, "Cannot open: $file");
      return -1;
   }
   while ($cur_line = <IN>) {
      chop($cur_line);
      $cur_line =~ s/^\s+//;  #Remove preceding whitespace.
      next if (($cur_line eq '') || ($cur_line =~ /^\#/));   #Ignore comment and blank lines.
      $cur_line =~ /^(\S+)\s*(.*)/;
      $key = $1;
      $value = $2;
      if ($key eq '<geometry>') {
         next unless $geom;
         $MAIN->geometry($value);
      } elsif ($key eq '<sort>') {
         @data = split(/\s+/, $value);
         $SORT = $data[0];
         $SORTDIR = $data[1];
         &AdjustSortStack
      } elsif ($key eq '<view>') {
         $viewflag = 1;
      } elsif ($key eq '<db>') {
         $viewflag = 0;
         $dbflag = 1;
         $obj = $value;
         next;
      }
      if ($viewflag) {
         $VIEW{$key} = $value;
      } elsif ($dbflag) {
         @lines = split(chr(31), $value);
         $value = join("\n", @lines);
         $OBJECTS{$obj}{$key} = $value;
      }
   }

   close(IN);
   $MODCOUNT = 0;
   &UpdateDisplay;

   return 0;
} #end ReadTDB

#Writes the .tdb file for the currently loaded database.  Assumes that the filename is correct.
#Arg: filepath
sub WriteTDB {
   my ($file) = $_[0];
   my ($geom, $key, $ley, $value, @lines);

   $geom = $MAIN->geometry;

   open(OUT, ">$file");   #Should probably test for success here before continuing!
  #Write application state information.
   print OUT "<geometry> $geom\n";
   print OUT "<sort> $SORT $SORTDIR\n";
   print OUT "<view>\n";
   foreach $key (keys(%VIEW)) {
      print OUT "  $key $VIEW{$key}\n";
   }

  #Write DB information.
   foreach $key (keys(%OBJECTS)) {
      print OUT "<db> $key\n";
      foreach $ley (keys(%{$OBJECTS{$key}})) {
         $value = $OBJECTS{$key}{$ley};
         @lines = split(/\n/, $value);
         $value = join(chr(31), @lines);
         print OUT "  $ley $value\n";
      }
   }
   close(OUT);

   $MODCOUNT = 0;   #Reset the modification count.
} #end WriteTDB

#Puts up a warning dialog to confirm a dangerous selection.  Returns 0 if user hits ok, non-zero otherwise.
#Args: Parent win, Message
my (%WD_Info);
sub WarningDialog {
   my ($parent, $msg) = @_;
   my ($w, $f, $wid, $hgt, $color);
   
   $WD_Info{'ret_val'} = 999;
   if (exists($WD_Info{'toplevel'})) {
      $w = $WD_Info{'toplevel'};
   } else {
      $color = 'skyblue';   #Color of the dialog.
      $w = $WD_Info{'toplevel'} = $parent->Toplevel(-bg => $color);
      $w->withdraw;

      $WD_Info{'msg'} = $w->Label(-wraplength => int($w->screenwidth / 2), -justify => 'left', -bg => $color);
      $WD_Info{'msg'}->pack(-side => 'top', -padx => 5, -pady => 5);
      $w->Frame(-height => 3, -relief => 'sunken', -bd => 1, -bg => $color)
        ->pack(-side => 'top', -padx => 3, -pady => 2, -fill => 'x');
      $f = $w->Frame(-bg => $color)
             ->pack(-side => 'bottom', -fill => 'x');
      $f->Button(-text => '  Ok  ', -command => sub{$WD_Info{'ret_val'} = 0}, -bg => $color)
        ->pack(-side => 'right', -pady => 5, -padx => 5);
      $f->Button(-text => 'Cancel', -command => sub{$WD_Info{'ret_val'} = -1}, -bg => $color)
        ->pack(-side => 'left', -pady => 5, -padx => 5);
      $w->protocol('WM_DELETE_WINDOW', sub{$WD_Info{'ret_val'} = -1});
      $w->resizable(0, 0);
      $w->title('Warning!');
   }
   $WD_Info{'msg'}->configure(-text => $msg);

  #Size the window to the requested amount.
   $w->update;
   $wid = $w->reqwidth;
   $hgt = $w->reqheight;
   $w->geometry("${wid}x${hgt}");
   &PositionWin($w, $parent);

   &LockWin($w, $parent);
   $w->waitVariable(\$WD_Info{'ret_val'});

   &UnlockWin($w, $parent);
   return $WD_Info{'ret_val'};
} #end WarningDialog

#Updates the file browser window contents.  Returns non-zero if an error occurs.
#Args: dir, filter
sub FB_Update {
   my ($dir, $filter) = @_;
   my ($curdir, $curfile, @files, @dirs);

   $curdir = $CURDIR;
   unless (chdir($dir)) {
      &ErrorDialog("Bad directory: $dir");
      return -1;
   }

  #Clear the current contents.
   $FB_Info{'dirlist'}->delete(0, 'end');
   $FB_Info{'filelist'}->delete(0, 'end');
   $FB_Info{'dir'}->delete(0, 'end');
   $FB_Info{'filter'}->delete(0, 'end');

   @files = @dirs = ();
   opendir(DIR, '.');
   while ($curfile = readdir(DIR)) {
      if ((-d $curfile) && ($curfile ne '.') && ($curfile ne '..')) {
         push(@dirs, $curfile);
      }
   }
   closedir(DIR);

   foreach $curfile (glob($filter)) {
      if (-f $curfile) {
         push(@files, $curfile);
      }
   }

   $FB_Info{'dirlist'}->insert('end', '..');
   foreach $curfile (sort {$a <=> $b} @dirs) {
      $FB_Info{'dirlist'}->insert('end', $curfile);
   }
   foreach $curfile (sort {$a <=> $b} @files) {
      $FB_Info{'filelist'}->insert('end', $curfile);
   }
   $FB_Info{'dir'}->insert(0, $dir);
   $FB_Info{'filter'}->insert(0, $filter);

   $CURDIR = $curdir;
} #end FB_Update

#Returns a resolved directory path from one containing multiple '.' and '..'.
#Arg: Directory path
sub ResolvePath {
   my ($path) = $_[0];
   my (@elements, $element, @path);

   @elements = split(/\//, $path);
   @path = ();
   foreach $element (@elements) {
      next if (($element eq '.') || ($element eq ''));
      if ($element eq '..') {
         pop(@path);
      } else {
         push(@path, $element);
      }
   }
   if ($path[0] =~ /^[a-zA-Z]:/) {    #Win32 drive letter prefix, do not begin with a slash!
      $path = join('/', @path).'/';
   } else {
      $path = '/'.join('/', @path).'/';
   }
   $path =~ s/\/+/\//g;

   return $path;
} #end ResolvePath

#Positions a window in the center of its parent.
#Arg: Window path, Parent window path
sub PositionWin {
   my ($w, $parent) = @_;
   my ($px, $py, $pwid, $phgt, $cx, $cy, $cwid, $chgt, $scrnwid, $scrnhgt);

   $w->update;

   $px = $parent->x;
   $py = $parent->y;
   $pwid = $parent->width;
   $phgt = $parent->height;
   $cwid = $w->reqwidth;
   $chgt = $w->reqheight;
   $scrnwid = $w->screenwidth;
   $scrnhgt = $w->screenheight;
   $cx = int($px + ($pwid - $cwid) / 2);
   $cy = int($py + ($phgt - $chgt) / 2);

  #Adjust for screen limits.
   if ($cx < 0) {
      $cx = 0;
   } elsif (($cx + $cwid) > $scrnwid) {
      $cx = $scrnwid - $cwid;
   }
   if ($cy < 0) {
      $cy = 0;
   } elsif (($cy + $chgt) > $scrnhgt) {
      $cy = $scrnhgt - $chgt;
   }

   $w->geometry("+${cx}+${cy}");
} #end PositionWin

#Blocks the parent window and brings brings its child into focus.
#Args: Window, Parent window.
sub LockWin {
   my ($win, $parent) = @_;
   $parent->configure(-cursor => 'watch');
   $parent->grabRelease;
   $win->deiconify;
   $win->transient($parent);
   $win->grab;
   $win->focus;
} #end LockWin

#Unlocks a blocking window.
#Args: Window, Parent Window
sub UnlockWin {
   my ($win, $parent) = @_;
   $parent->configure(-cursor => 'left_ptr');
   $win->grabRelease;
   $win->withdraw;
   $parent->grab;
} #end UnlockWin

#Puts up an information dialog.
#Args: parent window, text message
sub InfoDialog {
   my ($parent, $msg) = @_;

   &ErrorDialog($parent, $msg, 'Information');
} #end InfoDialog

#Puts up an error message.
#Args: parent window, text message, window title (optional)
my (%ED_Info);
sub ErrorDialog {
   my ($parent, $msg, $title) = @_;
   my ($w, $hgt, $wid, $color);

   $ED_Info{'ret_val'} = 999;
   if (exists($ED_Info{'toplevel'})) {
      $w = $ED_Info{'toplevel'};
   } else {
      $w = $ED_Info{'toplevel'} = $parent->Toplevel;
      $ED_Info{'default'} = $w->cget(-bg);   #Default message color.
      $ED_Info{'color'} = 'red';             #Error message color
      $w->withdraw;

      $ED_Info{'msg'} = $w->Label(-wraplength => int($w->screenwidth / 2), -justify => 'left');
      $ED_Info{'msg'}->pack(-side => 'top', -padx => 5, -pady => 5);
      $ED_Info{'sep'} = $w->Frame(-height => 3, -relief => 'sunken', -bd => 1);
      $ED_Info{'sep'}->pack(-side => 'top', -padx => 3, -pady => 2, -fill => 'x');
      $ED_Info{'but'} = $w->Button(-text => '  Ok  ', -command => sub{$ED_Info{'ret_val'} = 0});
      $ED_Info{'but'}->pack(-side => 'bottom', -pady => 5);
      $w->protocol('WM_DELETE_WINDOW', sub{$ED_Info{'ret_val'} = 0});
      $w->resizable(0, 0);
   }
   $ED_Info{'msg'}->configure(-text => $msg);

  #Set the color of the window depending on the type of message.
   if ($title) {
      $w->title($title);
      $color = $ED_Info{'default'};
   } else {
      $w->title('Error!');
      $color = $ED_Info{'color'};
   }
   $w->configure(-bg => $color);
   $ED_Info{'msg'}->configure(-bg => $color);
   $ED_Info{'but'}->configure(-bg => $color);
   $ED_Info{'sep'}->configure(-bg => $color);

  #Size the window to the requested amount.
   $w->update;
   $wid = $w->reqwidth;
   $hgt = $w->reqheight;
   $w->geometry("${wid}x${hgt}");
   &PositionWin($w, $parent);

   &LockWin($w, $parent);
   while ($ED_Info{'ret_val'} == 999) {
      $w->waitVariable(\$ED_Info{'ret_val'});
   }

   &UnlockWin($w, $parent);
   return $ED_Info{'ret_val'};
} #end Error_Dialog

#Returns the filename from a filepath.
#Args: filepath
sub Basename {
   my ($filepath) = $_[0];
   my (@data);

   @data = split(/[\/\\]/, $filepath);
   return $data[$#data];
}

#Returns the directory portion of a path.
#Args: filepath
sub Dirname {
   my ($filepath) = $_[0];
   my (@data);

   @data = split(/[\/\\]/, $filepath);
   pop(@data);
   return join('/', @data);
} #end Dirname

if (($ARGV[0]) && !(&ReadTDB($ARGV[0], 1))) {
   $CURFILE = &Basename($ARGV[0]);
   my $dir = &Dirname($ARGV[0]);
   chdir ($dir);
   $CURDIR = cwd;
}

#Process events forever.
$MAIN->MainLoop;

print stderr "The event loop was unexpectedly terminated!\n";
exit -1;