/* OS/2 REXX syntax check with Quercus REXX/Personal PREXXX30.exe */

/* The default is to check all *.cmd in the current directory -   */
/* don't worry about non-REXX scripts, any file not starting with */
/* a REXX comment in column 1 of line 1 is silently ignored.  You */
/* can of course check Kedit *.KEX macros, ZOC *.zrx scripts, PC  */
/* DOS *.BAT, and other files (with 1st char. / and 2nd char. *). */

/* You can also use this script as external REXX procedure or as  */
/* function to check ONE other script, returning the result as a  */
/* string (instead of displaying it).  An empty string indicates  */
/* no REXX error or a file not starting with a REXX comment.  If  */
/* PREXX30 finds a syntax error, then it's returned in the format */
/* <line number>: <error text>.  Please note that you catch only  */
/* the first error for each input file.  OTOH you'll catch errors */
/* ignored by CMD.exe for years in "dead" parts of your code.     */

/* PREXX30.exe cannot handle quoted names, therefore this script  */
/* uses a temporary file in the directory specified by variable   */
/* TMP in the environment.  TMP must not contain embedded blanks. */

   REXX = 'd:\misc\rexx\prexx\prexx30.exe'   /* PLEASE EDIT THIS  */

   /* Future updates <URL:http://purl.net/xyzzy/src/syntaxed.cmd> */

   signal on  novalue  name TRAP ;  signal on  syntax name TRAP
   signal on  failure  name TRAP ;  signal on  halt   name TRAP
   signal on  error    name TRAP ;  call UTIL 'SysFileTree'

   parse source . TYPE TEMP
   TEMP = translate( TEMP, '/', '\' )
   TEMP = substr( TEMP, 1 + lastpos( '/', TEMP ))
   TEMP = XENV( 'TMP' ) || '\' || TEMP
   TEMP = left( TEMP, lastpos( '.', TEMP )) || 'tmp'
   if words( TEMP ) <> 1
      then exit TRAP( 'unsupported spaces in' TEMP )

   RXQU = RxQueue( 'GET' )
   FILE = strip( strip( strip( arg( 1 )),, '"' ))
   if FILE = '' then FILE = '*.cmd'

   call SysFileTree FILE, 'FILE', 'FO'
   select
      when result <> 0  then exit TRAP( 'error' result FILE )
      when FILE.0 = 0   then do
         say 'not found:' FILE   ;  exit 1
      end
      when FILE.0 = 1   then do
         LINE = DOIT( FILE.1 )
         if TYPE <> 'COMMAND'             then  return LINE
         if LINE = ''                     then  exit 0
         say LINE '"' || FILE.1 || '"' ;        exit 1
      end
      otherwise   do N = 1 to FILE.0
         LINE = DOIT( FILE.N )
         if LINE = '' then iterate N
         say LINE '"' || FILE.N || '"'
      end
   end
   exit 0

DOIT: procedure expose TEMP REXX RXQU
   LINE = ''   ;  address CMD '@TYPE "' || arg( 1 ) || '" >' TEMP

   if chars( TEMP ) > 1 then if charin( TEMP, 1, 2 ) = '/*' then do
      call charout TEMP
      do while sign( queued())   ;  pull  ;  end
      address CMD '@' || REXX '/o' TEMP '2>&1 | rxqueue' RXQU
      if sign( queued()) then parse pull THIS   ;  else THIS = ''
      parse var THIS ', line ' LINE
      if LINE = '' then LINE = THIS
      do while sign( queued())   ;  pull  ;  end
   end
   call charout TEMP ;  address CMD '@if exist' TEMP 'erase' TEMP
   return LINE

/* see <URL:http://purl.net/xyzzy/rexxtrap.htm>, (c) F. Ellermann */

XENV: procedure                  /* DOS REXX portable environment */
   parse version ENV . .
   if ENV = 'REXXSAA' then do
      parse source ENV . .       /* OS/2 REXXSAA:  os2environment */
      if ENV = 'OS/2'   then ENV = 'OS2ENVIRONMENT'
                        else ENV = ENV || 'ENVIRONMENT'
   end                           /* DOS  REXXSAA:  DOSENVIRONMENT */
   else  ENV = 'ENVIRONMENT'     /* REXX/Personal:    environment */
   select
      when arg() = 1 then  return value( arg( 1 ),/* get */, ENV )
      when arg() = 2 then  return value( arg( 1 ), arg( 2 ), ENV )
      otherwise            return abs( /* force REXX error 40 */ )
   end

UTIL: procedure                  /* load necessary RexxUtil entry */
   if RxFuncQuery(  arg( 1 )) then
      if RxFuncAdd( arg( 1 ), 'RexxUtil', arg( 1 )) then
         exit TRAP( "can't add RexxUtil"  arg( 1 ))
   return 0

TRAP:                            /* select REXX exception handler */
   call trace 'O' ;  trace N           /* don't trace interactive */
   parse source TRAP                   /* source on separate line */
   TRAP = x2c( 0D ) || right( '+++', 10 ) TRAP || x2c( 0D0A )
   TRAP = TRAP || right( '+++', 10 )   /* = standard trace prefix */
   TRAP = TRAP strip( condition( 'c' ) 'trap:' condition( 'd' ))
   select
      when wordpos( condition( 'c' ), 'ERROR FAILURE' ) > 0 then do
         if condition( 'd' ) > ''      /* need an additional line */
            then TRAP = TRAP || x2c( 0D0A ) || right( '+++', 10 )
         TRAP = TRAP '(RC' rc || ')'   /* any system error codes  */
         if condition( 'c' ) = 'FAILURE' then rc = -3
      end
      when wordpos( condition( 'c' ), 'HALT SYNTAX'   ) > 0 then do
         if condition( 'c' ) = 'HALT' then rc = 4
         if condition( 'd' ) > '' & condition( 'd' ) <> rc then do
            if condition( 'd' ) <> errortext( rc ) then do
               TRAP = TRAP || x2c( 0D0A ) || right( '+++', 10 )
               TRAP = TRAP errortext( rc )
            end                        /* future condition( 'd' ) */
         end                           /* may use errortext( rc ) */
         else  TRAP = TRAP errortext( rc )
         rc = -rc                      /* rc < 0: REXX error code */
      end
      when condition( 'c' ) = 'NOVALUE'  then rc = -2 /* dubious  */
      when condition( 'c' ) = 'NOTREADY' then rc = -1 /* dubious  */
      otherwise                        /* force non-zero whole rc */
         if datatype( value( 'RC' ), 'W' ) = 0 then rc = 1
         if rc = 0                             then rc = 1
         if condition() = '' then TRAP = TRAP arg( 1 )
   end                                 /* direct: TRAP( message ) */

   TRAP = TRAP || x2c( 0D0A ) || format( sigl, 6 )
   signal on syntax name TRAP.SIGL     /* throw syntax error 3... */
   if 0 < sigl & sigl <= sourceline()  /* if no handle for source */
      then TRAP = TRAP '*-*' strip( sourceline( sigl ))
      else TRAP = TRAP '+++ (source line unavailable)'
TRAP.SIGL:                             /* ...catch syntax error 3 */
   if abbrev( right( TRAP, 2 + 6 ), x2c( 0D0A )) then do
      TRAP = TRAP '+++ (source line unreadable)'   ;  rc = -rc
   end
   select
      when 0 then do                   /* in pipes STDERR: output */
         parse version TRAP.REXX . .   /* REXX/Personal: \dev\con */
         signal on syntax name TRAP.FAIL
         if TRAP.REXX = 'REXXSAA'      /* fails if no more handle */
            then call lineout 'STDERR'  , TRAP
            else call lineout '\dev\con', TRAP
      end
      when 0 then do                   /* OS/2 PM: RxMessageBox() */
         signal on syntax name TRAP.FAIL
         call RxMessageBox ,           /* fails if not in PMREXX  */
            translate( TRAP, ' ', x2c( 0D )), , 'CANCEL', 'WARNING'
      end                              /* replace any CR by blank */
      otherwise   say TRAP ; trace ?L  /* interactive Label trace */
   end

   if condition() = 'SIGNAL' then signal TRAP.EXIT
TRAP.CALL:  return rc                  /* continue after CALL ON  */
TRAP.FAIL:  say TRAP ;  rc = 0 - rc    /* force TRAP error output */
TRAP.EXIT:  exit   rc                  /* exit for any SIGNAL ON  */