program show(modlib, modcat, print, input, output);
(* show modules in a module library
   Thomas Schneider and Billie Lemmon
   module libraries required: delman, prgmods *)

label 1; (* end of program *)

const
(* begin module version *)
   version = 3.09; (* of show.p 1994 sep 5
origin: 1982 *)
(* end module version *)

(* begin module describe.show *)
(*
name
   show: show modules in a module library

synopsis
   show(modlib: in, modcat: inout, print: out, input: intty, output: out)

files
   modlib: a module library as used by program module
   modcat: a module catalogue for modlib, generated by program module or
           show.  it is used (if it is not empty) for faster startup.
   print:  modules that the user pulls out from modlib
   input:  typed instructions from the user
   output: messages to the user

description
   Among other uses, the show program lets you look at pages of the delila
   manual by using the computer.  Each page is a unit we call a 'module'.  The
   name of the module that contains the page you are reading is
   'describe.show'.  Notice that the name has two parts separated by periods.
   The show program takes advantage of this naming convention to let you select
   the section(s) of the manual that you want to see.  Show generates a list of
   the module names.  For delman this is

      1 * version
      2   delman.

   With this list of name-parts one has several choices:  you can choose to
   look at the "version" page by typing "version." or "1" (without quotes).
   The * in the list means that the page will print on the terminal.  To look
   at the list of pages that begin with "delman." you would simply type
   "delman." or "2".  The period in the list means that there are sub-parts to
   the name, such as "delman.intro".

   The names form a tree-like structure that the show program knows about.
   You can climb down the tree by either typing the name or the number given.

   One can type more parts to a name than one.  For example, the command
   "delman.describe.module" would print documentation on the module program.

   Commands are separated by blanks.  Show considers any consecutive
   string of characters (with no blanks) that contains a period to be
   a module name.  Anything without a period is a command, such as "top"
   which gets one to the top of the name tree.

   Once you find a section that you want to step through page by page, you can
   use the n command.  You can also simply hit the carriage return repeatedly.

   Type "help" for a list of other commands and details.

documentation
   moddef

see also
   module.p

author
   Thomas D. Schneider and Billie H. Lemmon

bugs
   Some combinations of n and l commands may make the parent on the list
   incorrect.  Go to the top to correct this.

   On Unix systems, the program will ignore the first line you type.  Simply
   hit a carriage return when the program starts.

technical notes
   The names in the module library must be separated by periods for the show
   program to recognize the parts of the names.

*)
(* end module describe.show *)

(* contents
section 1  const, type, var
section 2  primitives
section 3  help
section 4  module insertions
section 5  treegrowers
section 6  initialize
section 7  commands
section 8  main program *)

(* section 1 *)
(* more constants *)
      period = '.'; (* module name seperator *)
      defaultpagelength = 48; (* default pagelength *)
      defranbeg = 1; (* default rangebegin *)
      defranend = 10; (* default rangeend *)
      lastcharacter = ' '; (* the last character after a module name *)
(* begin module interact.const *)
      maxstring = 150; (* the maximum string *)
(* end module interact.const version = 'prgmod 3.96  85 mar 18 tds'; *)
      maxname = 50; (* one plus the largest name allowed *)

      (* the program will check the correspondence between modlib and modcat.
         checkuptimes is the number of modules to check.
         see the checkup procedure. *)
      checkuptimes = 2;

      debugging = true; (* for debugging purposes *)

type
(* begin module interact.type *)
      string = record (* a string of characters *)
         letters: array[1..maxstring] of char; (* the letters in the string *)
         length: integer; (* the number of characters in the string *)
         current: integer; (* the letter we are working on *)
      end;
(* end module interact.type version = 'prgmod 3.96  85 mar 18 tds'; *)

      treecatptr = ^treecat; (* pointer to a treecat *)

      treecat = record (* tree catalogue of names *)
         name: string; (* module subname *)
         linenumber: integer; (* location of the first line of the module.
                     zero (0) means that no module by that name (up to
                     this point in the tree) exists *)
         down: treecatptr; (* one dot level in *)
         up: treecatptr; (* the 'parent' module *)
         next: treecatptr; (* the next treecat on this level *)
      end;

      name = record (* a module name *)
         letter: packed array[1..maxname] of char;
         length: integer; (* the last character of the name *)
      end;

      trigger = record (* an object to be searched for *)
         n: name; (* the characters looked for *)
         state: integer; (* how close to triggering we are *)
         skip: boolean; (* trigger not found- skip the line *)
         found: boolean (* the trigger was found *)
      end;

      modcatitem = record (* an item in modcat *)
         module: name; (* the name of a module *)
         line: integer; (* the line module is on in modlib *)
      end;

      modcatfile = file of modcatitem;

      answers= set of 'a'..'z'; (* answers accepted by more *)

var
      modlib, (* the module library *)
      print: (* for physical printing of the module *)
         text;
      printingstarted: boolean; (* false until we actually request
         something to be printed.  Thus the program won't wreck the
         contents of a print file that exists unless the user really
         wants the printed module *)

      modcat: (* the catalogue as a file from module *)
         modcatfile;

      root, (* the module catalogue as a tree *)
      current, (* the current place in the tree *)
      last, (* the previous location in the tree *)
      view: (* the place the next command will show *)
         treecatptr;

      buffer, (* the interactive buffer *)
      command, (* the current command from the user *)
      parent, (* the name of the 'parent' module *)
      lastparent: (* the previous parent name *)
         string;

      linenumber, (* the current line in modlib *)
      shownext, (* if 1 then show the next module *)
      printnext, (* if 1 then print next module to file *)
      pagelength: (* the length put to output *)
         integer;

      begcom: char; (* the first letter of the command *)

      showlinenumbers, (* whether or not to display the line numbers to
         the person.  set by the w command. *)
      gotten, (* was the token gotten from the buffer *)
      haveperiod, (* has a period been found in the command *)
      error: (* errors in the command interpretation *)
         boolean;

      (* the triggers for the modules *)
      begintrigger, endtrigger: trigger;

      (* the range of the module names displayed on the screen *)
      rangebegin, rangeend: integer;

      (* variables used for checkup.
         the main purpose for these two variables is to prevent a halt when
         procedure checkup calls getline and the line refered to by the
         catalogue is past the end of the modlib.  this allows recovery from
         a switch to a shorter modlib without changing modcat:  a new
         modcat can be created. *)
      donthalt, (* the halt procedure should be silent *)
      haltcalled: (* if halt is called and donthalt is true
                     then halt will set this to true *)
                  boolean;


(* ************************************************************************ *)
(* ************************************************************************ *)
(* ************************************************************************ *)
(* section 2 primitives *)
(* halt :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: *)

procedure halt;
(* stop the program *)
begin
      if donthalt
      then haltcalled := true
      else begin
         writeln(output, ' program halt.');
         goto 1
      end
end;

(* begin module package.interact *)
(* ************************************************************************ *)
(* begin module interact.prompt *)
procedure prompt(var afile: text);
(* prompt a file.
   the prompt is sent to the output file, and
   a line is read into the pascal line buffer.
   (for the cyber system this means to readln afile.)
   guarantee no bomb *)
begin (* prompt *)
      if eof(afile) then reset(afile);
      readln(afile);
end; (* prompt *)
(* end module interact.prompt version = 'prgmod 3.96  85 mar 18 tds'; *)

(* begin module interact.readchar *)
procedure readchar(var afile:text; var ch: char);
(* read a character from afile, guarantee no bomb *)
begin (* readchar *)
      if eof(afile) then prompt(afile);
      read(afile,ch);
(*writeln(output,'"',ch,'"') *)
end; (* readchar *)
(* end module interact.readchar version = 'prgmod 3.96  85 mar 18 tds'; *)

(* begin module interact.clearstring *)
procedure clearstring(var ribbon: string);
(* empty the string *)
var   index: integer; (* to the ribbon *)
begin (* clearstring *)
      with ribbon do begin
         for index := 1 to maxstring do letters[index] := ' ';
         length := 0;
         current := 0;
      end
