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

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

&Xui(<<"__");
set translations {#override
     <Key>Up:    exec(echo prev)
     <Key>Down:  exec(echo next)
     <Key>Prior: exec(echo prev)
     <Key>Next:  exec(echo next)  
}
			 
mergeResources topLevel {
    *Command.callback {echo %w}
    *Form.translations \$translations
    *Text*translations \$translations
}

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

Form top topLevel $backGround
   $tcl

   Text 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
   Command prev top $buttonAtts fromHoriz next fromVert ergebnis

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

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

   realize

   setKeyboardFocus top search
   deleteWindowProtocol quit
   action search override {<Key>Return: exec(search)}
__

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 ($_=&wafe'read) {
    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/;
}

