(*
 *      $DESCRIPTION: Oberon-A Error Lister $
 *      $AUTHOR: Johan Ferreira $
 *)

MODULE  OEL;

(* $P- Portable code disabled *)

IMPORT  SYSTEM, Exec, Dos, Locale, ErrorMessages, OELRev, Strings;

CONST   argTemplate = "MODULE/A,MODULEPOSTFIX/K,ERRPOSTFIX/K,COLWIDTH/N,COLSEPERATOR/K,NOLINENUMBERS/S,ERRNUMBERS/S,NOANSI/S,TAGLENGTH/N,TABSIZE/N";
        numOfArgs = 10;
        defModulePostfix = ".mod";
        defErrPostfix = ".err";
        defColWidth = 75;
        defColSeperator = " ";
        defTagLength = 1;
        defTabSize = 8;

        oaerIdSTR = "OAER";
        eclipseSTR = "...";
        maxString = 256;


VAR     E, R, W: Dos.FileHandlePtr;
        errline, errcol, preverrline, errno: INTEGER;
        modline, modcol: INTEGER;
        tab: INTEGER;
        eclipse, bool: BOOLEAN;
        i, m, n: LONGINT;
        strptr, errstrptr: Exec.STRPTR;

        module, modulePostfix, errPostfix, colSeperator: Exec.STRPTR;
        colWidth, tagLength, tabSize: LONGINT;
        lineNumbers, errNumbers, ansi: BOOLEAN;
        argarray: ARRAY numOfArgs OF SYSTEM.LONGWORD;
        argresult: Dos.RDArgsPtr;


PROCEDURE PlainText ();
BEGIN   IF ansi THEN
                bool := Dos.base.FPuts (W, "\x9B0m")
        END
END PlainText;

PROCEDURE BoldfaceText ();
BEGIN   IF ansi THEN
                bool := Dos.base.FPuts (W, "\x9B1m")
        END
END BoldfaceText;

PROCEDURE ItalicText ();
BEGIN   IF ansi THEN
                bool := Dos.base.FPuts (W, "\x9B3m")
        END
END ItalicText;

PROCEDURE UnderscoreText ();
BEGIN   IF ansi THEN
                bool := Dos.base.FPuts (W, "\x9B4m")
        END
END UnderscoreText;

PROCEDURE WriteLn ();
BEGIN   n := Dos.base.FPutC (W, LONG( ORD (0AX)))
END WriteLn;

PROCEDURE WriteLineNumber ();
BEGIN   IF lineNumbers THEN
                BoldfaceText ();
                n := Dos.base.FPrintf (W, "%-4ld", LONG (modline));
                PlainText ();
                bool := Dos.base.FPuts (W, colSeperator^)
        END
END WriteLineNumber;

