(*
  .name       IOServer
  .task       IO-management (intuition, rexx)
  .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: 31/08/94, 18:02:25, version 65 *)

MODULE IOServer;

IMPORT
  SYS:= SYSTEM,
  OberonLib,

  Dos,
  Err:= ErrCodes,
  Exec,
  Gfx:= Graphics,
  GT:= GadTools,
  I:= Intuition,
  IE:= InputEvent,
  K:= Kernel,
  KM:= KeyMapLib,
  L:= UntracedLists,
  Rx:= RexxSysLib,
  Rexx,
  S:= Strings,
  Sett:= Settings,
  Str:= StrPool,
  Timer,
  Util:= Utility,
  Wb:= Workbench;

CONST
  maxDRIPens = 32;

TYPE
  PenArray = ARRAY maxDRIPens+1 OF INTEGER;
  PenArrayPtr = UNTRACED POINTER TO PenArray;

CONST
  backPen* = 0;
  markedBackPen* = 0FFH;

  (* results of 'Wait()' *)
  userMsg* = 0;
  rexxMsg* = 1;
  appMsg*  = 2;

 (* 'Handle...()' return codes *)
  msgLocal*     = 0;  (* command had no global effects *)
  msgClosed*    = 1;  (* 'active' (window) was closed *)
  msgQuit*      = 2;  (* all windows were closed *)
  msgRexxCtrl*  = 3;  (* rexx message(s) received *)
  msgUserCtrl*  = 4;  (* intuition message(s) received *)
  msgAppCtrl*   = 5;  (* app-window message(s) received *)

  (* supported qualifiers for 'SetRawKey()' *)
  qualCtrl*  = 0;
  qualAlt*   = 1;
  qualShift* = 2;
  qualAmiga* = 3;
  qualNumPad*= 4;

(* $IF M2Amiga THEN *)
  edtRexxFmt= "m2edt.%lD";
(* $ELSE *)
  edtRexxFmt= "edt.%lD";
(* $END *)

  wbName= "Workbench";

TYPE
  Text* = UNTRACED POINTER TO TextDesc;
  TextDesc* = RECORD (L.Node)
    autoIndent* , cleanLines* , insert* , wordWrap* , icons* : BOOLEAN;
    pPos, pP0, pLen, pLines, pTabs, pBegin, pEnd: LONGINT;  (* --> xxxProc *)
    pBusyInfo: ARRAY 80 OF CHAR;
    id- : INTEGER;
  END;

  Window*= UNTRACED POINTER TO WindowDesc;
  WindowDesc* = RECORD (L.Node)
    text- : Text;
    id- : INTEGER;
    appWindow: Wb.AppWindowPtr;
    menuStrip: I.MenuPtr;
    pItemID: INTEGER;
    pItemVal: BOOLEAN;
  END;

  (* this is executed when an item is selected *)
  (* 'w': 'selected'; 'id' item-identifier (--> 'AddMenu...()') *)
  Command* = PROCEDURE (w: Window; id: INTEGER): SHORTINT;

  MenuDefinition= UNTRACED POINTER TO ARRAY OF GT.NewMenu;
  MenuInfo= UNTRACED POINTER TO MenuInfoDesc;
  MenuInfoDesc= RECORD (K.ANYDesc)
    cmd: Command;
    code: INTEGER;
    global: BOOLEAN;
  END;

  Key= UNTRACED POINTER TO KeyDesc;
  KeyDesc= RECORD (L.Node)
    qual: SHORTSET;
    cmd:  Command;
    id: INTEGER;
    alpha: BOOLEAN;  (* ANSI key is alphanumric a-z *)
  END;

VAR
  windows-, texts- : L.List;
  screen- : I.ScreenPtr;
  drawInfo- : I.DrawInfoPtr;
  visualInfo- : GT.VisualInfo;
  textPen- , markedTextPen- , highTextPen- , markedHighTextPen- : INTEGER;
  userInput- , rexxPort- , appPort- : Exec.MsgPortPtr;
  rexxPortName- : ARRAY 20 OF CHAR;  (* "edt.#" *)
  screenName-: ARRAY 128 OF CHAR;
  menuTerminated- : BOOLEAN;
  screenSig: SHORTINT;
  custom: BOOLEAN;
  rawKeyCmd: ARRAY IE.keyCodeLast + 1 OF L.List;
  menuInfo: K.DynArray;  (* menu settings *)
  menuDef: MenuDefinition;
  keyID, menuID, menuNum, itemNum, subNum: INTEGER;
  textCnt, windowCnt: INTEGER;
  screenPens: PenArray;

PROCEDURE^ (w: Window) SetMenu* (menu: I.MenuPtr);

PROCEDURE^ (w: Window) ResetMenu* (menu: I.MenuPtr);

PROCEDURE^ (w: Window) RemMenu* ;

PROCEDURE^ CreateMenu(type: SHORTINT; title, commKey: ARRAY OF CHAR;
                      toggle, checked: BOOLEAN): INTEGER; (* id *)

(* -- lists -- *)

