home *** CD-ROM | disk | FTP | other *** search
/ Amiga ISO Collection / AmigaUtilCD2.iso / Misc / cx22.lha / CX2.2 / Quelltext / CXARexx.mod < prev    next >
Encoding:
Modula Implementation  |  1995-04-26  |  11.1 KB  |  386 lines
  1. IMPLEMENTATION MODULE CXARexx;
  2.  
  3.    (* CXARexx.mod - ARexx-Routinen
  4.     * Version     : $VER: CXARexx.mod 2.0 (© 1995 Fin Schuppenhauer)
  5.     * Autor       : Fin Schuppenhauer
  6.     *               Braußpark 10
  7.     *               20537 Hamburg
  8.     *               (Germany)
  9.     * E-Mail      : 1schuppe@informatik.uni-hamburg.de
  10.     * Erstellt am : 21 Mar 1995
  11.     * Letzte Änd. : 26 Apr 1995
  12.     *)
  13.  
  14. IMPORT
  15.     rd:RexxD, rl:RexxL,
  16.     ed:ExecD, el:ExecL, es:ExecSupport,
  17.     dd:DosD, dl:DosL,
  18.     cd:CommoditiesD, cp:CommoditiesPrivate,
  19.     id:IntuitionD, il:IntuitionL,
  20.     ll:LocaleL,
  21.     str:String,
  22.     cxc:CXCommodity,
  23.     cxl:CXLokal,
  24.     cxf:CXFileIO,
  25.     cxw:CXWindow;
  26.  
  27. FROM SYSTEM IMPORT
  28.     ADR, ADDRESS, CAST, LONGSET;
  29.  
  30. CONST
  31.     PORTNAME = "CX";
  32.     cxName = "Exchange";
  33.  
  34.     (* Templates der einzelen Kommandos: *)
  35.     TMPL_QUIT = "";
  36.     TMPL_QUERY = "BROKER/K";
  37.     TMPL_ENABLE = "BROKER/K,ALL/S";
  38.     TMPL_DISABLE = "BROKER/K,ALL/S";
  39.     TMPL_SHOW = "BROKER/K";
  40.     TMPL_HIDE = "BROKER/K";
  41.     TMPL_REMOVE = "BROKER/K,REMOVELIST/K,ALL/S,FORCE/S";
  42.     TMPL_GETLIST = "";
  43.  
  44. TYPE
  45.     ARexxCommands = (UNKNOWN, QUIT, QUERY, ENABLE, DISABLE, SHOW, HIDE, REMOVE, GETLIST);
  46.     ARexxProcedure = PROCEDURE (VAR LONGINT, VAR LONGINT, BOOLEAN, dd.RDArgsPtr);
  47.     String = ARRAY [0..127] OF CHAR;
  48.     StrPtr = POINTER TO String;
  49.  
  50. VAR
  51.     arexxport: ed.MsgPortPtr;
  52.     arexxproc: ARRAY ARexxCommands OF ARexxProcedure;
  53.  
  54. PROCEDURE InitARexx(): BOOLEAN;
  55. BEGIN
  56.     arexxport := es.CreatePort(ADR(PORTNAME),0);
  57.     IF arexxport # NIL THEN
  58.         arexxsignal := arexxport^.sigBit;
  59.         RETURN TRUE;
  60.     END;
  61.     RETURN FALSE;
  62. END InitARexx;
  63.  
  64. PROCEDURE FreeARexx;
  65. BEGIN
  66.     IF arexxport # NIL THEN
  67.         es.DeletePort (arexxport);
  68.         arexxport := NIL;
  69.     END;
  70. END FreeARexx;
  71.  
  72. (* --------------------------------------------------------------- *)
  73.  
  74. PROCEDURE ExtractARexxCmd (arg0 : ARRAY OF CHAR;
  75.                            VAR cmdLength : INTEGER) : ARexxCommands;
  76. (** "Kommando aus Argumentstring extrahieren"
  77. *)
  78. VAR
  79.    command: String;
  80.    i: INTEGER;
  81. BEGIN
  82.    i := 0;
  83.    WHILE (arg0[i] # " ") & (arg0[i] # 0C) DO
  84.       command[i] := arg0[i];
  85.       INC (i);
  86.    END;
  87.    command[i] := 0C;
  88.  
  89.    cmdLength := str.Length(command) + 1;
  90.    IF    str.Compare(command, "QUIT")=0   THEN RETURN QUIT;
  91.    ELSIF str.Compare(command, "QUERY")=0 THEN RETURN QUERY;
  92.    ELSIF str.Compare(command, "ENABLE")=0  THEN RETURN ENABLE;
  93.    ELSIF str.Compare(command, "DISABLE") = 0 THEN RETURN DISABLE;
  94.    ELSIF str.Compare(command, "SHOW") = 0 THEN RETURN SHOW;
  95.    ELSIF str.Compare(command, "HIDE") = 0 THEN RETURN HIDE;
  96.    ELSIF str.Compare(command, "REMOVE") = 0 THEN RETURN REMOVE;
  97.    ELSIF str.Compare(command, "GETLIST") = 0 THEN RETURN GETLIST;
  98.    ELSE RETURN UNKNOWN;
  99.    END;
  100. END ExtractARexxCmd;
  101. (* **)             
  102.  
  103. PROCEDURE CheckTemplate (template: ARRAY OF CHAR;
  104.                          VAR optionsArray: ADDRESS;
  105.                          rdargs: dd.RDArgsPtr) : LONGINT;
  106. (** "Template überprüfen" *)
  107. VAR
  108.    success: dd.RDArgsPtr;
  109.    IoErrMsg: String;
  110.    easyreq  : id.EasyStruct;
  111.    idcmp    : id.IDCMPFlagSet;
  112.    num: LONGINT;
  113. BEGIN
  114.    success := dl.ReadArgs(ADR(template), optionsArray, rdargs);
  115.    IF success = NIL THEN
  116.       IF dl.Fault(dl.IoErr(), NIL, ADR(IoErrMsg), 75) THEN
  117.            idcmp := id.IDCMPFlagSet{};
  118.            WITH easyreq DO
  119.               structSize  := SIZE(id.EasyStruct);
  120.               flags       := LONGSET{};
  121.               title       := ll.GetCatalogStr(cxw.catalog, cxl.REQ_AREXX_TITLE, ADR(cxl.REQ_AREXX_TITLESTR));
  122.               textFormat  := ADR(IoErrMsg);
  123.               gadgetFormat:= ll.GetCatalogStr(cxw.catalog, cxl.REQ_AREXX_FORMAT, ADR(cxl.REQ_AREXX_FORMATSTR));
  124.            END;
  125.            num := il.EasyRequestArgs(NIL, easyreq, idcmp, NIL);
  126.       END;
  127.       RETURN dd.error;
  128.    END;
  129.    RETURN dd.ok;
  130. END CheckTemplate;
  131. (* **)
  132.  
  133. PROCEDURE ClearOptionsArray (VAR array: ARRAY OF LONGINT;
  134.                              count: INTEGER);
  135. (** "Array für die Aufnahme der Optionen initialisieren" *)
  136. BEGIN
  137.    DEC (count);
  138.    WHILE count >= 0 DO
  139.       array[count] := 0;
  140.       DEC (count);
  141.    END;
  142. END ClearOptionsArray;
  143. (* **)
  144.  
  145. (* ----- ARexx-Kommandos: ---------------------------------------- *)
  146.  
  147. PROCEDURE Quit (VAR rs1, rs2: LONGINT; result: BOOLEAN; rdargs: dd.RDArgsPtr);
  148. BEGIN
  149.     rs1 := dd.ok;
  150. END Quit;
  151.  
  152. PROCEDURE Query (VAR rs1, rs2: LONGINT; result: BOOLEAN; rdargs: dd.RDArgsPtr);
  153. CONST
  154.     MAXOPTIONS = 1;
  155.     optBroker = 0;
  156. VAR
  157.     options: ARRAY [0..MAXOPTIONS-1] OF LONGINT;
  158.     optArray: ADDRESS;
  159.     infostr: String;
  160.     cpb: cp.BrokerCopyPtr;
  161. BEGIN
  162.     ClearOptionsArray (options, MAXOPTIONS);
  163.     optArray := ADR(options);
  164.     options[optBroker] := ADR(cxName);
  165.     rs1 := CheckTemplate(TMPL_QUERY, optArray, rdargs);
  166.     IF (rs1 = dd.ok) AND result THEN
  167.         cpb := cxc.GetBrokerCopyByName(CAST(cxc.StrPtr, options[optBroker]));
  168.         IF cpb # NIL THEN
  169.             IF cp.active IN cpb^.flags THEN
  170.                 infostr := "active";
  171.             ELSE
  172.                 infostr := "inactive";
  173.             END;
  174.             IF cp.showhide IN cpb^.flags THEN
  175.                 str.Concat(infostr, " window");
  176.             ELSE
  177.                 str.Concat(infostr, " nowindow");
  178.             END;
  179.             rs2 := CAST(LONGINT, rl.CreateArgstring(ADR(infostr), str.Length(infostr)));
  180.         ELSE
  181.             rs1 := dd.warn;
  182.         END;
  183.     END;
  184.     dl.FreeArgs (rdargs);
  185. END Query;
  186.  
  187. PROCEDURE Enable (VAR rs1, rs2: LONGINT; result: BOOLEAN; rdargs: dd.RDArgsPtr);
  188. CONST
  189.     MAXOPTIONS = 2;
  190.     optBroker = 0;
  191.     optAll = 1;
  192. VAR
  193.     options: ARRAY [0..MAXOPTIONS-1] OF LONGINT;
  194.     optArray: ADDRESS;
  195.     li: LONGINT;
  196. BEGIN
  197.     ClearOptionsArray (options, MAXOPTIONS);
  198.     optArray := ADR(options);
  199.     options[optBroker] := ADR(cxName);
  200.     rs1 := CheckTemplate(TMPL_ENABLE, optArray, rdargs);
  201.     IF rs1 = dd.ok THEN
  202.         IF options[optAll] # 0 THEN
  203.             cxc.SendAllBrokerCommand(cd.cxcmdEnable);
  204.         ELSE
  205.             li := cp.BrokerCommand(options[optBroker], cd.cxcmdEnable);
  206.         END;
  207.     END;
  208.     dl.FreeArgs(rdargs);
  209. END Enable;
  210.  
  211. PROCEDURE Disable (VAR rs1, rs2: LONGINT; result: BOOLEAN; rdargs: dd.RDArgsPtr);
  212. CONST
  213.     MAXOPTIONS = 2;
  214.     optBroker = 0;
  215.     optAll = 1;
  216. VAR
  217.     options: ARRAY [0..MAXOPTIONS-1] OF LONGINT;
  218.     optArray: ADDRESS;
  219.     li: LONGINT;
  220. BEGIN
  221.     ClearOptionsArray (options, MAXOPTIONS);
  222.     optArray := ADR(options);
  223.     options[optBroker] := ADR(cxName);
  224.     rs1 := CheckTemplate(TMPL_DISABLE, optArray, rdargs);
  225.     IF rs1 = dd.ok THEN
  226.         IF options[optAll] # 0 THEN
  227.             cxc.SendAllBrokerCommand (cd.cxcmdDisable);
  228.         ELSE
  229.             li := cp.BrokerCommand (options[optBroker], cd.cxcmdDisable);
  230.         END;
  231.     END;
  232.     dl.FreeArgs(rdargs);
  233. END Disable;
  234.  
  235. PROCEDURE Show (VAR rs1, rs2: LONGINT; result: BOOLEAN; rdargs: dd.RDArgsPtr);
  236. CONST
  237.     MAXOPTIONS = 1;
  238.     optBroker = 0;
  239. VAR
  240.     options: ARRAY [0..MAXOPTIONS-1] OF LONGINT;
  241.     optArray: ADDRESS;
  242.     li: LONGINT;
  243. BEGIN
  244.     ClearOptionsArray (options, MAXOPTIONS);
  245.     optArray := ADR(options);
  246.     options[optBroker] := ADR(cxName);
  247.     rs1 := CheckTemplate(TMPL_SHOW, optArray, rdargs);
  248.     IF rs1 = dd.ok THEN
  249.        li := cp.BrokerCommand(options[optBroker], cd.cxcmdAppear);
  250.     END;
  251.     dl.FreeArgs(rdargs);
  252. END Show;
  253.               
  254. PROCEDURE Hide (VAR rs1, rs2: LONGINT; result: BOOLEAN; rdargs: dd.RDArgsPtr);
  255. CONST
  256.     MAXOPTIONS = 1;
  257.     optBroker = 0;
  258. VAR
  259.     options: ARRAY [0..MAXOPTIONS-1] OF LONGINT;
  260.     optArray: ADDRESS;
  261.     li: LONGINT;
  262. BEGIN
  263.     ClearOptionsArray (options, MAXOPTIONS);
  264.     optArray := ADR(options);
  265.     options[optBroker] := ADR(cxName);
  266.     rs1 := CheckTemplate(TMPL_HIDE, optArray, rdargs);
  267.     IF rs1 = dd.ok THEN
  268.         li := cp.BrokerCommand(options[optBroker], cd.cxcmdDisappear);
  269.     END;
  270.     dl.FreeArgs(rdargs);
  271. END Hide;
  272.               
  273. PROCEDURE Remove (VAR rs1, rs2: LONGINT; result: BOOLEAN; rdargs: dd.RDArgsPtr);
  274. CONST
  275.     MAXOPTIONS = 4;
  276.     optBroker = 0;
  277.     optRemoveList = 1;
  278.     optAll = 2;
  279.     optForce = 3;
  280. VAR
  281.     options: ARRAY [0..MAXOPTIONS-1] OF LONGINT;
  282.     optArray: ADDRESS;
  283.     li: LONGINT;
  284. BEGIN
  285.     ClearOptionsArray (options, MAXOPTIONS);
  286.     optArray := ADR(options);
  287.     rs1 := CheckTemplate(TMPL_REMOVE, optArray, rdargs);
  288.     IF rs1 = dd.ok THEN
  289.         IF options[optAll] # 0 THEN
  290.             IF options[optForce] # 0 THEN
  291.                 cxc.SendAllBrokerCommand(cd.cxcmdKill);
  292.             ELSE
  293.                 IF options[optRemoveList] # 0 THEN
  294.                     cxf.FreeRemoveList;
  295.                     cxf.LoadRemoveList (options[optRemoveList]);
  296.                 END;
  297.                 cxw.KillAll;
  298.             END;
  299.         ELSE
  300.             li := cp.BrokerCommand(options[optBroker], cd.cxcmdKill);
  301.         END;
  302.     END;
  303.     dl.FreeArgs(rdargs);
  304. END Remove;
  305.               
  306. PROCEDURE GetList (VAR rs1, rs2: LONGINT; result: BOOLEAN; rdargs: dd.RDArgsPtr);
  307. VAR
  308.     infostr: String;
  309.     node: ed.NodePtr;
  310. BEGIN
  311.     IF cxc.brokerlist # NIL THEN
  312.         infostr := "";
  313.         node := cxc.brokerlist^.head;
  314.         WHILE node^.succ # NIL DO
  315.             str.Concat (infostr, CAST(cp.BrokerCopyPtr, node)^.name);
  316.             str.ConcatChar (infostr, " ");
  317.             node := node^.succ;
  318.         END;
  319.         rs2 := CAST(LONGINT, rl.CreateArgstring(ADR(infostr), str.Length(infostr)));
  320.     ELSE
  321.         rs2 := CAST(LONGINT, rl.CreateArgstring(ADR("emptylist"), 9));
  322.     END;
  323. END GetList;              
  324.  
  325. PROCEDURE Unknown (VAR rs1, rs2: LONGINT; result: BOOLEAN; rdargs: dd.RDArgsPtr);
  326. BEGIN
  327.     rs1 := dd.fail;
  328. END Unknown;
  329.  
  330. (* --------------------------------------------------------------- *)
  331.  
  332. PROCEDURE HandleARexxMsg (VAR done: BOOLEAN);
  333. VAR
  334.     msg: rd.RexxMsgPtr;
  335.     arg0: String;
  336.     cmd: ARexxCommands;
  337.     cmdLength: INTEGER;
  338.     rdargs: dd.RDArgsPtr;
  339.     result: BOOLEAN;
  340. BEGIN
  341.     LOOP
  342.         msg := CAST(rd.RexxMsgPtr, el.GetMsg(arexxport));
  343.         IF msg = NIL THEN EXIT; END;
  344.  
  345.         IF rl.IsRexxMsg(msg) THEN
  346.             str.Copy (arg0, CAST(StrPtr, msg^.args[0])^);
  347.             cmd := ExtractARexxCmd(arg0, cmdLength);
  348.             IF msg^.action.command = rd.comm THEN
  349.                 result := rd.result IN msg^.action.modifier;
  350.                 rdargs := dl.AllocDosObject(dd.dosRdArgs, NIL);
  351.                 IF rdargs # NIL THEN
  352.                     str.ConcatChar (arg0, "\n");
  353.                     WITH rdargs^.source DO
  354.                         buffer := ADR(arg0) + ADDRESS(cmdLength);
  355.                         length := str.Length(CAST(StrPtr, buffer)^);
  356.                         curChr := 0;
  357.                     END;
  358.  
  359.                     arexxproc[cmd] (msg^.result1, msg^.result2, result, rdargs);
  360.                     IF (cmd = QUIT) AND (msg^.result1 = dd.ok) THEN
  361.                         done := TRUE;
  362.                     END;
  363.  
  364.                     dl.FreeDosObject (dd.dosRdArgs, rdargs);
  365.                     rdargs := NIL;
  366.                 END;
  367.             END;
  368.         END;
  369.         el.ReplyMsg (msg);
  370.     END;
  371. END HandleARexxMsg;
  372.  
  373. (* --------------------------------------------------------------- *)
  374.  
  375. BEGIN (* main *)
  376.     arexxproc[UNKNOWN] := Unknown;
  377.     arexxproc[QUIT] := Quit;
  378.     arexxproc[QUERY] := Query;
  379.     arexxproc[ENABLE] := Enable;
  380.     arexxproc[DISABLE] := Disable;
  381.     arexxproc[SHOW] := Show;
  382.     arexxproc[HIDE] := Hide;
  383.     arexxproc[REMOVE] := Remove;
  384.     arexxproc[GETLIST] := GetList;
  385. END CXARexx.
  386.