end; (* clearstring *)
(* end module interact.clearstring version = 'prgmod 3.96  85 mar 18 tds'; *)

(* begin module interact.readstring *)
procedure readstring(var afile: text; var line: string);
(* read in a string from afile, protect against bombing *)
var
      index: integer; (* for line *)
      cha: char; (* a character read in *)
      done: boolean; (* used for removing trailing blanks from the line *)
      acceptable: boolean; (* was the line typed short enough? *)
begin (* readstring *)
      with line do begin
         repeat
            clearstring(line);
            prompt(afile);
            index := 0; (* we now count characters *)
            while (not eoln(afile)) and (index < maxstring) do begin
               index:=succ(index);
               readchar(afile,cha);
               line.letters[index]:=cha
            end;
            if not eoln(afile)
            then begin
               writeln(output, 'type lines shorter than ', (maxstring+1): 1,
                               ' characters.  please retype the line...');
               acceptable := false
            end
            else acceptable := true
         until acceptable;

         length := index;
         if length > 0 then begin
            done := false;
            repeat (* remove blanks from the line.  note that a while loop
                  can not be used because one must avoid letters[0], since that
                  position does not exist... *)
               if letters[length] = ' '
               then length := pred(length)
               else done := true;

               if length = 0 then done := true
            until done
         end;

         if length > 0 then current := 1
                       else current := 0
      end
end; (* readstring *)
(* end module interact.readstring version = 'prgmod 3.96  85 mar 18 tds'; *)

(* begin module interact.figurestring *)
procedure figurestring(
      var line: string; (* a string of characters to figure out *)
      var first: integer; (* first found non-blank character in the line *)
      var last:  integer; (* last character before a blank after first *)
      var whzat: char; (* what the token is *)
      var c:     char;  (* the first character of the token *)
      var i:     integer; (* integer value of token if it is integer; or 0 *)
      var r:     real); (* the real value if it is real; or 0.0 *)
(* figurestring figures out the tokens in a string.
 it recognizes words, integers, reals and poorly formed numbers.
 you can easily use it to parse lines.

our goal is to figure out what thing is on a string.
start looking at the current place on the line.
first and last are the first 'token' in line after start.
the current place is updated to the letter after last.
the thing found is described by the value of whzat:
      'c': character (when the token does not begin with a digit, '+', or '-')
      'i': integer
      'r': real
      ' ': blank line
      'g': garbage, cannot figure it out
and the value of the thing found is the appropriate variable *)
var
      numbers: set of '0'..'9';
      sign: integer; (* sign of a number *)
      numberstart: integer; (* the point a number starts,
                               beyond its sign, if any *)
      point: integer; (* location of decimal point *)
      power: integer; (* of 10 that a number is *)

      l: integer; (* an index for dissecting numbers *)

function figureinteger(first,last:integer):integer;
(* figure the integer in the token *)
var
      i: integer; (* index *)
      sum, increment: integer;
begin (* figureinteger *)
      power:=1; (* start at ones place *)
      sum:=0; (* start sum at zero *)
      for i:=last downto first do begin
         case line.letters[i] of
            '0': increment:=0;
            '1': increment:=1;
            '2': increment:=2;
            '3': increment:=3;
            '4': increment:=4;
            '5': increment:=5;
            '6': increment:=6;
            '7': increment:=7;
            '8': increment:=8;
            '9': increment:=9
         end;
         sum:=sum+power*increment;
         power:=power*10
      end;
      figureinteger:=sum
end; (* figureinteger *)

begin (* figurestring *)
      numbers:=['0','1','2','3','4','5','6','7','8','9'];
(* c:=' '; i:=0; r:=0.0; do not affect these variables unless necessary *)
      point:=0;
      whzat := '.'; (* assume that we have someting to work on *)
      (* now to see if that is true: *)

      with line do if (length = 0) or (current < 1) or (current > length)
      then whzat := ' '
      else begin
         (* figure out where the first token is in the line *)
         first:=line.current;
         while (line.letters[first]=' ') and (first < line.length)
            do first:=succ(first);
         if (first = line.length) and (line.letters[first] = ' ')
            then whzat := ' ';
      end;

      if whzat <> ' ' then begin
         last:=first;
         while (line.letters[last]<>' ') and (last < line.length)
            do last:=succ(last);
         if line.letters[last] = ' ' then last := pred(last);

         (* the token is between inclusive first and last *)

         c:=line.letters[first];
         if (c in numbers) or (c in ['+','-']) then begin
            if c in ['+','-'] then begin
               case c of
                  '+': sign:=+1;
                  '-': sign:=-1;
               end;
               numberstart:=succ(first)
            end
            else begin
               sign:=+1;
               numberstart:=first
            end;

            whzat:='i';
            for l:=numberstart to last do begin
               if not(line.letters[l] in numbers)
               then if line.letters[l]='.' (* we found a period *)
                  then if whzat='i' (* if so far it is numbers *)
                     then begin
                        whzat:='r'; (* it is actually real *)
                        point:=l
                     end
                     else whzat:='g' (* it is a second '.', ie garbage *)
                  else whzat:='g' (* it is garbage *)
            end;
            (* if it is only numbers, it is integer *)

            (* build number *)
            (* if it ends in a period, it is integer *)
            if (whzat = 'r') and (point = last) then whzat:='i';

            if whzat = 'i' then begin
               if point = last (* had an ending decimal point *)
               then i:=sign * figureinteger(numberstart,pred(last))
               else i:=sign * figureinteger(numberstart,last);
               r:=i
            end
            else if whzat = 'r' then begin
               i:=figureinteger(numberstart,point-1);
               r:=sign * (i+figureinteger(point+1,last)/power);
               i:=sign * i
            end
         end
         else begin
            whzat:='c';
         end;

         (* move the start to just beyond the last character of the token *)
         line.current:=succ(last)
      end
end; (* figurestring *)

(* end module interact.figurestring version = 'prgmod 3.96  85 mar 18 tds'; *)

(* ************************************************************************ *)
(* end module package.interact version = 'prgmod 3.96  85 mar 18 tds'; *)

(* begin module package.interact.gets *)
(* ************************************************************************ *)
(* begin module interact.nostring *)
function nostring(var buffer: string): boolean;
(* true if there are no characters in the rest of the buffer;
   false if there are characters.
   also, if there is no buffer, then buffer.length is set to 0 *)
var   answer: boolean; (* the answer returned *)
procedure kill;
(* destroy the line *)
begin (* kill *)
      answer := true; (* blood and gore *)
      clearstring(buffer) (* total death *)
end; (* kill *)
begin (* nostring *)
      with buffer do begin
         if length > 0 then begin
            if length < maxstring
            then while (letters[current] = ' ') and (current < length)
               do current := succ(current);

            if current <= maxstring
            then if letters[current] = ' '
                 then kill
                 else answer := false
            else kill
         end
         else kill
      end;
      nostring := answer
end; (* nostring *)
(* end module interact.nostring version = 'prgmod 3.96  85 mar 18 tds'; *)

(* begin module interact.writestring *)
procedure writestring(var tofile: text; var s: string);
(* write the string s to file tofile, no writeln *)
var   i: integer; (* index to s *)
begin (* writestring *)
      with s do for i := 1 to length do write(tofile, letters[i])
end; (* writestring *)
(* end module interact.writestring version = 'prgmod 3.96  85 mar 18 tds'; *)

(* begin module interact.flagstring *)
procedure flagstring(var afile: text; var buffer: string);
(* flag an error in the buffer at the current place, and clear the buffer *)
begin (* flagstring *)
      with buffer do length := current; (* chop off the rest of the buffer *)
      writestring(afile, buffer); (* show the buffer *)
      write(afile,'? ');
      clearstring(buffer)
end; (* flagstring *)
(* end module interact.flagstring version = 'prgmod 3.96  85 mar 18 tds'; *)

(* begin module interact.getchar *)
procedure getchar(var afile: text; var buffer: string;
                  var cha: char; var gotten: boolean);
(* get a character from the buffer, or refill the buffer and
   let the calling program figure out whether the buffer has non
   blank characters in it. *)
