(*
     $RCSfile$
  Description: A utility to strip control codes from text files

   Created by: fjc (Frank Copeland)
    $Revision$
      $Author$
        $Date$

  Copyright © 1994, Frank Copeland.
  This file is part of Oberon-A.
  See Oberon-A.doc for conditions of use and distribution.
  ________________________________________________________________________

*)

MODULE StripComments;

(* $P- allow non-portable code *)

IMPORT
  SYS := SYSTEM, Types, Dos, DosUtil, Args, Errors, Files, IO := StdIO,
  Str := Strings;

CONST
  VersionTag   = "\0$VER: StripComments 1.0 (13 May 1994)";
  VersionStr   = "StripComments 1.0 (13 May 1994)\r\n";
  CopyrightStr = "Copyright © 1994, Frank Copeland\n";
  UsageStr     = "see Oberon-A.doc for conditions of use\n";

CONST

  PathLen = 255;

TYPE

  Path = ARRAY PathLen + 1 OF CHAR;

VAR

  pattern,    (* The pattern to be searched for. *)
  dest        (* The destination directory. *)
    : Path;

  (*
    These variables are global so that they may be found by the Cleanup()
    procedure in the event of an abnormal exit
  *)

  input,      (* The current input file. *)
  output      (* The current output file. *)
    : Files.File;

  (* This is also required by the cleanup procedure. *)

  OldCleanup : PROCEDURE (rc : LONGINT);

  r, w : Files.Rider;
  ch : CHAR;

CONST

  CR = 0DX; LF = 0AX; TAB = 09X; SP = " ";

VAR

  state, line, spaces, blanklines : INTEGER;
  blankline : BOOLEAN;

CONST

  STARTLINE = 0;
  WHITESPACE = 1;
  COPYCHAR = 2;
  LEFTBRACKET = 3;
  STARTCOMMENT = 4;
  COPYCOMMENT = 5;
  SKIPCOMMENT = 6;
  STAR = 7;
  ENDCOMMENT = 8;

(*------------------------------------*)
PROCEDURE Greetings ();

BEGIN (* Greetings *)
  IO.WriteStr (VersionStr);
  IO.WriteStr (CopyrightStr);
  IO.WriteStr (UsageStr);
  IO.WriteLn ();
END Greetings;

PROCEDURE GetArgs ();

  (*------------------------------------*)
  PROCEDURE Usage ();

  BEGIN (* Usage *)
    IO.WriteStr ("format  : StripComments <pattern> <destination>\n");
    IO.WriteStr ("template: PATTERN/A, DESTINATION/A\n\n");
    IO.WriteStr ("<pattern>    : files to be converted\n");
    IO.WriteStr ("<destination>: destination directory\n\n");
  END Usage;

