{==============================================================}
{			 IXDOIT.PAS			       }
{Copyright (C) 1986 David E. Cortesi--see notice in IXMAIN.PAS.}
{  This include section contains the user interaction. The user}
{ is prompted for a term at the current indentation level.     }
{ A null entry terminates this level of the index -- and ends  }
{ the program, at the outermost level.			       }
{   When entering a term, pressing ESCape causes us to locate  }
{ the term as typed so far in the tree at this level, and to   }
{ complete the term on the screen from the matching term that  }
{ lexically least. Further presses of ESC bring up successive  }
{ matching terms until the user accepts one (by pressing any   }
{ key except ESC) or until no more matches are found.  DEL     }
{ makes us give up trying to match the term and remove the     }
{ letters supplied from the candidate term.  After a term is   }
{ ended with either CR or LF, we insert or find it in the      }
{ current tree. 					       }
{   Terminating a term with CR causes a prompt for a page      }
{ number reference.  We read the number digit by digit and do  }
{ our own conversion to binary so as to avoid crashing with a  }
{ pascal run-time error. Any signed 16-bit integer is allowed  }
{ (previous versions of the program couldn't handle 0).        }
{   Terminating the number with CR ends entry of the number.   }
{ Ending it with LF instead makes us prompt with ".." and take }
{ another number (must be algebraically greater) to store as   }
{ the end of a range of numbers.			       }
{   Terminating term-entry with LF not CR causes us to enter   }
{ a subtree off the completed term.  We enter the subtree of   }
{ the entered term and prompt again at a deeper indent level.  }
{ History:						       }
{ don't put a page item on a term when no page # given 11/3/86 }
{ initial code 6/3-5/86 				       }
{==============================================================}
var scan: walk;

{------ indent the cursor for the current nesting level -------}
procedure indent;
var i : integer;
begin
    for i := 1 to indlevel do write('. . ')
end;

{------ get one byte from the keyboard.  bypass pascal and go -}
{------ straight to DOS.  Echo printables, don't echo ctls. ---}
function readnc : nchar;
var c : nchar;
begin
    repeat
	c := bdos(6,-1) { CHECK: OK FOR MS-DOS???? }
    until (c<>0);
    if (c>31) then write(chr(c));
	readnc := c;
    end;

{------ implement destructive backspace -----------------------}
procedure backspace;
begin
    write(chr(asciibs),chr(asciiblank),chr(asciibs))
end;

{------ reject a user keystroke, blanking if printable --------}
procedure reject(c:nchar);
begin
    write(chr(asciibel));
    if (c>31) then backspace
end;

{------ get a valid page number keyed in and set its value in -}
{------ PAGE.  Return its delimiter as the result: asciieof ---}
{------ if no page entered, or asciicr, or asciilf.  Since we -}
{------ deal direct with the user we give immediate feedback --}
{------ when a number is too long or too large or whatever ----}
function getpage(var page: integer) : nchar;
const hyphen = 45;
var c : nchar;			{ keyed character }
    s : set of 0..57;		{ set of currently-valid ones }
    x : array[0..5] of 0..57;	{ keys typed so far }
    j,k : 0..6; 		{ indices over x }
    w : real;			{ accumulated value at end }
begin
    j := 0;			{ nothing typed so far }
    s := [asciilf,asciicr,hyphen, 48..57]; { bytes we can take }
    repeat
	c := readnc;
	if not(c in s) then reject(c)
	else if (c = asciibs) then begin
	    backspace;
	    j := j-1;
	    if (j=0) then s := s - [asciibs];
	    if (j=1) then s := s + [hyphen]
	end
	else if (c>asciicr) then begin
	    if (j>5) then reject(c)
	    else begin
		x[j] := c;
		j := j+1;
		s := s - [hyphen];
		s := s + [asciibs]
	    end
	end
    until ((c=asciicr)or(c=asciilf));
    if (j > 0) then begin {nonnull page number}
	getpage := c;
	c := x[0];
	k := 0; if (c = hyphen) then k := 1;
	w := 0.0;
	while (k<j) do begin
	    w := (w * 10.0)+(x[k]-48);
	    k := k+1
	end;
	if (w > 32767.0) then w := 32767.0;
	if (c = hyphen) then w := -w;
	page := trunc(w)
    end {of nonnull page}
    else begin {no page entered}
	getpage := asciieof;
	page := 0
    end
end;

{------ make a page record for numbers I and J ----------------}
function makepage(i,j:integer):ppage;
var p : ppage;
begin
    new(p);
    with p^ do begin
	next := nil;
	num1 := i;
	num2 := j
    end;
    makepage := p
end;

{------ Add the range of consecutive numbers from I to J to ---}
{------ the chain of numbers off treenode T, economizing on ---}
{------ PAGE structures.  The method used keeps the chain in --}
{------ numeric sequence but may produce overlapping values ---}
{------ under some entry sequences, e.g. (3,8),(5,5)(12,12) ---}
procedure putpage(i,j:integer; t: tree);
var p,q,n : ppage; stop : boolean;
begin
    p := nil; q := t^.pages;
    if (q = nil) then { new entry, no numbers yet }
	t^.pages := makepage(i,j)
    else begin
	stop := false;
	repeat
	    if ((j+1) < q^.num1) then begin
		{ (i,j) has to follow p^ and precede q^ }
		n := makepage(i,j);
		if (p <> nil) then p^.next := n
		else t^.pages := n;
		n^.next := q;
		stop := true
	    end
	    else if ((i-1) > q^.num2) then begin
		{ (i,j) has to follow q^ ... }
		p := q; q := q^.next;
		if (q = nil) then begin
		    { (i,j) goes at end of chain }
		    p^.next := makepage(i,j);
		    stop := true
		end
	    end
	    else begin { (i,j) overlaps or touches q^ }
		if (i < q^.num1) then q^.num1 := i;
		if (j > q^.num2) then q^.num2 := j;
		stop := true
	    end
	until stop;
    end
end;


{------ fill in term string TRM from the keyboard in context --}
{------ of tree T. Return a signal, asciieof, -cr, or -lf -----}
{------ depending on the outcome, as the result. --------------}
function getterm( t : tree) : nchar;
var
    c	: nchar;	{ current input keystroke }
    j	: strindex;	{ indexes over current term in TERM }
    k	: strlength;	{ indexes recalled term, or else 0 }
    p	: tree; 	{ ^tree of recalled term }

    {-- back up the screen to the original term --}
    procedure backup;
    begin
	while (k > j) do begin
	    backspace; k := k-1
	end
    end;

    {-- common finish of both starting and stepping a scan ----}
    procedure showtrm;
    begin
	if (p <> nil) then begin
	    stget(p^.term,scratch);
	    k := j;
	    while (scratch[k] <> null) do
		begin write(chr(scratch[k])); k := k+1 end;
	end
	else begin
	    write(chr(asciibel));
	    k := 0
	end
    end;

    {-- accept the current scanned term for use, if any -------}
    procedure accept;
    begin
	while (j < k) do begin
	    workterm[j] := scratch[j];
	    j := j+1
	end;
	workterm[j] := null;
	k := 0
    end;

    {-- set up for a treewalk over all terms that are an ------}
    {-- initial match to the entry so far. --------------------}
    procedure startscan;
    begin
	stucase(workterm,workdict);
	p := setscan(t,workdict,scan);
	showtrm
    end;

    {-- scan to the next equal term in the tree and show it ---}
    procedure stepscan;
    begin
	p := wstep(scan);
	if p<>nil then
	    if (equal<>stbcmpa(workdict,p^.dict)) then p := nil;
	showtrm
    end;

begin { the main Get Term procedure }
    indent; write('term: ');
    j := 1;
    k := 0;
    repeat
	workterm[j] := null;
	c := readnc;
	case c of
	asciibs :   begin { destructive backspace }
			accept; { accept current match if any }
			if (j > 1) then begin
			    backspace;
			    j := j-1;
			end
		    end;
	asciicr :   begin { normal completion }
			accept;
			writeln
		    end;
	asciilf :   begin { complete, move on to subterm }
			accept;
			writeln
		    end;
	asciiesc :  begin { automatic scan for match }
			backup; { wipe rejected match if any   }
			if (k=0) then startscan else stepscan
		    end;
	asciidel :  begin { cancel search for match }
			backup;
			k := 0 { no scan active }
		    end;
	else	    begin { ordinary (?) character }
			accept;
			if (c<asciiblank) or (j=strmax) then
			    reject(c)
			else begin
			    workterm[j] := c;
			    j := j+1;
			    workterm[j] := null;
			end
		    end
	end {case}
    until ((c = asciicr) or (c = asciilf));
    if (j = 1) then c := asciieof;
    getterm := c
end;

{------ Load terms from the keyboard into tree T. -------------}
{------ The proc is recursive, if the user wants to do a ------}
{------ sub-term it calls itself to load just one term into ---}
{------ the current term's sub-tree. --------------------------}
procedure keyinto(var t:tree);
label 111;
var insnode : tree;
    p1, p2 : integer;
    c : nchar;
begin
    repeat
	c := getterm(t);
	if (c <> asciieof) then begin {nonnull term entered}
	    insnode := insert(workterm,t);
	    if (c = asciicr) then begin {final term}
	111:	indent; write('page: ');
		c := getpage(p1);
		if (c <> asciieof) then begin {nonnull page#}
		    if (c = asciicr) then p2 := p1
		    else begin {page# then lf entered}
			write('..');
			c := getpage(p2);
			if (p2 < p1) then begin
			    writeln(' bad range, redo.');
			    goto 111
			end
		    end;{page range}
		    putpage(p1,p2,insnode)
		end {of entering page for this term}
		else c := asciicr; {null page #}
		writeln;
	    end {of term ended in cr}
	    else begin { user hit lf, wants to recurse }
		indlevel := indlevel+1;
		if (indlevel > maxnests) then reject(c)
		else keyinto(insnode^.subtree);
		indlevel := indlevel-1
	    end {of recursing to lower-level term on lf}
	end {of handling nonnull term}
    until (c = asciieof) or (indlevel>0)
end;
end {of recursing to lower-level term on lf}
	end {of handling nonnull term}
    unt