(*
  .name       Modula2
  .task       M2Amiga support
  .release    1.0
  .language   Oberon-2
  .translator Amiga Oberon 3.11
  .system     AmigaOS 2.04/2.1/3.0
  .author     Joachim Barheine
  .address    Hochgrevestraße 3, D-38640 Goslar
  .copyright  (c) 1994 by Joachim Barheine
*)

(* .info: 29/09/94, 13:37:05, version 33 *)

(* $IF M2Amiga THEN *)

MODULE Modula2;

IMPORT
  SYS:= SYSTEM,

  AVL:= UntracedAVL,
  BM:= Bookmarks,
  Dos,
  Exec,
  F:= Files,
  GUI,
  I:= Intuition,
  IO:= IOServer,
  K:= Kernel,
  Req:= ERequests,
  Rx:= ERexx,
  S:= Strings,
  Str:= StrPool,
  T:= ETexts,
  Util:= Utility,
  W:= Windows;

TYPE
  ErrList* = RECORD
    currErr-, numErrs- : INTEGER;
    errors: K.DynArray;
    errFileID, errID: LONGINT;
    endID: INTEGER;
    strID: CHAR;
  END;

  ErrNode = UNTRACED POINTER TO ErrNodeDesc;
  ErrNodeDesc = RECORD (K.ANYDesc)
    addInfo: K.DynString;
    bm: BM.BookmarkID;
    err: INTEGER;
  END;

  ErrMsgNode = UNTRACED POINTER TO ErrMsgNodeDesc;
  ErrMsgNodeDesc = RECORD (AVL.Node)
    err: LONGINT;
    txt: K.DynString;
  END;

  ErrStringPool = RECORD (AVL.Root)
    loaded: BOOLEAN;
  END;

  Stream = RECORD
    i: LONGINT; (* parse position *)
    data: UNTRACED POINTER TO ARRAY OF SYS.BYTE;
  END;

VAR
  strings: ErrStringPool;
  searchErr: LONGINT;

(* -- parsing stream -- *)

PROCEDURE NewStream(VAR s: Stream; VAR f: F.File): BOOLEAN;

BEGIN
  s.i:= 0;
  NEW(s.data, f.len);
  f.Read(s.data^, f.len);
  RETURN f.done;
END NewStream;

PROCEDURE DisposeStream(VAR s: Stream);

BEGIN
  DISPOSE(s.data);
END DisposeStream;

PROCEDURE Read(VAR s: Stream; VAR data: ARRAY OF SYS.BYTE): BOOLEAN;

BEGIN
  RETURN K.Read(s.data^, s.i, data);
END Read;

PROCEDURE Match(VAR s: Stream; data: ARRAY OF SYS.BYTE): BOOLEAN;

(* $CopyArrays- *)

BEGIN
  RETURN K.Match(s.data^, s.i, data);
END Match;

PROCEDURE Even(VAR s: Stream);

BEGIN
  IF ODD(s.i) THEN INC(s.i) END;
END Even;

(* -- error file -- *)

PROCEDURE* ErrFind(VAR root: AVL.Root; n: AVL.NodePtr): INTEGER;

BEGIN
  RETURN SHORT(n(ErrMsgNode).err - searchErr);
END ErrFind;

PROCEDURE* ErrComp(a, b: AVL.NodePtr): INTEGER;

BEGIN
  RETURN SHORT(a(ErrMsgNode).err - b(ErrMsgNode).err);
END ErrComp;

PROCEDURE ReadMessageFile(VAR strings: ErrStringPool);

VAR
  s: Stream;
  n: ErrMsgNode;
  f: F.File;
  next: LONGINT;
  err: INTEGER;
  done: BOOLEAN;