PROCEDURE NumTexts* (): LONGINT;

BEGIN
  RETURN L.CountElements(texts);
END NumTexts;

PROCEDURE NumWindows* (): LONGINT;

BEGIN
  RETURN L.CountElements(windows);
END NumWindows;

PROCEDURE WindowFromText* (t: Text): L.NodePtr;

VAR
  n: L.NodePtr;

BEGIN
  n:= windows.head;
  REPEAT UNTIL (n(Window).text = t) OR ~L.Next(n);
  RETURN n;
END WindowFromText;

PROCEDURE GetWindow* (id: INTEGER): L.NodePtr;

VAR
  n: L.NodePtr;

BEGIN
  n:= windows.head;
  REPEAT UNTIL (n(Window).id = id) OR ~L.Next(n);
  RETURN n;
END GetWindow;

PROCEDURE GetText* (id: INTEGER): L.NodePtr;

VAR
  n: L.NodePtr;

BEGIN
  n:= texts.head;
  REPEAT UNTIL (n(Text).id = id) OR ~L.Next(n);
  RETURN n;
END GetText;

PROCEDURE DoText* (t: Text; proc: L.DoProc);

VAR
  n: L.NodePtr;

BEGIN
  n:= L.Head(windows);
  WHILE n # NIL DO
    IF n(Window).text = t THEN proc(n) END;
    n:= n.next;
  END;
END DoText;

(* -- text -- *)

(* to be redefined *)
PROCEDURE (t: Text) TestAutosave*;
END TestAutosave;

PROCEDURE (t: Text) Autosave*;
END Autosave;

(* add a text to the list *)
PROCEDURE (t: Text) New*;

BEGIN
  t.autoIndent:= Sett.autoIndent;
  t.icons:= Sett.icons;
  t.wordWrap:= Sett.wordWrap;
  t.insert:= Sett.insert;
  t.cleanLines:= Sett.cleanLines;
  L.AddHead(texts, t);
END New;

(* remove a text from the list *)
PROCEDURE (t: Text) Dispose*;

BEGIN
  L.Remove(texts, t);
END Dispose;

PROCEDURE (t: Text) NewPrefs*;
END NewPrefs;

PROCEDURE (t: Text) RestoreStatus*;
END RestoreStatus;

PROCEDURE ToggleItem* (t: Text; id: INTEGER);

VAR
  w: L.NodePtr;
  item: I.MenuItemPtr;
  code: LONGINT;

BEGIN
  IF id # K.undef THEN
    code:= menuInfo.Get(id)(MenuInfo).code;
    w:= windows.head;
    WHILE w # NIL DO
      WITH w: Window DO
        IF (t = NIL) OR (w.text = t) THEN
          item:= I.ItemAddress(w.menuStrip^, code);
          w.RemMenu;
          IF I.checked IN item.flags THEN
            EXCL(item.flags, I.checked);
          ELSE
            INCL(item.flags, I.checked);
          END;
          w.ResetMenu(w.menuStrip);
        END;
      END;
      w:= w.next;
    END;
  END;
END ToggleItem;

PROCEDURE SetItemVal* (t: Text; id: INTEGER; newState: BOOLEAN);

VAR
  w: L.NodePtr;
  item: I.MenuItemPtr;
  code: LONGINT;
  state: BOOLEAN;

BEGIN
  IF id # K.undef THEN
    code:= menuInfo.Get(id)(MenuInfo).code;
    w:= windows.head;
    WHILE w # NIL DO
      WITH w: Window DO
        IF (t = NIL) OR (w.text = t) THEN
          item:= I.ItemAddress(w.menuStrip^, code);
          state:= I.checked IN item.flags;
          IF newState # state THEN
            w.RemMenu;
            IF state THEN
              EXCL(item.flags, I.checked);
            ELSE
              INCL(item.flags, I.checked);
            END;
            w.ResetMenu(w.menuStrip);
          END;
        END;
      END;
      w:= w.next;
    END;
  END;
END SetItemVal;

PROCEDURE (t: Text) GetItemVal* (id: INTEGER): BOOLEAN;

VAR
  w: Window;

BEGIN
  w:= WindowFromText(t)(Window);
  RETURN I.checked IN I.ItemAddress(w.menuStrip^, menuInfo.Get(id)(MenuInfo).code).flags;
END GetItemVal;

(* -- project -- *)

PROCEDURE (w: Window) NewText* (t: Text);

BEGIN
  w.text:= t;
END NewText;

PROCEDURE (w: Window) Open* (t: Text): BOOLEAN;

BEGIN
  w.appWindow:= NIL;
  w.text:= t;
  w.id:= windowCnt; INC(windowCnt);
  L.AddTail(windows, w);
  IF ~menuTerminated THEN
    IF CreateMenu(GT.end, "", "", FALSE, FALSE) = 0 THEN END; (* terminate *)
    menuTerminated:= TRUE;
  END;
  w.menuStrip:= GT.CreateMenus(menuDef^, Util.done);
  IF (w.menuStrip # NIL) & GT.LayoutMenus(w.menuStrip, visualInfo, GT.fullMenu, I.LTRUE,
                                         GT.mnNewLookMenus, I.LTRUE, Util.done) THEN
    w.SetMenu(w.menuStrip);
    RETURN TRUE;
  ELSE
    IF w.menuStrip # NIL THEN GT.FreeMenus(w.menuStrip) END;
    RETURN FALSE;
  END;
