program remember (input, output, oldfile, newfile);

  {**************************************************************}
  {                                                              }
  { Copyright (c) 1982, 83, 85    Bob Schor                      }
  {                               Rockefeller University         }
  {                               1230 York Ave                  }
  {                               New York, NY   10021           }
  {                                                              }
  { All rights reserved.  May not be copied without this notice. }
  {                                                              }
  {**************************************************************}

  {**************************************************************}
  {                                                              }
  { Copyright (c) 1988            Bob Schor                      }
  {                               Eye and Ear Hospital           }
  {                               230 Lothrop Street             }
  {                               Pittsburgh, PA   15213         }
  {                                                              }
  { All rights reserved.  May not be copied without this notice. }
  {                                                              }
  {**************************************************************}

  { allow remembering significant events }

  { information stored in reminder files (.REM)

   reminders in following format

   Date <tab> information

   the program will look at the file REMEMB.REM
   }

  { date and time obtained from Oregon Software timestamp procedure }

  { Version 3.12 -- Pascal-2, answer update }
  { Version 3.12 -- rewrites REM file only if modified }
  { Version 5.8 -- fix bug to allow creation of new file }
  { Version 8.12 -- update, use delete/rename, eliminate copyfile }
  { Version 8.12 -- guard against no file present }

CONST
  version = 'REMEMB    Version 8.12';
  namelength = 10;
  remembname = 'REMEMB.REM';
  tempname   = 'REMEMB.TMP';
  entrylength = 80;   { length of basic entry }
  datelength  = 16;   { space reserved for date }
TYPE
  nametype = PACKED ARRAY [1 .. namelength] OF char;
  entryindextype = 1 .. entrylength;
  entrylengthtype = 0 .. entrylength;
  entrytype = PACKED ARRAY [entryindextype] OF char;
  answerset = SET OF char;
VAR
  oldfile, newfile : text;
  day, month, year : integer;
  hour, minute, second : integer;
  keepnewfile : boolean;

  PROCEDURE timestamp (VAR day, month, year,
		       hour, minute, second : integer); EXTERNAL;

  FUNCTION uppercase (letter : char) : char;

   BEGIN   { uppercase }
     IF ('a' <= letter) AND (letter <= 'z')
      THEN uppercase := chr(ord(letter) - ord('a') + ord('A'))
      ELSE uppercase := letter
   END;

  FUNCTION legalanswer (possibleanswers : answerset) : char;

  VAR
    answer : char;

    PROCEDURE informoferror;

    VAR
      answer : char;
      commabelongshere : boolean;

     BEGIN   { informoferror }
       write ('Error -- legal answers are ');
       IF ' ' IN possibleanswers
	THEN
	 BEGIN
	   write ('[space]');
	   commabelongshere := true
	 END
	ELSE commabelongshere := false;
       FOR answer := succ(' ') TO 'Z' DO
       IF answer IN possibleanswers
	THEN
	 BEGIN
	   IF commabelongshere
	    THEN write (', ');
	   commabelongshere := true;
	   write (answer:1)
	 END;
       write (' :  ')
     END;

   BEGIN  { legalanswer }
      REPEAT
       IF eoln
	THEN
	 BEGIN
	   readln;
	   answer := ' '
	 END
	ELSE readln (answer);
       answer := uppercase(answer);
       IF NOT (answer IN possibleanswers)
	THEN informoferror
      UNTIL answer IN possibleanswers;
     legalanswer := answer
   END;

  PROCEDURE initialize;

   BEGIN   { initialize }
     { writeln;
      writeln (version);
      writeln; }
     rewrite (newfile, tempname);
     keepnewfile := false
   END;

  FUNCTION readable (VAR filearg : text;
		     filename : nametype) : boolean;

  VAR
    filelength : integer;

   BEGIN   { readable }
     reset (filearg, filename, '.REM', filelength);
     readable := (filelength <> 0) AND (filelength <> -1)
   END;

  PROCEDURE checkoldentries;

  VAR
    entry : entrytype;
    length : entrylengthtype;

    PROCEDURE getentry;

     BEGIN   { getentry }
       length := 0;
       WHILE NOT eoln (oldfile) DO
	BEGIN
	  length := succ(length);
	  read (oldfile, entry[length])
	END;
       readln (oldfile)
     END;

   BEGIN   { checkoldentries }
     IF readable (oldfile, remembname)
      THEN
       BEGIN
	 writeln ('The following old notices are in the file --');
	 writeln ('Type "K" to kill them, "Return" to keep');
	 writeln;
	 WHILE NOT eof (oldfile) DO
	  BEGIN
	    getentry;
	    write (entry:length, ' ':3);
	    CASE legalanswer (['K', ' ']) OF
	      'K' : keepnewfile := true;
	      ' ' : writeln (newfile, entry:length)
	     END
	  END;
	 close (oldfile)
       END
   END;

  PROCEDURE addnewentries;

  CONST
    tab = 11B;
  VAR
    newentry : entrytype;
    length : entrylengthtype;

    PROCEDURE getnewentry;

     BEGIN   { getnewentry }
       write (chr(tab), chr(tab));
       readln (newentry);
       length := entrylength - datelength;
       WHILE (length > 1) AND (newentry[length] = ' ') DO
       length := pred(length);
       IF newentry[length] = ' '
	THEN length := pred(length)
     END;

    PROCEDURE writemonth (month : integer);

     BEGIN  { writemonth }
       IF month IN [1 .. 12]
	THEN
	CASE month OF
	  1 : write (newfile, 'Jan');
	  2 : write (newfile, 'Feb');
	  3 : write (newfile, 'Mar');
	  4 : write (newfile, 'Apr');
	  5 : write (newfile, 'May');
	  6 : write (newfile, 'Jun');
	  7 : write (newfile, 'Jul');
	  8 : write (newfile, 'Aug');
	  9 : write (newfile, 'Sep');
	  10 : write (newfile, 'Oct');
	  11 : write (newfile, 'Nov');
	  12 : write (newfile, 'Dec')
	 END
	ELSE write (newfile, '???')
     END;

    PROCEDURE writeyear (twodigityear : integer);

     BEGIN   { writeyear }
       IF (twodigityear < 10)
	THEN write (newfile, '0', twodigityear:1)
	ELSE write (newfile, twodigityear:2)
     END;


   BEGIN   { addnewentries }
     writeln;
     writeln ('Enter new entries, ending with null line');
     writeln;
     getnewentry;
     WHILE length > 0 DO
      BEGIN
	write (newfile, day:2, '-');
	writemonth (month);
	write (newfile, '-');
	writeyear (year MOD 100);
	write (newfile, chr(tab));
	writeln (newfile, newentry:length);
	keepnewfile := true;
	getnewentry
      END
   END;

  PROCEDURE keeponlyonefile;

   BEGIN   { keeponlyonefile }
     IF keepnewfile
      THEN rename (newfile, remembname)
      ELSE delete (newfile)
   END;

 BEGIN   { remember }
   initialize;
   checkoldentries;
   timestamp (day, month, year, hour, minute, second);
   addnewentries;
   keeponlyonefile
 END.