/* REXX (DOS or OS/2) implementation of the UNIX tee filter, but  */
/*       only one output file (or device) in addition to stdout   */

   call trace 'O'                   /* disable any SET RXTRACE=ON */
   signal on novalue name TRAP   ;  signal on syntax name TRAP
   signal on failure name TRAP   ;  signal on halt   name TRAP

   TEE = strip( arg( 1 ))           /* stripped arg. = file name  */

   if verify( left( TEE, 1 ), '-/', 'M' ) then do
      GOT = translate( substr( TEE, 2, 1 ))        /* option char */
      TEE = strip( substr( TEE, 3 ))               /* white space */
   end
   else GOT = '-'                   /* default option: DELETE tee */

   TEE = strip( TEE,, '"' )         /* strip "quo ted" TEE blanks */
   select
      when TEE = ''  then  exit INFO()
      when GOT = 'A' then  nop                     /* -a = APPEND */
      when GOT = '-' then  call XDEL TEE           /* -- = DELETE */
      otherwise            exit INFO()             /* -h, -?, ... */
   end
   do until GOT == ''               /* blank input okay with '==' */
      GOT = charin( ,, 1000 )       /* get (next) block of input: */
      call charout    , GOT         /* copy any input to STDOUT   */
      call charout TEE, GOT         /* copy any input to TEE file */
   end

   signal on notready name TRAP  ;  call charout TEE
   exit chars( TEE ) = 0

INFO: procedure                  /* ----------------------------- */
   parse source . . TEE
   say 'usage: prog1 |' TEE '   file | prog3'
   say 'or   : prog1 |' TEE '-a file | prog3'
   say 'or   : prog1 |' TEE '-- file | prog3'
   say 'copies standard output of prog1 to file,'
   say 'e.g. file \dev\con to watch prog3 input.'
   say 'option -a appends (logs) output to file,'
   say 'option -- ignored, allows filename -xyz.'
   return 1

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

XDEL: procedure                  /* semi-portable SysFileDelete() */
   parse source KEY . .          /* assuming ooREXX for WindowsNT */
   if KEY = 'OS/2' | KEY = 'WindowsNT' then  do
      call UTIL 'SysFileDelete'
      return SysFileDelete( arg( 1 )) <> 0   /* 0: okay, 1: error */
   end
   parse version KEY . .
   if KEY = 'REXXSAA'
      then return RxDelete( arg( 1 )) <> 0   /* 0: okay, 1: error */
      else return DosDel(   arg( 1 )) == 0   /* 0: okay, 1: error */

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 1 then do                   /* in pipes STDERR: output */
         parse version TRAP.REXX       /* REXX/Personal: \dev\con */
         if abbrev( TRAP.REXX, 'REXXSAA ' ) |                /**/ ,
            6 <= word( TRAP.REXX, 2 )  then  TRAP.REXX = 'STDERR'
                                       else  TRAP.REXX = '\dev\con'
         signal on syntax name TRAP.FAIL
         call lineout TRAP.REXX , TRAP /* fails if no more handle */
      end
      when 0 then do                   /* OS/2 PM or ooREXX on NT */
         signal on syntax name TRAP.FAIL
         call RxMessageBox translate( TRAP, ' ', x2c( 0D )), /**/ ,
            'Trap' time(),, 'ERROR'
      end
      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  */