#!@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. */
