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

:Program.    EdRexx.mod
:Contents.   Rexx- and Applications-Interface for AmokEd
:Author.     Hartmut Goebel
:Language.   Oberon
:Translator. Amiga Oberon Compiler V2.13
:Imports.    Printf (Volker Rudolph)
:History.    V0.1, 3 Dec 1990, Hartmut Goebel
:History.    V1.0, 14 Apr 1991 Hartmut Goebel [hG]
:History.    V1.0b 19 Apr 1991 [hG] Portname enthält Adresse => eindeutig
:History.    V1.1  20 Apr 1991 [hG] + Applications
:History.    V1.1b 18 Jun 1991 [hG] Typedefs taken from Rexx.mod
:History.    V1.2  16 Oct 1991 [hG] +GetVal, revised doRexx
:History.    V1.3  02 Feb 1992 [hG] revised doRexx, again
:History.    V1.4  08 Feb 1992 [hG] -Bug: UserSpecifiedMacroError
:Date.       08 Feb 1992 13:00:25

****************************************************************************)

MODULE EdRexx;

IMPORT
  Printf,
  d  : Dos,
  e  : Exec,
  es : ExecSupport,
  eAD: EdApplDefs,
  edD: EdDisplay,
  edE: EdErrors,
  edG: EdGlobalVars,
  edL: EdLowLevel,
  lst: EdLists,
  ol : OberonLib,
  rx : Rexx, (* only Type Defs *)
  rxs: RexxSysLib, (* only Type Defs *)
  str: Strings,
  s  : SYSTEM;

CONST
  (*CallingARexxMacro = "Calling ARexx Macro ...";*)
  UnknownCommand = "Unknown Command";
  NoMacrosARexxNotActive = "Unknown Command -- No Macros: ARexx Not Active";
  CreateRexxMsgFailed = "CreateRexxMsg() Failed";
  FillRexxMsgFailed = "FillRexxMsg() Failed";
  ApplicationNotFound = "Application not found";
  (*RemoteError = "Remote error";*)
  (*ARexxMacroExecHalted = "ARexx Macro Execution Halted";*)
  ARexxMacroError = "ARexx Macro Error: Code = %ld Severity = %ld";
  UserSpecifiedMacroError = "User Specified Macro Error: RC = %ld  %0.32s";
  (* Text darf max. 34 Zeichen haben, weil sonst Buffer übertreten wird *)
  ApplAlreadyIncluded = "Application already included";

  REXX = "REXX"; (* send to ARexx-Port "REXX" *)

CONST
  (* Command *)
  comm* = 1;
  func* = 2;
  close* = 3;
  query* = 4;
  addFH* = 7;
  addLib* = 8;
  remLib* = 9;
  addCon* = 10;
  remCon* = 11;
  tcOpn* = 12;
  tcCls* = 13;

  (* ModifierFlags *)
  noIO* = 0;
  result* = 1;
  moString* = 2;
  token* = 3;
  nonRet* = 4;

TYPE
  ActionRec* = STRUCT
    command* : SHORTINT;
    modifier* : SHORTSET;
    add* : INTEGER;
  END;

VAR
  AEdRxPort*: e.MsgPortPtr;
  CmdMsg*: rx.RexxMsgPtr;   (* the incomming Msg *)
  ApplArgCnt*: INTEGER;
  AEdRxPortSigBit*: SHORTINT;
  Buffer: edG.String;
  ErrTitle: ARRAY 80 OF CHAR; (* für Fehlermeldungen *)
  ApplList: lst.List;

TYPE
  ApplPtr = POINTER TO Application;
  Application = STRUCT (node: lst.Node)
    name: edG.StringPtr;
    port: edG.StringPtr;
  END;

CONST
  Extension = "aed";

(*------------------------------------------------------------------*)

PROCEDURE IsApplMsg*(msg{8}: rx.RexxMsgPtr): BOOLEAN;
BEGIN
  IF msg.node.node.name = eAD.idAEd1 THEN
    INCL(edG.Status,edG.isAppl); RETURN TRUE;
  ELSIF msg.node.node.name = eAD.idAEd0 THEN
    edG.Status := edG.Status - LONGSET{edG.isAppl} + LONGSET{edG.isRexx};
    RETURN TRUE;
  ELSE
    edG.Status := edG.Status - LONGSET{edG.isAppl,edG.isRexx};
    RETURN FALSE;
  END;
END IsApplMsg;