END Open;

PROCEDURE (w: Window) Close*;

BEGIN
  L.Remove(windows, w);
  w.RemMenu;
  GT.FreeMenus(w.menuStrip);
  IF w.appWindow # NIL THEN
    WHILE ~Wb.RemoveAppWindow(w.appWindow) DO Dos.Delay(100) END;
  END;
END Close;

(* -- keys -- *)

(* init key-definition-arrays *)
PROCEDURE InitKeys;

VAR
  i: INTEGER;

BEGIN
  FOR i:= 0 TO LEN(rawKeyCmd) - 1 DO L.Init(rawKeyCmd[i]) END;
  keyID:= 0;
END InitKeys;

(* convert 'InputEvent'-qualifier to a 'Windows'-qualifier *)
PROCEDURE Qual(ieQual: SET): SHORTSET;

VAR
  q: SHORTSET;

BEGIN
  IF ieQual # {} THEN
    q:= SHORTSET{};
    IF (IE.lShift IN ieQual) OR ((IE.rShift) IN ieQual) THEN INCL(q, qualShift) END;
    IF (IE.lAlt IN ieQual) OR (IE.rAlt IN ieQual) THEN INCL(q, qualAlt) END;
    IF IE.control IN ieQual THEN INCL(q, qualCtrl) END;
    IF IE.rCommand IN ieQual THEN INCL(q, qualAmiga) END;
    IF IE.numericPad IN ieQual THEN INCL(q, qualNumPad) END;
    RETURN q;
  ELSE
    RETURN SHORTSET{};
  END;
END Qual;

PROCEDURE ANSICode* (VAR c: CHAR; rawCode: INTEGER; ieQual: SET; iAdr: SYS.ADDRESS): BOOLEAN;

VAR
  ie: IE.InputEventAdr;
  buf: ARRAY 1 OF CHAR;

BEGIN
  ie.nextEvent:= NIL;
  ie.class:= IE.rawkey;
  ie.subClass:= 0;
  ie.code:= rawCode;
  ie.qualifier:= ieQual;
  ie.addr:= iAdr;
  ie.timeStamp:= Timer.TimeVal(0, 0);
  IF KM.MapRawKey(SYS.ADR(ie), buf, 1, NIL) = 1 THEN
    c:= buf[0];
    RETURN TRUE;
  ELSE
    RETURN FALSE;
  END;
END ANSICode;

PROCEDURE RawCode(VAR rawCode: INTEGER; VAR ieQual: SET; c: CHAR): BOOLEAN;

VAR
  raw: ARRAY 3 OF CHAR;
  str: ARRAY 1 OF CHAR;
  i: LONGINT;

BEGIN
  str[0]:= c;
  i:= KM.MapANSI(str, 1, raw, LEN(raw), NIL);
  IF i > 0 THEN
    rawCode:= SYS.VAL(SHORTINT, raw[(i - 1) * 2]);
    ieQual:= SYS.VAL(SET, ORD(raw[(i - 1) * 2 + 1]));
    RETURN TRUE;
  ELSE
    RETURN FALSE;
  END;
END RawCode;

(* map a raw key *)
PROCEDURE SetRawKey* (code: INTEGER; qual: SHORTSET; command: Command): INTEGER;  (* result id *)

VAR
  key: Key;
  n: L.NodePtr;

BEGIN
  NEW(key);
  key.cmd:= command;
  key.id:= keyID; INC(keyID);
  key.qual:= qual;
  key.alpha:= FALSE;
  IF (qual= SHORTSET{}) OR L.Empty(rawKeyCmd[code]) THEN
    L.AddHead(rawKeyCmd[code], key);
  ELSE
    L.AddTail(rawKeyCmd[code], key);
    n:= key;
    WHILE L.Previous(n) DO
      IF n(Key).qual = key.qual THEN
        L.Remove(rawKeyCmd[code], n);
        DISPOSE(n); n:= key;
      END;
    END;
  END;
  RETURN key.id;
END SetRawKey;

(* map a ANSI key *)
PROCEDURE SetANSIKey* (c: CHAR; qual: SHORTSET; command: Command): INTEGER;  (* result id *)

VAR
  code: INTEGER;
  ieQ0: SET;
  id: INTEGER;
  n: L.NodePtr;
  alpha: BOOLEAN;

BEGIN
  IF RawCode(code, ieQ0, c) THEN
    id:= SetRawKey(code, qual + Qual(ieQ0), command);
    alpha:= (c >= "A") & (c <= "Z") OR (c >= "Ä") & (c <= "Ü");
    IF alpha THEN
      n:= rawKeyCmd[code].head;
      WHILE n(Key).id # id DO n:= n.next END;  (* find key node *)
      n(Key).alpha:= alpha;
    END;
    RETURN id;
  ELSE
    I.DisplayBeep(screen);
    RETURN -1;
  END;
