#!/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}");
    &Xui("callback $w callback exec {echo eval &rdirs('$dirname')}");
    &Xui("action $w override {<Btn2Down> : exec(echo delbrothers $dirname)}");
    &Xui("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,$_); }
}

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

   form top topLevel $backGround
      panner pan top top chainTop 
      porthole hole top fromVert pan bottom chainBottom
         tree dirtree hole gravity east vSpace 5 hSpace 40 autoReconfigure no $roColors
         talk pan hole dirtree

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


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

while (<STDIN>) {
    if (/eval (\S+)/) {
	eval $1;
	&Xui("treeForceLayout 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);
    }
}







