home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 35 Internet / 35-Internet.zip / dongrovs.zip / rexxtry.cmd < prev    next >
OS/2 REXX Batch file  |  1996-10-16  |  12KB  |  292 lines
  1. /* SAA-portable REXXTRY procedure     11/08/91  version 1.05
  2.   Owned by IBM SAA REXX Development, Endicott, New York.
  3.     Loosely derived from an ancient formulation of Mike Cowlishaw.
  4.  
  5.   Modified by Don E. Groves, Jr.
  6.  
  7.   This procedure lets you interactively try REXX statements.
  8.     If you run it with no parameter, or with a question mark
  9.     as a parameter, it will briefly describe itself.
  10.   You may also enter a REXX statement directly on the command line
  11.     for immediate execution and exit.  Example:  rexxtry call show
  12.  
  13.   Enter 'call show' to see user variables provided by REXXTRY.
  14.   Enter '=' to Display History List of commands entered.
  15.   Enter 'call clearhistory' to clear the history list.
  16.     The REXXTRY .Cmdline object is called 'rexxhistrx'.
  17.   Enter 'call Savehistory' to Save the history list to a file.
  18.   Enter 'call Loadhistory' to Load a file into the history list.
  19.   Enter '?' to invoke system-provided online help for REXX.
  20.   The subroutine named 'sub' can be CALLed or invoked as 'sub()'.
  21.   REXXTRY can be run recursively with CALL.
  22.  
  23.   Except for the signal instructions after a syntax error, this
  24.     procedure is an example of structured programming.
  25.   The 'clear' routine illustrates system-specific SAA-portable coding.
  26. */
  27.   exposelist='exposelist RC result save trace rexxhistrx sysrx procrx promptrx bordrx siglrx1 siglrx2 argrx prev current REMINDRX'
  28.   parse arg argrx                      /* Get user's arg string.    */
  29.   call house                           /* Go do some housekeeping.  */
  30.   select                               /* 3 modes of operation...   */
  31.    when argrx = '?'
  32.     then call tell    /*   1.  Tell user how.      */
  33.    when argrx = ''
  34.     then do           /*   2.  Interactive mode.   */
  35.       call intro ;
  36.       call main ;
  37.      end
  38.     otherwise
  39.      push argrx ;
  40.      call main   /*   3.  One-liner and exit. */
  41.   end
  42. done:
  43.   exit                            /* The only exit. */
  44.  
  45. house: procedure expose (exposelist)        /* Housekeeping. */
  46.   rexxhistrx = .Cmdline~new(3)
  47.   parse source sysrx . procrx .        /* Get system & proc names.  */
  48.   remindrx = "Enter 'exit' to end."    /* How to escape rexxtry.    */
  49.   helprx=''                            /* Null if not CMS or OS/2.  */
  50.   if sysrx = 'CMS' | sysrx = 'OS/2'    /*   Extra reminder for CMS or OS/2 */
  51.   then helprx = "     Or '?' for online REXX help."   /*   Not used in intro.      */
  52.   promptrx=''                          /* Null if not one-liner.    */
  53.   if argrx<>''
  54.   then promptrx=procrx || ' '    /*   Name part of user line. */
  55.   if sysrx = 'OS/2'
  56.   then do            /* OS/2-specific...          */
  57.     posrx = lastpos('\',procrx)        /*   Find name separator.    */
  58.     procrx = substr(procrx,posrx+1)    /*   Pick up the proc name.  */
  59.   end
  60.   temprx = ' ' || procrx || ' on ' || sysrx     /* Make border...  */
  61.   posrx = 69-length(temprx)          /*   where to overlay name,  */
  62.   bordrx = copies('.',68)            /*   background of periods,  */
  63.   bordrx = overlay(temprx,bordrx,posrx)      /*   name right-adjusted.    */
  64.   save = ''                            /* Don't save user input.    */
  65.   trace = 'Off'                        /* Init user trace variable. */
  66. return result                        /* Preserve result contents. */
  67.  
  68. tell: procedure expose (exposelist)
  69.   call clear ;
  70.   do irx = 1 until sourceline(irx)~left(1) = '*'  /* Tell about rexxtry by */
  71.     say sourceline(irx) ;                         /* displaying the prolog. */
  72.   end
  73. return result               /* Preserve result contents. */
  74.  
  75. clear: procedure expose (exposelist)
  76.   select
  77.    when sysrx = 'OS/2'
  78.     then 'CLS'              /*   OS/400 or TSO.          */
  79.    otherwise
  80.     nop ;
  81.   end ;
  82.   say
  83. return result                        /* Preserve result contents. */
  84.  
  85. intro:   /* Display briefintrodory remarks for interactive mode. */
  86.   procedure expose (exposelist)
  87.   say '  ' || procrx || ' lets you interactively try REXX statements.'
  88.   say '    Each string is executed when you hit Enter.'
  89.           /* How to see description.   */
  90.   say "      Enter 'call tell' for a description of the features."
  91.   say '  Go on - try a few...             ' || remindrx
  92. return result                        /* Preserve result contents. */
  93.  
  94. sub:  /* User can CALL this  subroutine or invoke with 'sub()'.  */
  95.   say "  ...test subroutine 'sub'  ...returning 1234..."
  96. return 1234
  97.  
  98. clearhistory:  procedure expose (exposelist)
  99.   rexxhistrx~ClearHistory
  100. return result
  101.  
  102. SaveHistory: procedure expose (exposelist)
  103.   use arg name, mode
  104.   work= 'Rexx.History'
  105.   if ARG(1,'E')
  106.   then work= name~request('string')
  107.   if .nil = work
  108.   then say 'ERROR:: First Argument isnot a .String, objectname=' ARG(1)~ObjectName
  109.   else do
  110.     wmode = 'WRITE'
  111.     if ARG(2,'E')
  112.     then do
  113.       if .nil = mode~request('string')
  114.       then do
  115.         say 'ERROR:: Second Argument isnot a .String, objectname=' mode~ObjectName
  116.         return result
  117.       end
  118.       else do
  119.         if mode~makestring~translate~left(1) = 'R'
  120.         then wmode= wmode~' '('REPLACE')
  121.       END
  122.     END
  123.     work= .Stream~new(work)
  124.     if work~OPEN(wmode)~left(5) = 'READY'
  125.     then do
  126.       su=rexxhistrx~supplier;
  127.       do while su~available;
  128.         work~lineout(su~item);
  129.         su~next;
  130.       end;
  131.     end
  132.     else say work~string || ' reported "' || work~state || '"'
  133.     drop su
  134.     work~close
  135.   end
  136. return result
  137.  
  138. LoadHistory: procedure expose (exposelist)
  139.   name= 'Rexx.History'
  140.   if ARG(1,'E')
  141.   then name= ARG(1)~request('string')
  142.   if .nil = name
  143.   then say 'ERROR:: First Argument isnot a .String, objectname=' ARG(1)~ObjectName
  144.   else do
  145.     work= .Stream~new(name)
  146.     if work~OPEN('READ')~left(5) = 'READY'
  147.     then rexxhistrx~HistoryAdd(work~makearray)
  148.     else say work~string || ' reported "' || work~state || '"'
  149.     work~close
  150.   end
  151. return result
  152.  
  153. main: /* procedure expose (exposelist)  */
  154.   /* signal on Failure name hsyntax */     /* Enable syntax trap.       */
  155.   signal on syntax name hsyntax                     /* Enable syntax trap.       */
  156.   do foreverrx = 1                     /* Loop forever.             */
  157.     prev = inputrx                     /* User can repeat previous. */
  158.     if argrx <> ''
  159.     then parse pull inputrx                 /* Input keyboard or queue.  */
  160.     else inputrx= rexxhistrx~cmdline
  161.     current = inputrx                  /* Current line for 'show'.  */
  162.     if save <> ''
  163.     then call save inputrx    /* Save before interpreting. */
  164.     if argrx <> '' & inputrx = '='
  165.     then inputrx=prev /* '=' means repeat previous */
  166.       rc = 'X'                       /* Make rc change visible.   */
  167.     select
  168.      when inputrx = '='   /* change = to list history */
  169.       then do
  170.         inputrx= rexxhistrx~supplier  /* get a supplier of the history list */
  171.         do while inputrx~available
  172.           say ' '~''(inputrx~item)
  173.           inputrx~next
  174.         end
  175.         inputrx = '='
  176.       end
  177.      when inputrx = ''    /* If null line, remind      */
  178.       then say ' ' procrx':  ' remindrx helprx     /*   user how to escape.     */
  179.      when inputrx='?'
  180.       then call help  /* Request for online help.  */
  181.      otherwise
  182.       call set2 ; trace (trace)      /* Need these on same line.  */
  183.       interpret inputrx              /* Try the user's input.     */
  184.       trace 'Off'                    /* Don't trace rexxtry.      */
  185.     end
  186.     call border                    /* Go write the border.      */
  187.     if argrx <> '' & queued() = 0  /* For one-liner, loop until */
  188.     then leave                     /*   queue is empty.         */
  189.   end ;
  190. return result                      /* Preserve result contents. */
  191.  
  192. set1:  siglrx1 = sigl              /* Save pointer to lineout.  */
  193. return result                      /* Preserve result contents. */
  194.  
  195. set2:  siglrx2 = sigl              /* Save pointer to trace.    */
  196. return result                      /* Preserve result contents. */
  197.  
  198. save: procedure expose (exposelist)     /* Save before interpreting. */
  199.   USE ARG inputrx
  200.   call set1;rcrx=lineout(save,inputrx)  /* Need on same line.        */
  201.   if rcrx <> 0                          /* Catch non-syntax error    */
  202.   then  say "  Error on save=" || save  /*   from lineout.           */
  203. return result                           /* Preserve result contents. */
  204.  
  205. help: procedure expose (exposelist)
  206.   select                          /* Request for online help.  */
  207.    when sysrx = 'OS/2'             /* Invoke OS/2 online REXX reference. */
  208.     then do
  209.       rc= sysOpenObject("<ORX_INFO>","DEFAULT",1)
  210.       if rc
  211.       then rc= sysOpenObject("<ORX_INFO>","DEFAULT",1)
  212.       else address cmd 'view rexx.inf'
  213.     end
  214.    otherwise                         /* Todate, only CMS and OS/2 */
  215.     do
  216.       say '  'sysrx' has no online help for REXX.'  /*   provide online help  */
  217.       rc = 'Sorry !' ;
  218.     end
  219.   end                         /*   for REXX.               */
  220.   /* call border ; */
  221. return result          /* Preserve result contents. */
  222.  
  223. border: procedure expose (exposelist)      /* Display border.           */
  224.   if rc = 'X'
  225.   then say '  'bordrx
  226.   else say '  ' || overlay('rc = 'rc' ',bordrx)
  227.      /* Show return code if it  has changed.            */
  228. return result                        /* Preserve result contents. */
  229.  
  230. hsyntax:  trace 'Off'                   /* Stop any tracing.         */
  231.   /* procedure expose (exposelist) */
  232.   select
  233.    when sigl = siglrx1
  234.     then do        /* User's 'save' value bad.  */
  235.       say "  Invalid 'save' value'" || save || "', resetting to ''."
  236.       save='' ;
  237.     end
  238.    when sigl = siglrx2
  239.     then do        /* User's 'trace' value bad. */
  240.       say "  Invalid 'trace' value'"trace"', resetting to 'Off'." ;
  241.       trace='Off' ;
  242.     end
  243.    otherwise                          /* Some other syntax error.  */
  244.     do                                /* Show the error msg text.  */
  245.       say '  Oooops ! ... try again. ' || errortext(rc)
  246.                                        /* get the secondary message */ 
  247.       secondary = condition('o')~message 
  248.       if .nil <> secondary then        /* get a real one?           */
  249.                                        /* display it also           */ 
  250.         say '            ' || secondary
  251.     end
  252.   end ;
  253.   call border                    /* Go write the border.      */
  254.   if argrx <> '' & queued() = 0  /* One-liner not finished    */
  255.   then signal done               /*   until queue is empty.   */
  256. signal main                   /* Resume main loop.         */
  257.  
  258. exist: procedure expose (exposelist)
  259.   use arg inrx ;
  260.   outrx = 0           /* Assume file is missing.   */
  261.   address command 'ESTATE' inrx        /* Does the file exist ?     */
  262.   if rc = 0
  263.   then outrx = 1             /* estate says it exists.    */
  264. return outrx                         /* 1 makes condition true.   */
  265.  
  266. show: procedure expose (exposelist)
  267.   trace 'Off' ;
  268.   call clear        /* Display user variables provided by rexxtry.    */
  269.   parse version version                /* Fill-in 2 user variables. */
  270.   parse source source                  /*                           */
  271.   say '  'procrx' provides these user variables.'
  272.   say '  The current values are...'    /* Show current values.      */
  273.   say
  274.   say "    'version'   = '"version"'"  /* What level of REXX.       */
  275.   say "    'source'    = '"source"'"   /* What oper system etc.     */
  276.   say "    'result'    = '"result"'"   /* REXX special variable.    */
  277.   say
  278.   say '     Previous line entered by user.  Initial value=INPUTRX.'
  279.   say "    'prev'      = '"prev"'"     /* Previous user statement.  */
  280.   say "    'current'   = '"current"'"  /* Compare curr with prev.   */
  281.   say
  282.   say "     Save your input with save=filespec. Stop saving with save=''."
  283.   say "    'save'      = '"save"'"     /* Filespec for input keep.  */
  284.   say
  285.   say '     Enter trace=i, trace=o  etc. to control tracing.'
  286.   say "    'trace'     = '"trace"'"    /* Trace user statements.    */
  287. return result                        /* Preserve result contents. */
  288.  
  289. ::requires RexxUtil_Req
  290. ::requires cmdline
  291.  
  292.