program verbop(source, output);
(* verbop: increment the version number 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.10; (* of verbop.p 2002 May 5
2002 May  5, 2.10: previous changes
1994 Sep  6, 2.09: previous changes
1982 Nov  4, 1.00: origin was before this date
*)
(* end module version *)

(* begin module describe.verbop *)
(*
name
      verbop: increment the version number of a program

synopsis
      verbop(source: inout, output: out)

files
      source: a program source code, with a version constant in the form
          "version = " followed by a real number.
         the version number is incremented by 0.01.
      output: the new version number is reported.

description
      if you are too lazy to change the version number of a program
      every time you alter the code, then you have no excuses any longer,
      because this program will do it for you automatically...

see also
      ver.p, code.p

author
      Thomas Schneider

bugs
      none known

*)
(* end module describe.verbop *)


(* begin module interact.const *)
      maxstring = 150; (* the maximum string *)
(* 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
(* begin module verbop.var *)
      source: text; (* the input and output file *)
(* end module verbop.var *)

(* 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 copyaline *)
procedure copyaline(var fin, fout: text);
(* copy a line from file fin to file fout *)
begin (* copyaline *)
      while not eoln(fin) do begin
         fout^ := fin^;
         put(fout);
         get(fin)
      end;
      readln(fin);
      writeln(fout);
end; (* copyaline *)
(* end module copyaline 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 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 module verbop.capture *)
procedure capture(var field: text;
                  var rabbit: real;
                  var thisprogram: text);
(* capture the rabbit in the field (ie, pickup the version number),
thisprogram is the output made so far) *)
begin (* capture *)
      (* galump across the field in search of a hole *)
      while (not eoln(field)) and (field^ = ' ')
         do get(field);

      (* is there a rabbit? *)
      if field^ in ['0'..'9'] (* poke a stick in the hole *)
      then read(field, rabbit) (* got it - yum *)
      else begin (* nothing edible *)
         writeln(output,' version must be a real number'); (* scream *)
         rewrite(thisprogram); (* destroy things *)
         halt (* die of starvation *)
      end
end; (* capture - do you think i overdid this one? *)
(* end module verbop.capture *)

(* begin module verbop.themain *)
procedure themain(var source: text);
(* the main procedure of the program *)
var
      internal: text; (* internal copy of source file *)
      t: trigger; (* the version trigger *)
      theversion: real; (* the version and the incremented value *)
begin
      writeln(output, ' verbop ', version:4:2);

      (* copy source to internal *)
      reset(source);
      rewrite(internal);
      while not eof(source) do copyaline(source,internal);

      (* now scan internal and copy to source with the
         new version number *)
      reset(internal);
      rewrite(source);

        (*                     1         2         3         4         5 *)
        (*            12345678901234567890123456789012345678901234567890 *)
      filltrigger(t, 'version =                                         ');

      resettrigger(t);

      repeat
         testfortrigger(internal^, t);

         (* copy from internal to source *)
         if eoln(internal)
         then writeln(source)
         else begin
            source^ := internal^;
            put(source);
         end;

         get(internal);
      until eof(internal) or t.found;

      if t.found then begin
         capture(internal, theversion, source);
         theversion := theversion + 0.01;
         write(source, ' ', theversion:4:2); (* note the replaced space *)
         writeln(output, ' the new version is ', theversion:4:2)
      end
      else writeln(output, 'no "version =" string');

      (* copy the rest of the file *)
      while not eof(internal) do copyaline(internal, source)
end;
(* end module verbop.themain *)

begin
      themain(source);
1: end. (* verbop *)