(* ------------------------------------------------------------------------
  :Program.       EasyRexx
  :Contents.      easily add an Arexx Port to an Application
  :Author.        Fridtjof Siebert [fbs]
  :Author.        Kai Bolay [kai]
  :Address.       Snail-Mail:              E-Mail:
  :Address.       Hoffmannstraße 168       UUCP: kai@amokle.adsp.sub.org
  :Address.       D-7250 Leonberg 1        FIDO: 2:2407/106.3
  :History.       v1.0 [fbs] 11-Aug-91 created
  :History.       v1.1 [kai] 13-Nov-92 uppecase commands -> UISG, GC
  :Copyright.     Freeware
  :Language.      Oberon
  :Translator.    AMIGA OBERON v3.0d
------------------------------------------------------------------------ *)
MODULE EasyRexx;

IMPORT rsl := RexxSysLib,
       e * := Exec,
       es  := ExecSupport,
       rx  := Rexx,
       str := Strings,
       (* $IF GarbageCollector *)
       avl := AVL;
       (* $ELSE *)
       avl := UntracedAVL;
       (* $END *)

CONST
  errorImGone = 100;
  errorNoCmd  = 30;

TYPE
  String * = e.STRING;

  (* $IF GarbageCollector *)
  RexxCommandPtr * = POINTER TO RexxCommand;
  (* $ELSE *)
  RexxCommandPtr * = UNTRACED POINTER TO RexxCommand;
  (* $END *)

  UserProc * = PROCEDURE(comm: RexxCommandPtr;
                         args: String;
                         VAR result: String);

  RexxCommand * = RECORD (avl.SNode)
                    proc * : UserProc;
                  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 *)


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


PROCEDURE OpenRexx * (name: String): LONGSET;
(*
 * Öffnet AREXX-Port mit Namen 'name'. Ergebnis ist das Signal des Ports
 * (bereits in der LONGSET-Memge gesetzt).
 * Konnte der Port nicht geöffnet werden, weil ein Port mit gleichen Namen
 * bereits existiert oder weil zu wenig Speicher vorhanden war, wird
 * eine leere Menge zurückgegeben.
 *)

VAR
  (* $IF GarbageCollector *)
  Name: POINTER TO String;
  (* $ELSE *)
  Name: UNTRACED POINTER TO String;
  (* $END *)

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             *)
          Name^ := name;
          rexxPort := es.CreatePort(Name^, 0)  (* Port erzeugen        *)
        END;
      END;
    e.Permit() ;

  END;

  IF rexxPort # NIL THEN

    RETURN LONGSET{rexxPort.sigBit}                (* Signalset zurück *)

  ELSE

    RETURN LONGSET{}                                      (* leere Set *)

  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

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

END AddCommand;


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


PROCEDURE EasyAddCommand*(name: ARRAY OF CHAR; proc: UserProc): 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;
  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: 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;
    str.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;
    str.Upper (name);

            (* Spaces und Sonderzeichen bis zum 1. Argument übergehen: *)
    WHILE (args[i] # 0X) AND (args[i] <= " ") DO INC(i) END;
    str.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: *)

    IF comm=NIL THEN                  (* nicht gefunden: Fehler melden *)

      RexxMsg.result1 := errorNoCmd;

    ELSE

      result := "";                       (* Ergebnisstring vorbelegen *)
      WITH comm: RexxCommand DO
        comm.proc(comm,args,result);             (* Commando ausführen *)
      END;

(* Wenn Ergebnis vorhanden und von Rexx erwartet, Erbebnis abschicken: *)
      IF (result#"") AND ODD(RexxMsg.action DIV rx.rxResult)  THEN
        RexxMsg.result2 := rsl.CreateArgstring(result,str.Length(result));
      END;

    END;   (* IF comm=NIL THEN ... ELSE *)

    outStandingRMsg := NIL;                      (* Msg ist bearbeitet *)
    e.ReplyMsg(RexxMsg);                            (* und beantworten *)

  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) *)
    es.DeletePort(rexxPort);                         (* Port schließen *)
  e.Permit;
  DISPOSE(name);                                     (* Name freigeben *)
  rexxPort := NIL;
END CloseRexx;


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


BEGIN                                              (* Initialisierung: *)

  avl.SInit(commands);
  outStandingRMsg := NIL;
  rexxPort := NIL;

CLOSE                                                      (* Cleanup: *)

  CloseRexx;

END EasyRexx.