#!/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, june 13 1992
# Author: Gustaf Neumann
# Version: 0.92

%privOptions = (
	"p", "gopher port: default is 70",
	"s", "gopher server: default is gopher.micro.umn.edu",
	);

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

$opt_p = $opt_p || 70; # default gopher port
$gopherServer = $opt_s || "gopher.micro.umn.edu";

@res = (
    'leftBitmap $WafeBitmaps/text.xbm callback {echo r text $l1 $shp}', #0
    'leftBitmap $WafeBitmaps/folder.xbm callback {echo r dir $l1 $shp}', #1
    '', #2
    '', #3
    '', #4
    '', #5
    '', #6
    'leftBitmap $WafeBitmaps/search.xbm callback {global l sel hp;'
              .'set l {$l1};set sel {$sel};set hp {$hp};'
	      .'popup searchmenu none}', #7
    'leftBitmap $WafeBitmaps/telnet.xbm callback {echo telnet $shp}', #8
    );

sub listing {
    local($query) = @_;
    local($fail,$string,$conn);
    local($q,$server,$port) = ($1,$2,$3) 
	if $query =~ /^([^\t]*)\t([^\t]+)\t(\d+)\D?/;
    ($server,$port) = ($1,$2) if !$server && $query =~ /^([^\t]+)\t(\d+)\D?/;

    &Xui("sV i$l0 label {retrieving data from $server...}") if $level;
#    print "query: <$query>\nserver: $server, port= $port, query = $q\n";

    ($conn = &chat'open_port($server, $port)) || return ("cannot open connection","");
    &chat'print($conn, "$q\r\n");

     $*=1;
    ($fail,$string) = &chat'expect($conn, 30, 
           '^\.\r?\n', '("",$`)', 
            'TIMEOUT','("timeout","")');
    $* = 0;
    $string =~ tr/\r//d;
    return($fail,$string);
}

$widget = "waaa";
sub newWidget {
    return $widget++;
}

#sub tree {
#    local($father,$query) = @_;
#    local($fail,$string) = &listing($query);
#    foreach((split(/\n/,$string))) { 
#	if (/^(\d)([^\t]+)\t([^\t]*)\t([^\t]+)\t(\d+)$/) {
#	    local($type,$label,$sel,$host,$port) = ($1,$2,$3,$4,$5);
#            local($w) = &newWidget();
#	    &Xui("command $w tree label {$label} treeParent $father");
#            &Xui("sV $w callback {echo tree $w $sel\\t$host\\t$port}") if $type==1;
#	    &Xui("sV $w callback {echo text $w $sel\\t$host\\t$port}") if $type==0;
#	}
#    }
#}

sub replyList {
    local($t,$level,$query) = @_;
    local($l0,$l1,$vert,$shell,$callback) = ($level-1,$level+1);
    &Xui("sV i$level label {only one window for each level allowed}"), return 
	if $blocked{$level};

    $blocked{$level} = 1;
    local($fail,$string) = &listing($query);
    &Xui("sV i$l0 label {$fail}") if $level;
    undef $blocked{$level}, return 
	if $fail;

    local($lines) = ($string =~ tr/\n/\n/);
#    print "lines = $lines\n";
    &Xui("sV i$l0 label {no data available}"), 
        undef $blocked{$level}, return 
	if $lines == 0 && $level>0;

    if ($level) {
        local($off)=$level*30;
	&Xui("transientShell t$level f0;callback t$level popupCallback position f$l0:$off/$off");
	$shell = "t$level";
    } else {
	$shell = "topLevel";
    }

    &Xui("form ff$level $shell borderWidth 0 $backGround");

    if ($t eq "dir") {
	local($height) = "height 300" if  $lines > 20;
	&Xui("viewport v$level ff$level allowVert true $height borderWidth 0;"
	     ."form f$level v$level");
	&Xui("sV i$l0 label {preparing display with $lines lines ...}") if $level; 
	foreach((split(/\n/,$string))) { 
	    if (/^(\d)([^\t]+)\t(.*)$/) {
		local($type,$label,$shp) = ($1,$2,$3);
                ($sel,$hp) = ($1,$2) if $shp =~ /^([^\t]*)\t(.*)$/;
                $shp =~ s/\t/\\t/g;
		local($w) = &newWidget();
		eval '$callback = "'.@res[$type].'"';
		&Xui("command $w f$level label {$label} $vert width 500 borderWidth 0 "
		     ."justify left $callback");
		$vert = "fromVert $w";
	    }
	}
	$vert = "fromVert v$level";
	&Xui("sV i$l0 label {}") if $level;
    } else {
	local($w) = &newWidget();
        local($height) = "height 300" if $lines > 1;
	&Xui("asciiText $w ff$level width 500 $height scrollVertical always "
            ."$roColors $textFont type string");
	&wafe'tunnel("COMM",$string,"sV $w string \$COMM");
        &wafe'applyActions($w,@textActions);
	$vert = "fromVert $w";
    }
    $callback = $level ? 
        "callback {echo free $level;destroyWidget t$level}" : "callback quit";
    &Xui("command q$level ff$level label Quit $buttonAtts $vert $callback;"
        ."label i$level ff$level label {} width 470 $infoColors $vert fromHoriz q$level");
    &Xui("popup t$level none") if $level;
}

&UI( <<"End of TCL");
   transientShell  searchmenu topLevel 
   callback searchmenu popupCallback positionCursor 45

   dialog searchtext searchmenu label {Search string:} value {} $backGround
   sV searchtext.label $backGround $boldFont
   command searchquit searchtext label {cancel} $buttonAtts \\
          callback {popdown searchmenu}

   action searchtext.value  override \\
       {<Key>Return: exec(global l; global sel; global hp; \\
       echo r dir \$l \$sel\\t\[gV searchtext value\]\\t\$hp) \\
	   XtMenuPopdown(searchmenu) }

set sel ""
set l 1
set hp ""
#form top topLevel $backGround 
#   panner pan top top chainTop width 700 height 500 
#   porthole hole top fromVert pan bottom chainBottom
##   tree tree hole gravity west vSpace 5 hSpace 40 $roColors width 700 height 400
#   paned paned hole orientation horizontal
#   talk pan hole paned 
##   label wurzel tree label {}
#
#proc resize {box args} { \\
#  echo resize \$box \$args; \\
#  set width [gV \$box width]; \\
#  foreach w \$args {sV \$w width \$width label \"[gV \$w label]\"; echo \$w width \$width}}
End of TCL

#&tree("wurzel","\t$gopherServer\t$opt_p");
&replyList("dir",0,"\t$gopherServer\t$opt_p");
&Xui("realize");

while(<STDIN>) {
#    print;
#    &tree($1,$2) if /^tree\s+(\S+)\s+(.*)$/;
    &replyList($1,$2,$3) if /^r\s+(\S+)\s+(\S+)\s+(.*)$/;
    if (/^telnet\s*(\S*)\t(\S+)\t(.*)$/) {
        local($port) = $3 if $3>0;
        local($title) = "-T 'login $1'" if $1 ne "";
        system("xterm $title -e telnet $2 $port&");
    }
    undef $blocked{$1} if /^free (\d+)/;
}
&wafe'cleanup();
