#!/usr/local/bin/perl 
#
# Copyright (C) 1992 by Gustaf Neumann, Stefan Nusser
#
#      Wirtschaftsuniversitaet Wien,
#      Abteilung fuer Wirtschaftsinformatik
#      Augasse 2-6,
#      A-1090 Vienna, Austria
#      neumann@wu-wien.ac.at, nusser@wu-wien.ac.at
#
# Permission to use, copy, modify, and distribute this software and its
# documentation for any purpose and without fee is hereby granted, provided
# that the above copyright notice appears in all copies and that both that
# copyright notice and this permission notice appear in all supporting
# documentation.  This software is provided "as is" without expressed or
# implied warranty.
#
# Date: Mon, Apr 13 1992
# Author: Gustaf Neumann
# Version: 0.9
#


$WafeLib = $ENV{'WAFELIB'} || "/usr/lib/X11/wafe";
require "$WafeLib/perl/wafe.pl";

$top = ($ARGV[0] eq "") ? "/usr/local" : $ARGV[0];
$count=0;

sub add_node {
    local($path,$dir) = @_;
    $dirname = ($path eq '') ? $dir : "$path/$dir";
    return if $widgetname{$dirname} ne "";

    $w = "t$count"; $count ++;
    $widgetname{$dirname} = $w;
    $father{$dirname} = $path;
    &Xui("Command $w dirtree label {$dir} "
	 .  "callback {echo eval &rdirs('$dirname')};"
         ."action $w override {<Btn2Down> : exec(echo delbrothers $dirname)};"
         ."action $w override {<Btn3Down> : exec(echo deltree $dirname)}");
    &Xui("sV $w treeParent $widgetname{$path}") if $widgetname{$path};
}

sub del_node {
    &Xui("destroyWidget $widgetname{$_}");
    delete $widgetname{$_}; 
    delete $father{$_}; 
}

sub rdirs {
    local($path)=@_;
    chdir($path) || return;
    (opendir(DIR,".")) 
	&& (@dirs = sort grep(!/^\.\.?$/,grep(-d ,readdir(DIR)))) 
	&& (closedir(DIR));
    foreach (@dirs) { &add_node($path,$_); }
}

&Xui( <<"End of Wafe");
if {\$XVERSION<"R5"} {
  puts stderr "To run this program a R5 wafe is needed!"
  quit
}

Form top topLevel $backGround translations {<Key>q: exec(quit)}
   Panner pan top top chainTop 
   Porthole hole top fromVert pan bottom chainBottom
      Tree dirtree hole gravity east \\
           vSpace 5 hSpace 40 autoReconfigure no $roColors
      XawTalk pan hole dirtree

   Command quit top fromVert hole $buttonAtts callback quit \\
           left chainLeft right chainLeft top chainBottom bottom chainBottom
End of Wafe


&add_node('',$top);
$widgetname{"$top"} = $w;
&rdirs($top);
&Xui("realize;deleteWindowProtocol quit");

while ($_=&wafe'read) {
    if (/eval (\S+)/) {
	eval $1;
	&Xui("XawTreeForceLayout dirtree");
    }

    if (/deltree (\S+)/) {
	&Xui("quit") if $1 eq $top;
	($x= $1) =~ s/(\W)/\\\1/g;
	grep(/$x/ && &del_node,keys %widgetname);
    }

    if (/delbrothers (\S+)/) {
	 $x = $1;
	($f= "$father{$x}/") =~ s/(\W)/\\\1/g;
	 $x =~ s/(\W)/\\\1/g;
	grep(!/^$x/ && /^$f/ && &del_node,keys %widgetname);
    }
}







