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