home *** CD-ROM | disk | FTP | other *** search
/ Fresh Fish 8 / FreshFishVol8-CD2.bin / bbs / dev / oberon-a-1.4ß.lha / Oberon-A / source / oel / OEL.mod < prev    next >
Text File  |  1994-08-19  |  10KB  |  321 lines
  1. (*
  2.  *      $DESCRIPTION: Oberon-A Error Lister $
  3.  *      $AUTHOR: Johan Ferreira $
  4.  *)
  5.  
  6. MODULE  OEL;
  7.  
  8. (* $P- Portable code disabled *)
  9.  
  10. IMPORT  SYSTEM, Exec, Dos, Locale, ErrorMessages, OELRev, Strings,
  11.         IO := BufIO, ANSI, Msg := OELMsg, Errors;
  12.  
  13.  
  14. CONST   numOfArgs = 10;
  15.         defModulePostfix = ".mod";
  16.         defErrPostfix = ".err";
  17.         defColWidth = 71;
  18.         defColSeperator = " ";
  19.         defTagLength = 1;
  20.         defTabSize = 8;
  21.  
  22.         oaerIdSTR = "OAER";
  23.         eclipseSTR = "...";
  24.         programName = "OEL";
  25.         maxString = 256;
  26.  
  27.  
  28. VAR     E, R, W: Dos.FileHandlePtr;
  29.         errline, errcol, preverrline, errno: INTEGER;
  30.         modline, modcol: INTEGER;
  31.         tab: INTEGER;
  32.         eclipse, bool: BOOLEAN;
  33.         i, m, n: LONGINT;
  34.         strptr, errstrptr, prgname: Exec.STRPTR;
  35.  
  36.         module, modulePostfix, errPostfix, colSeperator: Exec.STRPTR;
  37.         colWidth, tagLength, tabSize: LONGINT;
  38.         lineNumbers, errNumbers(*, ansi*): BOOLEAN;
  39.         argarray: ARRAY numOfArgs OF SYSTEM.LONGWORD;
  40.         argresult: Dos.RDArgsPtr;
  41.  
  42.  
  43. PROCEDURE PrintFault ();
  44. BEGIN
  45.         IF Dos.base.PrintFault (Dos.base.IoErr (), prgname^) THEN END
  46. END PrintFault;
  47.  
  48.  
  49. PROCEDURE WriteLineNumber ();
  50. BEGIN
  51.         IF lineNumbers THEN
  52.                 ANSI.BoldfaceText (W, FALSE, TRUE);
  53.                 IO.WriteF1 (W, "%-4ld", LONG (modline));
  54.                 ANSI.PlainText (W);
  55.                 IO.WriteStr (W, colSeperator^)
  56.         END
  57. END WriteLineNumber;
  58.  
  59.  
  60. PROCEDURE WriteLine ();
  61. BEGIN
  62.         WriteLineNumber ();
  63.  
  64.         LOOP    IF (strptr^[i] # 00X) & (strptr^[i] # 0AX) THEN
  65.                         IF strptr^[i] = 09X THEN
  66.                                 n := tabSize - (modcol MOD tabSize);
  67.                                 WHILE n > 0 DO
  68.                                         IF ((modcol+1) MOD colWidth # 0) THEN
  69.                                                 IO.Write (W, " ");
  70.                                                 INC (modcol); DEC (n)
  71.                                         ELSE    INC (modcol, SHORT (n)); n := 0;
  72.                                                 INC (i); EXIT
  73.                                         END;
  74.                                 END
  75.                         ELSE
  76.                                 IO.Write (W, strptr^[i]);
  77.                                 INC (modcol);
  78.                         END;
  79.                         INC (i)
  80.                 END;
  81.  
  82.                 IF (strptr^[i] = 00X) OR (strptr^[i] = 0AX) THEN
  83.                         modcol := MAX (INTEGER);
  84.                         i := MAX (INTEGER);
  85.                         EXIT
  86.                 ELSIF (modcol MOD colWidth = 0) THEN
  87.                         EXIT
  88.                 END
  89.         END;
  90.         IO.WriteLn (W)
  91. END WriteLine;
  92.  
  93.  
  94. PROCEDURE WriteError ();
  95. BEGIN
  96.         IF lineNumbers THEN IO.WriteStr (W, "    ") END;
  97.         m := ((errcol-1) MOD colWidth) + SYSTEM.STRLEN (colSeperator^);
  98.         WHILE m > 0 DO
  99.                 IO.Write (W, " "); DEC (m)
  100.         END;
  101.         IO.Write (W, "^"); IO.WriteLn (W);
  102.  
  103.         ANSI.ItalicText (W, TRUE);
  104.         IF errNumbers THEN IO.WriteF1 (W, "%ld: ", LONG (errno)) END;
  105.         (* Internal errors *)
  106.         IF (950 < errno) & (errno < 1000) THEN
  107.                 errstrptr := ErrorMessages.GetString (ErrorMessages.msgErr950);
  108.                 IO.WriteStr (W, errstrptr^)
  109.         ELSIF (1000 < errno) & (errno < 1050) THEN
  110.                 errstrptr := ErrorMessages.GetString (ErrorMessages.msgErr1000);
  111.                 IO.WriteStr (W, errstrptr^)
  112.         END;
  113.         errstrptr := ErrorMessages.GetString (errno + 1);
  114.         IO.WriteStr (W, errstrptr^);
  115.         IO.WriteLn (W);
  116.         ANSI.PlainText (W)
  117. END WriteError;
  118.  
  119.  
  120. PROCEDURE ReadLine (output: BOOLEAN);
  121. BEGIN
  122.         WHILE output & (i # MAX (INTEGER)) DO
  123.                 WriteLine ()
  124.         END;
  125.  
  126.         IF Dos.base.FGets (R, strptr^, maxString) = NIL THEN
  127.                 modline := MAX (INTEGER);
  128.                 modcol := MAX (INTEGER)
  129.         ELSE
  130.                 i := 0;
  131.                 INC (modline);
  132.                 modcol := 0
  133.         END
  134. END ReadLine;
  135.  
  136.  
  137. PROCEDURE WriteCopyright ();
  138. BEGIN
  139.         strptr := Msg.GetString (Msg.msgCopyright);
  140.         IO.WriteF1 (NIL, strptr^, SYSTEM.ADR (OELRev.vers))
  141. END WriteCopyright;
  142.  
  143.  
  144. PROCEDURE ParseArgs ();
  145.  
  146. TYPE    LongPtr = CPOINTER TO LONGINT;
  147.  
  148. VAR     lp: LongPtr;
  149.  
  150.         PROCEDURE ArgError ();
  151.         BEGIN
  152.                 strptr := Msg.GetString (Msg.msgArgError);
  153.                 IO.WriteF1 (NIL, strptr^, prgname);
  154.                 HALT (Dos.returnError)
  155.         END ArgError;
  156.  
  157. BEGIN
  158.         FOR n := 0 TO numOfArgs-1 DO argarray[n] := SYSTEM.VAL (SYSTEM.LONGWORD, 0) END;
  159.         argarray[1] := SYSTEM.ADR (defModulePostfix);
  160.         argarray[2] := SYSTEM.ADR (defErrPostfix);
  161.         argarray[4] := SYSTEM.ADR (defColSeperator);
  162.  
  163.         strptr := Msg.GetString (Msg.msgTemplate);
  164.         argresult := Dos.base.ReadArgs (strptr^, argarray, NIL);
  165.  
  166.         IF argresult = NIL THEN
  167.                 PrintFault ();
  168.                 HALT (Dos.returnError)
  169.         END;
  170.  
  171.         module := SYSTEM.VAL (Exec.STRPTR, argarray[0]);
  172.         modulePostfix := SYSTEM.VAL (Exec.STRPTR, argarray[1]);
  173.         errPostfix := SYSTEM.VAL (Exec.STRPTR, argarray[2]);
  174.         lp := SYSTEM.VAL (LongPtr, argarray[3]);
  175.         IF lp = NIL THEN colWidth := defColWidth ELSE colWidth := lp^ END;
  176.         colSeperator := SYSTEM.VAL (Exec.STRPTR, argarray[4]);
  177.         lineNumbers := (SYSTEM.VAL (LONGINT, argarray[5]) = 0);
  178.         errNumbers := ~(SYSTEM.VAL (LONGINT, argarray[6]) = 0);
  179.         ANSI.ansi := (SYSTEM.VAL (LONGINT, argarray[7]) = 0);
  180.  
  181.         lp := SYSTEM.VAL (LongPtr, argarray[8]);
  182.         IF lp = NIL THEN tagLength := defTagLength ELSE tagLength := lp^ END;
  183.         IF tagLength < 0 THEN ArgError () END;
  184.  
  185.         lp := SYSTEM.VAL (LongPtr, argarray[9]);
  186.         IF lp = NIL THEN tabSize := defTabSize ELSE tabSize := lp^ END;
  187.         IF tabSize <= 0 THEN ArgError () END;
  188. END ParseArgs;
  189.  
  190.  
  191. PROCEDURE Init ();
  192. VAR     tag : ARRAY 5 OF CHAR;
  193.  
  194.         PROCEDURE NotErrorFile;
  195.         VAR     msgstrptr: Exec.STRPTR;
  196.         BEGIN
  197.                 msgstrptr := Msg.GetString (Msg.msgNotAnErrorFile);
  198.                 IO.WriteF2 (NIL, msgstrptr^, prgname, strptr);
  199.                 HALT (Dos.returnFail)
  200.         END NotErrorFile;
  201.  
  202. BEGIN
  203.         NEW (strptr, maxString);
  204.         NEW (errstrptr, maxString);
  205.         NEW (prgname, 32);
  206.  
  207.         Locale.OpenLib (FALSE);          (* Don't _need_ to open locale *)
  208.         Msg.OpenCatalog (NIL, "");
  209.         ErrorMessages.OpenCatalog (NIL, "");
  210.  
  211.         IF ~ Dos.base.GetProgramName (prgname^, 30) THEN prgname := SYSTEM.ADR (programName) END;
  212.  
  213.         ParseArgs ();
  214.         strptr^ := "";
  215.         Strings.Append (strptr^, module^); Strings.Append (strptr^, errPostfix^);
  216.         E := Dos.base.Open (strptr^, Dos.modeOldFile);
  217.         IF E # NIL THEN
  218.                 IF Dos.base.Read (E, tag, 4) = 4 THEN
  219.                         tag [4] := 0X; (* NUL-terminate the string *)
  220.                         IF tag # oaerIdSTR THEN NotErrorFile() END
  221.                 ELSE    NotErrorFile()
  222.                 END;
  223.         END;
  224.         IF E = NIL THEN
  225.                 PrintFault ();
  226.                 HALT (Dos.returnWarn)
  227.         END;
  228.  
  229.         strptr^ := "";
  230.         Strings.Append (strptr^, module^); Strings.Append (strptr^, modulePostfix^);
  231.         R := Dos.base.Open (strptr^, Dos.modeOldFile);
  232.         IF R = NIL THEN
  233.                 PrintFault ();
  234.                 HALT (Dos.returnFail)
  235.         END;
  236.  
  237.         W := Dos.base.Output ();
  238.  
  239.         modline := 0; modcol := 0;
  240.         errline := 0; errcol := 0;
  241.         i := MAX (INTEGER)
  242. END Init;
  243.  
  244.  
  245. PROCEDURE *Close ();
  246. BEGIN
  247.         ErrorMessages.CloseCatalog ();
  248.         Dos.base.FreeArgs (argresult);
  249.  
  250.         IF W = Dos.base.Output () THEN
  251.                 IF Dos.base.Flush (W) THEN (* Error *) END
  252.         ELSE    IF W # NIL THEN
  253.                         IF Dos.base.Close (W) THEN (* Error *) END
  254.                 END
  255.         END;
  256.         IF R # NIL THEN
  257.                 IF Dos.base.Close (R) THEN (* Error *) END
  258.         END;
  259.         IF E # NIL THEN
  260.                 IF Dos.base.Close (E) THEN (* Error *) END
  261.