(*---------------------------------------------------------------------------
  :Program.    EzRexx.mod
  :Author.     Thomas Igracki
  :Address.    Obstallee 45, 1000 Berlin 20, W-Germany
  :E-Mail.     InterNet -> lokai@cs.tu-berlin.de
  :E-Mail.     Z-Netz   -> T.Igracki@BAMP.ZER
  :E-Mail.     Fido     -> Thomas_Igracki%2:2403_10.40
  :Version.    1.1
  :Date.       22-Oct-1992
  :Copyright.  Thomas Igracki (If you like to use it, contact me!)
  :Language.   Oberon
  :Translator. Amiga Oberon 2.14d
  :Contents.   modifiziertes EasyRexx-Modul (von Fridtjof)
  :Usage.      IMPORT EzRexx:
  :Remark.     OS2.0 Only!
 --------------------------------------------------------------------------
 History:
   OpenRexx() gibt jetzt das Signal zurück anstatt das SignalSet!
   EasyRexx läuft jetzt nur noch ab OS2.0, da die Exec-Funcs für CreatePort()
   benutzt werden, anstatt die des ExecSupportModuls

   20-Oct-92: Thomas Igracki
   - UserProc geändert, da ich keine Verwendung für den Parameter 'comm' finden kann
   - DefaulfProcedure eingeführt, bei OpenARexx mitangeben!
   22-Oct-92: Thomas Igracki 
   - SendRexx() Proc. eingebaut.
   - asynchrone Kommandos 
---------------------------------------------------------------------------*)
MODULE EzRexx;

IMPORT
  sys: SYSTEM, d: Dos, e: Exec, 
  rsl: RexxSysLib, rx : Rexx, st : Strings, avl: AVL;

CONST
  errorImGone = 100;
  errorNoCmd  = 30;

TYPE

  RexxCommandPtr * = POINTER TO RexxCommand;

  DefaultProc * = PROCEDURE(name,args: ARRAY OF CHAR; VAR result: ARRAY OF CHAR);

  UserProc * = PROCEDURE(args: ARRAY OF CHAR; VAR result: ARRAY OF CHAR);

  RexxCommand * = RECORD (avl.SNode)
                    proc * : UserProc;
                    async* : BOOLEAN; (* asynchrone Kommandos? *)
                  END;

