program makman(input, output);
(* makman: make manual entries from a source code

  Dr. Thomas D. Schneider
  National Cancer Institute
  Laboratory of Experimental and Computational Biology
  Molecular Information Theory Group
  Frederick, Maryland  21702-1201
  toms@ncifcrf.gov
  permanent email: toms@alum.mit.edu (use only if first address fails)
  http://www.lecb.ncifcrf.gov/~toms/

  module libraries required: delman, prgmod *)

label 1; (* end of program *)

const
(* begin module version *)
   version = 1.44; (* of makman.p 2004 Sep 15
2004 Sep 15, 1.44: upgrade documentation
1.41 2000 July 19: put complete version module at top, allows recursion!
1.34 2000 July 12: package the module grab function
1.34 2000 Feb 18: move version to top of output for visibility
1997 January 10: previous changes
origin 1986 dec 9 *)
(* end module version *)

(* begin module describe.makman *)
(*
name
   makman: make manual entries from a source code

synopsis
   makman(input: in, output: out)

files
   input: a source code containing one or more modules with names
      of the form 'describe.name'.  The module must be proceeded
      by a "version = " identification line.
   output: the modules with names of the form 'describe.name'.
      This is preceeded by the "version = " line.

description
   Modules with names of the form "describe.name" are copied from the
   input to the output.  By appending a set of such modules together
   from several programs, one can create a manual.  The pages may
   then be broken apart with the pbreak program.

see also
   module.p, pbreak.p, shell.p, htmlink.p

author
   Thomas D. Schneider

bugs
   none known
*)
(* end module describe.makman *)

(* begin module string.const *)
      maxstring = 150; (* the maximum string *)
(* end module string.const version = 4.41; (@ of prgmod.p 2000 June 24 *)

(* begin module makman.filler.const *)
      fillermax = 32; (* the size of the filler array for a string *)
(* end module makman.filler.const *)

type
(* begin module string.type *)
   stringptr = ^string; (* pointer to a string *)
   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 *)
      next: stringptr; (* the next string in a series *)
   end;
