home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / CLIPPER / MISC / BIPL.ZIP / PROCS.ZIP / REXX.ICN < prev    next >
Encoding:
Text File  |  1992-11-20  |  4.6 KB  |  126 lines
  1. ############################################################################
  2. #
  3. #    File:     rexx.icn
  4. #
  5. #    Subject:  Procedures to communicate between Icon and Rexx
  6. #
  7. #    Author:   Alan Beale
  8. #
  9. #    Date:     April 8, 1990
  10. #
  11. ###########################################################################
  12. #
  13. #  This package can also be used on MVS to communicate with the TSO CLIST
  14. #  languages, but some messages may not be appropriate.  The functions
  15. #  rexxvar, rexxset, rexxdrop and rexxnext must be installed in the extcall
  16. #  module of iconx for these procedures to do anything useful.
  17. #
  18. #     These procedures provide an interface between Icon and Rexx:
  19. #
  20. #     RexxActive()    fails if no Rexx (or EXEC2) EXEC is active, else
  21. #                     returns &null.
  22. #
  23. #     RexxVar(var)    returns the value of a Rexx variable, or fails if
  24. #                     the variable is not defined.  Any other errors
  25. #                     detected by the Rexx interface cause run-time
  26. #                     error 500, and print an error message if errors
  27. #                     are not trapped.  If errors are not trapped, the
  28. #                     message is in &errorvalue.
  29. #
  30. #     RexxSet(var, val) stores a new value in a Rexx variable (or
  31. #                     creates the variable if it does not exist).
  32. #                     Returns &null if successful.  Errors are handled
  33. #                     as by RexxVar.
  34. #
  35. #     RexxDrop(var)   drop a Rexx variable.  Returns &null if
  36. #                     successful.  If the variable does not exist,
  37. #                     no action is taken, and &null is returned.
  38. #                     Errors are handled as by RexxVar.
  39. #
  40. #     RexxAll()       returns a Rexx table whose keys are all the
  41. #                     currently defined Rexx variables, and whose
  42. #                     elements are their values.  Errors are handled
  43. #                     as by RexxVar.
  44. #
  45. ############################################################################
  46. #
  47. #  Requires:  CMS or MVT
  48. #
  49. ############################################################################
  50.  
  51. procedure RexxActive()     # return whether an EXEC is active
  52.    if callout("rexxvar", "a") == "Rexx error: No EXEC is active" then
  53.       fail
  54.    else return &null
  55. #
  56. #   Ask for the value of any old variable.  Unless it fails because
  57. #   Rexx is not active, Rexx is up.
  58. #
  59. end
  60.  
  61. procedure RexxVar(var)     # return the value of a Rexx variable
  62.    local result
  63.  
  64.    if not (result := callout("rexxvar", var)) then fail
  65.    if result[1] == "=" then return result[2:0]
  66. #
  67. #   Note: ispcopy returns either "=value", if the variable was found,
  68. #         or "msg" if a Rexx error occurred other than "variable not
  69. #         defined" (which is a failure condition).
  70. #
  71.    if result[1+:4] ~== "Rexx" then result := "Rexx error: "||result
  72.    if &error = 0 then write(&errout, result)
  73.    runerr(500, result)
  74. end
  75.  
  76. procedure RexxSet(var,value)   # assign to a Rexx variable
  77.    local result
  78.  
  79.    result := callout("rexxset", var, value)
  80.    if type(result) == "string" then {
  81.       if result[1+:4] ~== "Rexx" then result := "Rexx error: "||result
  82.       if &error = 0 then write(&errout, result)
  83.       runerr(500, result)
  84.    }
  85.    else return result
  86. end
  87.  
  88. procedure RexxDrop(var,value)  # drop a Rexx variable
  89.    local result
  90.  
  91.    result := callout("rexxdrop", var, value)
  92.    if type(result) == "string" then {
  93.       if result[1+:4] ~== "Rexx" then result := "Rexx error: "||result
  94.       if &error = 0 then write(&errout, result)
  95.       runerr(500, result)
  96.    }
  97.    else return result
  98. end
  99.  
  100. procedure RexxAll()           # return a table of all Rexx variables
  101.    local result, allofthem, nextvar
  102. #
  103. # Note:  You might suppose that RexxAll would be better designed as a
  104. #        generator, rather than returning a table.  Unfortunately,
  105. #        the Rexx interfaces used provide a snapshot of a moment in
  106. #        time, and do not restart "correctly" after some other Rexx
  107. #        interface is used.  If RexxAll were a generator, it could be
  108. #        suspended indefinitely in a co-expression, and reasonable
  109. #        behavior could hardly be expected, if other parts of the
  110. #        program did anything at all with Rexx.
  111. #
  112.    allofthem := table()
  113.    while nextvar := callout("rexxnext") do {
  114.       if nextvar[1] ~== "=" then {
  115.          if nextvar[1+:4] ~== "Rexx" then
  116.             result := "Rexx error: "||nextvar
  117.          if &error = 0 then write(&errout, result)
  118.          runerr(500, result)
  119.          fail
  120.       }
  121.       nextvar := nextvar[2:0]
  122.       allofthem[nextvar] := RexxVar(nextvar)
  123.    }
  124.    return allofthem
  125. end
  126.