#!/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.96

%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";

# type of service
%tos = (
  0,'leftBitmap text.xbm callback {echo r text $l1 $shp;e %w}', 
  1,'leftBitmap folder.xbm callback {echo r dir $l1 $shp;e %w}', 
  7,'leftBitmap search.xbm callback {global l sel hp;'
              .'set l {$l1};set sel {$sel};set hp {$hp};'
	      .'popup searchmenu none;e %w}', 
  8,'leftBitmap telnet.xbm callback {echo telnet $shp;e %w}', 
'T','leftBitmap telnet.xbm callback {echo tn3270 $shp;e %w}', 
'I','leftBitmap graphic.xbm callback {echo r gif $l1 $shp;e %w}', 
'g','leftBitmap graphic.xbm callback {echo r gif $l1 $sh;e %wp}', 
);

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

sub listing {
    local($query) = @_;
    local($_,$fail,$conn,$q,$server,$port);
    local(@parms) = split("\t",$query);
#   print "tabs= ",$query =~ tr/\t/\t/, "...$#parms...\n";
  TABS: {
      ($server,$port) = @parms, last if $#parms == 1;
      ($q,$server,$port) = @parms, last if $#parms == 2;
      ($q,$server,$port) = ("$parms[0]\t$parms[1]", $parms[2], $parms[3]), 
             last if $#parms == 3; 
  }

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

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

     $*=1;
     while (!$fail) {
	 &chat'expect($conn, 30, 
           '^\.\r?\n', '$fail="done",$_.=$`', 
           '.*\r?\n', '$_.=$&', 
           'EOF', '$fail="eof"', 
           'TIMEOUT','$fail="timeout"');
    }
    &chat'close($conn);
    $* = 0;
# print "string=<$_>\n"; 

    return ("",$_) unless $fail eq "timeout";
    return($fail,$_);
}


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

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

    if ($t eq "gif") {
	local($fname) = "tmp$t$$".&newWidget();
	open(G,">$fname"); print G $string; close(G);
	system("(xv $fname;rm $fname)&");
	return;
    }
    $blocked{$level} = 1;

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

    local($shell) = $level ?
	"TransientShell t$level f0;" 
	    ."callback t$level popupCallback position ff$l0:$off/$off" :
	"Box t$level topLevel hSpace 0 vSpace 0";

    &Xui("$shell;Form ff$level t$level 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))) { 
	    $w = &newWidget();
	    if (/^(\S)([^\t]+)\t(.*)$/) {
		local($type,$label,$shp) = ($1,$2,$3);
		$shp =~ s/([ \\\[\]{}";])/\\\1/g;
                ($sel,$hp) = ($1,$2) if $shp =~ /^([^\t]*)\t(.*)$/;
                $shp =~ s/\t/\\t/g;
                chop($hp);
		eval '$callback = "'.$tos{$type}.'"';
		&Xui("Command $w f$level label {$label} $callback "
                     ."$vert width 500 borderWidth 0 justify left");
                &Xui("action $w override {<Btn3Down>: "
                            ."exec(sV i$level label {$hp})}");
                &Xui("action $w override {<Btn3Up>: "
                            ."exec(sV i$level label {})}");
		$vert = "fromVert $w";
	    } else {
		&Xui("label $w f$level label {$_} "
                     ."$vert width 500 borderWidth 0 justify left");
		$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("Text $w ff$level width 500 $height scrollVertical always "
            ."$roColors $textFont type string");
        $string =~ tr/\r//d;
	&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;
}

&Xui(<<"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) }

proc e {w} { sV \$w $backGround sensitive true }
set sel ""
set l 1
set hp ""
End of TCL

&replyList("dir",0,"\t$gopherServer\t$opt_p");
&Xui("realize; deleteWindowProtocol quit");

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