var
      (* variables for calling figurestring: *)
      first: integer;
      last: integer;
      what: char;
      int: integer;
      rea: real;
begin (* getchar *)
      if buffer.length = 0 then begin
         gotten:=false;
         readstring(afile,buffer)
      end
      else begin
         figurestring(buffer,first,last,what,cha,int,rea);
         gotten := (what <> ' ')
      end
end; (* getchar *)
(* end module interact.getchar version = 'prgmod 3.96  85 mar 18 tds'; *)

(* begin module interact.getinteger *)
procedure getinteger(var afile: text; var buffer: string;
                     var int: integer; var gotten: boolean);
(* get the integer int from the buffer or interactive file afile *)
var
      (* variables for calling figurestring: *)
      first: integer;
      last: integer;
      what: char;
      cha: char;
      rea: real;
begin (* getinteger *)
      if buffer.length = 0
      then begin
         gotten:=false;
         readstring(afile,buffer)
      end
      else begin
         figurestring(buffer,first,last,what,cha,int,rea);

         if what <> 'i'
         then begin
            flagstring(output,buffer);
            writeln(output,' please type an integer');
            gotten:=false
         end
         else gotten:=true
      end
end; (* getinteger *)
(* end module interact.getinteger version = 'prgmod 3.96  85 mar 18 tds'; *)

(* begin module interact.getreal *)
procedure getreal(var afile: text; var buffer: string;
                  var rea: real; var gotten: boolean);
(* get the real rea from the buffer or interactive file afile
integer values are also accepted. *)
var
      (* variables for calling figurestring: *)
      first: integer;
      last: integer;
      what: char;
      cha: char;
      int: integer;
begin (* getreal *)
      if buffer.length = 0
      then begin
         gotten:=false;
         readstring(afile,buffer)
      end
      else begin
         figurestring(buffer,first,last,what,cha,int,rea);

         if not (what in ['r', 'i'])
         then begin
            flagstring(output,buffer);
            writeln(output,' please type a real number');
            gotten:=false
         end
         else gotten:=true
      end;

      (* handle integers *)
      if what = 'i' then rea := int
end; (* getreal *)
(* end module interact.getreal version = 'prgmod 3.96  85 mar 18 tds'; *)

(* begin module interact.token *)
procedure token(var buffer, atoken: string; var gotten: boolean);
(* get a token from the buffer *)
var
      (* variables for calling figurestring: *)
      first: integer;
      last: integer;
      what: char;
      cha: char;
      int: integer;
      rea: real;
      index: integer; (* to the buffer *)
begin
      figurestring(buffer,first,last,what,cha,int,rea);

      if what = ' '
      then gotten := false
      else begin
         clearstring(atoken);
         for index := first to last
            do atoken.letters[index-first+1] := buffer.letters[index];
         atoken.length := last - first + 1;
         atoken.current := 1;

         gotten:=true
      end
end;
(* end module interact.token version = 'prgmod 3.96  85 mar 18 tds'; *)

(* begin module interact.gettoken *)
procedure gettoken(var afile: text; var buffer: string;
                   var atoken: string; var gotten: boolean);
(* get a token from the buffer or interactive file afile *)
begin (* gettoken *)
      if buffer.length = 0
      then begin
         gotten:=false;
         readstring(afile,buffer)
      end
      else token(buffer,atoken,gotten)
end; (* gettoken *)
(* end module interact.gettoken version = 'prgmod 3.96  85 mar 18 tds'; *)

(* ************************************************************************ *)
(* end module package.interact.gets version = 'prgmod 3.96  85 mar 18 tds'; *)


function equalstring(a, b: string): boolean;
(* test for equality between two strings (current positions are ignored) *)
var   index: integer; (* index to both strings *)
      equal: boolean; (* are letters in a and b the same? *)
begin (* equalstring *)
      if a.length = b.length
      then begin
         index := 1;
         repeat
            equal := (a.letters[index] = b.letters[index]);
            index := succ(index)
         until (not equal) or (index > a.length);
         equalstring := equal
      end
      else equalstring := false
end; (* equalstring *)

procedure copystring(a: string; var b: string);
(* copy string a into b *)
var
      i: integer; (* index to array *)
begin (* copystring *)
      clearstring(b);
      for i:=1 to a.length
         do b.letters[i] := a.letters[i];
      b.length := a.length;
      b.current := a.current
end; (* copystring *)

procedure removeperiods(var s: string);
(* remove periods from s *)
var   index: integer; (* index to s *)
begin (* removeperiod *)
      with s
         do for index := 1 to length
            do if letters[index] = period
               then letters[index] := ' '
end; (* removeperiod *)

procedure pushstring(newtoken: string;
                     var parent, lastparent: string);
(* update the last parent string and
   put the new token onto parent *)
var   index: integer; (* for the parent and token *)
      final: integer; (* the final length *)
begin (* pushstring *)
      final := parent.length + newtoken.length + 1;
      if final > 0 then begin
         if final > maxstring then begin
            writeln(output, 'in procedure pushstring: maxstring exceeded');
            halt
         end;
         copystring(parent, lastparent);
         for index := 1 to newtoken.length
            do parent.letters[index + parent.length]
               := newtoken.letters[index];
         parent.length := final;
         parent.letters[parent.length] := period;
      end
(*;if debugging then writestring(output,parent); *)
(*;if debugging then writeln(output,' pushstring') *)
end; (* pushstring *)

procedure popstring(var parent, lastparent: string);
(* update lastparent and pop the last token off parent *)
var   done: boolean;
begin (* popstring *)
      copystring(parent, lastparent);
      with parent do if length > 0 then begin
         if letters[length]<> '.' then begin
            writeln(output,'error in popstring: ',
                           'parent does not end with "', period,'"');
            write(output, ' parent string was "');
            writestring(output, parent);
            writeln(output, '"');
            halt
         end;

         (* remove the periods *)
         length := length - 1;
         (* scan until period or no string *)
         done := false;
         repeat
            if length > 0
            then if letters[length] = period
               then done := true
               else length := length - 1
            else done := true
         until done
      end
      else begin
         clearstring(parent);
         clearstring(lastparent)
      end
(*;if debugging then writestring(output,parent); *)
(*;if debugging then writeln(output,' popstring') *)
end; (* popstring *)

(* ************************************************************************ *)
(* ************************************************************************ *)
(* ************************************************************************ *)
(* section 3 help *)
function needhelp (var buffer: string): boolean;
(* find out if the user needs help *)
var  (* for interaction *)
      c: char; (* a response *)
      gotten: boolean; (* have we got a char? *)
      answer: boolean; (* the answer *)
begin (* needhelp *)
      write(output,'error: ');
      flagstring (output, buffer);
      repeat
         if nostring(buffer)
         then writeln(output, ' Do you need help(y/n)');
         getchar(input, buffer, c, gotten);
      until gotten;
      answer := (c = 'y');
      if not answer then writeln(output,'help aborted');
      needhelp := answer
end; (* needhelp *)

function more(a: answers; var c: char): boolean;
(* ask the user if more display is wanted *)
var   l: char; (* index of the alphabet *)
begin (* more *)
      repeat
         if nostring(buffer)
            then begin
               writeln(output, 'MORE?'); (* prompt *)
               getchar(input, buffer, c, gotten); (* readstring *)
               (* now pull c from buffer *)
               if not nostring(buffer)
               then getchar(input, buffer, c, gotten);
            end
            else getchar(input, buffer, c, gotten);

         (* did a carriage return get typed? *)
         if not gotten then c := 'y';

         if not (c in a) then begin
            clearstring(buffer);
            writeln(output,'''more?'' means ''do you want more of this?''');
            write(output,' type one of:');
            for l := 'a' to 'z'
               do if l in a then write(output,' ''',l,'''');
            writeln(output,'; an empty line is the same as ''yes''')
         end;
      until c in a;
      more := (c = 'y')
end; (* more *)