VAR
  rexxPort : e.MsgPortPtr;           (* this is *our* rexx port           *)
  commands : avl.SRoot;              (* our command list (actually a tree *)

  outStandingRMsg : rx.RexxMsgPtr;   (* the outstanding Rexx message *)

  DefProc : DefaultProc; 		     (* DefaultProcedure sie wird aufgerufen,*)
  				     (* wenn das Komanndo nicht bekannt war! *)


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

(* $CopyArrays- *)
PROCEDURE OpenRexx * (name: ARRAY OF CHAR; defProc: DefaultProc): SHORTINT;
(*
 * Öffnet AREXX-Port mit Namen 'name'. Ergebnis ist das Signal des Ports.
 * Konnte der Port nicht geöffnet werden, weil ein Port mit gleichen Namen
 * bereits existiert oder weil zu wenig Speicher vorhanden war, wird
 * -1 zurückgegeben.
 * defProc: Kann auch auf NIL gesetzt werden -> Keine DefaultProzedur!
 *)

VAR
  Name: e.STRPTR;

BEGIN

  IF rexxPort = NIL THEN

    e.Forbid();
      IF e.FindPort(name)=NIL THEN    (* existiert gleichnamiger Port? *)
        NEW(Name);
        IF Name#NIL THEN              (* Speicher für Name *)
          COPY(name,Name^); 	      (* alt: Name^ := name *)
          rexxPort := e.CreateMsgPort();  (* Port erzeugen *)
          rexxPort.node.name := Name; rexxPort.node.pri := 0;
          e.AddPort(rexxPort);
        END;
      END;
    e.Permit() ;

  END;

  IF rexxPort # NIL THEN DefProc := defProc; RETURN rexxPort.sigBit (* Signal zurück *)
		    ELSE DefProc := NIL;     RETURN -1 (* Fehler *)
  END;

END OpenRexx;


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


PROCEDURE AddCommand * (comm: RexxCommandPtr);
(*
 * Fügt ein REXX-Command an die Commandoliste an. comm muß auf eine mit
 * NEW() allozierten RECORD zeigen. In dem RECORD müssen die Felder
 * comm.name für den Commandoname und comm.proc für die aufzurufende
 * Prozedur ausgefüllt werden. comm.proc bekommt die eigene Struktur
 * comm als ersten Parameter übergeben, so daß man durch Erweiterung
 * von comm noch weitere Werte an die Prozedur übergeben kann.
 *
 * Commandos mit gleichen Namen dürfen nur 1 mal mit AddCommand()
 * aktiviert werden, ansonsten bricht das Programm mit rc=20 ab.
 *
 *)

BEGIN

  IF NOT avl.Add(commands,comm) THEN HALT(20) END;

END AddCommand;


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


PROCEDURE EasyAddCommand*(name: ARRAY OF CHAR; proc: UserProc; async: BOOLEAN): BOOLEAN;
(*
 * Fügt ähnlich AddCommand() ein REXX-Commando an Commandoliste an.
 * Hier wird jedoch lediglich ein standard-RexxCommand erzeugt und
 * das Record kann vom Benutzer nicht erweitert werden.
 *
 * Ergebnis ist FALSE, wenn zu wenig Speicher vorhanden war.
 *
 *)

VAR
  comm: RexxCommandPtr;

BEGIN

  NEW(comm); IF comm=NIL THEN RETURN FALSE END;

  comm.proc := proc; comm.async := async; COPY(name,comm.name);
  AddCommand(comm);

  RETURN TRUE;

END EasyAddCommand;


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


PROCEDURE HandleRexx*;
(*
 * Dies Prozedur bearbeitet ankommende Rexx-Commandos. Sie sollte immer dann
 * aufgerufen werden, wenn man den Verdacht hat, daß REXX-Messages angekommen
 * sein könnten. Dies ist z.B. nach dem Aufruf von Exec.Wait(SignalSet+XYZ)
 * der Fall, wenn SignalSet der von OpenRexxPort() erhaltene LONGSET ist.
 *
 * HandleRexxMsg ruft die mit AddCommand() aktivierten Prozeduren auf.
 *
 *)

VAR
  RexxMsg: rx.RexxMsgPtr;
  name: avl.String;
  args,result: e.STRING;
  i : INTEGER;
  comm: avl.NodePtr;

BEGIN

  IF rexxPort = NIL THEN RETURN END;         (* kein Port -> keine Msg *)

  LOOP

    RexxMsg := e.GetMsg(rexxPort);                (* nächste Msg holen *)
    IF RexxMsg=NIL THEN EXIT END;          (* keine mehr, dann tschüß! *)

    args := RexxMsg.args[0]^;                  (* Argumentstring holen *)

    i := 0;            (* Führende Spaces und Sonderzeichen übergehen: *)
    WHILE (args[i] # 0X) AND (args[i] <= " ") DO INC(i) END;
    st.Delete(args,0,i);

    i := 0;                               (* Commandoname extrahieren: *)
    WHILE (args[i] # 0X) AND (args[i] >  " ") DO INC(i) END;

    COPY(args,name);                         (* Commandoname nach name *)
    name[i] := 0X;
    st.Upper (name);                        (* => Kein Groß/Klein unterscheiden *)

            (* Spaces und Sonderzeichen bis zum 1. Argument übergehen: *)
    WHILE (args[i] # 0X) AND (args[i] <= " ") DO INC(i) END;
    st.Delete(args,0,i);

    RexxMsg.result1 := 0 ;                        (* Result vorbelegen *)
    RexxMsg.result2 := 0 ;

            (* Msg als unbearbeitet markieren, falls Command abbricht: *)
    outStandingRMsg := RexxMsg ;

    comm := avl.SFind(commands,name);              (* Commando suchen: *)

    result := "";                     (* Ergebnisstring vorbelegen *)
    IF comm = NIL THEN (* nicht gefunden: evtl. Fehler melden *)
      IF DefProc = NIL THEN (* keine DefaultProcedure *)
         RexxMsg.result1 := errorNoCmd;
         RexxMsg.result2 := sys.ADR('Unknown command!');
      ELSE
         DefProc (name,args,result);
      END;
    ELSE
      WITH comm: RexxCommand DO
        IF comm.async THEN
	   outStandingRMsg := NIL; e.ReplyMsg(RexxMsg);
        END;
        comm.proc(args,result);           (* Commando ausführen *)
      END;
    END;   (* IF comm=NIL THEN ... ELSE *)

    (* Wenn Ergebnis vorhanden und von Rexx erwartet, Erbebnis abschicken: *)

    IF (result#"") AND ODD(RexxMsg.action DIV rx.rxResult)  THEN
        RexxMsg.result2 := rsl.CreateArgstring(result,st.Length(result));
    END;

    IF (comm = NIL) OR ~comm(RexxCommand).async THEN
       outStandingRMsg := NIL;                      (* Msg ist bearbeitet *)
       e.ReplyMsg(RexxMsg);                            (* und beantworten *)
    END;

  END;   (* LOOP, nach nächste Msg schauen. *)

END HandleRexx;  (* das war's *)


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


PROCEDURE CloseRexx*;
(*
 * Schließt mit OpenRexx() geöffneten AREXX-Port.
 *)

VAR
  name: e.STRPTR;

BEGIN
  IF rexxPort=NIL THEN RETURN END;                        (* kein Port *)
  IF outStandingRMsg#NIL THEN                   (* unbeantwortete Msg? *)
    outStandingRMsg.result1 := errorImGone;          (* Fehler liefern *)
    e.ReplyMsg(outStandingRMsg) ;                  (* und beantworten. *)
    outStandingRMsg := NIL;
  END;
  e.Forbid;
    LOOP
      outStandingRMsg := e.GetMsg (rexxPort);
      IF outStandingRMsg=NIL THEN EXIT END;
      outStandingRMsg.result1 := errorImGone;        (* Fehler liefern *)
      e.ReplyMsg(outStandingRMsg) ;                (* und beantworten. *)
    END;
    name := rexxPort.node.name;  (* Zeiger auf Portname (wg. Speicher) *)
    e.RemPort (rexxPort);                         (* Port schließen *)
    e.DeleteMsgPort(rexxPort);
  e.Permit;
  DISPOSE(name);                                     (* Name freigeben *)
  rexxPort := NIL;
END CloseRexx;


(*--------------------- Die nächsten 2 sind neu ! ----------------------------*)
(* $CopyArrays- *)
PROCEDURE SendRexx* (rxPortName, com: ARRAY OF CHAR; VAR res : ARRAY OF CHAR): BOOLEAN;
VAR
   Reply, rxPort: e.MsgPortPtr;
   Msg: rx.RexxMsgPtr; Arg: rx.RexxArgPtr; strPtr: e.STRPTR;
BEGIN
     (* ARexx-Msg init. *)
     Reply := e.CreateMsgPort(); IF Reply = NIL THEN RETURN FALSE END;
     Msg := rsl.CreateRexxMsg(Reply, NIL, NIL);

     (* Build up the CommandString *)
     Msg.args[0] := rsl.CreateArgstring(com,st.Length(com));
     IF Msg.args[0] = NIL THEN
        rsl.DeleteRexxMsg(Msg); e.DeleteMsgPort (Reply); RETURN FALSE
     END;

     (* result is always wanted *)
     Msg.action := rx.rxComm+rx.rxResult;

     e.Forbid;
       rxPort := e.FindPort (rxPortName);
       IF rxPort = NIL THEN
          rsl.DeleteArgstring (Msg.args[0]); rsl.DeleteRexxMsg(Msg);
          e.DeleteMsgPort(Reply); RETURN FALSE
       ELSE
          e.PutMsg (rxPort,Msg);
       END;
     e.Permit;

     IF rxPort # NIL THEN
        e.WaitPort (Reply); Msg := e.GetMsg (Reply);
        WHILE Msg # NIL DO
            IF Msg.result1 = rx.ok THEN
               IF Msg.result2 # NIL THEN
                  strPtr := Msg.result2; COPY(strPtr^,res);
                  (* Weils Probs mit CED V2.12 gibt *)
                  IF rxPortName # 'rexx_ced' THEN
                     rsl.DeleteArgstring(Msg.result2);
                  END;
               END;
            ELSE
               res := 'Error'
            END;
            rsl.DeleteArgstring(Msg.args[0]);
            rsl.DeleteRexxMsg(Msg);
            Msg := e.GetMsg(Reply);
        END; (* WHILE *)
     END; (* IF *)
     e.DeleteMsgPort (Reply);
     RETURN TRUE
END SendRexx;

PROCEDURE NextArg* (VAR RxArgs, arg: ARRAY OF CHAR; ToUpper: BOOLEAN): BOOLEAN;
VAR i: INTEGER; Quote: BOOLEAN;
BEGIN
     (* $IFNOT ClearVars *) i := 0; Quote := FALSE; (* $END *)
     WHILE ((RxArgs[i] # ' ') OR Quote) & (RxArgs[i] # 0X) DO
        IF RxArgs[i] = "'" THEN Quote := NOT Quote END; INC(i)
     END;
     IF i > 0 THEN st.Cut (RxArgs,0,i,arg); st.Delete (RxArgs,0,i+1) END;
     IF ToUpper THEN st.Upper (arg) END;
     RETURN i > 0
END NextArg;

BEGIN
   (* Initialisierung: *)
   avl.SInit(commands); outStandingRMsg := NIL; rexxPort := NIL;
CLOSE
   CloseRexx
END EzRexx.