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