home *** CD-ROM | disk | FTP | other *** search
/ The World of Computer Software / World_Of_Computer_Software-02-387-Vol-3of3.iso / e / epmmac2.zip / CALLREXX.E < prev    next >
Text File  |  1992-12-10  |  17KB  |  449 lines
  1. /*
  2.  * Name        CallRexx
  3.  *
  4.  * Author      Ralph E. Yozzo & Larry Margolis
  5.  *
  6.  * Function    Call a Rexx Macro from EPM
  7.  *
  8.  *                The steps that are followed are:
  9.  *
  10.  *                  - We set up the default environment to point to EPM
  11.  *                  - We register our subcommand DLL.
  12.  *                  - We call the EPM-REXX macro.
  13.  */
  14.  
  15. const
  16.    RXCOMMAND       = '0'
  17.    RXSUBROUTINE    = '1'          -- Program called as Subroutine
  18.    RXFUNCTION      = '2'
  19.    RXFUNC_DYNALINK = '1'          -- Function Available in DLL
  20.    RXFUNC_CALLENTRY ='2'          -- Registered as mem entry pt.
  21.  
  22. compile if not defined(ERES_DLL)  -- Being compiled separately?
  23.    include 'STDCONST.E'
  24. compile endif
  25.  
  26. compile if 1 -- EVERSION < 6  -- Rexx stuff temporarily omitted in 32-bit version
  27. defc epmrexx,rx=
  28.    parse value arg(1) with  macro getall
  29.    if macro='' then
  30.       sayerror RX_PROMPT__MSG
  31.       return
  32.    endif
  33.    if not pos('.',substr(macro,lastpos('\',macro)+1)) then
  34.       macro=macro||'.erx'   /* add the default extention */
  35.    endif
  36.               /* Try to register the subcommand interface */
  37.    rc= rexxsubcomregister()
  38.    if rc then
  39.       sayerror RX_SUBCOM_FAIL__MSG rc
  40.       return
  41.    endif
  42.    rc= rexxfunctionregister()
  43.    if rc then
  44.       sayerror RX_FUNC_FAIL__MSG rc
  45.       return
  46.    endif
  47. ;  string=atol(length(getall))||offset(getall)||selector(getall)
  48.    /*
  49.     *    Call the macro named by the macro variable
  50.     *    The default environment is "ERXSUBCOM".
  51.     *    The EPM subcommand DLL is "ERXSBCOM.DLL".
  52.     */
  53. ;  sayerror 'EPM REXX macro "'macro'" running...'
  54.    functionname =macro\0
  55. ;  saveautoshell = .autoshell
  56. ;  .autoshell = 0
  57.  
  58. ; Allocate buffer for string, functionname, envname, rcresult, and resultstring.
  59. ;                                           'ENV'\0   2 bytes       8 bytes
  60. ;  len = length(string) + length(functionname) + length(envname) + 2 + 8
  61. ;  string_ofs = 0
  62.    func_ofs = 8  -- length(string)
  63.    env_ofs = func_ofs + length(functionname)
  64.    rc_ofs = env_ofs + 4
  65. compile if EPM32
  66.    res_ofs = rc_ofs + 4  -- return code is a long
  67. compile else
  68.    res_ofs = rc_ofs + 2  -- return code is a short
  69. compile endif
  70.    parm_ofs = res_ofs + 8
  71.    len = parm_ofs + length(getall)
  72. compile if EPM32  -- mymalloc returns a long; we split off selector.
  73.    bufhndl  = substr(atol(dynalinkc(E_DLL, 'mymalloc', atol(len), 2)), 3, 2)
  74.    bufhndla =  ltoa(bufhndl\0\0, 10)
  75.    r = 0
  76. compile else
  77.    bufhndl = "??"                  -- initialize string pointer
  78.    r =  dynalink('DOSCALLS',           -- dynamic link library name
  79.             '#34',                     -- DosAllocSeg
  80.             atoi(len)              ||  -- Number of Bytes requested
  81.             selector(bufhndl)  ||  -- string selector
  82.             offset(bufhndl)    ||  -- string offset
  83.             atoi(0))                   -- Share information
  84.    bufhndla = itoa(bufhndl,10)
  85. compile endif
  86.  
  87.    if r then sayerror 'Error 'r' allocating memory segment; command halted.'; stop; endif
  88. ;  poke bufhndla, 0, string  -- assume string_ofs = 0
  89.    poke bufhndla, 0, atol(length(getall))||atoi(parm_ofs)||bufhndl
  90.    poke bufhndla, func_ofs, functionname
  91.    poke bufhndla, env_ofs, 'EPM'\0
  92.    poke bufhndla, parm_ofs, getall
  93.  
  94. compile if EPM32
  95.    result=dynalinkc('REXX',                   -- dynamic link library name
  96.                    'RexxStart',                -- Rexx input function
  97.                    atol(1)                || -- Num of args passed to rexx
  98.                    \0\0                   || -- offset of Arglist
  99.                    bufhndl                || -- selector of "
  100.                    atoi(func_ofs)         || -- offset of program name
  101.                    bufhndl                || -- selector of "
  102.                    atol(0)                || -- Loc of rexx proc in memory
  103.                    atoi(env_ofs)          || -- offset of env.
  104.                    bufhndl                || -- sel. ASCIIZ initial environment.
  105.                    atol(RXCOMMAND )       || -- type (command,subrtn,funct)
  106.                    atol(0)                || -- SysExit env. names &  codes
  107.                    atoi(rc_ofs)           || -- offset Ret code from if numeric
  108.                    bufhndl                || -- sel. Ret code from if numeric
  109.                    atoi(res_ofs)          || -- offset Retvalue from the rexx proc
  110.                    bufhndl)                  -- selector of "
  111. compile else
  112.    result=dynalink('REXX',                   -- dynamic link library name
  113.                    'REXXSAA',                -- Rexx input function
  114.                    atoi(1)                || -- Num of args passed to rexx
  115.                    bufhndl                || -- Array of args passed to rex
  116.                    \0\0                   || --
  117.                    bufhndl                || -- [d:][path] filename[.ext]
  118.                    atoi(func_ofs)         || --
  119.                    atol(0)                || -- Loc of rexx proc in memory
  120.                    bufhndl                || -- ASCIIZ initial environment.
  121.                    atoi(env_ofs)          || --
  122.                    atoi(RXCOMMAND )       || -- type (command,subrtn,funct)
  123.                    atol(0)                || -- SysExit env. names &  codes
  124.                    bufhndl                || -- Ret code from if numeric
  125.                    atoi(rc_ofs)           || --
  126.                    bufhndl                || -- Retvalue from the rexx proc
  127.                    atoi(res_ofs) )
  128. compile endif
  129.  
  130. ;  .autoshell = saveautoshell
  131.    rc= rexxsubcomdrop()
  132.       if rc then
  133.          sayerror RX_SUBCOM_FAIL__MSG rc
  134.          return
  135.       endif
  136.    rc = itoa(peek(bufhndla,rc_ofs,2),10)  -- Set universal RC for use by callers.
  137. /* debug info...
  138.    rcresult = peek(bufhndla,rc_ofs,2)
  139.    resultstring = peek(bufhndla,res_ofs,8)
  140.    peekseg=itoa(substr( resultstring ,7 ,2),10)
  141.    peekoff=itoa(substr( resultstring ,5 ,2),10)
  142.    peeklen=ltoa(substr( resultstring ,1 ,4),10)
  143.    sayerror 'Input <'||getall||'>  and the result from REXX is <'|| peek(peekseg,peekoff,peeklen)||'>'
  144. */
  145. compile if EPM32
  146.    call dynalinkc(E_DLL,         -- dynamic link library name
  147.                   'myfree',                   -- DosFreeSeg
  148.                   bufhndl)
  149. compile else
  150.    call dynalink('DOSCALLS',         -- dynamic link library name
  151.             '#39',                   -- DosFreeSeg
  152.             bufhndl)
  153. compile endif
  154.  
  155. /*
  156.  *    Register the EPM subcommand DLL.
  157.  *    Store the EPM window handle in the Rexx subcommand user area.
  158.  */
  159. defproc rexxsubcomregister()
  160. compile if EPM32
  161.    pib = "????????????????????????????"
  162.    tid = "????????????????????????"
  163.  
  164.    call dynalinkc('DOSCALLS',      /* dynamic link library name       */
  165.                  '#312',           /* ordinal value for DOS32GETINFOBLOCKS */
  166.                  offset(tid)   ||
  167.                  selector(tid) ||
  168.                  offset(pib)   ||
  169.                  selector(pib), 2)
  170.  
  171.     pid = substr(pib , 1, 4)
  172.  
  173. compile else
  174.    string='LarryM'
  175.    call dynalink('DOSCALLS',      /* dynamic link library name       */
  176.                  '#94',           /* ordinal value for DOSGETPID     */
  177.                  selector(string)||offset(string) )    /* stack string                    */
  178.    pid=itoa(string,10)
  179. compile endif
  180.  
  181. compile if EPM32
  182.   SubcomName='EPM'\0
  183.   SubcomDLL =ERES_DLL\0
  184.   SubcomProc='ERESREXX'\0
  185.   UserArea  =atol(getpminfo(EPMINFO_EDITCLIENT))||atol(pid)
  186.  
  187.   result=dynalinkc('REXXAPI',
  188.                    'RexxRegisterSubcomDll',
  189.                    offset(SubcomName)   ||
  190.                    selector(SubcomName) ||
  191.                    offset(SubcomDLL)    ||
  192.                    selector(SubcomDll)  ||
  193.                    offset(SubcomProc)   ||
  194.                    selector(SubcomProc) ||
  195.                    offset(UserArea)     ||
  196.                    selector(UserArea)   ||
  197.                    atol(0))
  198.  
  199.    if result then
  200.       result=dynalinkc('REXXAPI',
  201.                        'RexxDeregisterSubcom',
  202.                         offset(SubcomName)   ||
  203.                         selector(SubcomName) ||
  204.                         offset(SubcomDLL)    ||
  205.                         selector(SubcomDll) )
  206.       if result then
  207.          return result
  208.       endif
  209.  
  210.       result=dynalinkc('REXXAPI',
  211.                        'RexxRegisterSubcomDll',
  212.                        offset(SubcomName)   ||
  213.                        selector(SubcomName) ||
  214.                        offset(SubcomDLL)    ||
  215.                        selector(SubcomDll)  ||
  216.                        offset(SubcomProc)   ||
  217.                        selector(SubcomProc) ||
  218.                        offset(UserArea)     ||
  219.                        selector(UserArea)   ||
  220.                        atol(0))
  221.       return result
  222.    endif
  223. compile else
  224.    scbname='EPM'\0
  225.    scbdll_name=ERES_DLL\0
  226.    scbproc_name='ERESREXX'\0
  227.    subcomblock= atol(0)||                           /* pointer to the next block  */
  228.       offset(scbname)||selector(scbname)||          /* subcom environment name    */
  229.       offset(scbdll_name)||selector(scbdll_name)||  /* subcom module name         */
  230.       offset(scbproc_name)||selector(scbproc_name)||/* subcom procedure name      */
  231.       atol(getpminfo(EPMINFO_EDITCLIENT))||atol(pid)||  /* user area                  */
  232.       atol(0)||                                     /* subcom environment address */
  233.       atoi(0)||                                     /* dynalink module handle     */
  234.       atoi(0)||                                     /* Permission to drop         */
  235.       atoi(0)||                                     /* Pid of Registrant          */
  236.       atoi(0)                                       /* Session ID.                */
  237.  
  238.    result=dynalink('REXXAPI',              /* dynamic link library name       */
  239.                    'RXSUBCOMREGISTER',     /* Rexx input function             */
  240.                    selector(subcomblock)||
  241.                    offset(subcomblock))
  242.  
  243.    if result then
  244.       result=dynalink('REXXAPI',         /* dynamic link library name       */
  245.                      'RXSUBCOMDROP',     /* Rexx input function             */
  246.                      selector(scbname)||
  247.                      offset(scbname)||
  248.                      selector(scbdll_name)||
  249.                      offset(scbdll_name))
  250.        if result then
  251.           return result
  252.        endif
  253.        result=dynalink('REXXAPI',         /* dynamic link library name       */
  254.                   'RXSUBCOMREGISTER',     /* Rexx input function             */
  255.                   selector(subcomblock)||
  256.                   offset(subcomblock))
  257.        return result
  258.    endif
  259. compile endif
  260. return 0
  261.  
  262. defproc rexxsubcomdrop()
  263.    scbname='EPM'\0
  264.    scbdll_name=ERES_DLL\0
  265. compile if EPM32
  266.    result=dynalinkc('REXXAPI',
  267.                     'RexxDeregisterSubcom',
  268.                      offset(scbname)     ||
  269.                      selector(scbname)   ||
  270.                      offset(scbdll_name) ||
  271.                      selector(scbdll_name) )
  272. compile else
  273.    scbproc_name='ERESREXX'\0
  274.    result=dynalink('REXXAPI',         /* dynamic link library name       */
  275.                   'RXSUBCOMDROP',     /* Rexx input function             */
  276.                   selector(scbname)||
  277.                   offset(scbname)||
  278.                   selector(scbdll_name)||
  279.                   offset(scbdll_name))
  280. compile endif
  281.    return result
  282.  
  283. /*
  284.  *    Call the PIPEDLL dynamic link library.
  285.  *    This function will start a window and allows
  286.  *    interaction with the standard input and standard output of EPM.
  287.  */
  288. defc rxshell=
  289.    if arg(1)='' then
  290.       string='PMMORE.EXE'\0
  291.    else
  292.       string=arg(1)\0
  293.    endif
  294. compile if EPM32
  295.    result=dynalinkc(ERES_DLL,                  /* dynamic link library name       */
  296.                     'PipeStartExecution',      /* input function                  */
  297.                     offset(string)   ||        /* command to execute              */
  298.                     selector(string) )
  299. compile else
  300.    result=dynalink(ERES_DLL,                  /* dynamic link library name       */
  301.                    'PIPESTARTEXECUTION',      /* input function                  */
  302.                    selector(string) ||        /* command to execute              */
  303.                    offset(string))            /*                                 */
  304. compile endif
  305.  
  306.  
  307. /*
  308.  *    Register the EPM functions.
  309.  */
  310. defproc rexxfunctionregister()
  311.    functionname='all'\0
  312. compile if EPM32
  313.    result=dynalinkc(ERES_DLL,                 /* dynamic link library name  */
  314.                    'EtkRexxFunctionRegister',  /* Rexx input function        */
  315.                    offset(functionname)   ||
  316.                    selector(functionname))
  317. compile else
  318.    result=dynalink(ERES_DLL,                 /* dynamic link library name  */
  319.                    'ETKREXXFUNCTIONREGISTER',  /* Rexx input function        */
  320.                    selector(functionname) ||
  321.                    offset(functionname))
  322. compile endif
  323.    if result then
  324.        call messagenwait(ERES_DLL':ETKREXXFUNCTIONREGISTER: rc='result);
  325.    endif
  326.    return result
  327. compile endif  -- EVERSION < 6
  328.  
  329. defc buildsubmenu
  330.    parse arg menuname submenuid submenutext attrib helppanel e_command
  331.    buildsubmenu menuname, submenuid, submenutext, e_command, attrib, helppanel
  332.  
  333. defc buildmenuitem
  334.    parse arg menuname submenuid menuitemid submenutext attrib helppanel e_command
  335.    buildmenuitem menuname,submenuid,menuitemid,submenutext,e_command,attrib,helppanel
  336.  
  337. defc showmenu
  338.    universal activemenu
  339.    activemenu = arg(1)
  340.    showmenu activemenu
  341.  
  342. defc deletemenu
  343.    parse arg menuname submenuid menuitemid itemonly
  344.    deletemenu menuname, submenuid, menuitemid, itemonly
  345.  
  346. defc showlist
  347.    if arg(1)<>'' then
  348.       return listbox('List',arg(1));
  349.    endif
  350.  
  351. defc sayerror = sayerror arg(1)
  352.  
  353. defc buildaccel
  354.    universal activeaccel
  355.    parse arg table flags key index command
  356.    if table='*' then
  357.       table = activeaccel
  358.    endif
  359.    buildacceltable table, command, flags, key, index
  360.  
  361. defc activateaccel
  362.    universal activeaccel
  363.    parse arg newtable .
  364.    if newtable <> '' then
  365.       activeaccel = newtable
  366.    endif
  367.    activateacceltable activeaccel
  368.  
  369. defc register_mouse
  370.    parse arg which button action shifts command
  371.    call register_mousehandler(which, button action shifts, command)
  372.  
  373. defc display
  374.    display arg(1)
  375.  
  376. defc universal
  377.    universal default_search_options, default_edit_options, default_save_options
  378.    parse arg varname varvalue
  379.    varname = upcase(varname)
  380.    if varname='DEFAULT_SEARCH_OPTIONS' then
  381. ;     if varvalue='' then
  382. ;        sayerror varname '=' default_search_options
  383. ;     else
  384.          default_search_options = varvalue
  385. ;     endif
  386.    elseif varname='DEFAULT_EDIT_OPTIONS' then
  387. ;     if varvalue='' then
  388. ;        sayerror varname '=' default_edit_options
  389. ;     else
  390.          default_edit_options = varvalue
  391. ;     endif
  392.    elseif varname='DEFAULT_SAVE_OPTIONS' then
  393. ;     if varvalue='' then
  394. ;        sayerror varname '=' default_save_options
  395. ;     else
  396.          default_save_options = varvalue
  397. ;     endif
  398.    else
  399.       sayerror -263  -- Invalid argument
  400.    endif
  401.  
  402. defc Insert_attr_val_Pair
  403.    parse arg class attr_val fstline lstline fstcol lstcol fid
  404.    if attr_val='' | (fstline<>'' & lstcol='') then
  405.       sayerror -263  -- Invalid argument
  406.       return
  407.    endif
  408.    mt = marktype()
  409.    if fstline='' then  -- assume mark
  410.       if mt='' then
  411.          sayerror NO_MARK__MSG
  412.          return
  413.       endif
  414.       getmark fstline, lstline, fstcol, lstcol, fid
  415.    else
  416.       mt = 'CHAR'
  417.    endif
  418.    if fid='' then   -- default to current file
  419.       getfileid fid
  420.    endif
  421.    if leftstr(mt,5)='BLOCK' then
  422.       do i = fstline to lstline
  423.          Insert_Attribute_Pair(class, attr_val, i, i, fstcol, lstcol, fid)
  424.       enddo
  425.    else
  426.       if mt='LINE' then
  427.          getline line, lstline, mkfileid
  428.          lstcol=length(line)
  429.       endif
  430.       Insert_Attribute_Pair(class, attr_val, fstline, lstline, fstcol, lstcol, fid)
  431.    endif
  432.  
  433. defc Insert_attribute
  434.    parse arg class attr_val IsPush offst col line fid junk
  435.    if offst='' | junk<>'' then
  436.       sayerror -263  -- Invalid argument
  437.       return
  438.    endif
  439.    if fid='' then   -- default to current file
  440.       getfileid fid
  441.       if line='' then   -- default to current file
  442.          line = .line
  443.          if col='' then   -- default to current file
  444.             col = .col
  445.          endif
  446.       endif
  447.    endif
  448.    insert_attribute class, attr_val, IsPush, offst, col, line, fid
  449.