PROGRAM emulate_emacs_psp_logfile;


{ This is a tuesday evening hack... Don't even think of comments}
{ simply direct questions to s_vogt@ira.uka.de}

USES Dos, Crt;


CONST filename = 'logfile';

TYPE tTimeStr = String[20];
     tEntryStr = String[60];
     tShortMonthName = ARRAY[1..12] of String[3];
     Str2 = String[2];
     Str4 = String[4];
     FileStr = String[12];
VAR  logfile : TEXT;
     EntryString : tEntryStr;



function FileExists(FileName: string)
                                : Boolean;
{ Returns True if file exists; otherwise,
  it returns False. Closes the file if
  it exists. }
var
  f: file;
begin
  {$I-}
  Assign(f, FileName);
  Reset(f);
  Close(f);
  {$I+}
  FileExists := (IOResult = 0) and
   (FileName <> '');
end;  { FileExists }



FUNCTION FormatTime : tTimeStr;

 PROCEDURE InitMonthNames(VAR Months : tShortMonthName);

  BEGIN
   Months[1] := 'Jan';
   Months[2] := 'Feb';
   Months[3] := 'Mar';
   Months[4] := 'Apr';
   Months[5] := 'May';
   Months[6] := 'Jun';
   Months[7] := 'Jul';
   Months[8] := 'Aug';
   Months[9] := 'Sep';
   Months[10] := 'Oct';
   Months[11] := 'Nov';
   Months[12] := 'Dec';
  END;

 PROCEDURE StrLeadingZero(Number : Word; VAR NumberStr : Str2);
  BEGIN
   Str(Number:2, NumberStr);
   IF Number < 10 THEN NumberStr[1] := '0';
  END;


 VAR Hour, Minute, Sec, HunSec : Word;
     Year, Month, Day, DayOfWeek : Word;
     MonthNames : tShortMonthName;
     Return : tTimeStr;
     HourStr, MinuteStr, SecStr, DayStr : Str2;
     YearStr : Str4;

 BEGIN {Format Time}

  InitMonthNames(MonthNames);

  GetTime(Hour, Minute, Sec, HunSec);
  GetDate(Year, Month, Day, DayOfWeek);

  StrLeadingZero(Hour, HourStr);
  StrLeadingZero(Minute, MinuteStr);
  StrLeadingZero(Sec, SecStr);
  Str(Year:4, YearStr);
  Str(Day:2, DayStr);

  Return := MonthNames[Month]+' '+DayStr+' '+HourStr+':'+MinuteStr
   +':'+SecStr+' '+YearStr;

  FormatTime := Return;
 END; {Format Time}


 FUNCTION FormatEntry : tEntryStr;

  VAR CurChar : Char;
      ActionStr : tEntryStr;
      Return : tEntryStr;


   FUNCTION FormatBeginEnd : tEntryStr;
    BEGIN
     REPEAT
      Write('Type ( or ): ');
      CurChar := ReadKey;
     UNTIL CurChar IN ['(',')'];
     Write(CurChar);
     FormatBeginEnd := CurChar;
    END;


   FUNCTION AllowedAction(A : Str2) : Boolean;
    BEGIN
     IF (A='pl') OR (A='ds') OR (A='dr') OR (A='cd') OR (A='cr')
      OR (A='cp') OR (A='te') OR (A='pm') OR (A='i') OR (A='df') THEN
      AllowedAction := TRUE
     ELSE AllowedAction := FALSE;
    END;


   FUNCTION FormatAction : tEntryStr;

    VAR ActionStr : tEntryStr;

    BEGIN

     ActionStr := ' ';
     REPEAT
      Write(' Action: ');
      CurChar := ReadKey;
     UNTIL CurChar IN ['p','d','c','t','p','i'];
     Write(CurChar);

     ActionStr[1] := CurChar;

     IF ActionStr[1] <> 'i' THEN
      BEGIN
       ActionStr := ActionStr + ' ';
       REPEAT
         ActionStr[2] := ReadKey;
       UNTIL AllowedAction(ActionStr);
       Write(ActionStr[2]);
      END;
    FormatAction := ActionStr;
   END;


   FUNCTION FormatDefect : tEntryStr;

    VAR Return : tEntryStr;
        ErrorCode : tEntryStr;

    BEGIN
     WriteLn;
     Write('Type Error Code: ');
     ReadLn(ErrorCode);
     Write('Defect occured in which ');
     Return := ErrorCode + ' ' + FormatAction;
     FormatDefect := Return;
    END;

   FUNCTION FormatComment : tEntryStr;
    VAR Return : tEntryStr;
    BEGIN
     WriteLn;
     Write('Type Comment: ');
     ReadLn(Return);
     FormatComment := Return;
    END;



  BEGIN {Format Entry}
   Return := FormatBeginEnd;
   ActionStr := FormatAction;
   Return := Return + ActionStr;

   IF Return[1] = ')' THEN
    BEGIN
     IF ActionStr= 'df' THEN
      Return := Return +' '+ FormatDefect;
     IF (ActionStr = 'i') OR (ActionStr = 'df') THEN
      Return := Return + ' ' + FormatComment;
    END;
   FormatEntry := Return;
  END; {Format Entry}


 PROCEDURE PrintTextFile(filename : FileStr);

  VAR textfile : TEXT;
      linestr  : String;

  BEGIN
   WriteLn('Datei: ',filename);
   Assign(textfile, filename);
   Reset(textfile);
   WHILE not(EOF(textfile)) DO
    BEGIN
     ReadLn(textfile, linestr);
     WriteLn(linestr);
    END;
   Close(textfile);
  END;


BEGIN {Main}

 EntryString := '';
 WHILE EntryString <> ')pm' DO
  BEGIN
   ClrScr;
   Assign(logfile,filename);
   IF FileExists(filename) THEN
    BEGIN
     PrintTextFile(filename);
     Append(logfile);
    END
    ELSE Rewrite(logfile);
   EntryString := FormatEntry;
   WriteLn(logfile, FormatTime + ' ' + EntryString);
   Close(logfile);
 END;
END. {Main}