#!@OOREXX_SHEBANG_PROGRAM@ /*----------------------------------------------------------------------------*/ /* */ /* Copyright (c) 1995, 2004 IBM Corporation. All rights reserved. */ /* Copyright (c) 2005-2023 Rexx Language Association. All rights reserved. */ /* */ /* This program and the accompanying materials are made available under */ /* the terms of the Common Public License v1.0 which accompanies this */ /* distribution. A copy is also available at the following address: */ /* https://www.oorexx.org/license.html */ /* */ /* Redistribution and use in source and binary forms, with or */ /* without modification, are permitted provided that the following */ /* conditions are met: */ /* */ /* Redistributions of source code must retain the above copyright */ /* notice, this list of conditions and the following disclaimer. */ /* Redistributions in binary form must reproduce the above copyright */ /* notice, this list of conditions and the following disclaimer in */ /* the documentation and/or other materials provided with the distribution. */ /* */ /* Neither the name of Rexx Language Association nor the names */ /* of its contributors may be used to endorse or promote products */ /* derived from this software without specific prior written permission. */ /* */ /* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS */ /* "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT */ /* LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS */ /* FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT */ /* OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, */ /* SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED */ /* TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, */ /* OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY */ /* OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING */ /* NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS */ /* SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. */ /* */ /*----------------------------------------------------------------------------*/ /****************************************************************************/ /* Name: rexxtry.rex */ /* Type: ooRexx Script */ /* */ /* 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 /* 1. Tell user how. */ call tell when argrx = '' then do /* 2. Interactive mode. */ call intro call main end otherwise /* 3. One-liner and exit. */ push argrx call main end done: exit /* The only exit. */ house: /* Housekeeping. */ parse version version /* Fill-in 2 user variables. */ parse source source sysrx = word(source, 1) /* Get system name. */ remindrx = "Enter 'exit' to end." /* How to escape rexxtry. */ helprx = ' ', /* add extra help info */ " Or '?' for online REXX help." promptrx = '' /* Null if not one-liner. */ procrx = .context~package~name /* fully resolved name */ if argrx<>'' then promptrx = procrx' ' /* Name part of user line. */ filerx = .File~new(procrx) /* get a file object for parsing */ procrx = filerx~name /* Pick up the proc name. */ temprx = ' 'procrx' on 'sysrx /* Make border... */ posrx = 69-length(temprx) /* where to overlay name, */ bordrx = copies('.', 68) /* background of periods, */ bordrx = overlay(temprx, bordrx, posrx) /* name right-adjusted. */ save = '' /* Don't save user input. */ trace = 'Off' /* Init user trace variable. */ return result /* Preserve result contents. */ tell: call clear /* the following loop start and end may need to be modified should the */ /* comment at the top of the program be changed. */ do irx = 44 to 58 /* Tell about rexxtry by */ say substr(sourceline(irx), 4, 73) /* displaying the prolog. */ end return result /* Preserve result contents. */ clear: select /* SAA-portable code. */ when abbrev(sysrx, 'Windows') then 'CLS' /* system to clear screen */ when sysrx = 'LINUX' | sysrx = 'AIX' | sysrx = 'SUNOS' | sysrx = 'DARWIN' then 'clear' /* system to clear screen */ otherwise nop /* No such command available */ end; say return result /* Preserve result contents. */ intro: /* Display brief */ say version /* introductory */ say ' 'procrx' lets you', /* about rexxtry and */ '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. */ sub: say ' ...test subroutine', /* User can CALL this */ "'sub' ...returning 1234..." /* subroutine or */ return 1234 /* invoke with 'sub()'. */ main: signal on syntax /* Enable syntax trap. */ do forever /* 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 if argrx <> '' & queued() = 0 /* For one-liner, loop until */ then leave /* queue is empty. */ end return result /* Preserve result contents. */ set1: siglrx1 = sigl /* Save pointer to lineout. */ return result /* Preserve result contents. */ set2: siglrx2 = sigl /* Save pointer to trace. */ return result /* Preserve result contents. */ 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. */ help: /* Request for online help. */ select when abbrev(sysrx, 'Windows') then do /* ... for Windows */ /* issue the pdf as a command using quotes because the install dir may contain blanks */ say ' Online Help started' 'start "Rexx Online Documentation"' '"'||value("REXX_HOME",,"ENVIRONMENT")||"\doc\rexxref.pdf"||'"' end /* ... for Unix */ when sysrx = sysrx = 'LINUX' | sysrx = 'AIX' | sysrx = 'SUNOS' | sysrx = 'DARWIN' then do say ' Online help is not installed on' sysrx rc = 'Sorry!' /* If you wish to install your own help, comment out the above and * uncomment the below, filling in the correct path to the doc and the * proper pdf reader. */ /* pdfReader = 'x' docDir = 'dir' doc = docDir'/rexxref.pdf' say ' Online Help started using' pdfReader doc pdfReader doc'&' */ end otherwise do say ' 'sysrx' has no online help for REXX.' rc = 'Sorry!' end end call border return result /* Preserve result contents. */ 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. */ 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 = siglrx2 then do /* User's 'trace' value bad. */ say " Invalid 'trace' value '"trace"', resetting to 'Off'." trace = 'Off' end otherwise /* Some other syntax error. */ condition = condition('o') /* Show the error msg text. */ say ' Oooops ! ... try again. 'condition~errortext secondary = condition('o')~message if .nil <> secondary then /* get a real one? */ /* display it also */ say ' 'secondary rc = condition~code /* use the full error code */ end 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. */ 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. */