END SetANSIKey;

(* execute a key command *)
PROCEDURE DoRawKey* (VAR msg: SHORTINT; w: Window; code: INTEGER;
                     ieQual: SET): BOOLEAN;

VAR
  k: L.NodePtr;
  key: Key;
  qual: SHORTSET;
  c: CHAR;

BEGIN
  IF code < IE.upPrefix THEN
    IF (IE.numericPad IN ieQual) & ANSICode(c, code, ieQual, NIL)
      & RawCode(code, ieQual, c) THEN INCL(ieQual, IE.numericPad) END;
    k:= rawKeyCmd[code].head;
    key:= NIL;
    qual:= Qual(ieQual);
    WHILE (k # NIL) & (k(Key).qual # qual) DO
      WITH k: Key DO
        IF k.alpha & (k.qual = qual + SHORTSET{qualShift}) THEN key:= k END;
      END;
      k:= k.next;
    END;
    IF k # NIL THEN key:= k(Key) END;
    IF key # NIL THEN
      msg:= key.cmd(w, key.id);
      RETURN TRUE;
    ELSE
      RETURN FALSE;
    END;
  ELSE
    RETURN TRUE;  (* ignore all key-up events *)
  END;
END DoRawKey;

(* -- menus -- *)

PROCEDURE (w: Window) RemMenu* ;
END RemMenu;

PROCEDURE (w: Window) SetMenu* (menu: I.MenuPtr);
END SetMenu;

PROCEDURE (w: Window) ResetMenu* (menu: I.MenuPtr);
END ResetMenu;

PROCEDURE CreateMenu(type: SHORTINT; title, commKey: ARRAY OF CHAR;
                      toggle, checked: BOOLEAN): INTEGER; (* id *)

VAR
  oldMenuDef: MenuDefinition;
  i: INTEGER;
  keyLen: LONGINT;
  flags: SET;
  label, shortcut: Exec.LSTRPTR;

(* $CopyArrays- *)

BEGIN
  IF title= "" THEN    (* barLabel *)
    menuDef[menuID].label:= GT.barLabel;
    menuDef[menuID].flags:= {GT.itemDisabled};
  ELSE  (* item *)
    SYS.NEW(label, S.Length(title) + 1);
    COPY(title, label^);
    menuDef[menuID].label:= label;
    flags:= {};
    keyLen:= S.Length(commKey);
    IF keyLen = 1 THEN
      SYS.NEW(shortcut, 2);
      COPY(commKey, shortcut^);
    ELSIF (keyLen > 1) & (K.gtVer >= 39) THEN
      INCL(flags, GT.commandString);
      SYS.NEW(shortcut, keyLen + 1);
      COPY(commKey, shortcut^);
    ELSE
      shortcut:= NIL;
    END;
    menuDef[menuID].commKey:= shortcut;
    IF toggle THEN
      flags:= flags + {I.checkIt, I.menuToggle};
      IF checked THEN INCL(flags, I.checked) END;
    END;
    menuDef[menuID].flags:= flags;
    menuDef[menuID].mutualExclude:= LONGSET{};
  END;
  menuDef[menuID].type:= type;
  menuDef[menuID].userData:= menuID;

  INC(menuID);
  IF menuID >= LEN(menuDef^) THEN
    oldMenuDef:= menuDef;
    NEW(menuDef, menuID +  20);
    FOR i:= 0 TO menuID - 1 DO menuDef[i]:= oldMenuDef[i] END;
    DISPOSE(oldMenuDef);
  END;
  RETURN menuID - 1;
END CreateMenu;

(* define an menu *)
PROCEDURE AddMenu* (VAR name: ARRAY OF CHAR);

VAR
  n: MenuInfo;

BEGIN
  INC(menuNum); itemNum:= -1;
  NEW(n);
  n.cmd:= NIL;
  n.code:= I.FullMenuNum(menuNum, I.noItem, I.noSub);
  menuInfo.Put(n, menuID);
  IF CreateMenu(GT.title, name, "", FALSE, FALSE) = 0 THEN END;
END AddMenu;

(* define an menu *)
PROCEDURE AddItem* (VAR name: ARRAY OF CHAR; VAR shortcut: ARRAY OF CHAR;
                    command: Command): INTEGER;  (* id *)

VAR
  n: MenuInfo;

BEGIN
  INC(itemNum); subNum:= -1;
  NEW(n);
  n.cmd:= command;
  n.code:= I.FullMenuNum(menuNum, itemNum, I.noSub);
  menuInfo.Put(n, menuID);
  RETURN CreateMenu(GT.item, name, shortcut, FALSE, FALSE);
END AddItem;

(* define an menu *)
PROCEDURE AddSub* (name: ARRAY OF CHAR; shortcut: ARRAY OF CHAR;
                   command: Command): INTEGER;

VAR
  n: MenuInfo;

(* $CopyArrays- *)

BEGIN
  INC(subNum);
  NEW(n);
  n.cmd:= command;
  n.code:= I.FullMenuNum(menuNum, itemNum, subNum);
  menuInfo.Put(n, menuID);
  RETURN CreateMenu(GT.sub, name, shortcut, FALSE, FALSE);
END AddSub;

(* define an menu *)
PROCEDURE AddChkItem* (VAR name: ARRAY OF CHAR; VAR shortcut: ARRAY OF CHAR;
                       toggle: Command; global, checked: BOOLEAN) : INTEGER;

VAR
  n: MenuInfo;

BEGIN
  INC(itemNum); subNum:= -1;
  NEW(n);
  n.global:= global;
  n.cmd:= toggle;
  n.code:= I.FullMenuNum(menuNum, itemNum, I.noSub);
  menuInfo.Put(n, menuID);
  RETURN CreateMenu(GT.item, name, shortcut, TRUE, checked);
END AddChkItem;

(* define an menu *)
PROCEDURE AddChkSub* (VAR name: ARRAY OF CHAR; VAR shortcut: ARRAY OF CHAR;
                      toggle: Command; global, checked: BOOLEAN): INTEGER;

VAR
  n: MenuInfo;

BEGIN
  INC(subNum);
  NEW(n);
  n.global:= global;
  n.cmd:= toggle;
  n.code:= I.FullMenuNum(menuNum, itemNum, subNum);
  menuInfo.Put(n, menuID);
  RETURN CreateMenu(GT.sub, name, shortcut, TRUE, checked);
END AddChkSub;

PROCEDURE DoMenu* (VAR msg: SHORTINT; w: Window; code: INTEGER);

VAR
  item: I.MenuItemPtr;
  itemID: INTEGER;
  n: MenuInfo;
  t: Text;

BEGIN
  msg:= msgLocal;
  item:= I.ItemAddress(w.menuStrip^, code);
  WHILE (msg = msgLocal) & (item # NIL) DO
    itemID:= SHORT(SYS.VAL(LONGINT, GT.MenuItemUserData(item)));
    n:= menuInfo.Get(itemID)(MenuInfo);
    IF I.checkIt IN item.flags THEN
      IF n.global THEN t:= NIL ELSE t:= w.text END;
      SetItemVal(t, itemID, I.checked IN item.flags);
    END;
    item:= I.ItemAddress(w.menuStrip^, item.nextSelect);
    IF n.cmd # NIL THEN msg:= n.cmd(w, itemID) END;
  END;
END DoMenu;

(* -- editor -- *)

PROCEDURE (w: Window) Insert* (pos, len, lines, tabs: LONGINT);
END Insert;

PROCEDURE (w: Window) Delete* (pos, len, lines, tabs: LONGINT);
END Delete;

PROCEDURE (w: Window) OpenFold* (pos, p0, len, lines, tabs: LONGINT);
END OpenFold;

PROCEDURE (w: Window) CloseFold* (pos, p0, len, lines, tabs: LONGINT);
END CloseFold;

PROCEDURE (w: Window) NewFold* (begin, end: LONGINT);
END NewFold;

PROCEDURE (w: Window) ResolveFold* (begin, end: LONGINT);
END ResolveFold;

PROCEDURE (w: Window) Update* ;
END Update;

PROCEDURE* InsertProc(w: L.NodePtr);

BEGIN
  WITH w: Window DO
    w.Insert(w.text.pPos, w.text.pLen, w.text.pLines, w.text.pTabs);
  END;
END InsertProc;

PROCEDURE Insert* (t: Text; pos, len, lines, tabs: LONGINT);

BEGIN
  t.pPos:= pos;
  t.pLen:= len;
  t.pLines:= lines;
  t.pTabs:= tabs;
  DoText(t, InsertProc);
END Insert;

PROCEDURE* DeleteProc(w: L.NodePtr);

BEGIN
  WITH w: Window DO
    w.Delete(w.text.pPos, w.text.pLen, w.text.pLines, w.text.pTabs);
  END;
END DeleteProc;

PROCEDURE Delete* (t: Text; pos, len, lines, tabs: LONGINT);

BEGIN
  t.pPos:= pos;
  t.pLen:= len;
  t.pLines:= lines;
  t.pTabs:= tabs;
  DoText(t, DeleteProc);
END Delete;

PROCEDURE* OpenFoldProc(w: L.NodePtr);

BEGIN
  WITH w: Window DO
    w.OpenFold(w.text.pPos, w.text.pP0, w.text.pLen, w.text.pLines, w.text.pTabs);
  END;
END OpenFoldProc;

PROCEDURE OpenFold* (t: Text; pos, p0, len, lines, tabs: LONGINT);

BEGIN
  t.pPos:= pos;
  t.pP0:= p0;
  t.pLen:= len;
  t.pLines:= lines;
  t.pTabs:= tabs;
  DoText(t, OpenFoldProc);
END OpenFold;

PROCEDURE* CloseFoldProc(w: L.NodePtr);

BEGIN
  WITH w: Window DO
    w.CloseFold(w.text.pPos, w.text.pP0, w.text.pLen, w.text.pLines, w.text.pTabs);
  END;
END CloseFoldProc;

PROCEDURE CloseFold* (t: Text; pos, p0, len, lines, tabs: LONGINT);

BEGIN
  t.pPos:= pos;
  t.pP0:= p0;
  t.pLen:= len;
  t.pLines:= lines;
  t.pTabs:= tabs;
  DoText(t, CloseFoldProc);
END CloseFold;

PROCEDURE* NewFoldProc(w: L.NodePtr);

BEGIN
  WITH w: Window DO
    w.NewFold(w.text.pBegin, w.text.pEnd);
  END;
END NewFoldProc;

PROCEDURE NewFold* (t: Text; begin, end: LONGINT);

BEGIN
  t.pBegin:= begin;
  t.pEnd:= end;
  DoText(t, NewFoldProc);
END NewFold;

PROCEDURE* ResolveFoldProc(w: L.NodePtr);

BEGIN
  WITH w: Window DO
    w.ResolveFold(w.text.pBegin, w.text.pEnd);
  END;
END ResolveFoldProc;

PROCEDURE ResolveFold* (t: Text; begin, end: LONGINT);

BEGIN
  t.pBegin:= begin;
  t.pEnd:= end;
  DoText(t, ResolveFoldProc);
END ResolveFold;

(* -- graphics -- *)

PROCEDURE (w: Window) UpdateWindowTitle*;
END UpdateWindowTitle;

PROCEDURE (w: Window) UpdateHProp*;
END UpdateHProp;

PROCEDURE (w: Window) UpdateVProp*;
END UpdateVProp;

PROCEDURE (w: Window) DisplayOn*;
END DisplayOn;

PROCEDURE (w: Window) DisplayOff*;
END DisplayOff;

PROCEDURE (w: Window) Busy* (str: ARRAY OF CHAR);

(* $CopyArrays- *)

END Busy;

PROCEDURE (w: Window) BusyDone* ;
END BusyDone;

PROCEDURE (w: Window) RestoreStatus*;
END RestoreStatus;

PROCEDURE (w: Window) Draw*;
END Draw;

PROCEDURE (w: Window) DrawRange* (begin, end: LONGINT);
END DrawRange;

PROCEDURE (w: Window) Refresh*;
END Refresh;

PROCEDURE* UpdateWindowTitleProc(w: L.NodePtr);

BEGIN
  w(Window).UpdateWindowTitle;
END UpdateWindowTitleProc;

PROCEDURE* UpdateHPropProc(w: L.NodePtr);

BEGIN
  w(Window).UpdateHProp;
END UpdateHPropProc;

PROCEDURE* UpdateVPropProc(w: L.NodePtr);

BEGIN
  w(Window).UpdateVProp;
END UpdateVPropProc;

PROCEDURE* DisplayOnProc(w: L.NodePtr);

BEGIN
  w(Window).DisplayOn;
END DisplayOnProc;

PROCEDURE* DisplayOffProc(w: L.NodePtr);

BEGIN
  w(Window).DisplayOff;
END DisplayOffProc;

PROCEDURE* BusyProc(w: L.NodePtr);

BEGIN
  w(Window).Busy(w(Window).text.pBusyInfo);
END BusyProc;

PROCEDURE* BusyDoneProc(w: L.NodePtr);

BEGIN
  w(Window).BusyDone;
END BusyDoneProc;

PROCEDURE* DrawProc(w: L.NodePtr);

BEGIN
  w(Window).Draw;
END DrawProc;

PROCEDURE* RefreshProc(w: L.NodePtr);

BEGIN
  w(Window).Refresh;
END RefreshProc;

PROCEDURE* RestoreProc(w: L.NodePtr);

BEGIN
  WITH w: Window DO
    w.text.RestoreStatus;
    w.RestoreStatus;
  END;
END RestoreProc;

PROCEDURE UpdateWindowTitle* (t: Text);

BEGIN
  DoText(t, UpdateWindowTitleProc);
END UpdateWindowTitle;

PROCEDURE UpdateHProp* (t: Text);

BEGIN
  DoText(t, UpdateHPropProc);
END UpdateHProp;

PROCEDURE UpdateVProp* (t: Text);

BEGIN
  DoText(t, UpdateVPropProc);
END UpdateVProp;

PROCEDURE DisplayOn* (t: Text);

BEGIN
  DoText(t, DisplayOnProc);
END DisplayOn;

PROCEDURE DisplayOff* (t: Text);

BEGIN
  DoText(t, DisplayOffProc);
END DisplayOff;

PROCEDURE Refresh*;

BEGIN
  L.DoForward(windows, RefreshProc);
END Refresh;

PROCEDURE Busy* (t: Text; info: ARRAY OF CHAR);

(* $CopyArrays- *)

BEGIN
  COPY(info, t.pBusyInfo);
  DoText(t, BusyProc);
END Busy;

PROCEDURE BusyDone* (t: Text);

BEGIN
  DoText(t, BusyDoneProc);
END BusyDone;

PROCEDURE RestoreStatus*;

BEGIN
  L.DoForward(windows, RestoreProc);
END RestoreStatus;

PROCEDURE Draw* (t: Text);

BEGIN
  DoText(t, DrawProc);
END Draw;

PROCEDURE* DrawRangeProc(w: L.NodePtr);

BEGIN
  w(Window).DrawRange(w(Window).text.pBegin, w(Window).text.pEnd);
END DrawRangeProc;

PROCEDURE DrawRange* (t: Text; begin, end: LONGINT);

BEGIN
  t.pBegin:= begin;
  t.pEnd:= end;
  DoText(t, DrawRangeProc);
END DrawRange;

(* -- misc. -- *)

PROCEDURE* UpdateProc(w: L.NodePtr);

BEGIN
  w(Window).Update;
END UpdateProc;

(* text information (length, changes, ...) have changed *)
PROCEDURE Update* (t: Text);

BEGIN
  DoText(t, UpdateProc);
END Update;

PROCEDURE (w: Window) NewPrefs* ;
END NewPrefs;

PROCEDURE* WNewPrefsProc(w: L.NodePtr);

BEGIN
  w(Window).NewPrefs;
END WNewPrefsProc;

PROCEDURE* TNewPrefsProc(t: L.NodePtr);

BEGIN
  t(Text).NewPrefs;
END TNewPrefsProc;

PROCEDURE NewPrefs* ;

BEGIN
  L.DoForward(windows, WNewPrefsProc);
  L.DoForward(texts, TNewPrefsProc);
END NewPrefs;

PROCEDURE* TestAutosaveProc(t: L.NodePtr);

BEGIN
  t(Text).TestAutosave;
END TestAutosaveProc;

PROCEDURE TestAutosave*;

BEGIN
  L.DoForward(texts, TestAutosaveProc);
END TestAutosave;

PROCEDURE* AutosaveProc(t: L.NodePtr);

BEGIN
  t(Text).Autosave;
END AutosaveProc;

PROCEDURE Autosave*;

BEGIN
  L.DoForward(texts, AutosaveProc);
END Autosave;

(* wait for input *)
PROCEDURE Wait* (): SHORTINT;  (* result: msg-type (rexx, intuition) *)

VAR
  sigs: LONGSET;

BEGIN
  LOOP
    sigs:= Exec.Wait(LONGSET{userInput.sigBit, rexxPort.sigBit, appPort.sigBit});
    IF userInput.sigBit IN sigs THEN
      RETURN userMsg;
    ELSIF rexxPort.sigBit IN sigs THEN
      RETURN rexxMsg;
    ELSIF appPort.sigBit IN sigs THEN
      RETURN appMsg;
    END;
  END;
END Wait;

(* add as AppWindow *)
PROCEDURE AddAppWindow* (w: Window; win: I.WindowPtr);

BEGIN
  IF screenName = wbName THEN
    w.appWindow:= Wb.AddAppWindow(w.id, NIL, win, appPort, Util.done);
  END;
END AddAppWindow;

(* close all windows *)
PROCEDURE CloseAllWindows* ;

VAR
  w: L.NodePtr;

BEGIN
  w:= windows.head;
  IF w # NIL THEN REPEAT w(Window).Close UNTIL ~L.Next(w) END;
END CloseAllWindows;

PROCEDURE CreateRexxPortName;

VAR
  args: ARRAY 1 OF LONGINT;

BEGIN
  args[0]:= -1;
  REPEAT
    INC(args[0]);
    K.FormatString(rexxPortName, edtRexxFmt, args);
  UNTIL Exec.FindPort(rexxPortName) = NIL;
END CreateRexxPortName;

PROCEDURE ClearRexxPort;

VAR
  msg: Exec.MessagePtr;

BEGIN
  msg:= Exec.GetMsg(rexxPort);
  WHILE msg # NIL DO
    IF msg.node.type = Exec.replyMsg THEN
      Rx.DeleteArgstring(msg(Rexx.RexxMsg).args[0]);
      Rx.DeleteRexxMsg(msg);
    ELSE
      msg(Rexx.RexxMsg).result1:= 100;
      Exec.ReplyMsg(msg);
    END;
    msg:= Exec.GetMsg(rexxPort);
  END;
END ClearRexxPort;

PROCEDURE ClearAppPort;

VAR
  msg: Wb.AppMessagePtr;

BEGIN
  msg:= Exec.GetMsg(appPort);
  WHILE msg # NIL DO
    Exec.ReplyMsg(msg);
    msg:= Exec.GetMsg(appPort);
  END;
END ClearAppPort;

PROCEDURE CloneWbPens;

VAR
  wb: I.ScreenPtr;
  di: I.DrawInfoPtr;
  pens: PenArrayPtr;
  i: INTEGER;

BEGIN
  wb:= I.LockPubScreen(wbName);
  IF wb # NIL THEN
    di:=  I.GetScreenDrawInfo(wb);
    IF di # NIL THEN
      IF di.depth <= Sett.sDepth THEN
        pens:= SYS.VAL(PenArrayPtr, di.pens);
        i:= 0;
        WHILE (i < maxDRIPens) & (pens[i] # -1) DO
          screenPens[i]:= pens[i];
          INC(i);
        END;
        screenPens[i]:= -1;
      END;
      I.FreeScreenDrawInfo(wb, di);
    END;
    I.UnlockPubScreen(wbName, wb);
  END;
END CloneWbPens;

PROCEDURE InitPens;

VAR
  penArray: I.DRIPenArrayPtr;

BEGIN
  penArray:= drawInfo.pens;
  IF I.drifNewLook IN drawInfo.flags THEN
    textPen:= penArray[I.textPen];
    highTextPen:= penArray[I.highLightTextPen];
    markedTextPen:= 0FFH - textPen;
    markedHighTextPen:= 0FFH - highTextPen;
  ELSE
    textPen:= 1;
    highTextPen:= 1;
    markedTextPen:= 254;
    markedHighTextPen:= 254;
  END;
END InitPens;

BEGIN
  screen:= NIL;
  custom:= FALSE;
  menuTerminated:= FALSE;
  screenSig:= -1;
  drawInfo:= NIL;
  visualInfo:= NIL;
  userInput:= NIL;
  rexxPort:= NIL;
  appPort:= NIL;
  screenPens[0]:= -1;
  menuID:= 0;
  menuNum:= -1;
  menuInfo.New(20, 10);
  NEW(menuDef, 20);
  L.Init(windows); windowCnt:= 0;
  L.Init(texts); textCnt:= 0;
  InitKeys;

  COPY(Sett.sName, screenName);
  screen:= I.LockPubScreen(screenName);
  IF (screen = NIL) & (Sett.sType = Sett.screenCustom) THEN
    screenSig:= Exec.AllocSignal(-1);
    K.Assert(screenSig # -1, Err.ioServerNoSignal);
    CloneWbPens;
    screen:= I.OpenScreenTagsA(NIL, I.saType, I.publicScreen,
                              I.saWidth, Sett.sWidth, I.saHeight, Sett.sHeight,
                              I.saDepth, Sett.sDepth, I.saDisplayID, Sett.sMode,
                              I.saTitle, SYS.ADR(Str.screenTitle),
                              I.saPubName, SYS.ADR(screenName),
                              I.saPubSig, screenSig, I.saPubTask, OberonLib.Me,
                              I.saPens, SYS.ADR(screenPens), I.saFullPalette, I.LTRUE,
                              I.saSharePens, I.LTRUE, I.saInterleaved, I.LTRUE,
                              I.saSysFont, 1, I.saOverscan, I.oScanText,
                              I.saAutoScroll, I.LTRUE,
                              Util.done);
    custom:= screen # NIL;
    IF custom & (I.PubScreenStatus(screen, {}) = {}) THEN END;
  END;
  IF screen = NIL THEN
    screenName:= wbName;
    screen:= I.LockPubScreen(screenName);
  END;
  K.Assert(screen # NIL, Err.ioServerNoWorkbench);
  I.ScreenToFront(screen);
  drawInfo:= I.GetScreenDrawInfo(screen);
  K.Assert(drawInfo # NIL, Err.ioServerNoDrawInfo);
  InitPens;
  visualInfo:= GT.GetVisualInfo(screen, Util.done);
  K.Assert(visualInfo # NIL, Err.ioServerNoVisualInfo);
  userInput:= Exec.CreateMsgPort();
  K.Assert(userInput # NIL, Err.ioServerNoUserPort);
  appPort:= Exec.CreateMsgPort();
  K.Assert(appPort # NIL, Err.ioServerNoAppPort);
  rexxPort:= Exec.CreateMsgPort();
  K.Assert(rexxPort # NIL, Err.ioServerNoRexxPort);
  Exec.Forbid;
  CreateRexxPortName;
  rexxPort.node.name:= SYS.ADR(rexxPortName);
  Exec.AddPort(rexxPort);
  Exec.Permit;
  InitPens;

CLOSE
  menuInfo.Dispose;
  IF visualInfo # NIL THEN
    GT.FreeVisualInfo(visualInfo);
  END;
  IF drawInfo # NIL THEN
    I.FreeScreenDrawInfo(screen, drawInfo);
  END;
  IF custom THEN
    WHILE ~I.CloseScreen(screen) DO
      IF Exec.Wait(LONGSET{screenSig}) = LONGSET{} THEN END;
    END;
  ELSIF screen # NIL THEN
    I.UnlockPubScreen(screenName, screen);
  END;
  IF screenSig # -1 THEN
    Exec.FreeSignal(screenSig);
  END;
  IF userInput # NIL THEN
    Exec.DeleteMsgPort(userInput);
  END;
  IF rexxPort # NIL THEN
    Exec.RemPort(rexxPort);
    ClearRexxPort;
    Exec.DeleteMsgPort(rexxPort);
  END;
  IF appPort # NIL THEN
    ClearAppPort;
    Exec.DeleteMsgPort(appPort);
  END;
END IOServer.