program ver(input,output);
(* look at the version of a program

  Dr. Thomas D. Schneider
  National Cancer Institute
  Laboratory of Experimental and Computational Biology
  Frederick, Maryland  21702-1201
  toms@ncifcrf.gov
  permanent email: toms@alum.mit.edu
  http://www.lecb.ncifcrf.gov/~toms/

   module libraries: delman, prgmods *)

label 1; (* the end of the program *)

const
(* begin module version *)
version = 2.06; (* of ver.p 2002 May 5
2002 May 5, 2.06: put fix documentation
2000 Mar 2, 2.04: set string size large
1994 Sep 6, 2.03: previous changes
origin before 1982 nov 4 *)
(* end module version *)

(* begin module describe.ver *)
(*
name
      ver: look at the version of a program

synopsis
      ver(input: in, output: out)

files
      input: a program source code
      output: the line that contains "version = " in input

description
      this program lets one look at the version number of a program
      source code.

see also

      {program to automatically increment a version:}
      verbop.p

      {Example use for Delila instruction titles:}
      http://www.lecb.ncifcrf.gov/~toms/delilainstructions.html#title

author
      Thomas Schneider

bugs
      none known

*)
(* end module describe.ver *)

      debugging = false; (* for figuring out this mess *)

(* LOCK begin module interact.const *)
      maxstring = 1000; (* the maximum string *)
(* LOCK end module interact.const version = 'prgmod 3.96  85 mar 18 tds'; *)

(* begin module filler.const *)
      fillermax = 50; (* the size of the filler array for a string *)
(* end module filler.const version = 'prgmod 3.96  85 mar 18 tds'; *)

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'; *)

(* 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 = 'prgmod 3.96  85 mar 18 tds'; *)

(* 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 = 'prgmod 3.96  85 mar 18 tds'; *)

var
      t: trigger; (* the version trigger *)
      s: string; (* a string in input *)
      index: integer; (* index to string s *)
      gotten: boolean; (* did we get the version? *)

(* 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 = '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.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.getstring *)
procedure getstring(var afile: text; var buffer: string;
                    var gotten: boolean);
(* get 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 = 'prgmod 3.96  85 mar 18 tds'; *)

(* 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 = 'prgmod 3.96  85 mar 18 tds'; *)

(* 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 = 'prgmod 3.96  85 mar 18 tds'; *)

(* 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. *)
begin (* testfortrigger *)
      with t do begin
         state := succ(state);
(*         if debugging then begin
            writestring(list,seek);
            writeln(list,'testfortrigger seek.letters[',state:1,']:',
                           seek.letters[state],' ch:',ch);
         end;*)
         if seek.letters[state] = ch
         then begin
            skip := false;
            if state = seek.length then found := true
                                   else found := false
         end
         else begin (* reset trigger *)
            state := 0;
            skip := true;
            found := false
         end
      end
end; (* testfortrigger *)
(* end module trigger.proc version = 'prgmod 3.96  85 mar 18 tds'; *)

begin (* ver *)
      writeln(output,' ver ',version:4:2);

      if not eof(input) then begin
           (*                    1         2         3         4         5 *)
           (*           12345678901234567890123456789012345678901234567890 *)
         filltrigger(t,'version =                                         ');

         resettrigger(t);

         repeat
            getstring(input, s, gotten);
            if gotten then begin
{
(*if debugging then writeln(output,'got a line');
if debugging then writestring(output,s);  *)
}
               index := 1;
               while (index < s.length) and
                     (not t.found) do begin
                  testfortrigger(s.letters[index],t);
{
if debugging then writeln(output,s.letters[index],t.found,t.skip);
}
                  index := succ(index)
               end
            end
         until (not gotten) or (t.found);

         if t.found then begin
            writestring(output, s);
            writeln(output)
         end
         else writeln(output,'no "version =" string');

         (* read through the rest of the file so that the program can
            act as part of Unix pipes. *)
         while not eof(input) do readln(input);
      end
      else writeln(output,' input is empty');
1: end. (* ver *)