procedure gohelp(var t: text);
(* give help to the user in file t *)
var   c: char; (* for the more question *)
begin (* gohelp *)
writeln(t, 'show commands are single letters without periods:');
writeln(t, '(you may type the whole command word if you want.)');
writeln(t);
writeln(t, 'f(ile), the next module is printed to the print file.');
writeln(t, 'h(elp)  this list.');
writeln(t, 'l(ast)  position is jumped to.');
writeln(t, 'n(ext)  module is shown.  Typing n lets you see the next page.');
writeln(t, '        You can also just type a carriage return');
writeln(t, 'p(age)  size adjustment for showing modules.  (currently it is ',
                    pagelength:1,').');
writeln(t, 'q(uit)  the program.');
writeln(t, 'r(ange) of the name-list numbers displayed (currently it is ',
                    rangebegin:1,' to ',rangeend:1,').');
writeln(t, '        if you see "..." it means there are modules above');
writeln(t, '        or below those listed; reset the range to see them');
writeln(t, 's(how)  the next module instead of entering it.');
writeln(t, '        this is necessary for modules like "*name.". ');
writeln(t, '        to print such a module type "file show name."');
writeln(t, 't(op)   of the tree is jumped to.');
writeln(t, 'u(p)    one name level.');
writeln(t, 'w(here) are the modules?  a toggle switch to show');
write  (t, '        the module line numbers.  currently: ');
      if showlinenumbers
      then writeln(t,'showing.')
      else writeln(t,'not showing.');

      if more(['y','n','q'],c) then begin
writeln(t, 'The show program allows you to look at modules in a module');
writeln(t, 'library.  Modules are named with several parts, as in');
writeln(t, '"describe.show".  These are called name-parts.  One does');
writeln(t, 'not type the full module name all at once (unless one wants to),');
writeln(t, 'usually one types one name-part at a time.  Show lists all those');
writeln(t, 'name-parts that you can choose from.  You must type');
writeln(t, 'a period in the name or at one end to indicate a name-part.');
writeln(t, '(Otherwise show will assume you mean one of the commands above.)');
writeln(t);
writeln(t, 'If the name has no further name-parts then the module is shown.');
write  (t, 'The list includes numbers that you can type instead of the ');
writeln(t, 'name-parts.');
writeln(t);
writeln(t, 'Several commands can be typed on one line, separated by spaces.');
      if more(['y','n','q'],c) then begin
writeln(t, 'The listing of module name-parts begins with the parent name.');
writeln(t, 'You would type the parent name to get to your current place');
writeln(t, 'in the tree from the top of the tree (top means root,');
writeln(t, 'the tree is "upside-down", the leaves are in the earth...).');
writeln(t, 'at the top of the tree, the parent name is blank.');
writeln(t);
writeln(t, 'On the listing of module name-parts are:');
writeln(t, 'a number: this is a short hand way to state the name.');
writeln(t, '[number]: the line number of the module.  See the w command.');
writeln(t, '*       : one can print these modules');
writeln(t, 'name    : a part (or sometimes all) of the module name.');
writeln(t, '.       : a period means that the module name has several parts');
writeln(t, '          separated by periods.  It can be entered by typing');
writeln(t, '          "name." or ".name" (without quotes) or the number.');
writeln(t);
writeln(t, 'In the example below, typing "1" is the same as typing');
writeln(t, '"son." and will display the module called parent.son');
writeln(t, 'typing "2" or "daughter." makes one go into the other module.');
writeln(t, 'module parent.son begins at line 256.');
writeln(t, '   parent');
writeln(t, '    1 [ 256] * son');
writeln(t, '    2 [    ]   daughter.');
      if more(['y','n','q'],c) then; (* prevent list right away *)
      end
      end
end; (* gohelp *)

procedure goprinthelp(var t: text);
(* help for goprintmodule *)
begin(* goprinthelp *)
writeln(t, 'commands for printing');
writeln(t, 'h(elp)  this list (additional help is at show command level)');
writeln(t, 'n(o)    more printing');
writeln(t, 'p(age)  size adjustment for showing modules.  (currently it is ',
                    pagelength:1,')');
writeln(t, 'q(uit)  printing');
writeln(t, 'y(es)   continue printing the module');
writeln(t, '(blank) lines cause more printing')
end; (* goprinthelp *)

(* ************************************************************************ *)
(* ************************************************************************ *)
(* ************************************************************************ *)
(* section 4 'module' insertions from program module (modified slightly) *)

procedure gettoline(line: integer; var f: text; var current: integer);
(* get to a line in f from the current place.
   current = line after gettoline is done *)
begin
      if current > line then begin (* the line is above where we are *)
         reset(f);
         current := 1
      end;

      while (current < line) and (not eof(f)) do begin
         current := succ(current);
         readln(f)
      end;

      if eof(f) then begin
         writeln(output, ' modcat refers to a line (', line: 1,
                        ') that is past the end of modlib.');
         halt
      end
end;

(* name manipulations ::::::::::::::::::::::::::::::::::::::::::::::::::::: *)

procedure clearname(var n: name);
(* set the name to blank *)
var   l: integer; (* a position in the name *)
begin (* clearname *)
      with n do begin
         for l := 1 to maxname do letter[l] := ' ';
         length := 0
      end
end; (* clearname *)

procedure printname(var f: text; n: name);
(* print the name of n to file f *)
begin
      with n do write(f, letter: length)
end;

procedure untrail(var n: name);
(* remove all trailing blanks from name n and
   end n with the lastcharacter *)
begin
      with n do begin
         length := maxname;
         while (length > 0) and (letter[length] = ' ')
            do length := pred(length);

         (* put lastcharacter at end *)
         length := succ(length);

         if length > maxname then begin
            length:=maxname;
            write(output, ' this name was found: "');
            printname(output, n);
            writeln(output, '".');
            writeln(output, ' names must be one character shorter than ',
                           maxname: 1, ' characters.');
            halt
         end
         else n.letter[length] := lastcharacter;
      end
end;

procedure getname(var source: text; var n: name);
(* return the name n in namomod, upto and including the
global constant lastcharacter *)
var
      ch: char; (* one of the characters in n *)
begin (* getname *)
      clearname(n);
      ch := '.'; (* start with a character that is not lastcharacter *)
      with n do begin
         while (not eoln(source)) and
               (ch <> lastcharacter) and
               (length <= maxname) do begin
            length := succ(length);
            read(source, ch);
            letter[length] := ch
         end;
         if letter[length] <> lastcharacter then begin
            writeln(output, ' this module name: ');
            printname(output, n);
            if length = maxname
            then writeln(output, ' is too long (>', (maxname - 1): 1,
                                 ' characters)')
                 (* if not that, it must be eoln: *)
            else writeln(output, ' did not end with a "', lastcharacter, '".');
            halt
         end
      end
end; (* getname *)

function equalname(a, b: name): boolean;
(* are the names a and b the same? *)
begin (* equalname *)
      if a.length = b.length
      then equalname := (a.letter = b.letter)
      else equalname := false
end; (* equalname *)

(* module mechanisms :::::::::::::::::::::::::::::::::::::::::::::::::::::: *)

procedure resettrigger(var t: trigger);
(* reset the trigger to ground state *)
begin (* resettrigger *)
      with t do begin
         state := 0;
         skip := false;
         found := false
      end
end; (* resettrigger *)

procedure testfortrigger(ch: char; var t: trigger);
(* look at the character ch.
   if it is part of the trigger (at the current trigger state),
       then the trigger state goes higher.
   if it is not part of the trigger then the trigger state is reset,
      skip is true and one should skip onward to find the trigger.
   if the trigger is found, found is true. *)
begin  (* testfortrigger *)
      with t do begin
         state := succ(state);
(*         if debugging then begin
            printname(output, n);
            writeln(output, 'testfortrigger n.letter[', state: 1, ']: ',
                           n.letter[state], ' ch: ', ch);
         end;*)
         if n.letter[state] = ch
         then begin
            skip := false;
            if state = n.length then found := true
                                else found := false
         end
         else begin (* reset trigger *)
            state := 0;
            skip := true;
            found := false
         end
      end
end; (* testfortrigger *)

procedure findmoduleend(var sin: text; module: name; var sinline: integer);
(* find (by reads) the end of the module in sin.  increment
sinline, the line in sin *)
var
      found: boolean; (* the module end was found *)
      ch: char; (* a character in sin *)
      endname: name; (* perhaps the end *)
