program versave(input, output);
(* versave: save the file under the version number

  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: delman, prgmods *)

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

const
(* begin module version *)
   version = 1.12; (* of versave.p 2005 Jan 19
2005 Jan 19, 1.12: allow negative version numbers
1995 Dec 20, 1.11: upgrade this so it accepts string versions
origin from verbop 2.04 *)
(* end module version *)

(* begin module describe.versave *)
(*
name
   versave: save the file under the version number

synopsis
   versave(input: in, output: out)

files
   input: a text file, with a version constant in the form
       'version = ' followed by a real number.  The name of the
       file (including dot extensions) must be found after the word 'of '.
       For example:
version = 1.11; (@ of versave.p 1995 December 20 @)

       (where @ would be * in the actual program)

       Alternatively, the input line can be of the form:
version = '6.09 of module.p 95Dec20 tds';

       The program will handle either form.

   output: Four lines are produced:
       file
       (name of text file found after the 'of')
       version
       (the real number found after 'version = ')

description
   Generate commands for worcha on how to change a script for saving
   the file.  A script is then passed through worch to produce the
   executable commands.

example
   For an input file containing:
      version = 1.00; (@ of versave.p 1989 April 4
   The output is:
      file
      versave.p
      version
      1.00
   This is to be placed in the worcha parameter file, worchap.

   An example script is:
      cp file old/file.version
      echo saved file in old/file.version

   Using worcha with the script would become:

      cp versave.p old/versave.p.1.00
      echo saved versave.p in old/versave.p.1.00

   When executed, this will save the text.

author
   thomas schneider

see also
   worcha.p, verbop.p, ver.p, code.p

bugs
   none known

*)
(* end module describe.versave *)


(* begin module interact.const *)
      maxstring = 150; (* the maximum string *)
(* end module interact.const version = 'prgmod 3.98  86 nov 11 tds'; *)

(* begin module filler.const *)
      fillermax = 50; (* the size of the filler array for a string *)
(* end module filler.const version = 'prgmod 3.98  86 nov 11 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.98  86 nov 11 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.98  86 nov 11 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.98  86 nov 11 tds'; *)

var
(* begin module versave.var *)
      source: text; (* the input and output file *)
(* end module versave.var *)

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,'echo "program halt."');
      goto 1
end;

(* 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.98  86 nov 11 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.98  86 nov 11 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.98  86 nov 11 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.98  86 nov 11 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.98  86 nov 11 tds'; *)

(* begin module versave.capture *)
procedure capture(var field: text;
                  var rabbit: real);
(* capture the rabbit in the field (ie, pickup the version number)
2005 Jan 19: allow negative numbers. *)
begin (* capture *)
      (* galump across the field in search of a hole *)
      while (not eoln(field)) and
            ((field^ = ' ')  (* skip blank field *)
	  or (field^= '''')) (* don't be fooled by fake rabbit tails *)
      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,'echo "version must be a real number"'); (* scream *)
         halt (* die of starvation *)
      end
end; (* capture - do you think i overdid this one? *)
(* end module versave.capture *)

(* begin module versave.themain *)
procedure themain(var source: text);
(* the main procedure of the program *)
var
   t: trigger; (* the version trigger *)
   n: string; (* the name of the source *)
   theversion: real; (* the version *)
begin
(*
   writeln(output,'#!/bin/csh -f');
   writeln(output,'#(ie run the cshell on this but don''t read the .cshrc)');
   writeln(output, '# versave ', version:4:2);
*)

   reset(source);

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

   resettrigger(t);

   repeat
      testfortrigger(source^, t);
      get(source);
   until eof(source) or t.found;

   if t.found then begin
      capture(source, theversion);
(*
      writeln(output, '# THE VERSION IS ', theversion:4:2);
*)
   end
   else begin
      writeln(output, 'echo "no ''version ='' string"');
      halt
   end;

   (* now locate the 'of' string *)
     (*                     1         2         3         4         5 *)
     (*            12345678901234567890123456789012345678901234567890 *)
   filltrigger(t, 'of                                                ');

   resettrigger(t);

   repeat
      testfortrigger(source^, t);
      get(source);
   until eof(source) or t.found;

   if source^ = ' '
   then get(source) (* move past the space *)
   else begin
      writeln(output, 'echo " ''of'' not followed by a space"');
      halt
   end;

   if t.found then begin
      (* capture the name string *)
      clearstring(n);
      while (not eoln(source)) and (source^<>' ') do with n do begin
         length := length + 1;
         letters[length] := source^;
         get(source)
      end;
(*
      write(output,'# THE STRING FOUND IS <');
      writestring(output,n);
      writeln(output,'>');
*)
   end
   else begin
      writeln(output, 'echo "no ''of'' string"');
      halt
   end;

   writeln(output,'file');
   writestring(output,n);
   writeln(output);

   writeln(output,'version');
   writeln(output,theversion:4:2);

end;
(* end module versave.themain *)

begin
   themain(input);
1: end. (* versave *)