#!/usr/bin/rexx
/* ------------------------------------------------------------------ */
/* REXXTRY.CMD                                                        */
/*                                                                    */
/* function:                                                          */
/*                                                                    */
/*                                                                    */
/* usage:                                                             */
/*                                                                    */
/*                                                                    */
/* parameters:                                                        */
/*                                                                    */
/*                                                                    */
/* history:                                                           */
/*                                                                    */
/*                                                                    */
/* notes:                                                             */
/*                                                                    */
/*                                                                    */
/* ------------------------------------------------------------------ */
/* unpacked on 12/06/05 at 19:41:51 with UPCKREXX.CMD (c) B. Schemmer */
/* ------------------------------------------------------------------ */

/* SAA-portable REXXTRY procedure     11/08/91  version 1.05
  Owned by IBM REXX Development.
    Loosely derived from an ancient formulation of Mike Cowlishaw.

  This procedure lets you interactively try REXX statements.
    If you run it with no parameter, or with a question mark
    as a parameter, it will briefly describe itself.
  You may also enter a REXX statement directly on the command line
    for immediate execution and exit.  Example:  rexxtry call show

  Enter 'call show' to see user variables provided by REXXTRY.
  Enter '=' to repeat your previous statement.
  Enter '?' to invoke system-provided online help for REXX.
  The subroutine named 'sub' can be CALLed or invoked as 'sub()'.
  REXXTRY can be run recursively with CALL.

  Except for the signal instructions after a syntax error, this
    procedure is an example of structured programming.
  The 'clear' routine illustrates system-specific SAA-portable coding.
*/ 
  parse arg argrx /* Get user's arg string.    */ 
  call house /* Go do some housekeeping.  */ 

  select /* 3 modes of operation...   */ 

    when argrx = '?' then 
      call tell /*   1.  Tell user how.      */ 

    when argrx = '' then 
    do /*   2.  Interactive mode.   */ 

      call intro 
      call main 

    end /* when argrx = '' then do /*   2.  Interactive mode.   */ */

    otherwise 
    push argrx 
    call main /*   3.  One-liner and exit. */ 

  end /* select /* 3 modes of operation...   */ */

done: exit /* The only exit.            */ 