begin (* findmoduleend *)
      found := false;
      while (not found) and (not eof(sin)) do begin
         (* the following loop speeds up this operation *)
         while (not eof(modlib)) and (modlib^ <> '(') do begin
            readln(modlib);
            sinline := succ(sinline)
         end;
         if not eof(modlib) then begin
            resettrigger(endtrigger);
            while not( eoln(sin) or
                       endtrigger.skip or endtrigger.found) do begin
               read(sin, ch);
               testfortrigger(ch, endtrigger)
            end;

            if endtrigger.found then begin
               getname(sin, endname);
               if equalname(endname, module) then found := true;
            end;

            (* close sin line up *)
            readln(sin);
            sinline := succ(sinline)
         end
      end;

      if eof(sin) and (not found) then begin
         write(output, ' no end to module ');
         printname(output, module);
         writeln(output, ' whose contents were being skipped.');
         halt
      end
end; (* findmoduleend *)

(* ************************************************************** *)
(* ************************************************************** *)
(* ************************************************************** *)
(* section 5 tree growers *)
(* catalogue manipulations ::::::::::::::::::::::::::::::::::::::::::::::: *)

procedure grab(var f: modcatfile; var item: modcatitem);
(* obtain an item from file f *)
begin
      item := f^;
      get(f)
end;

procedure drop(var t: modcatfile; var item: modcatitem);
(* place an item into file t *)
begin
      t^ := item;
      put(t)
end;

function inmodcat(var modcat: modcatfile; module: name;
                  var line: integer): boolean;
(* is the module in modcat?
   return the line number in modlib (side effect).
   this version of inmodcat differs from that in the module program,
   in that it can not take advantage of an alphabetical modcat *)
var
      n: modcatitem; (* an item in modcat *)
      found: boolean; (* true when module is found *)
begin (* inmodcat *)
      reset(modcat);
      found := false;

      while not(eof(modcat) or found) do begin
         grab(modcat, n);
         if equalname(n.module, module) then found := true
      end;

      if found
      then begin
         inmodcat := true;
         line := n.line
      end
      else begin
         inmodcat := false;
         line := -1 (* an impossible line number *)
      end
end; (* inmodcat *)



procedure checkup(var modlib: text;
                  var modcat: modcatfile);
(* check that modlib corresponds to modcat.
   the number of modules to check is set by the global constant
   checkuptimes. *)
var
      times: integer; (*  number of checks completed *)
      fail: boolean; (* what may well happen during this checkup *)
      cat: modcatitem; (* one item in modcat *)
      ch: char; (* a character from modlib *)
      libname: name; (* a name from modlib *)
      modlibline: integer; (* the current line in modlib *)
      modcatline: integer; (* a line refered to by modcat *)
begin (* checkup *)
      writeln(output, ' check modlib-modcat correspondence:');
      reset(modlib);
      reset(modcat);
      modlibline := 1;
      times := 0;
      fail := false;

      (* first check: do items in the catalogue point
         to modules in modlib *)
      donthalt := true; (* prevent halting during this check *)
      repeat (* this forces at least one check. *)
         (* get an item from the catalogue *)
         grab(modcat, cat);

         (* use the item to locate a line in modlib *)
         gettoline(cat.line, modlib, modlibline);

         if haltcalled
         then begin
            (* reference by modcat to a line past the end of modlib *)
            fail := true;
            haltcalled := false;
         end
         else begin
            (* first we must determine that a module <begin> is there *)
            resettrigger(begintrigger);

            while not (eoln(modlib) or
                       begintrigger.found or begintrigger.skip) do begin
               read(modlib, ch);
               testfortrigger(ch, begintrigger)
            end;

            if begintrigger.skip or eoln(modlib)
            then fail := true
            else (* begintrigger.found *) begin (* check the name *)
               getname(modlib,libname);
               if not equalname(libname, cat.module) then fail := true
            end;

            times := succ(times);
         end;
      until (times >= checkuptimes) or (eof(modcat)) or fail;
      donthalt := false; (* allow halting again *)

      (* second check: do items in modlib have
         corresponding items in modcat? *)
      if not fail then begin
(*         if debugging then writeln(list,' second check'); *)
         reset(modlib);
         reset(modcat);
         modlibline := 1;
         times := 0;

         repeat
            resettrigger(begintrigger);
            while not (eoln(modlib) or
                 begintrigger.skip or begintrigger.found) do begin
               read(modlib, ch);
               testfortrigger(ch, begintrigger)
            end;

            if begintrigger.found then begin
               times := succ(times);
               getname(modlib, libname);
               if not(inmodcat(modcat, libname, modcatline))
               then fail := true
                  (* maybe the lines do not match... *)
               else if modcatline <> modlibline then fail := true;
               if not fail then findmoduleend(modlib, libname, modlibline)
            end
            else begin
               readln(modlib);
               modlibline := succ(modlibline)
            end
         until (times > checkuptimes) or eof(modlib) or fail
      end;

      if fail
      then begin
         write(output,' failed:');
         repeat
            if nostring(buffer)
            then writeln(output,' halt or rebuild (h/r)?');
            gettoken(input,buffer,command,gotten);
            begcom := command.letters[1];
            if gotten then if not(begcom in ['h','r']) then gotten := false
         until gotten;
         if begcom = 'h' then halt
                         else begin
                            rewrite(modcat);
                            reset(modlib)
                         end
      end
      else begin
         writeln(output,' passed.');
         reset(modlib);
         reset(modcat)
      end
end; (* checkup *)

procedure namestring(var s: string; n: name);
(* transfer module name to string type *)
var
      index: integer; (* index to names *)
begin (* namestring *)
      clearstring(s);
      for index := 1 to n.length
      do s.letters[index] := n.letter[index];
      s.length := n.length;
      s.current := 1
end; (* namestring *)

procedure getlibmodule(var modlib: text; var token: string;
                       var currentline,  lineofmodule: integer;
                       var found: boolean;
                       var modcat: modcatfile);
(* search modlib from current line to find module beginning. the module
found is at lineofmodule; the name is token. if no module exists found is
false.  currentline is incremented to the line after the end of the module.
finally, the names are used to generate a modcat file for next time. *)
var
      ch: char; (* a character in modlib *)
      modnam: name; (* name of the module *)
      item: modcatitem; (* an item of modcat *)
begin (* getlibmodule *)
      found := false;
(* if debugging then writeln(output, 'getlibmodule ==================='); *)
      while (not eof(modlib)) and (not found) do begin
(* if debugging then writeln(output, 'getlibmodule line ', currentline: 1); *)
         (* the following loop speeds up this operation *)
         while (not eof(modlib)) and (modlib^ <> '(') do begin
            readln(modlib);
            currentline := succ(currentline)
         end;
         if not eof(modlib) then begin
            resettrigger(begintrigger);
            resettrigger(endtrigger);
            while not ( eoln(modlib) or
                        ((begintrigger.skip or begintrigger.found) and
                         (  endtrigger.skip or   endtrigger.found)    ) )
            do begin
               read(modlib, ch);
   (* if debugging then writeln(output, 'getlibmodule ch: ', ch); *)
               testfortrigger(ch, begintrigger);
               testfortrigger(ch, endtrigger)
            end;

            if begintrigger.found then begin
               lineofmodule := currentline;
               found := true;
               getname(modlib, modnam);
               namestring(token, modnam);

               (* put to modcat this info *)
               item.module := modnam;
               item.line   := lineofmodule;
               drop(modcat,item);

               findmoduleend(modlib, modnam, currentline)
            end
            else if endtrigger.found then begin
               getname(modlib, modnam);
               writeln(output, 'no beginning to module ');
               printname(output, modnam);
               writeln(output, ' at line ', currentline: 1);
               halt
            end
            else begin
               readln(modlib);
               currentline := succ(currentline)
            end
         end
      end
(*;if debugging then begin
      writeln(output, 'getlibmodule line ', currentline: 1);
      writestring(output, token);
      writeln(output,'found: ',found);
      if found then writeln(output,'at line ',lineofmodule: 1)
end*)
end; (* getlibmodule *)

