home *** CD-ROM | disk | FTP | other *** search
/ BCI NET 2 / BCI NET 2.iso / archives / programming / arexx / ole1v10a.lha / OLE_System / server / OLE.rexx < prev    next >
Encoding:
OS/2 REXX Batch file  |  1995-02-10  |  11.7 KB  |  453 lines
  1. /*
  2.  * OLE.rexx
  3.  *
  4.  * USAGE: "Run >NIL: Rx OLE.rexx"
  5.  *
  6.  * A lot of changes from the first release of my OLE Server. Read the
  7.  * documentation for more information.
  8.  *
  9.  * HISTORY:
  10.  * v1.11    added some improvements, a few bugs fixed
  11.  *            the INFO command add the ability to read internal parameters
  12.  *            checked all server commands
  13.  *
  14.  * v1.12    WaitForPort() replaced with an external Wait_For_Port.rexx
  15.  *
  16.  * v1.13    WaitForPort() MUST be internal
  17.  *
  18.  * $(C): (1994, Rocco Coluccelli, Bologna)
  19.  *
  20.  *    TODO: try to open this in the userscreen
  21.  *    TODO: put up a message for libraries not founded
  22.  *    TODO: add amigaguide.library support
  23.  */
  24.  
  25. ver_TAG = "$VER: OLE.rexx 1.13 (10.Feb.1995)"
  26. tit_TAG = ' OLE Server'
  27.  
  28. CALL IniLibs()
  29. CALL PostMsg(100,100,'\' || LEFT(tit_TAG || ':',40) || '\')
  30.  
  31. module.  = ''; module.path = 'OLE:'
  32. status.  = ''
  33. locale.  = ''; locale.path = 'OLE:Catalogs/'
  34. config.  = ''; config.path = 'OLE:Prefs/'
  35.  
  36. olewin.  = 'OLE_WIN'
  37. oleclip. = 'OLE_CLIP'
  38. olepipe. = 'OLE_PIPE'
  39. oleport. = 'OLE_HOST'
  40. oleind.  = 0
  41.  
  42. userport.   = 'REXX'
  43. userscreen. = 'Workbench'
  44.  
  45. module.0    = 0
  46. module.0.0    = 1
  47. module.0.1    = 'OLE.rexx'
  48. olewin.0    = 'OLE_IDCMP'
  49. oleport.0.1    = 'OLE_SERVER'
  50.  
  51. CALL ReadLocale(0,1)
  52. CALL ReadConfig(0,1)
  53. CALL PostMsg(,,'\' || tit_TAG || GetLocale(0,1,8))
  54.  
  55.  
  56. IF ~OPENPORT(oleport.0.1) THEN DO
  57.     CALL PostMsg()
  58.     CALL RTezRequest(GetLocale(0,1,'ERR_1',oleport.0.1),GetLocale(0,1,'OK3'),tit_TAG)
  59.     EXIT 20
  60.     END
  61.  
  62. CALL GetServerConfig()
  63.  
  64. winw. = 120; winh. = win.bt; winl. = 130; wint. = 0; boxw. = 0; boxh. = 0
  65. oleind.hei = 20            /* min = 18  max = 100 ? */
  66.  
  67. /*
  68.  *    idcmp.0 and flags.0 are for the server
  69.  */
  70. idcmp. = "MENUPICK CLOSEWINDOW GADGETUP"
  71. flags. = "WINDOWDRAG WINDOWDEPTH WINDOWCLOSE ACTIVATE"
  72. idcmp.0.1 = "MENUPICK"
  73. flags.0.1 = "WINDOWDRAG WINDOWDEPTH"
  74.  
  75.  
  76. CALL PostMsg(,,GetLocale(0,1,9))
  77. IF ~NewWindow(0,1,tit_TAG) THEN DO
  78.     CALL PostMsg()
  79.     EXIT 10
  80.     END
  81.  
  82.  
  83. CALL PostMsg()
  84. rt_TAG  = 'rtez_flags=ezreqf_centertext'
  85. DO UNTIL cmd = 'QUIT'
  86.  
  87.     CALL WAITPKT(oleport.0.1)
  88.     pkt = GETPKT(oleport.0.1)
  89.  
  90.     IF pkt == NULL() THEN ITERATE
  91.  
  92.     PARSE VALUE GETARG(pkt) WITH cmd jobID modID argv
  93.     SELECT
  94.  
  95.         WHEN cmd = 'COMPLETE' THEN DO
  96.  
  97.             IF oleind.jobID = 0 THEN DO
  98.                 CALL CloseWindow(olewin.jobID,"CONTINUE")
  99.                 CALL OpenWindow(olewin.jobID,winl.jobID,wint.jobID,winw.jobID,oleind.hei + win.bt + win.bb,idcmp.0,flags.0,GetLocale(jobID,modID,'TITLE'))
  100.                 CALL DrawBorder(2,2,boxw.jobID - 2,oleind.hei - 2,oleind.outer)
  101.                 CALL DrawBorder(10,6,boxw.jobID - 10,oleind.hei - 6,oleind.inner)
  102.                 END
  103.  
  104.             oleind.jobID = SetOleInd(argv)
  105.         END
  106.  
  107.         /*
  108.          *    TODO: check this command when switch tasks
  109.          */
  110.         WHEN cmd = 'SETJOB' THEN CALL IniModule(jobID,modID)
  111.  
  112.         WHEN cmd = 'ICONIFY' THEN DO
  113.             PARSE VAR argv winl.jobID wint.jobID .
  114.             CALL CloseWindow(olewin.jobID,"CONTINUE")
  115.             CALL OpenWindow(olewin.jobID,winl.jobID,0,winw.jobID,win.bt,idcmp.0,flags.1,GetLocale(jobID,modID,'TITLE'))
  116.             CALL SetNotify(olewin.jobID,"CLOSEWINDOW","REXX")
  117.             INTERPRET "CALL ModifyHost(" || olewin.jobID || ",'CLOSEWINDOW'," || '2227'x || ADDRESS oleport.0.1 'UNICONIFY' jobID modID ';' ADDRESS oleport.jobID.modID 'UNICONIFY' || '2722'x || ")"
  118.         END
  119.  
  120.         WHEN cmd = 'UNICONIFY' THEN IF ~NewWindow(jobID,modID,GetLocale(jobID,modID,'TITLE')) THEN CALL FreeJob(jobID)
  121.  
  122.         WHEN cmd = 'WINDOW' THEN DO
  123.             PARSE VAR argv boxw.jobID boxh.jobID a1 a2 .
  124.  
  125.             winw.jobID = boxw.jobID + win.bl + win.br
  126.             winh.jobID = boxh.jobID + win.bt + win.bb
  127.             winl.jobID = (ScreenCols(userscreen.jobID) - winw.jobID) % 2
  128.             wint.jobID = (ScreenRows(userscreen.jobID) - winh.jobID) % 2
  129.             oleind.jobID = 0
  130.  
  131.             idcmp.jobID.modID = idcmp.a1; flags.jobID.modID = flags.a2
  132.  
  133.             IF ~NewWindow(jobID,modID,GetLocale(jobID,modID,'TITLE')) THEN CALL FreeJob(jobID)
  134.         END
  135.  
  136.         WHEN cmd = 'INFO' THEN INTERPRET 'CALL SETCLIP(' || oleclip.jobID || ',' || argv || ')'
  137.  
  138.         WHEN cmd = 'CONFIG' THEN CALL WriteConfig(jobID,modID)
  139.  
  140.         WHEN cmd = 'NEWJOB' THEN DO
  141.             DO jobID = 1 UNTIL module.jobID.0 = ''; END
  142.             module.0 = MAX(module.0,jobID)
  143.             DO i = 1 WHILE GETARG(pkt,i + 2) ~= ''
  144.                 oleport.jobID.i = oleport. || '.' || jobID || '.' || i
  145.                 PARSE VALUE GETARG(pkt,i + 2) WITH module.jobID.i status.jobID.i .
  146.             END
  147.             module.jobID.0 = i - 1
  148.             oleclip.jobID = oleclip. || '.' || jobID
  149.             olepipe.jobID = olepipe. || '.' || jobID
  150.             olewin.jobID = olewin. || '.' || jobID
  151.             olewin.jobID.0 = ''
  152.             userport.jobID = GETARG(pkt,1)
  153.             userscreen.jobID = GETARG(pkt,2)
  154.             CALL IniModule(jobID,1)
  155.         END
  156.  
  157.         WHEN cmd = 'NEWPREFS' THEN DO
  158.  
  159.             DO jobID = 0 TO module.0
  160.                 IF SHOW('P',olewin.jobID) THEN CALL CloseWindow(olewin.jobID,"CONTINUE")
  161.             END
  162.  
  163.             CALL DELAY(delaytime * 50)
  164.             CALL ReadLocale(0,1); CALL ReadConfig(0,1)
  165.             CALL GetServerConfig()
  166.  
  167.             DO jobID = 0 TO module.0
  168.  
  169.                 IF SHOW('P',olewin.jobID) & oleind.jobID = 0 THEN DO
  170.  
  171.                     modID = olewin.jobID.0
  172.                     IF ~NewWindow(jobID,modID,GetLocale(jobID,modID,'TITLE')) THEN
  173.                         CALL FreeJob(jobID)
  174.                     ELSE
  175.                         IF jobID ~= 0 THEN INTERPRET 'ADDRESS' oleport.jobID.modID 'UNICONIFY'
  176.  
  177.                     END
  178.  
  179.                 oleind.jobID = 0
  180.             END
  181.  
  182.         END
  183.  
  184.         WHEN cmd = 'ABOUT' | cmd = 'ERROR' THEN DO
  185.             PARSE VAR argv a1 a2
  186.  
  187.             IF cmd = 'ABOUT' THEN DO
  188.                 a1 = GetLocale(jobID,modID,a1,SUBSTR(ver_TAG,7))
  189.                 a2 = GetLocale(0,1,'OK1')
  190.                 END
  191.  
  192.             ELSE DO
  193.                 a1 = GetLocale(0,1,'ERR_' || a1,STRIP(a2,'B'))
  194.                 a2 = GetLocale(0,1,'OK2')
  195.                 END
  196.  
  197.             CALL RTezRequest(a1,a2,tit_TAG,rt_TAG 'rt_pubscrname=' || userscreen.jobID)
  198.         END
  199.  
  200.         WHEN cmd = 'QUIT' THEN IF RTezRequest(GetLocale(0,1,10),GetLocale(0,1,'OK5'),tit_TAG,rt_TAG) = 0 THEN cmd = ''
  201.  
  202.         /*
  203.          *    TODO: fix this section
  204.          */
  205.         OTHERWISE DO
  206.  
  207.             cmd = GETARG(pkt,0)
  208.             DO i = 1 TO 15
  209.                 cmd = cmd || '0A'x || GETARG(pkt,i)
  210.             END
  211.             CALL RTezRequest(GetLocale(0,1,'ERR_3',cmd),GetLocale(0,1,'OK3'),tit_TAG)
  212.         END
  213.  
  214.     END
  215.     CALL REPLY(pkt,0)
  216. END
  217.  
  218. DO i = 1 TO module.0
  219.     IF module.i.0 ~= '' THEN CALL FreeJob(i)
  220. END
  221.  
  222. CALL CLOSEPORT(oleport.0.1)
  223. CALL FreeJob(0)
  224.  
  225. EXIT 0
  226.  
  227.  
  228. GetLocale: PROCEDURE EXPOSE locale.
  229. ARG jobID,modID,strID
  230.  
  231.     IF strID = '' THEN RETURN ''
  232.     strID = 'þ'strID'þ'; PARSE VALUE GETCLIP(locale.jobID.modID) WITH (strID)text'Þ'
  233.  
  234.     DO i = 4
  235.         PARSE VAR text text '%s' clip
  236.         IF clip = '' THEN BREAK
  237.         text = text || ARG(i) || clip
  238.     END
  239.  
  240. RETURN text
  241.  
  242.  
  243. DrawBorder:
  244.  
  245.     IF ARG(5) = 0 THEN RETURN
  246.  
  247.     x1 = win.bl + ARG(1); y1 = win.bt + ARG(2); x2 = win.bl + ARG(3); y2 = win.bt + ARG(4)
  248.     CALL Move(olewin.jobID,x1,y2)
  249.     CALL SetAPen(olewin.jobID,3 - ARG(5)); CALL Draw(olewin.jobID,x1,y1); CALL Draw(olewin.jobID,x2,y1)
  250.     CALL SetAPen(olewin.jobID,ARG(5)); CALL Draw(olewin.jobID,x2,y2); CALL Draw(olewin.jobID,x1,y2)
  251.  
  252. RETURN
  253.  
  254.  
  255. SetOleInd:
  256.  
  257.     x1 = win.bl + 12; y1 = win.bt + 8; x2 = boxw.jobID - 24; y2 = win.bt + oleind.hei - 8
  258.     CALL SetAPen(olewin.jobID,0); CALL RectFill(olewin.jobID,x1,y1,x1 + x2,y2)
  259.     CALL SetAPen(olewin.jobID,oleind.color); CALL RectFill(olewin.jobID,x1,y1,x1 + ARG(1) * x2 % 100,y2)
  260.  
  261. RETURN ARG(1)
  262.  
  263.  
  264. ReadLocale: PROCEDURE EXPOSE module. locale.
  265. ARG jobID,modID
  266.  
  267.     locale = module.jobID.modID || '.catalog'
  268.     locale.jobID.modID = locale || '_' || jobID
  269.  
  270.     clip = ''
  271.     IF OPEN(loc,locale.path || 'english/' || locale,'R') THEN DO
  272.         clip = READCH(loc,20000)
  273.         CALL CLOSE(loc)
  274.         END
  275.  
  276.     IF GETENV('language') ~= 'english' THEN
  277.         IF OPEN(loc,locale.path || GETENV('language') || '/' || locale,'R') THEN DO
  278.             clip = READCH(loc,20000) || clip
  279.             CALL CLOSE(loc)
  280.             END
  281.  
  282.     CALL SETCLIP(locale.jobID.modID,clip)
  283.  
  284. RETURN
  285.  
  286.  
  287. ReadConfig: PROCEDURE EXPOSE module. config.
  288. ARG jobID,modID
  289.  
  290.     config = module.jobID.modID || '.prefs'
  291.     config.jobID.modID = config || '_' || jobID
  292.  
  293.     IF OPEN(cfg,config.path || config,'R') THEN DO
  294.         CALL SETCLIP(config.jobID.modID,READLN(cfg))
  295.         CALL CLOSE(cfg)
  296.         END
  297.  
  298. RETURN
  299.  
  300.  
  301. WriteConfig: PROCEDURE EXPOSE module. config. locale.
  302. ARG jobID,modID
  303.  
  304.     IF ~SHOW('C',config.jobID.modID) THEN RETURN
  305.  
  306.     config = module.jobID.modID || '.prefs'
  307.     IF OPEN(cfg,config.path || config,'W') THEN DO
  308.         CALL WRITELN(cfg,GETCLIP(config.jobID.modID))
  309.         CALL CLOSE(cfg)
  310.         END
  311.  
  312.     ELSE CALL RTezRequest(GetLocale(0,1,'ERR_4',config),GetLocale(0,1,'OK4'),tit_TAG)
  313.  
  314. RETURN
  315.  
  316.  
  317. FreeJob:
  318. ARG jobID
  319.  
  320.     IF SHOW('P',olewin.jobID) THEN CALL Quit(olewin.jobID)
  321.  
  322.     DO i = 1 TO module.jobID.0
  323.         IF SHOW('P',oleport.jobID.i) THEN INTERPRET 'ADDRESS' oleport.jobID.i 'QUIT'
  324.  
  325.         CALL SETCLIP(locale.jobID.i,''); CALL SETCLIP(config.jobID.i,'')
  326.     END
  327.  
  328.     module.jobID.0 = ''
  329.     CALL SETCLIP(oleclip.jobID,'')
  330.  
  331. RETURN
  332.  
  333.  
  334. IniModule:
  335. ARG jobID,modID
  336.  
  337.     IF module.jobID.modID = '' THEN DO
  338.         CALL FreeJob(jobID)
  339.         RETURN
  340.         END
  341.  
  342.     IF SHOW('P',oleport.jobID.modID) THEN RETURN
  343.  
  344.     CALL ReadLocale(jobID,modID)
  345.     CALL ReadConfig(jobID,modID)
  346.  
  347.     clip = jobID modID ,
  348.            win.bl win.bt win.fontw win.fonth ,
  349.            olewin.jobID oleport.0.1 oleport.jobID.modID ,
  350.            userscreen.jobID userport.jobID olepipe.jobID ,
  351.            locale.jobID.modID config.jobID.modID status.jobID.modID
  352.  
  353.     CALL RunModule(module.path || module.jobID.modID,oleclip.jobID,clip)
  354.  
  355. RETURN
  356.  
  357.  
  358. RunModule:
  359.  
  360.     CALL SETCLIP(ARG(2),ARG(3))
  361.     ADDRESS COMMAND 'Run >NIL: Rx "CALL' "'" || ARG(1) || "'" || '(' || ARG(2) || ')"'
  362.  
  363. RETURN
  364.  
  365.  
  366. NewWindow:
  367. ARG jobID,modID
  368.  
  369.     IF ~SHOW('P',olewin.jobID) THEN DO
  370.         CALL RunModule('New_Host.rexx',oleclip.jobID,olewin.jobID','oleport.0.1','userscreen.jobID',')
  371.         IF ~WaitForPort(olewin.jobID) THEN DO
  372.             CALL RTezRequest(GetLocale(0,1,'ERR_2',olewin.jobID),GetLocale(0,1,'OK2'),tit_TAG)
  373.             RETURN 0
  374.             END
  375.  
  376.             CALL SetReqColor(olewin.jobID,"BLOCKPEN",2)
  377.             CALL SetReqColor(olewin.jobID,"DETAILPEN",1)
  378.         END
  379.  
  380.     ELSE CALL CloseWindow(olewin.jobID,"CONTINUE")
  381.  
  382.     CALL OpenWindow(olewin.jobID,winl.jobID,wint.jobID,winw.jobID,winh.jobID,idcmp.jobID.modID,flags.jobID.modID,ARG(3))
  383.     CALL SetFont(olewin.jobID,win.font,win.fonth)
  384.     CALL SetDrMd(olewin.jobID,'JAM1')
  385.     CALL AddMenu(olewin.jobID,ARG(3))
  386.  
  387.     olewin.jobID.0 = modID
  388.     IF jobID = 0 THEN DO
  389.         CALL AddItem(olewin.jobID,GetLocale(0,1,1),'')
  390.         CALL AddSubItem(olewin.jobID,GetLocale(0,1,2),'ABOUT' 0 1 'OLE','o')
  391.         CALL AddSubItem(olewin.jobID,GetLocale(0,1,4),'ABOUT' 0 1 'ABOUT','a')
  392.         CALL AddItem(olewin.jobID,GetLocale(0,1,11),'NEWPREFS','n')
  393.         CALL AddItem(olewin.jobID,GetLocale(0,1,12),'NEWJOB %1' || userport.0 || '%2' || userscreen.0 || '%3Config.ole%4CatCompiler.ole','c')
  394.         CALL AddItem(olewin.jobID,GetLocale(0,1,7),'QUIT','q')
  395.         END
  396.  
  397.     ELSE DO
  398.         CALL SetNotify(olewin.jobID,"CLOSEWINDOW",oleport.0.1)
  399.         CALL ModifyHost(olewin.jobID,"CLOSEWINDOW",'SETJOB' jobID 'end')
  400.         CALL SetNotify(olewin.jobID,"GADGETUP",oleport.jobID.modID)
  401.         CALL SetNotify(olewin.jobID,"MENUPICK",'REXX')
  402.         cmd = "CALL AddItem(" || olewin.jobID || ",'" || GetLocale(0,1,3) || "'," || '2227'x || ADDRESS oleport.0.1 'ABOUT' jobID modID 'ABOUT' || '2722'x || ")"
  403.         cmd = cmd "; CALL AddItem(" || olewin.jobID || ",'" || GetLocale(0,1,5) || "'," || '2227'x || ADDRESS oleport.0.1 'CONFIG' jobID modID || '2722'x || ",'s')"
  404.         cmd = cmd "; CALL AddItem(" || olewin.jobID || ",'" || GetLocale(0,1,6) || "'," || '2227'x || ADDRESS oleport.0.1 'ICONIFY' jobID modID '%f %e' || '2722'x || ",'i')"
  405.         cmd = cmd "; CALL AddItem(" || olewin.jobID || ",'" || GetLocale(0,1,7) || "'," || '2227'x || ADDRESS oleport.jobID.modID 'QUIT' || '2722'x || ",'q')"
  406.         INTERPRET cmd
  407.         CALL ScreenToFront(userscreen.jobID)
  408.         END
  409.  
  410. RETURN 1
  411.  
  412.  
  413. IniLibs: PROCEDURE
  414.  
  415.     pri.1 = 5; lib.1 = 'rexxarplib.library'
  416.     pri.2 = 0; lib.2 = 'rexxreqtools.library'
  417.     pri.3 = 0; lib.3 = 'rexxsupport.library'
  418.  
  419.     DO i = 1 TO 3
  420.         IF (ADDLIB(lib.i,pri.i,-30,0) | SHOW('L',lib.i)) = 0 THEN EXIT 20
  421.     END
  422.  
  423. RETURN
  424.  
  425.  
  426. /*
  427.  *    TODO: all win.bx may be the same for all public screens, check this...
  428.  */
  429. GetServerConfig:
  430.  
  431.     IF ~SHOW('C',config.0.1) THEN DO
  432.         win.bl = 3; win.bt = 15; win.br = 4; win.bb = 2
  433.         win.font = 'topaz.font'; win.fonth = 8; win.fontw = 8
  434.         oleind.outer = 0; oleind.inner = 0; oleind.color = 4
  435.         END
  436.  
  437.     ELSE PARSE VALUE GETCLIP(config.0.1) WITH win.bl','win.bt','win.br','win.bb','win.font','win.fonth','win.fontw','oleind.outer','oleind.inner','oleind.color','
  438.  
  439.     delaytime = 2    /* secs */
  440.  
  441. RETURN
  442.  
  443.  
  444. WaitForPort: PROCEDURE
  445.  
  446.     DO iter = 1 TO 5
  447.  
  448.         ADDRESS COMMAND "WaitForPort" ARG(1)
  449.         IF SHOW('P',ARG(1)) THEN RETURN 1
  450.     END
  451.  
  452. RETURN 0
  453.