house: /* Housekeeping.             */ 
  parse version version /* Fill-in 2 user variables. */ 
  parse source source /*                           */ 
  parse source sysrx . procrx . /* Get system & proc names.  */ 
  remindrx = "Enter 'exit' to end." /* How to escape rexxtry.    */ 
  helprx='' /* Null if not CMS or OS/2.  */ 

  if sysrx = 'CMS' | sysrx = 'OS/2' /*   Extra reminder for CMS  */ 
    then helprx = '   '  /*     or OS/2.              */"  Or '?' for online REXX help." /*   Not used in intro.      */ 

  promptrx='' /* Null if not one-liner.    */ 

  if argrx<>'' then 
    promptrx=procrx' ' /*   Name part of user line. */ 

  if sysrx = 'OS/2' then 
  do /* OS/2-specific...          */ 

    posrx = lastpos('\',procrx) /*   Find name separator.    */ 
    procrx = substr(procrx,posrx+1) /*   Pick up the proc name.  */ 

  end /* if sysrx = 'OS/2' then do /* OS/2-specific...          */ */

  temprx = ' 'procrx' on 'sysrx /* Make border...            */ 
  if length( temprx ) > 69 then
    temprx = 69
  posrx = 69-length(temprx) /*   where to overlay name,  */ 
  bordrx = copies('.',68) /*   background of periods,  */ 
  bordrx =  /*   name right-adjusted.    */overlay(temprx,bordrx,posrx) 
  save = '' /* Don't save user input.    */ 
  trace = 'Off' /* Init user trace variable. */ 
return result /* Preserve result contents. */ /* house */


/* ------------------------------------------------------------------ */
/* function:                                                          */
/*                                                                    */
/* usage:     tell                                                    */
/*                                                                    */
/* where:     -                                                       */
/*                                                                    */
/* returns:   -                                                       */
/*                                                                    */
/*                                                                    */
/* notes:     -                                                       */
/*                                                                    */
/*                                                                    */
tell: call clear 

  do irx = 1 to 20 /* Tell about rexxtry by     */ 

    say sourceline(irx) 

  end /*   displaying the prolog.  */ /* do irx = 1 to 20 /* Tell about rexxtry by     */ */

return result /* Preserve result contents. */ /* tell */


/* ------------------------------------------------------------------ */
/* function:                                                          */
/*                                                                    */
/* usage:     clear                                                   */
/*                                                                    */
/* where:     -                                                       */
/*                                                                    */
/* returns:   -                                                       */
/*                                                                    */
/*                                                                    */
/* notes:     -                                                       */
/*                                                                    */
/*                                                                    */
clear: select /* SAA-portable code.        */ 

  when sysrx = 'CMS' then 
    'VMFCLEAR' /* No such command on        */ 

  when sysrx = 'OS/2' then 
    'CLS' /*   OS/400 or TSO.          */ 

  otherwise 
  nop 
  end 
  say 
return result /* Preserve result contents. */ /* clear */


/* ------------------------------------------------------------------ */
/* function:                                                          */
/*                                                                    */
/* usage:     intro                                                   */
/*                                                                    */
/* where:     -                                                       */
/*                                                                    */
/* returns:   -                                                       */
/*                                                                    */
/*                                                                    */
/* notes:     -                                                       */
/*                                                                    */
/*                                                                    */
intro: /* Display brief             */ 
  say '  'procrx' lets you'  /*   introductory            */'interactively try REXX'  /*   remarks for             */'statements.' /*   interactive mode.       */ 
  say '    Each string is executed' 'when you hit Enter.' 
  say "      Enter 'call tell' for"  /* How to see description.   */"a description of the features." 
  say '  Go on - try a few...   ' '         'remindrx 
return result /* Preserve result contents. */ /* intro */


/* ------------------------------------------------------------------ */
/* function:                                                          */
/*                                                                    */
/* usage:     sub                                                     */
/*                                                                    */
/* where:     -                                                       */
/*                                                                    */
/* returns:   -                                                       */
/*                                                                    */
/*                                                                    */
/* notes:     -                                                       */
/*                                                                    */
/*                                                                    */
sub: say '  ...test subroutine'  /* User can CALL this        */"'sub'  ...returning 1234..." /*   subroutine or           */ 
return 1234 /*   invoke with 'sub()'.    */ /* sub */


/* ------------------------------------------------------------------ */
/* function:                                                          */
/*                                                                    */
/* usage:     main                                                    */
/*                                                                    */
/* where:     -                                                       */
/*                                                                    */
/* returns:   -                                                       */
/*                                                                    */
/*                                                                    */
/* notes:     -                                                       */
/*                                                                    */
/*                                                                    */
main: signal on syntax /* Enable syntax trap.       */ 

  do foreverrx = 1 /* Loop forever.             */ 

    prev = inputrx /* User can repeat previous. */ 
    parse pull inputrx /* Input keyboard or queue.  */ 
    current = inputrx /* Current line for 'show'.  */ 

    if save <> '' then 
      call save /* Save before interpreting. */ 

    if inputrx = '=' then 
      inputrx=prev /* '=' means repeat previous */ 

    select 

      when inputrx = '' then 
        say ' '  /* If null line, remind      */procrx':  'remindrx helprx /*   user how to escape.     */ 

      when inputrx='?' then 
        call help /* Request for online help.  */ 

      otherwise 
      rc = 'X' /* Make rc change visible.   */ 
      call set2 
      trace (trace) /* Need these on same line.  */ 
      interpret inputrx /* Try the user's input.     */ 
      trace 'Off' /* Don't trace rexxtry.      */ 
      call border /* Go write the border.      */ 

    end /* select */

    if argrx <> '' & queued() = 0 /* For one-liner, loop until */ 
      then leave /*   queue is empty.         */ 

  end /* do foreverrx = 1 /* Loop forever.             */ */

return result /* Preserve result contents. */ /* main */


/* ------------------------------------------------------------------ */
/* function:                                                          */
/*                                                                    */
/* usage:     set1                                                    */
/*                                                                    */
/* where:     -                                                       */
/*                                                                    */
/* returns:   -                                                       */
/*                                                                    */
/*                                                                    */
/* notes:     -                                                       */
/*                                                                    */
/*                                                                    */
set1: siglrx1 = sigl /* Save pointer to lineout.  */ 
return result /* Preserve result contents. */ /* set1 */


/* ------------------------------------------------------------------ */
/* function:                                                          */
/*                                                                    */
/* usage:     set2                                                    */
/*                                                                    */
/* where:     -                                                       */
/*                                                                    */
/* returns:   -                                                       */
/*                                                                    */
/*                                                                    */
/* notes:     -                                                       */
/*                                                                    */
/*                                                                    */
set2: siglrx2 = sigl /* Save pointer to trace.    */ 
return result /* Preserve result contents. */ /* set2 */


/* ------------------------------------------------------------------ */
/* function:                                                          */
/*                                                                    */
/* usage:     save                                                    */
/*                                                                    */
/* where:     -                                                       */
/*                                                                    */
/* returns:   -                                                       */
/*                                                                    */
/*                                                                    */
/* notes:     -                                                       */
/*                                                                    */
/*                                                                    */
save: /* Save before interpreting. */ 
  call set1 
  rcrx=lineout(save,inputrx) /* Need on same line.        */ 

  if rcrx <> 0 then /* Catch non-syntax error    */ 
    say "  Error on save="save /*   from lineout.           */ 

return result /* Preserve result contents. */ /* save */


/* ------------------------------------------------------------------ */
/* function:                                                          */
/*                                                                    */
/* usage:     help                                                    */
/*                                                                    */
/* where:     -                                                       */
/*                                                                    */
/* returns:   -                                                       */
/*                                                                    */
/*                                                                    */
/* notes:     -                                                       */
/*                                                                    */
/*                                                                    */
help: select /* Request for online help.  */ 

  when sysrx = 'CMS' then /* Invoke CMS help menu for  */ 
    address CMS 'HELP REXX MENU' /*   for REXX.               */ 

  when sysrx = 'OS/2' then /* Invoke OS/2 online REXX   */ 
    'view rexx.inf' /*   Reference.              */ 

  otherwise 
  say '  'sysrx' has'  /* Todate, only CMS and OS/2 */'no online help for REXX.' /*   provide online help     */ 
  rc = 'Sorry !' 
  end /*   for REXX.               */ 
  call border 
return result /* Preserve result contents. */ /* help */


/* ------------------------------------------------------------------ */
/* function:                                                          */
/*                                                                    */
/* usage:     border                                                  */
/*                                                                    */
/* where:     -                                                       */
/*                                                                    */
/* returns:   -                                                       */
/*                                                                    */
/*                                                                    */
/* notes:     -                                                       */
/*                                                                    */
/*                                                                    */
border: if rc = 'X' then /* Display border.           */ 
  say '  'bordrx 
  else 
  say ' '  /* Show return code if it    */overlay('rc = 'rc' ',bordrx) /*   has changed.            */ 
return result /* Preserve result contents. */ /* border */


/* ------------------------------------------------------------------ */
/* function:                                                          */
/*                                                                    */
/* usage:     syntax                                                  */
/*                                                                    */
/* where:     -                                                       */
/*                                                                    */
/* returns:   -                                                       */
/*                                                                    */
/*                                                                    */
/* notes:     -                                                       */
/*                                                                    */
/*                                                                    */
syntax: trace 'Off' /* Stop any tracing.         */ 

  select 

    when sigl = siglrx1 then 
    do /* User's 'save' value bad.  */ 

      say "  Invalid 'save' value" "'"save"', resetting to ''." 
      save='' 

    end /* when sigl = siglrx1 then do /* User's 'save' value bad.  */ */

    when sigl = siglrx2 then 
    do /* User's 'trace' value bad. */ 

      say "  Invalid 'trace' value" "'"trace"', resetting to" "'Off'." 
      trace='Off' 

    end /* when sigl = siglrx2 then do /* User's 'trace' value bad. */ */

    otherwise /* Some other syntax error.  */ 
    do
                                         /* Show the error msg text.  */ 
    say '  Oooops ! ... try again.     'errortext(rc) 
    parse version . rxlevel . 

    if sysrx='CMS' then 
      call cmstax /* More syntax stuff for CMS */ 
    end 
  end /* select */

  call border /* Go write the border.      */ 

  if argrx <> '' & queued() = 0 then /* One-liner not finished    */ 
    signal done /*   until queue is empty.   */ 

  signal main /* Resume main loop.         */ 

cmstax: rcrx = rc /* More syntax stuff for CMS */ 

  if exist('PROMPT MODULE') then /* User's input to cmd line. */ 
    'PROMPT' promptrx||'13'x||inputrx /*   '13'x places cursor.    */ 

  if exist('REXX EXEC') & argrx='' /* Not for one-liners.       */ 
    then do 

  more='EXEC REXX' rcrx+20000 /* CMS rc is 20,000 higher.  */ 
  say "  Enter 'more' to see"  /* Prepare 'more' to access  */'information about this'  /*  REXX IOSLIB information. */'syntax error.' 
  end /* Tell user what to do.     */ 
  rc = rcrx 
return result /* Preserve result contents. */ /* cmstax */


/* ------------------------------------------------------------------ */
/* function:                                                          */
/*                                                                    */
/* usage:     exist                                                   */
/*                                                                    */
/* where:     -                                                       */
/*                                                                    */
/* returns:   -                                                       */
/*                                                                    */
/*                                                                    */
/* notes:     -                                                       */
/*                                                                    */
/*                                                                    */
exist: arg inrx 
  outrx = 0 /* Assume file is missing.   */ 
  address command 'ESTATE' inrx /* Does the file exist ?     */ 

  if rc = 0 then 
    outrx = 1 /* estate says it exists.    */ 

return outrx /* 1 makes condition true.   */ /* exist */


/* ------------------------------------------------------------------ */
/* function:                                                          */
/*                                                                    */
/* usage:     show                                                    */
/*                                                                    */
/* where:     -                                                       */
/*                                                                    */
/* returns:   -                                                       */
/*                                                                    */
/*                                                                    */
/* notes:     -                                                       */
/*                                                                    */
/*                                                                    */
show: trace 'Off' 
  call clear /* Display user variables    */ 
  say '  'procrx' provides'  /*   provided by rexxtry.    */'these user variables.' 
  say '  The current values are...' /* Show current values.      */ 
  say 
  say "    'version'   = '"version"'" /* What level of REXX.       */ 
  say "    'source'    = '"source"'" /* What oper system etc.     */ 
  say "    'result'    = '"result"'" /* REXX special variable.    */ 
  say 
  say '     Previous line entered by' 'user.  Initial value=INPUTRX.' 
  say "    'prev'      = '"prev"'" /* Previous user statement.  */ 
  say "    'current'   = '"current"'" /* Compare curr with prev.   */ 
  say 
  say '     Save your input with' 'save=filespec.' " Stop saving with save=''." 
  say "    'save'      = '"save"'" /* Filespec for input keep.  */ 
  say 
  say '     Enter trace=i, trace=o' ' etc. to control tracing.' 
  say "    'trace'     = '"trace"'" /* Trace user statements.    */ 
return result /* Preserve result contents. */ /* show */