(* end module string.type version = 4.41; (@ of prgmod.p 2000 June 24 *)

(* begin module filler.type *)
      (* the following is an array used to fill a string.
      it is convenient to have it much shorter than the maxstring, so that
      it is easy to fill the string using procedure fillstring.
      the user must declare the value of constant fillermax. *)
      filler = packed array[1..fillermax] of char;
(* end module filler.type version = 4.41; (@ of prgmod.p 2000 June 24 *)

(* begin module trigger.type *)
      trigger = record (* an object to be searched for *)
         seek: string; (* 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;
(* end module trigger.type version = 4.41; (@ of prgmod.p 2000 June 24 *)

(* begin module halt *)
procedure halt;
(* stop the program.  the procedure performs a goto to the end of the
   program.  you must have a label:
      label 1;
   declared, and also the end of the program must have this label:
      1: end.
   examples are in the module libraries.
   this is the only goto in the delila system. *)
begin
      writeln(output,' program halt.');
      goto 1
end;
(* end module halt version = 4.41; (@ of prgmod.p 2000 June 24 *)

(* begin module 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 *)
procedure initializestring(var ribbon: string);
(* start the string with a nil pointer.   This routine
should be called before doing linked list work.  This allows
the standard string routines to clear the string without
killing the pointer. *)
begin (* initializestring *)
   clearstring(ribbon);
   ribbon.next := nil;
end; (* initializestring *)
(* end module clearstring version = 4.41; (@ of prgmod.p 2000 June 24 *)

(* begin module 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 writestring version = 4.41; (@ of prgmod.p 2000 June 24 *)

(* begin module interact.getstring *)
procedure getstring(var afile: text; var buffer: string;
                    var gotten: boolean);
(* get a line (as a string) from a file not using string calls.  this lets
one obtain lines from a file without interactive prompts *)
var   index: integer; (* of buffer *)
begin (* getstring *)
      clearstring(buffer);
      if eof(afile)
      then gotten := false
      else begin
         index := 0;
         while (not eoln(afile)) and (index < maxstring) do begin
            index := succ(index);
            read(afile, buffer.letters[index])
         end;
         if not eoln(afile) then begin
            writeln(output, ' getstring: a line exceeds maximum string size (',
                            maxstring:1,')');
            halt
         end;
         buffer.length := index;
         buffer.current := 1;
         readln(afile);
         gotten := true
      end
end; (* getstring *)
(* end module interact.getstring version = 4.41; (@ of prgmod.p 2000 June 24 *)

(* begin module filler.fillstring *)
procedure fillstring(var s: string; a: filler);
(* this procedure makes it reasonably easy to fill the string s with
characters.  one calls the procedure as: *)
(*                           1         2         3         4         5 *)
(*                  12345678901234567890123456789012345678901234567890 *)
(*   fillstring(s, 'this-is-the-string                                ');
the two comments make it easy to line the characters up. also, for this
example, it was assumed that the length of filler as defined by the
constant fillermax was 50. *)
var
      length: integer; (* of the string without trailing blanks *)
      index: integer; (* of s *)
begin (* fillstring *)
      clearstring(s);
      length := fillermax;
      while (length > 1) and (a[length] = ' ') do length := pred(length);
      if (length = 1) and (a[length] = ' ') then begin
         writeln(output, 'fillstring: the string is empty');
         halt
      end;

      for index := 1 to length do s.letters[index] := a[index];
      s.length := length;
      s.current := 1
end; (* fillstring *)
(* end module filler.fillstring version = 4.41; (@ of prgmod.p 2000 June 24 *)

(* begin module filler.filltrigger *)
procedure filltrigger(var t: trigger;
                      a: filler);
(* fill the trigger t *)
begin (* filltrigger *)
         fillstring(t.seek,a)
end; (* fillstring *)
(* end module filler.filltrigger version = 4.41; (@ of prgmod.p 2000 June 24 *)

(* begin module trigger.proc *)
(* this module allows one to scan a series of characters, as from
an array or a file, and to "trigger" or detect a simple string
in the series.  the advantage of the trigger is that several triggers
can "observe" a stream of characters at once, each looking for a
different thing.
some other modules required: interact.const, interact.type *)

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.
1996 Sep 12: Bug found!  In the case of a trigger "ab", the program
used to miss it for situations like "aab".  This was because at the
first a it would step up.  Then it would see the second a and recognize
that was not part of ab.  It would fail to realize that it could be
the start of a new one.  The code now accounts for that possibility. *)
begin (* testfortrigger *)
      with t do begin
         state := succ(state);
{
writestring(list,seek);
writeln(list,'testfortrigger seek.letters[',state:1,']:',
seek.letters[state],' ch:',ch);
}
         if seek.letters[state] = ch
         then begin
            skip := false;
            if state = seek.length then found := true
                                   else found := false
         end
         else begin
            (* it failed.  But wait!  It could be the beginning
            of a NEW trigger string! *)
            if seek.letters[1] = ch then begin
               state := 1;
               skip := false;
               found := false
            end
            else begin (* reset trigger *)
               state := 0;
               skip := true;
               found := false
            end
         end
      end
end; (* testfortrigger *)
(* end module trigger.proc version = 4.41; (@ of prgmod.p 2000 June 24 *)

(* begin module copymanualpage *)
procedure copymanualpage(var fin, fout: text);
(* copy a delila manual page from fin to fout *)
var
   debe, deen: trigger; (* the describe begin and end module strings *)
   vebe, veen: trigger; (* the version begin and end module strings *)
   vt: trigger; (* the version trigger *)
   v: string; (* the version line *)

   aline, (* a line of text from fin *)
   anamebegin: string; (* the name of the module at the beginning
                          of the delman.describe *)
   gotten: boolean; (* true when a trigger is found *)
begin
     (*                      1         2         3   *)
(*                  12345678901234567890123456789012 *)
   filltrigger(vt ,'version =                       ');
   filltrigger(debe,'(@ begin module describe.       ');
   filltrigger(deen,'(@ end module describe.         ');
   filltrigger(vebe,'(@ begin module version *)      ');
   filltrigger(veen,'(@ end module version           ');
(* the @ signs prevent the makman program from detecting these
strings when it looks at its own source code!  But now we have
to fix it by putting the * there: *)
   debe.seek.letters[2] := '*';
   deen.seek.letters[2] := '*';
   vebe.seek.letters[2] := '*';
   veen.seek.letters[2] := '*';

   while not eof(fin) do begin

      (* pull out a line from the file *)
      getstring(fin,aline,gotten);
{write(output,'---');writestring(output,aline); writeln(output);}

      (* scan the line for both version and definition modules *)
      resettrigger(debe);
      resettrigger(vebe);
      with aline
      do while (current<=length) and
               (not debe.found) and (not vebe.found)
      do begin
         testfortrigger(letters[current],debe);
         testfortrigger(letters[current],vebe);

         (* only accept triggers at the beginning of the line *)
         if veen.found
         then if aline.current <> veen.seek.length
              then resettrigger(veen);
         if debe.found
         then if aline.current <> debe.seek.length
              then resettrigger(debe);
         current := succ(current)
      end;
{writeln(output,'vebe.found=',vebe.found);}
{writeln(output,'debe.found=',debe.found);}

      if vebe.found
      then begin (* grab the version line *)
         getstring(fin,v,gotten);
{
         writestring(fout,aline); writeln(fout);
         writestring(fout,v); writeln(fout);
}

         (* now verify that there really is a version on this line! *)
         resettrigger(vt);
         while (v.current <= v.length) and
               (not vt.found) do begin
            testfortrigger(v.letters[v.current],vt);
            v.current := succ(v.current);
         end;
{ ;writeln(output,'vt.found=',vt.found);}

         (* now verify that there really is a version module end!
            We allow one extra line in the module (for the origin
            date), and no more. *)
         resettrigger(veen);
         resettrigger(debe);
         while (not eof(fin))
                and (not veen.found) and (not debe.found)
         do begin
            getstring(fin,aline,gotten);
            while (aline.current <= aline.length) and
                  (not veen.found) and
                  (not debe.found) do begin
               testfortrigger(aline.letters[aline.current],veen);
               testfortrigger(aline.letters[aline.current],debe);

               (* only accept triggers at the beginning of the line *)
               if veen.found
               then if aline.current <> veen.seek.length
                    then resettrigger(veen);
               if debe.found
               then if aline.current <> debe.seek.length
                    then resettrigger(debe);

               aline.current := succ(aline.current);
            end;
{
            (* show the whole version module *)
            writestring(fout,aline); writeln(fout);
}
         end;

         if (not veen.found) or (debe.found) then begin
            writeln(fout,'{The end of the version module was not found for');
            writestring(fout,v); writeln(fout,'}');
            halt
         end;
      end

      else if debe.found then begin (* grab the entire definition *)

         (* display the version grabbed earlier at the end of the module *)
         (* new location: display at top *)
         if vt.found then begin
            writestring(fout,vebe.seek); writeln(fout);
            write(fout,'{');
            writestring(fout, v);
            writeln(fout,'}');
            writestring(fout,veen.seek); writeln(fout,' *',')');
            writeln(fout);
            resettrigger(vt);
         end
         else writeln(fout,'{no "version =" string found}');

         (* dump out the first line found *)
         writestring(fout,aline);
         writeln(fout);

         (* seek the end of the module while writing it out *)
         resettrigger(deen);
         while (not eof(fin)) and (not deen.found) do begin
            getstring(fin,aline,gotten);
            resettrigger(deen);

            with aline
            do while (current<length) and
               (not deen.skip) and
               (not deen.found)
               do begin
                  (* only accept triggers at the beginning of the line *)
                  testfortrigger(letters[current],deen);
                  if deen.found
                  then if aline.current <> deen.seek.length
                       then resettrigger(deen);
                  current := current + 1
               end;

             (* copy the line out *)
             writestring(fout,aline);
             writeln(fout);
         end;

         (* die if there was no end of the module *)
         if eof(fin) and (not deen.found) then begin
            write(fout, '{ module ');
            writestring(fout,anamebegin);
            writeln(fout,' has no end}');
            halt
         end;

      end;
   end;
end;
(* end module copymanualpage *)

(* begin module makman.themain *)
procedure themain(var fin, fout: text);
(* the main procedure of the program *)
begin
   copymanualpage(fin, fout);
   writeln(fout, '{This manual page was created by makman ',version:4:2,'}');
end;
(* end module makman.themain *)

begin
      themain(input,output);
1: end.