procedure getcatmodule(var modcat: modcatfile;
                       var token: string;
                       var lineofmodule: integer;
                       var found: boolean);
(* pick up the next modcatitem from modcat.  the module is at
lineofmodule; the name is token.  if no module exists, found is false *)
begin (* getcatmodule *)
      if eof(modcat)
      then found := false
      else begin
         namestring(token, modcat^.module);
         lineofmodule := modcat^.line;
         get(modcat);
         found := true
      end
end; (* getcatmodule *)

procedure filltree(var place, above: treecatptr; ident: string);
(* fill the treecat(place) with the name ident at some line number
above is the level above where we are *)
begin (* filltree *)
      with place^ do begin
         name := ident;
         linenumber := 0;
         down := nil;
         up := above;
         next := nil
      end
end; (* filltree *)

procedure growtree(var modlib: text; var modcat: modcatfile;
                   var root: treecatptr);
(* grow a tree catalogue from modlib or modcat *)
var
      currentline, (* the current line of modlib *)
      lineofmodule: (* the line a module begins on *)
         integer;
      nowhere, (* a pointer to nil, to be able to pass nil to filltree *)
      current, (* the current level we are growing *)
      above, (* the level above us *)
      endofname, (* the last name part put into the tree *)
      atreecat: (* one of the treecats on level with current *)
         treecatptr;
      usemodlib: boolean; (* are we using modlib or modcat? *)
      foundmodule, (* was namomod found on level current *)
      gotten, (* for getting tokens *)
      newlevel: (* the next token is the first on a new
                   level down below atreecat *)
         boolean;
      namomod, (* the name of a module *)
      token: (* a token in namomod *)
         string;
procedure filllower;
(* create the lower levels of the branch, if there are any, starting
just below atreecat  *)
begin (* filllower *)
      while (namomod.current <= namomod.length) and
            gotten do begin
         gettoken(input,namomod,token,gotten);
         if gotten then begin
            above := current; (* be sure to point to correct above... *)
            new(atreecat^.down);
            atreecat := atreecat^.down;
            filltree(atreecat,above,token);
            current := atreecat (* keep track of current so above is correct *)
         end
      end;
      endofname := atreecat
end; (* filllower *)
begin (* growtree *)
      reset(modlib);
      if eof(modlib) then begin
         writeln(output, '... wow, the module library is empty');
         halt
      end;

      reset(modcat);
      if eof(modcat) then rewrite(modcat)
                     else checkup(modlib, modcat);
      usemodlib := eof(modcat);

      write(output,'building name tree from ');
      if usemodlib
      then write(output, 'modlib')
      else write(output, 'modcat');
      write(output,' ... ');

      currentline := 1;
      nowhere := nil;
      root := nil;
      foundmodule := true;

      while foundmodule do begin
         if usemodlib
         then getlibmodule(modlib, namomod, currentline,
                           lineofmodule, foundmodule, modcat)
         else getcatmodule(modcat, namomod, lineofmodule, foundmodule);

         if foundmodule then begin
            current := root;
            above := current;
            endofname := current;
            removeperiods(namomod);
            gotten := true;
            newlevel := false;

            (* search through a module name *)
            while (namomod.current<=namomod.length) and gotten do begin
               gettoken(input, namomod, token, gotten);
               if gotten then begin (* we have part of the name *)
                  (* since we know that there is another name part, we can
                     advance the endofname pointer *)
                  endofname := current;

                  if newlevel then begin
                     (* create a new level below atreecat (see code below) *)
                     new(atreecat^.down);
                     above := current;
                     current := atreecat^.down;
                     atreecat := current;
                     filltree(current, above, token);
                     filllower;
                     newlevel := false
                  end
                  else if current = nil
                  then begin (* start the tree *)
                     new(root);
                     above := root;
                     filltree(root, nowhere, token);
                     atreecat := root;
                     current := root;
                     filllower
                  end
                  else begin
                     (* find a token at this level *)
                     atreecat := current;
                     while (atreecat^.next <> nil) and
                           (not equalstring(token, atreecat^.name)) do
                               atreecat := atreecat^.next;
                     (* keep proper track of the end of the name: *)
                     if atreecat <> current then endofname := atreecat;

                     if equalstring(token, atreecat^.name) then begin
                     (* the names match, go down *)
                        if atreecat^.down = nil then begin
                           (* when we get the next token, it goes on
                              a new level *)
                           newlevel := true;
                           (* in case no next token, we assign: *)
                           endofname := atreecat;
                        end
                        else begin (* move down *)
                           above := current;
                           current := atreecat^.down;
                           (* note that endofname is not moved down with
                              current because we do not know that there is
                              another module name part yet. *)
                        end
                     end
                     else begin (* grow a horizontal branch *)
                        new(atreecat^.next);
                        atreecat := atreecat^.next;

                        (* above is nil when we are at the top *)
                        if current=root
                        then filltree(atreecat, nowhere, token)
                        else filltree(atreecat, above,   token);

                        filllower
                        (* note: current remains the same *)
                     end
                  end
               end
            end;

            (* remove tokens, fix up linenumber *)
            if endofname^.linenumber <> 0
            then begin
               writeln (output, 'duplicate module names at lines ',
                  endofname^.linenumber: 1,
                  ' and ',
                  lineofmodule: 1);
               halt
            end
            else endofname^.linenumber := lineofmodule
         end
      end
end; (* growtree *)

