#!/usr/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
#

%privOptions = (
	"a", "application name: such as bib, passwd, group",
	"s", "sourcefile: file to be read in",
);

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

$app = $opt_a || "bib";
APP: {
    $source = $opt_s || $wafecfSearchPath,
    @Lines = ("Standortnummer:","Titel:","","Author:",
	      "Verlag:","","Klassifikation:"),
    $Delimiter = '|'
	if $app eq "bib";

    $source = $opt_s || '/etc/passwd',
    @Lines = ("Login-Name:",  "Passwort:",  "User-Id:", "Group-Id:",
	      "Owner:",  "Login-Directory:", "Shell:"),
    $Delimiter = ':'
	if $app eq "passwd";

    $source = $opt_s || '/etc/group',
    @Lines = (  "Group-Name:",  "", "Group-Id:",  "User:"),
    $Delimiter = ':'
	if $app eq "group";
}


$labelAtt = 
    "$boldFont width 145 borderWidth 0 internalHeight 0 justify right " 
    .$backGround;
$cursor = 0;
$Delimiter =~ s/(\W)/\\\1/g;

for ($[ .. $#Lines) {
        $const = "label l$_ top label {$Lines[$_]} $labelAtt";
	$tcl = "$const vertDistance 7"   if $_ == $[;
        $tcl .= "\n$const fromVert l".($_-1)." vertDistance 0" if $_ > $[;
}
$Height = 16 * ($#Lines+1);

&UI( <<"End of TCL");
proc poorManFocus {from to} { \\
   installAccelerators \$from \$to "#override \\n\\
	                 <Key>Right: forward-character()\\n\\
	                 <Key>Left: backward-character()\\n\\
	                 <Key>Delete: delete-previous-character()\\n\\
	                 <Key>BackSpace: delete-previous-character()\\n\\
	                 <Key>Return: exec(search)\\n\\
	                 <Key>: insert-char()"}

proc search {} {echo search [gV search string]}

form top topLevel $backGround
   $tcl

   asciiText ergebnis top height $Height width 500 $normalFont \\
           displayCaret false fromHoriz l0 $roColors
   command quit top $buttonAtts fromVert ergebnis callback quit

   command next top $buttonAtts fromHoriz quit fromVert ergebnis \\
           callback "echo %w"

   command prev top $buttonAtts fromHoriz next fromVert ergebnis \\
           callback "echo %w"

   asciiText search top width 100 editType edit $normalFont \\
           fromVert ergebnis fromHoriz l0

   label info top label {} width 400 borderWidth 0 $backGround \\
           fromVert ergebnis fromHoriz search 

   poorManFocus ergebnis search 
   poorManFocus top search 

   action search override {<Key>Return: exec(echo search [gV search string])}
End of TCL

foreach $f ('top','search','ergebnis') {
    &Xui("action $f override {<Key>Up : exec(echo prev)};"
	 ."action $f override {<Key>Down : exec(echo next)};"
	 ."action $f override {<Key>Prior : exec(echo prev)};"
	 ."action $f override {<Key>Next : exec(echo next)}");
}
&Xui("realize;deleteWindowProtocol quit");


sub show_entry {
    local($c,$f);
    $cursor = (@_[0] < 0) ? 0 : @_[0];
    $cursor = ($cursor > $#found) ? $#found : $cursor;
    ($x = $found[$cursor]) =~ s/$Delimiter/\\n/g;
    $x =~ s/\"/\\\"/g;
    &Xui("sV ergebnis string \"$x\"");
    $c = $cursor+1; $f = $#found+1;
    &info("entry $c of $f");
}

for (split(':',$source)) {
    print " trying to open <$_>\n";
    open(BIB, "<$_") && ($currentFile = $_) && last;
}
while (<BIB>) { chop; push(@bib,$_); }
close(BIB);
&info("$#bib records read from $currentFile");


while (<STDIN>) {
    if (/^search (\S+).*/) {
	($string = $1) =~ tr/a-z/A-Z/;
	($pattern= $string) =~ s/(\W)/\\\1/g;
	@found = grep(/$pattern/i,@bib);
	&info("$#found entries found");
	&show_entry(0);
    }
    &show_entry($cursor+1) if /^next/;
    &show_entry($cursor-1) if /^prev/;
}