BEGIN
  IF f.Open(Str.errMsgFile, FALSE) THEN
    done:= NewStream(s, f);
    f.Close;
    IF done & f.done THEN
      WHILE Read(s, next) & (next # 0) & Read(s, err) DO
        NEW(n);
        n.err:= err;
        NEW(n.txt, next-s.i);
        IF Read(s, n.txt^) & AVL.Add(strings, n) THEN END;
      END;
      strings.loaded:= (next = 0);
    END;
    DisposeStream(s);
  END;
END ReadMessageFile;

(* -- ErrList/ErrNode -- *)

PROCEDURE (e: ErrNode) Dispose*;

BEGIN
  IF e.addInfo # NIL THEN DISPOSE(e.addInfo) END;
END Dispose;

PROCEDURE (VAR e: ErrList) New*;

BEGIN
  e.currErr:= 0;
  e.numErrs:= 0;
  e.errors.New(5, 50);
  e.errFileID:= 3U;
  e.errID:= 0C1455252U;
  e.strID:= 0C2X;
  e.endID:= -1;
END New;

PROCEDURE (VAR e: ErrList) Dispose*(t: T.Text);

VAR
  i: INTEGER;
  n: K.ANY;

BEGIN
  FOR i:= 0 TO e.errors.len-1 DO
    n:= e.errors.Get(i);
    t.FreeBookmark(n(ErrNode).bm);
  END;
  e.errors.Dispose;
END Dispose;

PROCEDURE GetErrString(w: W.Window; VAR str: ARRAY OF CHAR; err: LONGINT);

VAR
  n: AVL.NodePtr;

BEGIN
  IF ~strings.loaded THEN
    w.Busy(Str.loadingMsgFile^);
    ReadMessageFile(strings);
    w.BusyDone;
  END;
  searchErr:= err;
  n:= AVL.Find(strings);
  IF n # NIL THEN
    COPY(n(ErrMsgNode).txt^, str);
  ELSE
    COPY(Str.noErrMsg^, str);
  END;
END GetErrString;

PROCEDURE (VAR e: ErrList) Goto* (w: W.Window; num: INTEGER): BOOLEAN;

VAR
  n: ErrNode;
  pos, dummy: LONGINT;
  a: ARRAY 4 OF LONGINT;
  str: ARRAY 80 OF CHAR;
  msg: ARRAY 256 OF CHAR;
  i: INTEGER;

BEGIN
  IF (num >= 0) & (num < e.numErrs) THEN
    n:= e.errors.Get(num)(ErrNode);
    w.text(T.Text).GetBookmark(n.bm, pos, dummy);
    GetErrString(w, str, n.err);
    a[0]:= n.err; a[1]:= SYS.ADR(str); a[2]:= NIL;
    IF n.addInfo # NIL THEN a[2]:= SYS.ADR(n.addInfo^) END;
    K.FormatString(msg, "%lD: %s%s.", a);
    w.SetPos(pos);
    w.Title(msg);
    e.currErr:= num;
    RETURN TRUE;
  ELSE
    IF num = 0 THEN
      w.Title(Str.noErrors^);
    ELSE
      w.Title(Str.noMoreErrors^);
    END;
    RETURN FALSE;
  END;
END Goto;

PROCEDURE (VAR e: ErrList) Next* (w: W.Window): BOOLEAN;

BEGIN
  RETURN e.Goto(w, e.currErr + 1);
END Next;

PROCEDURE (VAR e: ErrList) Prev* (w: W.Window): BOOLEAN;

BEGIN
  RETURN e.Goto(w, e.currErr - 1);
END Prev;

PROCEDURE (VAR e: ErrList) Load* (w: W.Window): BOOLEAN;

VAR
  s: Stream;
  f: F.File;
  name: ARRAY F.pathLen + F.nameLen OF CHAR;
  t: T.Text;
  id: LONGINT;
  done: BOOLEAN;

  PROCEDURE Invalid;

  VAR
    a: ARRAY 1 OF LONGINT;
    errFile: ARRAY F.nameLen OF CHAR;
    msg: ARRAY 80 OF CHAR;

  BEGIN
    COPY(t.name, errFile); S.Append(errFile, "E");
    a[0]:= SYS.ADR(errFile);
    K.FormatString(msg, Str.invalidErrFile^, a);
    Req.ReqMessage(w.win, msg, Str.cancel^);
    done:= FALSE;
  END Invalid;

  PROCEDURE Parse(VAR s: Stream): BOOLEAN;

  VAR
    err, i, j: INTEGER;
    pos: LONGINT;       (* error position *)
    str: ARRAY 80 OF CHAR;
    old: K.DynString;
    n: ErrNode;
    c: CHAR;

  BEGIN
    i:= 0; n:= NIL;
    WHILE Read(s, pos) DO
      REPEAT
        IF Match(s, e.strID) THEN       (* string *)
          str[0]:= " ";
          j:= 1; WHILE (j < 79) & Read(s, str[j]) & (str[j] # 0X) DO INC(j) END;
          str[j]:= 0X;
          IF n.addInfo = NIL THEN
            NEW(n.addInfo, j + 1); COPY(str, n.addInfo^);
          ELSE
            old:= n.addInfo;
            NEW(n.addInfo, LEN(n.addInfo^) + j + 2);
            COPY(old^, n.addInfo^); S.Append(n.addInfo^, ", "); S.Append(n.addInfo^, str);
            DISPOSE(old);
          END;
        ELSIF Read(s, err) THEN          (* number *)
          NEW(n);
          n.err:= err;
          n.bm:= t.NewBookmark(t.OpenFoldFPos(pos), K.undef);
          n.addInfo:= NIL;
        ELSE
          RETURN FALSE;
        END;
        Even(s);
      UNTIL Match(s, e.errID) OR Match(s, e.endID);
      e.errors.Put(n, i); INC(i);
    END;
    e.numErrs:= i;
    RETURN TRUE;
  END Parse;

BEGIN
  done:= FALSE;
  t:= w.text(T.Text);
  e.Dispose(t); e.New;
  F.GetFilename(name, t.path, t.name);
  S.Append(name, "E");
  IF f.Open(name, FALSE) THEN
    done:= NewStream(s, f);
    f.Close;
    done:= done & Match(s, e.errFileID) & Match(s, e.errID) & Parse(s);
    DisposeStream(s);
    IF ~done THEN e.Dispose(t); e.New; Invalid; END;
  ELSE
    w.Title(Str.noErrors^);
  END;
  IF done & e.Goto(w, 0) THEN END;
  RETURN done;
END Load;

(* -- tools -- *)

PROCEDURE GetProject(VAR path, name: ARRAY OF CHAR; t: T.Text): BOOLEAN;

VAR
  ext: ARRAY 5 OF CHAR;

  PROCEDURE GetExt(name: ARRAY OF CHAR; VAR ext: ARRAY OF CHAR): BOOLEAN;

  VAR
    l: LONGINT;

  (* $CopyArrays- *)

  BEGIN
    l:= S.Length(name);
    IF l > 4 THEN
      S.Cut(name, l-4, 4, ext);
      S.UpperIntl(ext);
      RETURN TRUE;
    ELSE
      RETURN FALSE;
    END;
  END GetExt;

BEGIN
  COPY(t.name, name);
  IF GetExt(name, ext) & ((ext = ".MOD") OR (ext = ".DEF")) THEN
    S.Delete(name, S.Length(name)-4, 4);
  ELSE
    RETURN FALSE;
  END;
  COPY(t.path, path);
  IF GetExt(path, ext) & ((ext = "/TXT") OR (ext = ":TXT")) THEN
    S.Append(path, "//");        (* parent *)
  END;
  RETURN TRUE;
END GetProject;

PROCEDURE Compile* (w: W.Window): BOOLEAN;

VAR
  t: T.Text;
  path: ARRAY F.pathLen OF CHAR;
  name: ARRAY F.nameLen OF CHAR;
  str: ARRAY F.filenameLen + 80 OF CHAR;
  a: ARRAY 2 OF LONGINT;

BEGIN
  t:= w.text(T.Text);
  IF GetProject(path, name, t) THEN
    IF Exec.FindPort("M2C") # NIL THEN
      COPY(t.name, name);       (* keep extension *)
      a[0]:= SYS.ADR(path); a[1]:= SYS.ADR(name);
      K.FormatString(str, "OPTIONS FAILAT 11; ADDRESS 'M2C' 'COMPILE -g\"%s\" \"%s\"'; LoadErrors", a);
      RETURN Rx.Execute(str, FALSE);
    ELSE
      GUI.Flash;
      w.Title(Str.noCompiler^);
    END;
  ELSE
    GUI.Flash;
    w.Title(Str.noM2Source^);
  END;
  RETURN FALSE;
END Compile;

PROCEDURE Link* (w: W.Window): BOOLEAN;

VAR
  t: T.Text;
  path: ARRAY F.pathLen OF CHAR;
  name: ARRAY F.nameLen OF CHAR;
  str: ARRAY F.filenameLen + 60 OF CHAR;
  a: ARRAY 2 OF LONGINT;

BEGIN
  t:= w.text(T.Text);
  IF GetProject(path, name, t) THEN
    IF Exec.FindPort("M2L") # NIL THEN
      a[0]:= SYS.ADR(path); a[1]:= SYS.ADR(name);
      K.FormatString(str, "OPTIONS FAILAT 11; ADDRESS 'M2L' 'LINK -g\"%s\" \"%s\"'", a);
      RETURN Rx.Execute(str, FALSE);
    ELSE
      GUI.Flash;
      w.Title(Str.noLinker^);
    END;
  ELSE
    GUI.Flash;
    w.Title(Str.noM2Source^);
  END;
  RETURN FALSE;
END Link;

PROCEDURE Make* (w: W.Window);

VAR
  t: T.Text;
  path: ARRAY F.pathLen OF CHAR;
  name: ARRAY F.nameLen OF CHAR;
  str: ARRAY F.filenameLen + 80 OF CHAR;
  lock, old: Dos.FileLockPtr;
  a: ARRAY 1 OF LONGINT;

BEGIN
  t:= w.text(T.Text);
  IF GetProject(path, name, t) THEN
    lock:= Dos.Lock(path, Dos.sharedLock);
    IF lock # NIL THEN
      old:= Dos.CurrentDir(lock);
      COPY(t.name, name);       (* keep extension *)
      a[0]:= SYS.ADR(name);
      K.FormatString(str, "M2:M2Make %s", a);
      IF Dos.SystemTags(str, Dos.sysInput, SYS.VAL(LONGINT, Rx.stdio),
                        Dos.sysOutput, NIL, Util.done)#0 THEN
        GUI.Flash
      END;
      Dos.UnLock(lock);
      lock:= Dos.CurrentDir(old);
      RETURN;
    END;
    GUI.Flash;
  ELSE
    GUI.Flash;
    w.Title(Str.noM2Source^);
  END;
END Make;

PROCEDURE Execute* (w: W.Window);

VAR
  t: T.Text;
  args: ARRAY 128 OF CHAR;
  cmd: ARRAY 160 OF CHAR;
  name: ARRAY F.nameLen OF CHAR;
  path: ARRAY F.pathLen OF CHAR;
  io: Dos.FileHandlePtr;
  lock, old: Dos.FileLockPtr;
  a: ARRAY 2 OF LONGINT;

BEGIN
  t:= w.text(T.Text);
  IF GetProject(path, name, t) THEN
    lock:= Dos.Lock(path, Dos.sharedLock);
    IF lock # NIL THEN
      old:= Dos.CurrentDir(lock);
      IO.TestAutosave;
      args:= "";
      IF Req.ReqString(w.win, Str.execPrg^, Str.arguments^, args) = Req.cmdOk THEN
        a[0]:= SYS.ADR(name);
        IF args = "" THEN a[1]:= NIL ELSE a[1]:= SYS.ADR(args) END;
        K.FormatString(cmd, '%s %s', a);
        IO.Busy(t, Str.executing^);
        io:= Dos.Open(Rx.stdioDesc, Dos.oldFile);
        IF io # NIL THEN
          IF Dos.SystemTags(cmd, Dos.sysInput, SYS.VAL(LONGINT, io),
                          Dos.sysOutput, NIL, Dos.sysAsynch, I.LTRUE, Util.done)=-1 THEN
            WHILE ~Dos.Close(io) DO Dos.Delay(100) END;
            GUI.Flash;
          END;
        END;
        IO.BusyDone(t);
      END;
      Dos.UnLock(lock);
      lock:= Dos.CurrentDir(old);
    END;
  ELSE
    GUI.Flash;
    w.Title(Str.noM2Source^);
  END;
END Execute;

(* -- main -- *)

BEGIN
  AVL.Init(strings, ErrComp, ErrFind);
  strings.loaded:= FALSE;
END Modula2.

(* $END *)