(* ************************************************************************ *)
(* ************************************************************************ *)
(* ************************************************************************ *)
(* section 6 initialize *)
procedure initialize;
(* set up the variables *)
begin (* initialize *)
      writeln(output, 'show ', version: 4: 2);
      printingstarted := false; (* we have not started printing to the
         print file yet, so we won't rewrite it yet *)
      pagelength := defaultpagelength;
      rangebegin := defranbeg;
      rangeend := defranend;
      clearstring(buffer);
      clearstring(parent);
      clearstring(command);
      begcom := command.letters[1];
      shownext := 2;
      printnext := 2;
      (* set up triggers.  they must be the same size as maxname. *)
      with begintrigger do begin
         (*                    1         2         3         4         5 *)
         (*           12345678901234567890123456789012345678901234567890 *)
         n.letter := '(* begin module                                   ';
         untrail(n)
      end;

      with endtrigger do begin
         (*                    1         2         3         4         5 *)
         (*           12345678901234567890123456789012345678901234567890 *)
         n.letter := '(* end module                                     ';
         untrail(n)
      end;

      (* set up halt variables *)
      donthalt := false;
      haltcalled := false;

      (* now build the tree of names *)
      growtree(modlib, modcat, root);
      if root = nil then begin
         writeln(output,'no modules in modlib file');
         halt
      end;
      current := root;
      view := root;
      last := current;
      reset(modlib);
      linenumber := 1;
      showlinenumbers := false;
      writeln(output,'done');
end; (* initialize *)

procedure gonext(var place: treecatptr);
(* move the place across on the current level. refuse to go
   if there is nothing at place. *)
begin (* gonext *)
      if place <> nil
      then place := place^.next
end; (* gonext *)

procedure writetreecat(var afile: text; place: treecatptr);
(* writes one treecat name *)
begin (* writetreecat *)
      with place^ do begin
         if linenumber <> 0 then write(afile,'* ')
                            else write(afile,'  ');
         writestring(afile, name);
         if down <> nil then write(afile,'.')
      end
end; (* writetreecat *)

procedure writelinenumber(var afile: text; place: treecatptr);
(* write the line number of the treecat name within brackets *)
const
      width = 4; (* the number of characters to reserve for the numbers *)
begin (* writelinenumber *)
      with place^ do begin
         write(afile,'[');
         if linenumber = 0
         then write(afile,' ':width)
         else write(afile,linenumber:width);
         write(afile,'] ')
      end
end; (* writelinenumber *)


procedure writelevel(var afile: text; parent: string; place: treecatptr;
                         showlinenumbers: boolean);
(* list to afile the names at this level in the range of numbers defined by
globals rangebegin to rangeend.  display the linenumbers of the modules if
showlinenumbers is true.  *)
var
      counter: integer; (* counts names on the level *)
      lines: integer; (* the number of lines written to the terminal
         since the last more question or the start of the list *)
      c: char; (* to keep more happy... *)
begin (* writelevel *)
      counter := 0;
      writestring(afile, parent);
      writeln(afile);
      lines := 1;

      if rangebegin > 1 then writeln(afile,'...');
      while (place <> nil) and (counter < rangeend) do begin
         if lines >= pagelength
         then if not more(['y','n','q'],c)
            then counter := maxint
            else lines := 0
         else begin
            counter := counter + 1;
            if counter >= rangebegin then begin
               write(afile, counter: 2, ' ');
               if showlinenumbers then writelinenumber(afile,place);
               writetreecat(afile, place);
               writeln(afile);
               lines := succ(lines)
            end;
            gonext(place)
         end
      end;
      if place <> nil then writeln(afile,'...')
end; (* writelevel *)

procedure findonlevel(var place: treecatptr; theone: string;
                      var box: treecatptr);
(* find on level place the box with name theone *)
var
      found: boolean; (* have we found it yet *)
begin (* findonlevel *)
      box := place;
      found := false;
      while(not found) and (box <> nil) do begin
         if equalstring(box^.name, theone)
         then found := true
         else gonext(box)
      end
end; (* findonlevel *)

(* ************************************************************************ *)
(* ************************************************************************ *)
(* ************************************************************************ *)
(* section 7 commands *)

procedure gopage(var buffer: string; var t: text);
(* set the page global variable *)
var
      gotten: boolean;
begin (* gopage *)
      repeat
         if nostring(buffer) then writeln(t,
                'page length was ', pagelength: 1,' type new:');
         getinteger(input, buffer, pagelength, gotten);
         if gotten then if pagelength <= 0 then begin
            writeln(t,'type a positive integer');
            gotten := false
         end
      until gotten
end; (* gopage *)

procedure gorange(var buffer: string; var t: text);
(* set the range global variables *)
var
      gotten: boolean;
begin (* gorange *)
      repeat
         if nostring(buffer) then writeln(t,
              'the visible range of the name-part list began at ',
              rangebegin: 1,', type new: ');
         getinteger(input,buffer,rangebegin,gotten);
         if gotten then begin
            if rangebegin < 1 then begin
               writeln(t,'use a positive integer');
               gotten := false
            end;

            if rangebegin >= maxint then begin
               writeln(t,'use a smaller value'); (* protect writelevel *)
               gotten := false
            end
         end
      until gotten;

      repeat
         if nostring(buffer) then writeln(t,
              'the visible range of the name-part list ended at ',
              rangeend: 1,', type new: ');
         getinteger(input,buffer,rangeend,gotten);
         if gotten then begin
            if rangeend >= maxint then begin
               writeln(t,'use a smaller value'); (* protect writelevel *)
               gotten := false
            end;

            if rangebegin < 1 then begin
               writeln(t,'use a positive integer');
               gotten := false
            end;

            if rangebegin > rangeend then begin
               writeln(t,'use a value larger than or equal to the',
                              ' begin (',rangebegin:1,')');
               gotten := false
            end
         end
      until gotten;

      writeln(t,'range ',rangebegin:1,' to ',rangeend:1)
end; (* gorange *)

procedure goprintmodule(var modlib, display: text; place: treecatptr;
                        var line: integer);
(* print to display a module in modlib named place *)
var
      done, (* done printing *)
      gotten: boolean; (* have we gotten a command *)
      c: char; (* a character to print or a response from the person *)
      count: integer; (* count number of lines printed *)
      thename, (* name of the module being printed *)
      endname: (* name of a module end, perhaps for thename *)
         name;
      thenamefound: boolean; (* was thename found yet? *)
begin (* goprintmodule *)
      c := ' ';
      if place^.linenumber = 0
      then begin
         write(output, 'no text exists for ');
         writestring(output, parent);
         writestring(output, place^.name);
         writeln(output)
      end

      else begin (* the text exists *)

         gettoline(place^.linenumber, modlib, line);

         resettrigger(begintrigger);
         resettrigger(endtrigger);
         count := 0;
         thenamefound := false;
         done := false;

         while (not eof(modlib)) and (not done) do begin
            (* write one line out *)
            while not eoln(modlib) do begin
               read(modlib, c);
               write(display, c);

               if thenamefound
               then begin
                  testfortrigger(c, endtrigger);
                  if endtrigger.found then begin
                     getname(modlib,endname);
                     printname(display,endname);
                     if equalname(endname, thename) then done := true
                  end
               end
               else begin
                  testfortrigger(c,begintrigger);
                  if begintrigger.found then begin
                     getname(modlib,thename);
                     printname(display,thename);
                     thenamefound := true
                  end
               end
            end;
            readln(modlib);
            writeln(display);
            line := line + 1;
            count := count + 1;

            (* see what to do after this line *)
            if not done then if count >= pagelength then begin
               count := 0;
               gotten := false;
               repeat
                       if more(['y','n','q','h','p'],c) then gotten := true
                  else if c = 'h' then goprinthelp(output)
                  else if c = 'p' then gopage(buffer, output)
                  else begin
                       gotten := true;
                       done := true
                  end
               until gotten
            end
         end;

         if pagelength = maxint then begin
            writestring(output,parent);
            writestring(output,place^.name);
            writeln(output,' printed')
         end;

         (* prevent writing the list right away (it can be
            long and would force the display off the top of a crt) *)
         if (not (c in ['q','n'])) and (pagelength <> maxint)
             (* did they say to stop already? *)
         then if more(['y','n','q'],c) then writeln(output,'no more text')
      end;
end; (* goprintmodule *)

procedure down(var place: treecatptr; var modlib, display: text;
               var parent, lastparent: string;
               var line: integer; var printed: boolean);
(* if shownext = 1 then print the module if possible, (and print to
the print file if printnext = 1 ...) otherwise
move the place down one level. if there is no level below, print the
module, extend the parent string, done means module was printed *)
var
      temppagelength: integer; (* temporary hold for pagelength *)
begin (* down *)
      if (shownext = 1) or (place^.down = nil)
      then begin
         printed := true;
         if printnext = 1
         then begin
            temppagelength := pagelength;
            pagelength := maxint; (* print all the module *)
            (* only rewrite the print file if we are going to use it *)
            if not printingstarted then begin
               rewrite(print);
               printingstarted := true
            end;
            goprintmodule(modlib, print, place, line);
            pagelength := temppagelength
         end
         else goprintmodule(modlib, display, place, line);
      end
      else begin (* go into the name *)
         printed := false; (* because we are going down *)
         pushstring(place^.name, parent, lastparent);
         place := place^.down
      end
end; (* down *)

procedure godown(var dottednames, parent, lastparent: string;
                 var current, last, view: treecatptr;
                 var modlib, display: text;
                 var linenumber: integer;
                 var error: boolean);
(* go down from current into the names indicated by dottednames,
   advance parent list *)
var
      gotten, (* a subname was found in dottednames *)
      printed: boolean; (* module was printed out *)
      count: integer; (* how many levels we go down *)
      aname: string; (* parent of dottednames *)
      hole: treecatptr; (* the next place we will go *)
      originalcurrent: treecatptr; (* the first value of current *)
begin (* godown *)
      removeperiods(dottednames);
      gotten := true;
      count := 0;
      printed := false;
      originalcurrent := current; (* hold while we dive... *)

      while (dottednames.current <= dottednames.length) and
           gotten and (not printed) do begin
(*if debugging then writeln(output,'godown: about to gettoken'); *)
         gettoken(input, dottednames, aname, gotten);
         if gotten then begin
(*if debugging then begin
      write(output,'godown: got token ');
      writestring(output,aname);
      writeln(output)
end; *)
            (* find a name *)
            findonlevel(current, aname, hole);
(*if debugging then writeln(output,'godown: after findonlevel'); *)
            if hole = nil then begin
               write(output, 'can not find ');
               writestring(output, aname);
               writeln(output, ' on this level');
               error := true
            end
            else begin (* attempt to go down *)
               down(hole, modlib, display, parent, lastparent,
                    linenumber, printed);
               if not printed then begin
                  count := succ(count);
                  current := hole
               end;
               view := hole
            end
         end
      end;
      if not printed then if count = 0
         then writeln(output, 'no movement')
         else begin
            last := originalcurrent;
            write(output, 'moved ', count: 1, ' name level');
            if count <> 1 then write(output,'s');
            writeln(output,' down')
         end
end; (* godown *)

procedure gonumber(var nstring, parent, lastparent: string;
                   var current, last, view: treecatptr;
                   var modlib, display: text;
                   var linenumber: integer;
                   var error: boolean);
(* pick up a number n from nstring, find the nth name on the current
   level, go down, advance parent string, print the module if
   one can not go down *)
var
      n, (* the requested module name number *)
      count: integer; (* current count on this level *)
      gotten: boolean; (* was n found *)
      printed: boolean; (* was the module printed? *)
      hole: treecatptr; (* where we may try to godown *)
begin (* gonumber *)
      getinteger(input, nstring, n, gotten);
      if gotten then if n < 1
      then begin
         writeln(output, 'only positive integers are permitted');
         error := true
      end
      else begin
         hole := current;
         count := 1; (* we are pointing to the first name *)
         gotten := false;
         repeat
            if n = count then begin
(*if debugging then writeln(output,'gonumber: n=count,gotten');*)
               gotten := true;
               down(hole, modlib, display, parent, lastparent,
                    linenumber, printed);
(*if debugging then writeln(output,'printed: ',printed);*)
               if not printed then begin
                  last := current;
                  current := hole
               end;
               view := hole
            end
            else begin (* move to next name *)
               hole := hole^.next;
               count := count + 1
            end
         until gotten or (hole = nil);
         if not gotten then begin
            writeln(output, 'type a number smaller than ', count: 1);
            error := true
         end
      end
end; (* gonumber *)

procedure gotonext(var parent, lastparent: string;
                   var current, last, view: treecatptr;
                   var modlib, display: text;
                   var linenumber: integer);
(* move to the next module and show it *)
procedure shift;
(* shift to another module ... *)
var   upward: boolean; (* we are going up *)
      lastcurrent: treecatptr; (* the last view spot *)
begin (* shift *)
(*if debugging then writeln(output,'shift start');*)
           if view^.down <> nil then begin
              pushstring(view^.name, parent, lastparent);
              view := view^.down;
              current := view
           end
      else if view^.next <> nil then view := view^.next
      else begin
(*if debugging then writeln(output,'upward'); *)
         upward := true;
         while upward do begin
            popstring(parent, lastparent);
            lastcurrent := current; (* remember where we were down there *)
            view := view^.up; (* jump up one level *)
            current := view;

            if view <> nil then begin
               (* now march the view over to the last view ... *)
               while (view^.down <> lastcurrent) and (view^.next <> nil)
                  do view := view^.next;

               (* now step to the next one *)
               if view^.next <> nil
               then begin
                  view := view^.next;
                  upward := false
               end
               (* else view^.next is nil so up we go... *)
            end
            else begin
               view := root; (* we ran off the top reset. *)
               current := view;
               upward := false
            end
         end
      end
end; (* shift *)
begin (* gotonext *)
      last := current;

      (* did we reach the top? *)
      if view = root then writeln(output,'at treetop');

      goprintmodule(modlib, display, view, linenumber);

      (* there is at least one module... *)
      repeat shift until view^.linenumber <> 0;
end; (* gotonext *)

procedure gofile;
(* make next module print to file *)
begin (* gofile *)
      if nostring(buffer)
         then writeln(output,'next name will be printed to file');
      printnext := 0;
      if shownext = 1 then shownext := 0 (* let both go together *)
end; (* gofile *)

procedure gostar;
(* set global shownext to a value that means print the next
   module instead of moving down *)
begin (* gostar *)
      if nostring(buffer)
         then writeln(output,'next name will be shown');
      shownext := 0;
      if printnext = 1 then printnext := 0 (* let both go together *)
end; (* gostar *)

procedure golast(var c, l, v: treecatptr;
                 var parent, lastparent: string);
(* move from the location(c) to the previous one(l)
   and adjust the parent strings, and the view v *)
var
      holdt: treecatptr; (* hold the current location *)
      holds: string; (* hold string *)
begin (* golast *)
      (* switch the tree positions *)
      holdt := c;
      c := l;
      l := holdt;

      v := c;

      (* switch the strings *)
      copystring(parent, holds);
      copystring(lastparent, parent);
      copystring(holds, lastparent);

      writeln(output, 'at last location')
end; (* golast *)

procedure gotop(var current, top, last, view: treecatptr;
                var parent, lastparent: string);
(* move current location to the top of the tree *)
begin (* gotop *)
      last := current;
      current := top;
      view := current;
      copystring(parent, lastparent);
      clearstring(parent)
end; (* gotop *)

procedure goup(var curlevel, last, view: treecatptr;
               var parent, lastparent: string);
(* move to next level up, decrease parent string *)
begin (* goup *)
      if curlevel^.up<>nil then begin
         last := curlevel; (* leave previous position *)
         popstring(parent, lastparent);
         curlevel := curlevel^.up; (* go up *)
      end
      else writeln(output, 'nothing is above this level');
      view := current
end; (* goup *)

procedure goquit;
(* leave the system *)
begin (* goquit *)
      writeln(output, 'quit')
end; (* goquit *)

procedure gowhere(var showlinenumbers: boolean);
(* toggle the display for showing where modules are *)
begin (* gowhere *)
      showlinenumbers := not showlinenumbers;
      write(output,'now ');
      if not showlinenumbers then write(output,'not ');
      writeln(output,'showing line numbers.')
end; (* gowhere *)

(* ************************************************************************ *)
(* ************************************************************************ *)
(* ************************************************************************ *)
(* section 8 main program *)

begin (* show *)
      initialize;
      while begcom <> 'q' do begin
         repeat
            if nostring(buffer) then begin
               writelevel(output, parent, current, showlinenumbers);
               if nostring(buffer)
               then writeln(output, 'show');
            end;
            gettoken(input, buffer, command, gotten);

            (* if a carriage return was typed, then go to the next page *)
            if (not gotten) and (nostring(buffer))
            then begin
               clearstring(buffer); (* make sure that all is clean so that
                  the more function won't see anything *)

               gotonext(parent, lastparent, current, last, view,
                                           modlib, output, linenumber);
            end
         until gotten;
         begcom := command.letters[1];
         error := false;

         (* increment counts for printnext and shownext *)
         printnext := printnext + 1;
         shownext := shownext + 1;

         (* see if the command has a period in it *)
         with command do begin
            current := 1;
            haveperiod := false;
            while(current <= length) and (not haveperiod) do begin
               haveperiod := (letters[current]=period);
               current := current + 1
            end;
            current := 1;
         end;

              if haveperiod then godown(command, parent, lastparent,
                                        current, last, view,
                                        modlib, output,
                                        linenumber, error)
         else if begcom = 'f' then gofile
         else if begcom = 'h' then gohelp(output)
         else if begcom = 'l' then golast(current, last, view,
                                          parent, lastparent)
         else if begcom = 'n' then gotonext(parent, lastparent,
                                            current, last, view,
                                            modlib, output,
                                            linenumber)
         else if begcom = 'p' then gopage(buffer, output)
         else if begcom = 'q' then goquit
         else if begcom = 'r' then gorange(buffer, output)
         else if begcom = 's' then gostar
         else if begcom = 't' then gotop(current, root, last, view,
                                         parent, lastparent)
         else if begcom = 'u' then goup(current, last, view,
                                        parent, lastparent)
         else if begcom = 'w' then gowhere(showlinenumbers)
         else if begcom in ['0', '1'..'9']
         then gonumber(command, parent, lastparent,
                       current, last, view,
                       modlib, output,
                       linenumber, error)
         else if needhelp(buffer) then gohelp(output);

         if error then clearstring(buffer)
      end;
1: end. (* show *)