PROCEDURE dRexx*(modifier: SHORTSET; port: edG.StringPtr; argo: e.ADDRESS);
VAR
  rxMsg: rx.RexxMsgPtr;
  rxArg: rx.RexxArgPtr;
  arexxPort: e.MsgPortPtr;
  oldLock: d.FileLockPtr;
  oldTxt: edG.TextHeaderPtr;
  action: ActionRec;

  PROCEDURE incomingRexx;
  VAR
    cmd, buffer: edG.StringPtr;
    aux1, aux2: e.ADDRESS;
    status: LONGSET;
    argCnt: INTEGER;
    help: ARRAY 8 OF CHAR;
  BEGIN
    IF edG.Text = NIL THEN RETURN; END;
    IF rxs.IsRexxMsg(CmdMsg) OR IsApplMsg(CmdMsg) THEN
      IF IsApplMsg(CmdMsg) AND (CmdMsg.args[eAD.TextSlot] # NIL)
      AND (edG.Text # s.VAL(s.ADDRESS,CmdMsg.args[eAD.TextSlot]))
      AND lst.IsElement(edG.EditList,
                        s.VAL(s.ADDRESS,CmdMsg.args[eAD.TextSlot]))
      THEN
        edD.SwitchEdit(s.VAL(s.ADDRESS,CmdMsg.args[eAD.TextSlot]));
      END;

      EXCL(edG.Status,edG.cmdFound); (* neues Spiel, neues Glück *)
      edG.Rc := edE.cmdInitial;
      CmdMsg.result2 := edE.noError;
      ApplArgCnt := 0;

      COPY(CmdMsg.args[0]^,help); help[7] := 0X;
      action := s.VAL(ActionRec,CmdMsg.action);
      IF (result IN action.modifier)
      AND edL.NCStrCmp(s.ADR(help),s.ADR("GETVAL ")) THEN
        INCL(edG.Status,edG.cmdFound);
        IF edG.isAppl IN edG.Status THEN
          EXCL(edG.Status,edG.isAppl); (* so BreakOut works correctly *)
          buffer := edL.CopyString(s.VAL(s.ADDRESS,CmdMsg.args[1]));
        ELSE
          buffer := edL.CopyString(s.VAL(s.ADDRESS,
                                   s.VAL(LONGINT,CmdMsg.args[0])+7));
        END;
        IF buffer # NIL THEN
          aux1 := buffer;
          cmd := edG.BreakOut(buffer,aux2);
          IF cmd # NIL THEN
            CmdMsg.result2 := rxs.CreateArgstring(cmd^,edL.Length(cmd^)); END;
          IF aux1 # NIL THEN DISPOSE(aux1); END;
          DISPOSE(aux1);
        END;
      ELSE
        aux1 := CmdMsg;         (* sichern *)
        status := edG.Status * LONGSET{edG.isAppl,edG.isRexx};
        argCnt := ApplArgCnt;
        edG.ExecCmd(s.VAL(s.ADDRESS,CmdMsg.args[0]));
        CmdMsg := aux1;         (* zurückschreiben *)
        edG.Status := edG.Status + status; ApplArgCnt := argCnt;
      END;

      IF NOT (edG.cmdFound IN edG.Status) THEN
        edG.Rc := edE.rxFailed;
        CmdMsg.result2 := edE.cmdNotFound;
      ELSIF edG.Rc < edE.failLevel THEN
        edG.Rc := edE.cmdValid0;
      ELSE
        CmdMsg.result2 := edG.Result;
      END;
      CmdMsg.result1 := edG.Rc;
    END; (* IF IsRexxMsg OR IsApplMsg *)
  END incomingRexx;

BEGIN
  IF NOT (edG.arexxAvail IN edG.Status) THEN
    edL.Title(NoMacrosARexxNotActive); edG.Rc := edE.cmdFailed;
    RETURN;
  END;
  rxMsg := rxs.CreateRexxMsg(AEdRxPort,Extension,edG.AEdrxPort);
  IF (rxMsg = NIL) AND (edG.Text # NIL) THEN
    edL.Title(CreateRexxMsgFailed); edG.Rc := edE.cmdSevere;
    RETURN;
  END;
  rxMsg.args[0] := argo;
  rxMsg.args[eAD.TextSlot] := s.VAL(s.ADDRESS,edG.Text);
  IF argo = NIL THEN
    action.command := close;
  ELSE
    IF NOT rxs.FillRexxMsg(rxMsg,1,{}) AND (edG.Text # NIL) THEN
      (*
       * wandelt gleich in Argstrings
       *)
      edL.Title(FillRexxMsgFailed); edG.Rc := edE.cmdSevere;
      rxs.DeleteRexxMsg(rxMsg);
      RETURN;
    END;
    action.command := comm;
  END;
  rxMsg.node.node.name := eAD.idAEd0;
  action.modifier := modifier-SHORTSET{result};
  rxMsg.action  := s.VAL(LONGINT,action);
  oldTxt := edG.Text;
  IF edG.Text # NIL THEN
    oldLock := d.CurrentDir(edG.Text.dirLock);
    EXCL(edG.Text.status,edG.keepTitle);
  END;
  e.Forbid;
  arexxPort := e.FindPort(port^);
  IF arexxPort # NIL THEN
    e.PutMsg(arexxPort,rxMsg);
    e.Permit;

    (*edL.Title(CallingARexxMacro);*)
    LOOP
      e.WaitPort(AEdRxPort);
      CmdMsg := e.GetMsg(AEdRxPort);
      WHILE CmdMsg # NIL DO
        IF CmdMsg = rxMsg THEN EXIT; END;   (* eigene Msg zurück -> fertig *)
        incomingRexx;
        e.ReplyMsg(CmdMsg);
        CmdMsg := e.GetMsg(AEdRxPort);
      END;
    END;

    IF edG.Text # NIL THEN
      IF oldTxt # edG.Text THEN edD.SwitchEdit(oldTxt); END;
      INCL(edG.Status,edG.cmdFound);
      IF edG.keepTitle IN edG.Text.status THEN
        edG.Rc := edE.cmdValid2;
      ELSIF (CmdMsg.result1 # 0) AND (edG.Rc = CmdMsg.result1) THEN
        IF CmdMsg.result1 = 1 THEN
           EXCL(edG.Status,edG.cmdFound);
           edL.Title(UnknownCommand);
        ELSE
          Printf.SPrintf2(ErrTitle,ARexxMacroError,
                          CmdMsg.result2,CmdMsg.result1);
          edL.Title(ErrTitle);
        END;
      ELSIF CmdMsg.result2 # 0 THEN
        Printf.SPrintf2(ErrTitle,UserSpecifiedMacroError,CmdMsg.result2,rxMsg.args[0]);
        edL.Title(ErrTitle); edG.Rc := edE.cmdFailed;
      END; (* IF CmdMsg.result1 # 0 *)
    END; (* edG.Text # NIL *)
  ELSE  (* IF ARexxPort#NIL *)
    e.Permit;
    IF edG.Text # NIL THEN
      edL.Title(NoMacrosARexxNotActive); END;
    edG.Rc := edE.cmdError;
  END;
  IF edG.Text # NIL THEN
    oldLock := d.CurrentDir(oldLock); END;
  rxs.ClearRexxMsg(rxMsg,1);
  rxs.DeleteRexxMsg(rxMsg);
  edG.Status := edG.Status - LONGSET{edG.isAppl,edG.isRexx};
END dRexx;


PROCEDURE dRx*;
BEGIN
  IF moString IN edG.ArgSet THEN
    dRexx(SHORTSET{moString},s.ADR(REXX),edG.Arg[0]);
  ELSE
    dRexx(SHORTSET{},s.ADR(REXX),edG.Arg[0]);
  END;
END dRx;

(*
 *  dRex1 is also used as implicit invocation interface between
 *  dCommand() and dRexx for ARexx macros implicitly called;
 *  arbitrary number of arguments
 *)

PROCEDURE dRx1*;
BEGIN
  Printf.SPrintf2(Buffer,"%s %s",edG.Arg[0],edG.Arg[1]);
  dRexx(SHORTSET{},s.ADR(REXX),s.ADR(Buffer));
END dRx1;


PROCEDURE dRx2*;
BEGIN
  Printf.SPrintf3(Buffer,"%s %s %s",edG.Arg[0],edG.Arg[1],edG.Arg[2]);
  dRexx(SHORTSET{},s.ADR(REXX),s.ADR(Buffer));
END dRx2;

(* -------------------------------------------------------------------------*)

PROCEDURE FindApplNode(name: edG.StringPtr): ApplPtr;
VAR
  appl: lst.NodePtr;
  (* $ClearVars- *)
BEGIN
  (* $ClearVars= *)
  appl := ApplList.head;
  WHILE appl # NIL DO
    IF edL.NCStrCmp(appl(Application).name,name) THEN
      RETURN appl(Application); END;
    appl := appl.next;
  END;
  RETURN NIL;
END FindApplNode;


PROCEDURE GetApplPort*(find: edG.StringPtr): edG.StringPtr;
VAR
  appl: ApplPtr;
  (* $ClearVars- *)
BEGIN
  (* $ClearVars= *)
  appl := FindApplNode(find);
  IF appl # NIL THEN RETURN appl.port ELSE RETURN NIL END;
END GetApplPort;


PROCEDURE ReleaseAppl(appl: ApplPtr);
BEGIN
  lst.Remove(ApplList,appl);
  (* DISPOSE(appl.port); DISPOSE(appl.name); *)
  DISPOSE(appl); (* wurde ja am Stück alloziert!! *)
END ReleaseAppl;


PROCEDURE dApplAdd*;
VAR
  appl: ApplPtr;
  len0, len1: INTEGER;
  (* $ClearVars- *)
BEGIN
  (* $ClearVars= *)
  IF FindApplNode(edG.Arg[0]) # NIL THEN
    edL.Title(ApplAlreadyIncluded); edG.Rc := edE.cmdFailed;
    RETURN;
  END;
  len0 := edL.Length(edG.Arg[0]^)+1;
  len1 := edL.Length(edG.Arg[1]^)+1;
  ol.New(appl,s.SIZE(Application)+len0+len1);
  IF appl=NIL THEN
    INCL(edG.Status,edG.memoryFail); edG.Rc := edE.cmdSevere;
    RETURN;
  END;
  (* s.INIT(appl); STRUCT!! *)
  appl.name := s.VAL(s.ADDRESS,s.VAL(LONGINT,appl)+s.SIZE(Application));
  appl.name := s.VAL(s.ADDRESS,s.VAL(LONGINT,appl.name)+len0);
  e.CopyMem(edG.Arg[0]^,appl.name^,len0);
  e.CopyMem(edG.Arg[1]^,appl.port^,len1);
  lst.AddTail(ApplList,appl);
  Printf.SPrintf1(Buffer,"Appl installed: %s",edG.Arg[0]);
  edL.Title(Buffer);
  edG.Rc := edE.cmdValid2; edG.Result := s.VAL(LONGINT,ol.Me);
END dApplAdd;


PROCEDURE dApplClose*;
VAR
  appl: ApplPtr;
  (* $ClearVars- *)
BEGIN
  (* $ClearVars= *)
  appl := FindApplNode(edG.Arg[0]);
  IF appl#NIL THEN
    dRexx(SHORTSET{},appl.port,NIL);
    ReleaseAppl(appl);
  END;
END dApplClose;

(*
 *  dAppl is also used as implicit invocation interface between
 *  dCommand() and dRexx for Applications implicitly called;
 *  arbitrary number of arguments
 *)

PROCEDURE dAppl*;
VAR
  appl: ApplPtr;
  (* $ClearVars- *)
BEGIN
  (* $ClearVars= *)
  appl := FindApplNode(edG.Arg[0]);
  IF appl#NIL THEN
    dRexx(SHORTSET{},appl.port,edG.Arg[1]);
  ELSE
    edL.Title(ApplicationNotFound); edG.Rc := edE.cmdFailed;
  END;
END dAppl;

(*--------------------------------------------------------------------------*)

PROCEDURE OpenRexx():BOOLEAN;
BEGIN
  Printf.SPrintf1(edG.AEdrxPort,"AEd%08lx",e.FindTask(NIL));
  AEdRxPort := es.CreatePort(edG.AEdrxPort,0);
  IF AEdRxPort = NIL THEN RETURN FALSE; END;
  INCL(edG.Status,edG.arexxAvail);
  AEdRxPortSigBit := AEdRxPort.sigBit;
  RETURN TRUE;
END OpenRexx;


PROCEDURE CloseRexx;
BEGIN
  IF AEdRxPort # NIL THEN
    es.DeletePort(AEdRxPort);
  END;
  edG.AEdrxPort := "";
  EXCL(edG.Status,edG.arexxAvail);
END CloseRexx;

(* $IF NoRexx *)

BEGIN
  EXCL(edG.Status,edG.arexxAvail);

(* $ELSE *)

BEGIN
  lst.Init(ApplList);
  IF (rxs.base = NIL) OR (NOT OpenRexx()) THEN
    CloseRexx; END;

CLOSE
  WHILE ApplList.head # NIL DO
    edG.Arg[0] := ApplList.head(Application).name;
    dApplClose;
  END;
  CloseRexx;

(* $END *)

END EdRexx.