program pbreak(pbreakp,input,output,list);
(* pbreak: triggered paging program
     by patrick roche with major assistance from thomas schneider
     modlibs required: delman, delmods *)

label  1;   (* end of pbreak *)

const
(* begin module version *)
version = 4.26; (* of pbreak.p 1993 Jan 27
1993 Jan 27: page positioning commands improved
1988 December 14: conversion to LaTeX, added lastpage
1986 December from the break program (now does from input/output)
origin 1981 October 31 *)
(* end module version *)

(* begin module describe.pbreak *)
(*
name
   pbreak: breaks a file into pages at a certain trigger phrase

synopsis
   pbreak(pbreakp: in, input: in, output: out, list: out)

files
   pbreakp: The parameter file which contains the trigger on one line.
      Only one trigger is allowed in pbreakp.
      The next line may contain one integer which represents the right most
      position (in characters, 1 is the first character on a line)
      where the trigger will be looked for.  Default is an enormous number.
   input: the file to break up
   output: the broken file
   list: where messages will appear.

description
   The program pbreak will go through a file, line by line, looking for a
   "trigger" phrase.  Upon finding the trigger on a line, pbreak will insert a
   "new page" mark at the beginning of the line.  This will cause the printer
   to start a new page at this line when the file is printed.  A page number is
   added and an alphabetical index of the lines containing the trigger strings
   and their page numbers is printed at the end of the output file.  The
   trigger phrase can be any string of characters and is in the file pbreakp.
   The pbreak program is thus useful for breaking up large files into
   workable-size chunks, or to make a large file more readable.

examples
   Pbreak has been used to make pascal source code easier to read and
   work with by using the trigger "procedure" to make a file which
   when printed has one procedure to a page.  Pbreak also has been used
   to make the delila manual, delman.  Delman is one large, continuous
   textfile, and pbreak is used to break delman into its formatted pages
   by using the parameters 
        (@ begin module
        1
   which will only recognize modules that begin at the left margin.
   (Note: the @ in the example above must be replaced by a '*' to
   make the example work.  The (@ form fools the compiler, and prevents
   it from thinking I'm doing something funny.)

documentation
   delman.intro.organization: "technical notes"

author
   Patrick R. Roche
   modified by Tom Schneider

bugs
   none known

technical notes
   Three procedures, firstpage, makepage and lastpage contain instructions for
   forming new pages.  These are system dependent.  Constant pagelength
   determines the size of the page.

   If a line is too wide, the page number will not be printed, however the
   number will override the characters on the line in the index at the end.
   The constant "top" defines the maximum length of a buffer, thus the maximum
   length of an input line or a trigger.  The constant "pagewidth" defines the
   page width for numbering of pages and the printing of the index.  Pagewidth
   should be set to the desired page width - 1 to come out right.  The constant
   liston (true or false) indicates whether or not to display the index on the
   file list.

*)
(* end module describe.pbreak *)

      top = 170;  (* max length of line *)
      pagewidth = 90;  (* the page width for index printing purposes *)
	 (* The original value for this was 78 characters, so that pages would
	 not be wider than 80 characters (when the document is < 100 pages!!).
	 By making this larger for LaTeX output, the page number will be able
	 to be placed on the right side of the page for all documents that are
	 not wider than 80 characters.  (Documents should not be wider than 80
	 characters.) *)
      pagelength = 54;   (* the page length for index printing purposes *)
      liston = false;   (* whether or not the index is printed to list *)
      debug = false;  (* whether or not to display debuging outputs *)

type
      buffptr = ^buffer;

      buffer = record      (* a buffer is a line of characters with a length *)
         place: array[1..top] of char;
         length,      (* length of line *)
         pagenumber :integer; (* the page that this record is on if it is a
                                 trigger *)
         next: buffptr
      end;

var
      list,    (* description of what happened  *)
      pbreakp: (* the parameter file containing the trigger *)
       text;

      first,       (* first memb of index list *)
      trigger: (* a phrase to be recognized *)
       buffptr;

      trigerinbuffer: boolean;   (* presence of trigger *)

      numbpgs: integer;   (* number of pages the program adds *)

      rightbound: integer; (* the rightmost location of a trigger *)

(* 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 = 'delmod 6.50 85 apr 17 tds/gds' *)

(* begin module pbreak.firstpage *)
procedure firstpage(var afile: text);
(* what to do for the first page of the list on this computer system.
This allows the use of special forms.  The simplest form that will work is
to simply call the pascal 'page(afile)' procedure. *)
begin
(* troff:
   writeln(afile,'.\"       print this file with UNIX troff -ms');
(@ writeln(afile,'.ds CH \" turn off page numbering'); oh leave it @)
   writeln(afile,'.ft L  \" use constant size font L');
   writeln(afile,'.nf    \" no text filling');
   writeln(afile,'.bp    \" page break');
*)
(* LaTeX: *)
writeln(afile,'% LaTeX input, generated by version = ',
              version:4:2,' of pbreak');
writeln(afile,'\documentstyle{article}');
writeln(afile,'\begin{document}'); (* start the document *)
writeln(afile,'%\footnotesize');    (* make it fit on the page *)
writeln(afile,'\textheight 9in');
writeln(afile,'\topmargin -0.25in % -0.5 would shift the whole thing up');
writeln(afile,'\headheight 0in');
writeln(afile,'\headsep 0in');
writeln(afile,'\textwidth 7in');
writeln(afile,'\hsize=9in % make TeX shut up about overfull \hboxes!!!');
writeln(afile,'\oddsidemargin 0.0in % -0.5 shifts left');
writeln(afile,'\begin{verbatim}'); (* start exact verbatim mode *)

end;
(* end module pbreak.firstpage *)

(* begin module pbreak.makepage *)
procedure makepage(var afile: text);
(* make a page break on this computer system.
This allows the use of special forms.  The simplest form that will work is
to simply call the pascal 'page(afile)' procedure. *)
begin
(* troff:
   writeln(afile,'.bp   \" UNIX troff page break');
*)

(* LaTeX: *)
writeln(afile,'\end{verbatim}'); (* end previous page *)
writeln(afile,'\pagebreak'); (* start page *)
writeln(afile,'\begin{verbatim}'); (* restart verbatim mode *)

end;
(* end module pbreak.makepage *)

(* begin module pbreak.lastpage *)
procedure lastpage(var afile: text);
(* complete the last page on this computer system. *)
begin
(* troff: no instructions needed *)

(* LaTeX: *)
writeln(afile,'\end{verbatim}');
writeln(afile,'\end{document}');

end;
(* end module pbreak.lastpage *)

procedure readintobuffer(var fin: text; var b: buffptr);
      (* read a line from fin into a buffer b *)

      var i: integer;   (* index for b^.place[i] and counter *)

      begin
         i:=0;          (* starting at beginning of the line *)
         b^.length :=0;     (* keeping track of the length of the buffer *)

         while ( i<top ) and not (eoln(fin) or eof(fin) ) do begin
         (* keeping line length below max and going to end of line *)
            i:= i+1 ;    (* next character *)
            read(fin, b^.place[i]);   (* read in next character to buffer *)
            b^.length := i          (* keeping track of length of the buffer *)
         end;
         if i=top then if not eoln(fin) then begin
            writeln(list,' line longer than ',top:1);
            halt
         end;
         b^.pagenumber:=0;  (* initialize pagenumber to zero *)
         b^.next:=nil;   (* initialize pointer to nil *)
         if not eof(fin) then readln(fin)

      end;

procedure lookfortrigger(trigger, b: buffptr; var trigerinbuffer: boolean);
      (* look for the trigger in the buffer b and if found return true
         for trigerinbuffer *)

      var   d, (* index of trigger *)
            i, (* index of b *)
            level:   (* recognition or 'matching' level *)
              integer;

      begin
         i:=1;   (* start with first char in b *)
         d:=1;   (* start with first char of trigger *)
         level:=0;   (* the initial 'recognition' level is 0 *)

         while (level < trigger^.length) and (i <= b^.length) do begin
            if b^.place[i] = trigger^.place[d]  (* incase of match *)
            then begin   (* advance both trigger and b,
                            and increase level *)
                    level:= level + 1;   (* yea we have one match *)
                    i:= i+1;             (* advance b to next char *)
                    d:= d+1              (* advance trigger to next char *)
                 end
            else if b^.place[i] = trigger^.place[1]
                 then begin    (* if does not match current trigger char *)
                               (* but matches first trigger char *)
                               (* reset trigger and level, *)
                               (* but do not advance b *)
                        level := 0;
                        d:= 1
                      end
                 else begin    (* no match so, *)
                               (* reset level and trigger *)
                               (* and advance b to the next char *)
                        level:=0;
                        d:=1;
                        i:=i+1;
                        if i > rightbound
                        then i := b^.length + 1 (* force exit *)
                      end
         end;
         if level = trigger^.length
         then trigerinbuffer := true
         else trigerinbuffer := false
      end;


procedure writebuffer(var fout: text; b: buffptr);
      (* write b^.buffer to fout *)
      (* you must writeln(fout) manualy after this
      if you want to be on the next line of fout *)

      var   i,   (* index of b *)
            c:   (* counter *)
             integer;

      begin
         i:=0;
         for c:=1 to b^.length do begin
            i:= i+1;
            write(fout,b^.place[i])
         end
      end;

procedure writetrigger(var fout: text; b: buffptr);
      (* write trigger b to fout within quotes *)

      var   i,   (* index of b *)
            c:   (* counter *)
             integer;

      begin
         write(fout,' ''');
         i:=0;
         for c:=1 to b^.length do begin
            i:= i+1;
            write(fout,b^.place[i])
         end;
         write(fout,'''');
         writeln(fout)
      end;

procedure removeblanks(var b: buffptr);
      (* remove blanks from the end of a buffer *)

      begin
         with b^ do begin
            if length>0 then
            if place[length]=' '   (* if the last place is blank *)
            then begin   (* remove the blank and check next place etc. *)
               while (place[length]=' ') and (length<>1) do begin
                  length:=length-1
               end;
            end;
         end;
      end;
procedure checktrigger;
 (* check to make sure trigger is not blank and if blank,
    tell user and halt program *)

   begin
      if trigger^.length <=0
      then  begin
              writeln(list,'  trigger is blank.');
              halt
            end
   end;

function afteryou(p: buffptr): boolean;
      (* answers the question 'do i belong after you?' or more accurately,
         does p^.place belong after p^.next^.place in this list. *)

      var  n: integer;
         done: boolean;

      begin
         n:=1;   (* start with first letters of the lines *)
         done:= false;
         while not done do begin
            if p^.next= nil   (* if we are at the end of the list *)
            then begin
               afteryou:= false;
               done:= true
            end
            else if p^.place[n] < p^.next^.place[n]
            (* we belong before you *)
               then begin
                  afteryou:= false;
                  done:= true;
               end
               else if p^.place[n] > p^.next^.place[n]
               (* we belong after you *)
                  then begin
                     afteryou:= true;
                     done:= true
                  end
                  else if (n=p^.length) and (n<p^.next^.length)
                  (* we match to my length but you are longer
                  therefore i belong before you *)
                     then begin
                        afteryou:= false;
                        done:= true
                     end
                     else if (n=p^.next^.length) and (n<p^.length)
                     (* we match to your length but i am longer
                     so i belong after you *)
                        then begin
                           afteryou:= true;
                           done:= true
                        end
                        else if (n=p^.length) and (n=p^.next^.length)
                        (* lines match so now check pagenumber, the
                        larger pagenumber comes last as a rule *)
                           then if p^.pagenumber>p^.next^.pagenumber
                              then begin
                                 afteryou:=true;
                                 done:=true
                              end
                              else begin
                                 afteryou:=false;
                                 done:=true
                              end
                           else begin
                              done:= false;
                              n:= n+1  (* go to next letter of the lines *)
                           end
         end
      end;


procedure putinlist(var first, current: buffptr);
      (* puts the current line into an alphabetical linked list of records
      of the lines containing the trigger phrase and their respective
      page numbers for an index *)

      var
         lookptr: buffptr;     (* a pointer used to look through the list*)

      begin
         lookptr:= first;   (* start at beginning of list *)
         current^.next:= first;
         if not afteryou(current)  (* see 'function afteryou' *)
         then first:= current   (* insert new member if it belongs
                                   as first memb *)
         else begin
            current^.next:= first^.next; (* move to next memb of list *)
            while afteryou(current) do begin
            (* move thru list till find right spot for insertion *)
               lookptr:= lookptr^.next;
               current^.next:= current^.next^.next
            end;
            lookptr^.next:= current  (* insert new member *)
         end
      end;

procedure listout(var place: text; first: buffptr);
      (* this will print out the index of the lines that
      had the trigger phrases in them and thus the first
      lines of the pages. *)

const   numfield=4;   (* the field to hold the page number in
                         the index listing *)

var   i,   (* counter *)
      linenumb: integer;  (* a counter for the lines *)
      listptr: buffptr;   (* the pointer used to look thru the list *)

begin
      linenumb:=0;   (* starting at the beginning *)
      listptr:= first;   (* start at the beginning of the list *)
      while listptr<>nil do begin
         if (linenumb mod pagelength)=0
         then begin    (* start a new page for the index *)
            makepage(place);   (* start the index on a new page *)

            (* write title and space between title and body *)
            for i:=1 to (round(pagewidth/2)-3) do write(place,' ');
            writeln(place,'index');
            writeln(place);
            writeln(place);

            (* write headings of index *)
            for i:=1 to 5 do write(place,' ');
            write(place,'page title');
            for i:=16 to (pagewidth-12) do write(place,' ');
            writeln(place,'page number');

            (* underline headings *)
            for i:=1 to 5 do write(place,' ');
            for i:=6 to 15 do write(place,'-');
            for i:=16 to (pagewidth-12) do write(place,' ');
            for i:=(pagewidth-11) to (pagewidth-1) do write(place,'-');
            writeln(place);
            linenumb:= linenumb+6   (* account for lines of heading *)
         end;
         (* write out the index-list *)
if debug then writeln(place,' listptr^.length is:',listptr^.length:4);
         removeblanks(listptr);
         write(place,' '); (* printer control blank *)
         if (listptr^.length+2) <= (pagewidth-(numfield+3))
            (* if line will fit in the space allowed for it in the index *)
         then begin  (* write all of line and tack on pagenumber *)
            writebuffer(place,listptr);
            write(place,' ');   (* write a blank after the line *)
            for i:=(listptr^.length+2) to (pagewidth-(numfield+3)) do
               write(place,'.');
            write(place,' ');
            writeln(place,listptr^.pagenumber:numfield)
         end
         else begin
            listptr^.length:= (pagewidth-(numfield+4));
            (* shorten the buffer to the maximum allowable size for entry
               into the index table *)
            (* now write the line and tack on pagenumber *)
            writebuffer(place,listptr);
            write(place,'/');
            write(place,' ');
            writeln(place,listptr^.pagenumber:numfield)
         end;
         listptr:= listptr^.next; (* go to next member *)
if debug then writeln(place,' went to listptr^.next:');
         linenumb:= linenumb+1  (* bop up linenumber *)
      end
end;

procedure doit(var fin,fout: text);
(* scan and break up from fin to fout *)
var   current: buffptr;   (* the current line of fin *)
      i: integer;         (* a counter *)
      linenumber: integer; (* the number of the line on the page *)
begin
   numbpgs:=0;   (* start at beginning *)
   new(current); (* make buffer for first line *)
   first:=nil;
   linenumber := 0;

   while not eof(fin)  do begin
      readintobuffer(fin,current);
      linenumber := linenumber + 1;

      lookfortrigger(trigger,current,trigerinbuffer);

      if trigerinbuffer or (linenumber > pagelength)
      then begin
         if numbpgs=0 then firstpage(fout)
                      else makepage(fout);
         linenumber := 1;
         numbpgs:= numbpgs+1;   (* keeping track of the # of pages *)

         (* put the line number into the buffer *)
         current^.pagenumber:= numbpgs; (* assign pagenumber *)
         if current^.length<=(pagewidth-7)
            (* if there is space for the pagenumber *)
         then begin  (* write line and pagenumber *)
            writebuffer(fout,current);
            for i:=current^.length to (pagewidth-7) do
               write(fout,' ');
            writeln(fout,current^.pagenumber:5);
         end
         else begin
         (* if line too big for pagenumber then just write out the line *)
            writebuffer(fout,current);
            writeln(fout)
         end;

         (* only add to the list if it is triggered *)
         if trigerinbuffer then begin
            putinlist(first,current);
            new(current)
         end
      end
      else begin
      (* write(fout,' ');   (@ blank necessary for carriage control *)
         writebuffer(fout,current);   (* write out the line *)
         writeln(fout)
      end
   end;

   writeln(list,' number of pages added: ',numbpgs:3);
   if liston then listout(list,first);
   listout(fout,first);

   lastpage(fout); (* finish the document *)
end;

procedure themain(var pbreakp, fin, fout, list: text);
(* the main procedure of pbreak *)
begin  (* pbreak *)
      rewrite(list);
      writeln(list,' pbreak ',version:4:2,'   breaks files into pages.');
      reset(pbreakp);

      new(trigger);
      readintobuffer(pbreakp,trigger);
      checktrigger;
      removeblanks(trigger);

      writeln(list);
      write(list,' trigger length is: ');
      writeln(list,trigger^.length:3);
      write(list,' the trigger used is:  ');
      writetrigger(list,trigger);
      writeln(list);

      if eof(pbreakp)
      then begin
         rightbound := maxint;
         writeln(list,' triggers will be detected',
            ' anywhere in the file');
      end
      else begin
         readln(pbreakp,rightbound);
         if rightbound < 1 then begin
            writeln(list,' right boundary for trigger must be positive');
            halt
         end;
         writeln(list,' triggers will not be detected',
            ' to the right of character column ',rightbound:1)
      end;
      writeln(list);

      (* identification on first page: (not functional in this version)
      writeln(fout,' pbreak ',version:4:2,'   breaks files into pages.');
      write(fout,' trigger length is: ');
      writeln(fout,trigger^.length:3);
      write(fout,' the trigger used is:  ');
      writetrigger(fout,trigger);
      *)

      doit(fin,fout);
end;

begin
   themain(pbreakp, input, output, list);
1: end. (* pbreak *)