PROCEDURE WriteLine ();
BEGIN
        WriteLineNumber ();

        LOOP    IF (strptr^[i] # 00X) & (strptr^[i] # 0AX) THEN
                        IF strptr^[i] = 09X THEN
                                n := tabSize - (modcol MOD tabSize);
                                WHILE n > 0 DO
                                        IF ((modcol+1) MOD colWidth # 0) THEN
                                                m := Dos.base.FPutC (W, LONG (ORD (" ")));
                                                INC (modcol); DEC (n)
                                        ELSE    INC (modcol, SHORT (n)); n := 0;
                                                INC (i); EXIT
                                        END;
                                END
                        ELSE
                                n := Dos.base.FPutC (W, LONG (ORD (strptr^[i])));
                                INC (modcol);
                        END;
                        INC (i)
                END;

                IF (strptr^[i] = 00X) OR (strptr^[i] = 0AX) THEN
                        modcol := MAX (INTEGER);
                        i := MAX (INTEGER);
                        EXIT
                ELSIF (modcol MOD colWidth = 0) THEN
                        EXIT
                END
        END;
        WriteLn ()
END WriteLine;

PROCEDURE WriteError ();
BEGIN
        IF lineNumbers THEN n := Dos.base.FPrintf (W, "    ", NIL) END;
        m := ((errcol-1) MOD colWidth) + SYSTEM.STRLEN (colSeperator^);
        WHILE m > 0 DO
                n := Dos.base.FPutC (W, LONG (ORD (" "))); DEC (m)
        END;
        n := Dos.base.FPutC (W, LONG (ORD ("^"))); WriteLn ();

        errstrptr := ErrorMessages.GetString (errno + 1);
        ItalicText ();
        IF errNumbers THEN n := Dos.base.FPrintf (W, "%ld: ", LONG (errno)) END;
        bool := Dos.base.FPuts (W, errstrptr^); WriteLn ();
        PlainText ()
END WriteError;

PROCEDURE ReadLine (output: BOOLEAN);
BEGIN
        WHILE output & (i # MAX (INTEGER)) DO
                WriteLine ()
        END;

        IF Dos.base.FGets (R, strptr^, maxString) = NIL THEN
                modline := MAX (INTEGER);
                modcol := MAX (INTEGER)
        ELSE
                i := 0;
                INC (modline);
                modcol := 0;

                WHILE output & (i # MAX (INTEGER)) DO
                        WriteLine ()
                END;
        END
END ReadLine;

PROCEDURE WriteCopyright ();
BEGIN
        bool := Dos.base.FPuts (Dos.base.Output (), OELRev.vers);
        bool := Dos.base.FPuts (Dos.base.Output (),
                ", Copyright © 1994 Johan Ferreira.\n"
                "OEL (Oberon-A Error Lister) comes with ABSOLUTELY NO WARRANTY.\n"
                "This is free software, and you are welcome to redistribute it\n"
                "under certain conditions.  See OEL.guide for details.\n"
                "\n");

END WriteCopyright;

PROCEDURE ParseArgs ();
TYPE    LongPtr = CPOINTER TO LONGINT;
VAR     lp: LongPtr;

        PROCEDURE ArgError ();
        BEGIN
                bool := Dos.base.FPuts (Dos.base.Output (), "Argument Error!\n");
                HALT (20)
        END ArgError;

BEGIN
        FOR n := 0 TO numOfArgs-1 DO argarray[n] := SYSTEM.VAL (SYSTEM.LONGWORD, 0) END;
        argarray[1] := SYSTEM.ADR (defModulePostfix);
        argarray[2] := SYSTEM.ADR (defErrPostfix);
        argarray[4] := SYSTEM.ADR (defColSeperator);

        argresult := Dos.base.ReadArgs (argTemplate, argarray, NIL);

        IF argresult = NIL THEN
                ArgError ()
        END;

        module := SYSTEM.VAL (Exec.STRPTR, argarray[0]);
        modulePostfix := SYSTEM.VAL (Exec.STRPTR, argarray[1]);
        errPostfix := SYSTEM.VAL (Exec.STRPTR, argarray[2]);
        lp := SYSTEM.VAL (LongPtr, argarray[3]);
        IF lp = NIL THEN colWidth := defColWidth ELSE colWidth := lp^ END;
        colSeperator := SYSTEM.VAL (Exec.STRPTR, argarray[4]);
        lineNumbers := (SYSTEM.VAL (LONGINT, argarray[5]) = 0);
        errNumbers := ~(SYSTEM.VAL (LONGINT, argarray[6]) = 0);
        ansi := (SYSTEM.VAL (LONGINT, argarray[7]) = 0);

        lp := SYSTEM.VAL (LongPtr, argarray[8]);
        IF lp = NIL THEN tagLength := defTagLength ELSE tagLength := lp^ END;
        IF tagLength < 0 THEN ArgError () END;

        lp := SYSTEM.VAL (LongPtr, argarray[9]);
        IF lp = NIL THEN tabSize := defTabSize ELSE tabSize := lp^ END;
        IF tabSize <= 0 THEN ArgError () END;
END ParseArgs;

PROCEDURE Init ();
  VAR tag : ARRAY 5 OF CHAR;

        PROCEDURE NotErrorFile;
        BEGIN
                n := Dos.base.FPrintf (Dos.base.Output (), "%s is not an Oberon-A error file", strptr);
                n := Dos.base.FPutC (Dos.base.Output (), LONG (ORD (0AX)));     (* WriteLn () *)
                bool := Dos.base.Close (E);
                HALT (5)
        END NotErrorFile;

BEGIN
        ParseArgs ();
        Locale.OpenLib (FALSE);                 (* Don't _need_ to open locale *)
        ErrorMessages.OpenCatalog (NIL, "");

        NEW (strptr, maxString);
        NEW (errstrptr, maxString);

        (* Make the version string visible *)
        strptr^ := OELRev.versTag; strptr^ := "";

        Strings.Append (strptr^, module^); Strings.Append (strptr^, errPostfix^);
        E := Dos.base.Open (strptr^, Dos.modeOldFile);
        IF E # NIL THEN
          IF Dos.base.Read (E, tag, 4) = 4 THEN
            tag [4] := 0X; (* NUL-terminate the string *)
            IF tag # oaerIdSTR THEN NotErrorFile() END
          ELSE NotErrorFile()
          END;
        END;

        strptr^ := "";
        Strings.Append (strptr^, module^); Strings.Append (strptr^, modulePostfix^);
        R := Dos.base.Open (strptr^, Dos.modeOldFile);

        W := Dos.base.Output ();


        IF (R = NIL) THEN
                n := Dos.base.FPrintf (Dos.base.Output (), "Couldn't open %s%s", module, modulePostfix);
                n := Dos.base.FPutC (Dos.base.Output (), LONG (ORD (0AX)));     (* WriteLn () *)
                HALT (20)
        END;
        IF (E = NIL) THEN
                HALT (5)
        END;

        modline := 0; modcol := 0;
        errline := 0; errcol := 0;
        i := MAX (INTEGER)
END Init;

PROCEDURE Close ();
BEGIN
        ErrorMessages.CloseCatalog ();
        Dos.base.FreeArgs (argresult);

        bool := Dos.base.Flush (W);
        bool := Dos.base.Close (R);
        bool := Dos.base.Close (E)
END Close;


BEGIN   WriteCopyright ();
        Init ();

        LOOP    preverrline := errline;

                IF Dos.base.Read (E, errline, 2) < 2 THEN EXIT END;
                IF Dos.base.Read (E, errcol, 2) < 2 THEN EXIT END;
                IF Dos.base.Read (E, errno, 2) < 2 THEN EXIT END;

                (* Trailing lines *)
                WHILE (preverrline # 0) & (modline < preverrline + tagLength) & (modline < errline) DO
                        ReadLine (TRUE)
                END;

                (* Skip *)
                eclipse := FALSE;
                WHILE (modline < errline - tagLength) DO
                        IF ~eclipse THEN
                                bool := Dos.base.FPuts (W, eclipseSTR); WriteLn ();
                                eclipse := TRUE
                        END;
                        ReadLine (FALSE)
                END;

                (* Leading lines *)
                WHILE (modline < errline) DO
                        ReadLine (TRUE)
                END;

                (* Wrap the line *)
                WHILE (modcol <= errcol) & (i # MAX (INTEGER)) DO
                        WriteLine ()
                END;

                (* If we reached the end of the source, then end *)
                IF (modline = MAX (INTEGER)) & (modcol = MAX (INTEGER)) THEN EXIT END;

                WriteError ()
        END;

        (* Trailing lines *)
        IF preverrline > errline THEN errline := preverrline END;
        WHILE (errline # 0) & (modline < errline + tagLength) DO
                ReadLine (TRUE)
        END;

        (* If not the end of souce, then write eclipse *)
        IF Dos.base.FGets (R, strptr^, maxString) # NIL THEN
                bool := Dos.base.FPuts (W, eclipseSTR); WriteLn ()
        END;

        Close ()
END OEL.


(*
 *      VERSION REV     DESCTIPTION
 *
 *      0       1       DATE: 27.7.94
 *                      Sent to Frank Copeland.
 *
 *      0       2       DATE: 31.7.94
 *                      Now will work with KS 2, by using FlexCat 1.3's Oberon-A.sd.
 *                      Wrote a bit more documentation.
 *                      Include GPL.text and copyright message.
 *                      Sent to Frank Copeland for possible inclusion in the
 *                      Oberon-A 1.4 distribution.
 *
 *      0       3       DATE: 1.8.94 [fjc]
 *                      Now checks for 'OAER' tag in error file.
 *                      Minor changes to compile with Oberon-A release 1.4.
 *
 *)