home *** CD-ROM | disk | FTP | other *** search
/ The Ultimedia Application / IBM_UCD_101.ISO / os2se20 / disk_6 / rexx / OS2_REXXTRY.CMD next >
Encoding:
Text File  |  1992-07-15  |  10.2 KB  |  188 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.   This procedure lets you interactively try REXX statements.
  6.     If you run it with no parameter, or with a question mark
  7.     as a parameter, it will briefly describe itself.
  8.   You may also enter a REXX statement directly on the command line
  9.     for immediate execution and exit.  Example:  rexxtry call show
  10.  
  11.   Enter 'call show' to see user variables provided by REXXTRY.
  12.   Enter '=' to repeat your previous statement.
  13.   Enter '?' to invoke system-provided online help for REXX.
  14.   The subroutine named 'sub' can be CALLed or invoked as 'sub()'.
  15.   REXXTRY can be run recursively with CALL.
  16.  
  17.   Except for the signal instructions after a syntax error, this
  18.     procedure is an example of structured programming.
  19.   The 'clear' routine illustrates system-specific SAA-portable coding.
  20. */
  21.   parse arg argrx                      /* Get user's arg string.    */
  22.   call house                           /* Go do some housekeeping.  */
  23.   select                               /* 3 modes of operation...   */
  24.     when argrx = '?' then call tell    /*   1.  Tell user how.      */
  25.     when argrx = ''  then do           /*   2.  Interactive mode.   */
  26.       call intro ; call main ; end
  27.     otherwise push argrx ; call main   /*   3.  One-liner and exit. */
  28.   end
  29. done:  exit                            /* The only exit.            */
  30.  
  31. house:                                 /* Housekeeping.             */
  32.   parse version version                /* Fill-in 2 user variables. */
  33.   parse source source                  /*                           */
  34.   parse source sysrx . procrx .        /* Get system & proc names.  */
  35.   remindrx = "Enter 'exit' to end."    /* How to escape rexxtry.    */
  36.   helprx=''                            /* Null if not CMS or OS/2.  */
  37.   if sysrx = 'CMS' | sysrx = 'OS/2'    /*   Extra reminder for CMS  */
  38.     then helprx = '   ',               /*     or OS/2.              */
  39.     "  Or '?' for online REXX help."   /*   Not used in intro.      */
  40.   promptrx=''                          /* Null if not one-liner.    */
  41.   if argrx<>'' then promptrx=procrx' ' /*   Name part of user line. */
  42.   if sysrx = 'OS/2' then do            /* OS/2-specific...          */
  43.     posrx = lastpos('\',procrx)        /*   Find name separator.    */
  44.     procrx = substr(procrx,posrx+1)    /*   Pick up the proc name.  */
  45.     end
  46.   temprx = ' 'procrx' on 'sysrx        /* Make border...            */
  47.     posrx = 69-length(temprx)          /*   where to overlay name,  */
  48.     bordrx = copies('.',68)            /*   background of periods,  */
  49.     bordrx =,                          /*   name right-adjusted.    */
  50.       overlay(temprx,bordrx,posrx)
  51.   save = ''                            /* Don't save user input.    */
  52.   trace = 'Off'                        /* Init user trace variable. */
  53.   return result                        /* Preserve result contents. */
  54.  
  55. tell:  call clear ; do irx = 1 to 20   /* Tell about rexxtry by     */
  56.   say sourceline(irx) ; end            /*   displaying the prolog.  */
  57.   return result                        /* Preserve result contents. */
  58.  
  59. clear:  select                         /* SAA-portable code.        */
  60.   when sysrx = 'CMS'  then 'VMFCLEAR'  /* No such command on        */
  61.   when sysrx = 'OS/2' then 'CLS'       /*   OS/400 or TSO.          */
  62.   otherwise nop ; end ; say
  63.   return result                        /* Preserve result contents. */
  64.  
  65. intro:                                 /* Display brief             */
  66.   say '  'procrx' lets you',           /*   introductory            */
  67.     'interactively try REXX',          /*   remarks for             */
  68.     'statements.'                      /*   interactive mode.       */
  69.   say '    Each string is executed',
  70.     'when you hit Enter.'
  71.   say "      Enter 'call tell' for",   /* How to see description.   */
  72.     "a description of the features."
  73.   say '  Go on - try a few...   ',
  74.     '         'remindrx
  75.   return result                        /* Preserve result contents. */
  76.  
  77. sub:  say '  ...test subroutine',      /* User can CALL this        */
  78.   "'sub'  ...returning 1234..."        /*   subroutine or           */
  79.   return 1234                          /*   invoke with 'sub()'.    */
  80.  
  81. main:  signal on syntax                /* Enable syntax trap.       */
  82.   do foreverrx = 1                     /* Loop forever.             */
  83.     prev = inputrx                     /* User can repeat previous. */
  84.     parse pull inputrx                 /* Input keyboard or queue.  */
  85.     current = inputrx                  /* Current line for 'show'.  */
  86.     if save <> '' then call save       /* Save before interpreting. */
  87.     if inputrx = '=' then inputrx=prev /* '=' means repeat previous */
  88.     select
  89.       when inputrx = '' then say ' ',  /* If null line, remind      */
  90.         procrx':  'remindrx helprx     /*   user how to escape.     */
  91.       when inputrx='?' then call help  /* Request for online help.  */
  92.       otherwise
  93.         rc = 'X'                       /* Make rc change visible.   */
  94.         call set2 ; trace (trace)      /* Need these on same line.  */
  95.         interpret inputrx              /* Try the user's input.     */
  96.         trace 'Off'                    /* Don't trace rexxtry.      */
  97.         call border                    /* Go write the border.      */
  98.     end
  99.     if argrx <> '' & queued() = 0      /* For one-liner, loop until */
  100.       then leave                       /*   queue is empty.         */
  101.   end ; return result                  /* Preserve result contents. */
  102.  
  103. set1:  siglrx1 = sigl                  /* Save pointer to lineout.  */
  104.   return result                        /* Preserve result contents. */
  105.  
  106. set2:  siglrx2 = sigl                  /* Save pointer to trace.    */
  107.   return result                        /* Preserve result contents. */
  108.  
  109. save:                                  /* Save before interpreting. */
  110.   call set1;rcrx=lineout(save,inputrx) /* Need on same line.        */
  111.   if rcrx <> 0 then                    /* Catch non-syntax error    */
  112.     say "  Error on save="save         /*   from lineout.           */
  113.   return result                        /* Preserve result contents. */
  114.  
  115. help:  select                          /* Request for online help.  */
  116.   when sysrx = 'CMS' then              /* Invoke CMS help menu for  */
  117.     address CMS 'HELP REXX MENU'       /*   for REXX.               */
  118.   when sysrx = 'OS/2' then             /* Invoke OS/2 online REXX   */
  119.     'view rexx.inf'                    /*   Reference.              */
  120.   otherwise say '  'sysrx' has',       /* Todate, only CMS and OS/2 */
  121.     'no online help for REXX.'         /*   provide online help     */
  122.     rc = 'Sorry !' ; end               /*   for REXX.               */
  123.   call border ; return result          /* Preserve result contents. */
  124.  
  125. border:  if rc = 'X' then              /* Display border.           */
  126.     say '  'bordrx
  127.   else say ' ',                        /* Show return code if it    */
  128.     overlay('rc = 'rc' ',bordrx)       /*   has changed.            */
  129.   return result                        /* Preserve result contents. */
  130.  
  131. syntax:  trace 'Off'                   /* Stop any tracing.         */
  132.   select
  133.     when sigl = siglrx1 then do        /* User's 'save' value bad.  */
  134.       say "  Invalid 'save' value",
  135.         "'"save"', resetting to ''."
  136.       save='' ; end
  137.     when sigl = siglrx2 then do        /* User's 'trace' value bad. */
  138.       say "  Invalid 'trace' value",
  139.         "'"trace"', resetting to",
  140.         "'Off'." ; trace='Off' ; end
  141.     otherwise                          /* Some other syntax error.  */
  142.          say '  Oooops ! ... try',     /*                           */
  143.       'again.     'errortext(rc)       /* Show the error msg text.  */
  144.       if sysrx='CMS' then call cmstax  /* More syntax stuff for CMS */
  145.   end ; call border                    /* Go write the border.      */
  146.   if argrx <> '' & queued() = 0 then   /* One-liner not finished    */
  147.     signal done                        /*   until queue is empty.   */
  148.   signal main                          /* Resume main loop.         */
  149.  
  150. cmstax:  rcrx = rc                     /* More syntax stuff for CMS */
  151.   if exist('PROMPT MODULE') then       /* User's input to cmd line. */
  152.     'PROMPT' promptrx||'13'x||inputrx  /*   '13'x places cursor.    */
  153.   if exist('REXX EXEC') & argrx=''     /* Not for one-liners.       */
  154.   then do; more='EXEC REXX' rcrx+20000 /* CMS rc is 20,000 higher.  */
  155.     say "  Enter 'more' to see",       /* Prepare 'more' to access  */
  156.       'information about this',        /*  REXX IOSLIB information. */
  157.       'syntax error.' ; end            /* Tell user what to do.     */
  158.   rc = rcrx ; return result            /* Preserve result contents. */
  159.  
  160. exist:  arg inrx ; outrx = 0           /* Assume file is missing.   */
  161.   address command 'ESTATE' inrx        /* Does the file exist ?     */
  162.   if rc = 0 then outrx = 1             /* estate says it exists.    */
  163.   return outrx                         /* 1 makes condition true.   */
  164.  
  165. show:  trace 'Off' ; call clear        /* Display user variables    */
  166.   say '  'procrx' provides',           /*   provided by rexxtry.    */
  167.     'these user variables.'
  168.   say '  The current values are...'    /* Show current values.      */
  169.   say
  170.   say "    'version'   = '"version"'"  /* What level of REXX.       */
  171.   say "    'source'    = '"source"'"   /* What oper system etc.     */
  172.   say "    'result'    = '"result"'"   /* REXX special variable.    */
  173.   say
  174.   say '     Previous line entered by',
  175.     'user.  Initial value=INPUTRX.'
  176.   say "    'prev'      = '"prev"'"     /* Previous user statement.  */
  177.   say "    'current'   = '"current"'"  /* Compare curr with prev.   */
  178.   say
  179.   say '     Save your input with',
  180.     'save=filespec.',
  181.     " Stop saving with save=''."
  182.   say "    'save'      = '"save"'"     /* Filespec for input keep.  */
  183.   say
  184.   say '     Enter trace=i, trace=o',
  185.     ' etc. to control tracing.'
  186.   say "    'trace'     = '"trace"'"    /* Trace user statements.    */
  187.   return result                        /* Preserve result contents. */
  188.