BEGIN (* GetArgs *)
  (* Check the number of arguments. *)
  IF (Args.argc # 3) THEN Usage (); HALT (Dos.returnWarn) END;

  (* Copy the pattern and destination *)
  COPY (Args.argv [1]^, pattern);
  COPY (Args.argv [2]^, dest);

  (* The destination needs to be checked. *)
  Errors.Assert
    ( DosUtil.FileExists (dest), "Destination directory doesn't exist" )
END GetArgs;

(*$D-*)
PROCEDURE MakeOutputName
  (inputName : ARRAY OF CHAR; VAR outputName : ARRAY OF CHAR);

  VAR filePart : Types.STRPTR;

BEGIN (* MakeOutputName *)
  filePart := Dos.Base.FilePart (inputName);
  COPY (dest, outputName);
  Errors.Assert
    ( Dos.Base.AddPart (outputName, filePart^, PathLen),
      "Output file name too big" )
END MakeOutputName;

PROCEDURE WriteSpaces ();

BEGIN (* WriteSpaces *)
  WHILE spaces > 0 DO Files.Write (w, SP); DEC (spaces) END
END WriteSpaces;

(*$D-*)
PROCEDURE WriteString (s : ARRAY OF CHAR);

  VAR i : INTEGER; ch : CHAR;

BEGIN (* WriteString *)
  i := 0; ch := s [0];
  WHILE ch # 0X DO Files.Write (w, ch); INC (i); ch := s [i] END
END WriteString;

PROCEDURE CopyComment ();

BEGIN (* CopyComment *)
  state := COPYCOMMENT;
  LOOP
    Files.Read (r, ch);
    IF r.eof THEN
      IO.WriteStr (" !! End of file encountered in CopyComment()\n"); EXIT
    END;
    Files.Write (w, ch);
    CASE ch OF
      LF :
        INC (line);
        IF (line MOD 10) = 0 THEN IO.WriteInt (line); IO.Write (CR) END;
        state := COPYCOMMENT
      |
      "(" : state := LEFTBRACKET
      |
      "*" :
        IF state = LEFTBRACKET THEN CopyComment (); state := COPYCOMMENT
        ELSE state := STAR
        END
      |
      ")" : IF state = STAR THEN EXIT ELSE state := COPYCOMMENT END
      |
    ELSE state := COPYCOMMENT
    END
  END
END CopyComment;

PROCEDURE SkipComment ();

BEGIN (* SkipComment *)
  state := SKIPCOMMENT;
  LOOP
    CASE ch OF
      LF :
        INC (line); INC (blanklines);
        IF (line MOD 10) = 0 THEN IO.WriteInt (line); IO.Write (CR) END;
        state := SKIPCOMMENT
      |
      "(" : state := LEFTBRACKET
      |
      "*" :
        IF state = LEFTBRACKET THEN SkipComment (); state := SKIPCOMMENT
        ELSE state := STAR
        END
      |
      ")" : IF state = STAR THEN EXIT ELSE state := SKIPCOMMENT END
      |
    ELSE state := SKIPCOMMENT
    END;
    Files.Read (r, ch);
    IF r.eof THEN
      IO.WriteStr (" !! End of file encountered in SkipComment()\n"); EXIT
    END;
  END
END SkipComment;

PROCEDURE ChangeState ();

BEGIN (* ChangeState *)
  CASE state OF
    STARTLINE :
      INC (line);
      IF (line MOD 10) = 0 THEN IO.WriteInt (line); IO.Write (CR) END;
      IF blankline THEN INC (blanklines)
      ELSE blanklines := 0; blankline := TRUE
      END;
      IF blanklines < 2 THEN Files.Write (w, LF) END;
      spaces := 0;
      CASE ch OF
        LF : state := STARTLINE
        |
        SP : INC (spaces); state := WHITESPACE
        |
        TAB : INC (spaces, 8); state := WHITESPACE
        |
        "(" : state := LEFTBRACKET
        |
      ELSE
        Files.Write (w, ch); state := COPYCHAR
      END;
    |
    WHITESPACE :
      CASE ch OF
        LF : state := STARTLINE
        |
        SP : INC (spaces); state := WHITESPACE
        |
        TAB : INC (spaces, 8); state := WHITESPACE
        |
        "(" : state := LEFTBRACKET
        |
      ELSE
        WriteSpaces(); Files.Write (w, ch); state := COPYCHAR
      END;
    |
    COPYCHAR :
      blankline := FALSE;
      CASE ch OF
        LF : state := STARTLINE
        |
        SP : INC (spaces); state := WHITESPACE
        |
        TAB : INC (spaces, 8); state := WHITESPACE
        |
        "(" : state := LEFTBRACKET
        |
      ELSE
        Files.Write (w, ch); state := COPYCHAR
      END;
    |
    LEFTBRACKET :
      CASE ch OF
        "*" : state := STARTCOMMENT
        |
        LF :
          WriteSpaces (); Files.Write (w, "("); state := STARTLINE
        |
        SP :
          WriteSpaces (); Files.Write (w, "("); spaces := 1;
          blankline := FALSE; state := WHITESPACE
        |
        TAB :
          WriteSpaces (); Files.Write (w, "("); spaces := 8;
          blankline := FALSE; state := WHITESPACE
        |
        "(" :
          WriteSpaces (); Files.Write (w, "("); blankline := FALSE;
          state := LEFTBRACKET
        |
      ELSE
        WriteSpaces (); Files.Write (w, "("); Files.Write (w, ch);
        state := COPYCHAR
      END;
    |
    STARTCOMMENT :
      IF ch = "!" THEN
        WriteSpaces(); WriteString ("(*"); CopyComment ();
        blankline := FALSE
      ELSE
        SkipComment ()
      END;
      state := ENDCOMMENT
    |
    ENDCOMMENT :
      CASE ch OF
        LF : state := STARTLINE
        |
        SP : INC (spaces); state := WHITESPACE
        |
        TAB : INC (spaces, 8); state := WHITESPACE
        |
        "(" : state := LEFTBRACKET
        |
      ELSE
        Files.Write (w, ch); state := COPYCHAR
      END;
    |
  END
END ChangeState;

(*$D-*)
PROCEDURE Strip (inputName : ARRAY OF CHAR);

  VAR outputName : Path;

BEGIN (* Strip *)
  input := Files.Old (inputName);
  IF input # NIL THEN
    MakeOutputName (inputName, outputName);
    output := Files.New (outputName);
    IF output # NIL THEN
      IO.WriteF2
        (" !! %s -> %s\n", SYS.ADR (inputName), SYS.ADR (outputName));
      Files.Set (r, input, 0);
      Files.Set (w, output, 0);
      spaces := 0; state := WHITESPACE; line := 1; blankline := FALSE;
      WHILE ~r.eof DO
        Files.Read (r, ch);
        ChangeState ()
      END;
      WriteString ("\n\n(* Comments stripped by StripComments 1.0 *)\n");
      Files.Register (output)
    ELSE
      IO.WriteF1 (" !! Could not open %s\n", SYS.ADR (outputName))
    END;
    Files.Close (input)
  ELSE
    IO.WriteF1 (" !! Could not open %s\n", SYS.ADR (inputName))
  END;

  input := NIL; output := NIL;
  Files.Set (r, NIL, 0); Files.Set (w, NIL, 0);
  SYS.GC
END Strip;

PROCEDURE Scan ();

  TYPE

    MyAnchorPtr = CPOINTER TO MyAnchor;
    MyAnchor = RECORD (Dos.AnchorPath)
      path : Path
    END; (* MyAnchor *)

  VAR myAnchor : MyAnchorPtr; result : LONGINT;

BEGIN (* Scan *)
  (*
    Allocate an anchor structure and initialise with the length of the
    path variable.
  *)
  NEW (myAnchor); myAnchor.apStrlen := SIZE (Path);

  (* Find the first file matching the pattern *)
  result := Dos.Base.MatchFirst (pattern, myAnchor);
  WHILE result = 0 DO
    (* Strip the file and get the next name. *)
    Strip (myAnchor.path);
    result := Dos.Base.MatchNext (myAnchor)
  END
END Scan;

PROCEDURE * Cleanup (rc : LONGINT);

BEGIN (* Cleanup *)
  IF input # NIL THEN Files.Close (input) END;
  IF output # NIL THEN Files.Purge (output) END;
  IF OldCleanup # NIL THEN OldCleanup (rc) END
END Cleanup;

BEGIN (* StripComments *)
  (* Make sure we have been run from the CLI. *)
  Errors.Assert (Args.IsCLI, "Sorry, no Workbench support :-(");

  input := NIL; output := NIL; OldCleanup := NIL;
  SYS.SETCLEANUP (Cleanup, OldCleanup);

  Greetings ();
  GetArgs ();
  Scan ();
  IO.WriteStr (" !! StripComments finished\n")
END StripComments.

(*************************************************************************

  $Log$
*************************************************************************)