/* REXX hack: emulate UNIX wc */ /* BUGS: locked (etc.) file silently ignored, because REXX has no */ /* ISDEV() without additional libraries. A single "-" arg. */ /* to indicate STDIN is not supported, either specify files */ /* or use STDIN (e.g. in a pipe). Device input ignores any */ /* CR "eaten" by linein(), i.e. CR LF may be counted as LF. */ /* HT, VT, FF, NL, and SP are treated as word delimiters as */ /* in a UNIX wc, a wc "feature" in the case of VT and FF. */ signal on novalue name TRAP ; signal on syntax name TRAP signal on failure name TRAP ; signal on halt name TRAP LINE = strip( arg(1)) ; OPT = '' ; FILES = 0 LWC = 1 ; LINES = 0 ; WORDS = 0 ; CHARS = 0 TOT = 0 ; LINEC = 0 ; WORDC = 0 ; CHARC = 0 do while abbrev( LINE, '-' ) & OPT <> '-' parse var LINE '-' OPT LINE ; LINE = strip( LINE ) if sign( verify( OPT, '-lwct' )) then exit USE() if sign( pos( '-', OPT )) & OPT <> '-' then exit USE() if sign( pos( 'l', OPT )) then parse value 0 1 with LWC LINES if sign( pos( 'w', OPT )) then parse value 0 1 with LWC WORDS if sign( pos( 'c', OPT )) then parse value 0 1 with LWC CHARS TOT = TOT | sign( pos( 't', OPT )) end if LWC then parse value 0 1 1 1 with LWC LINES WORDS CHARS do while LINE <> '' LWC = LWC + 1 if abbrev( LINE, '"' ) then parse var LINE '"' WILD.LWC '"' LINE else parse var LINE WILD.LWC LINE LINE = strip( LINE ) end do M = 1 to LWC if TREE( WILD.M, 'FILE', 'FO' ) <> 0 then exit TRAP( 'SysFileTree error' ) if FILE.0 = 0 then do say 'no matching files:' WILD.M ; exit 1 end FILES = FILES + FILE.0 WILD.M = left( WILD.M, lastpos( '\', WILD.M )) do N = 1 to FILE.0 parse value LWC( FILE.N ) with L W C if \ TOT then do LINE = '' if LINES then LINE = LINE || right( L, 10 ) if WORDS then LINE = LINE || right( W, 10 ) if CHARS then LINE = LINE || right( C, 10 ) FILE.N = substr( FILE.N, 1 + lastpos( '\', FILE.N )) say LINE WILD.M || FILE.N end LINEC = LINEC + L ; WORDC = WORDC + W ; CHARC = CHARC + C end N end M if LWC = 0 then parse value LWC('STDIN:') with LINEC WORDC CHARC if LWC = 0 | FILES > 1 then do LINE = '' if LINES then LINE = LINE || right( LINEC, 12 ) if WORDS then LINE = LINE || right( WORDC, 12 ) if CHARS then LINE = LINE || right( CHARC, 12 ) say LINE 'total' end exit 0 LWC: procedure parse arg FILE ; signal on notready name EOF L = 0 ; W = 0 ; C = 0 ; WHITE = x2c( 090A0B0C0D ) do while sign( lines( FILE )) N = chars( FILE ) ; B = linein( FILE ) ; L = L + 1 W = W + words( translate( B, ' ', WHITE )) C = C + max( N - chars( FILE ), 1 + length( B )) end /* correct spurious chars() = 1 if reading from a device */ EOF: /* EOF if reading from device only trapped by NOTREADY */ call lineout FILE ; return L W C USE: procedure parse source . . S say 'usage:' S '[-l|w|c|t] [file(s)]' ; return 1 /* see , (c) F. Ellermann */ TREE: /* portable SysFileTree() subset */ if arg( 2, 'o' ) then return abs( /* force TREE syntax error */ ) THIS... = arg( 2 ) /* destroying any global THIS... */ if right( THIS... , 1 ) <> . then THIS... = THIS... || . if arg() < 3 then return TREE.PLUS( arg( 1 )) if arg() = 3 then return TREE.PLUS( arg( 1 ), arg( 3 )) else return TREE.PLUS( arg( 1 ), arg( 3 ), arg( 4 )) TREE.PLUS: procedure expose ( THIS... ) call value THIS... || '0', 0 /* prepare for result STEM.0 = 0 */ if arg() > 2 then return 1 /* attribute masking unsupported */ TOP = translate( arg( 2 )) /* Time option T not implemented */ if verify( TOP, 'FDBOS' ) > 0 then return 1 parse source KEY . . if KEY = 'OS/2' then do /* ----------------------------- */ call UTIL 'SysFileTree' if arg() = 1 then return SysFileTree( arg( 1 ), THIS... ) else return SysFileTree( arg( 1 ), THIS... , arg( 2 )) end /* ----------------------------- */ CWD = XDIR() /* transform rel. path into abs. */ SUB.1 = left( arg( 1 ), 0 + lastpos( '\', arg( 1 ))) ANY = substr( arg( 1 ), 1 + lastpos( '\', arg( 1 ))) if ANY = '..' | ANY = '.' then do SUB.1 = SUB.1 || ANY ; ANY = '*.*' end if SUB.1 = '' then do /* SysFileTree( 'D:.', x ) won't */ select /* work if in root dir.: ignored */ when right( ANY, 1 ) = ':' then SUB.1 = ANY || '.' when right( ANY, 2 ) = ':.' then SUB.1 = ANY when right( ANY, 3 ) = ':..' then SUB.1 = ANY when right( CWD, 1 ) = '\' then SUB.1 = CWD otherwise SUB.1 = CWD || '\' end if right( SUB.1, 1 ) <> '\' then do SUB.1 = XDIR( SUB.1 ) ; ANY = '*.*' end /* ANY patched for . and .. */ end /* SUB.1 always XDIR()-tested */ else SUB.1 = XDIR( SUB.1 || '.' ) call XDIR CWD /* reset caller's directory */ if SUB.1 = '' then return 0 /* for bad directory return 0 */ if right( SUB.1 , 1 ) <> '\' then SUB.1 = SUB.1 || '\' parse version KEY . . ; SUB = 1 ; ONE = '' ; NUM = 0 CWD = 1 - sign( pos( 'S', TOP )) /* 0: Subdirectories, 1: here */ FBD = 1 - sign( pos( 'B', TOP )) /* 1: File, 0: Both, -1: Dir. */ if FBD then FBD = sign( pos( 'F', TOP )) - sign( pos( 'D', TOP )) ADD = 1 - sign( pos( 'O', TOP )) /* 0: Only path, 1: more info */ do while ONE > '' | SUB > CWD /* DOS REXX/Personal push & pull */ if ONE = '' then do /* could fail, and REXXSAA stack */ CWD = CWD + 1 /* is limited, build direct TREE */ if KEY = 'REXXSAA' then ONE = RxFInfo( SUB.CWD || '*.*' ) else ONE = DosDir( SUB.CWD || '*.*',, 'HSD', 'D' ) end /* find 1st matching file / dir. */ if sign( pos( 'D', right( ONE, 6 ))) then do ONE = subword( ONE, 1, words( ONE ) - 4 ) if ONE <> '.' & ONE <> '..' then do SUB = SUB + 1 ; SUB.SUB = SUB.CWD || ONE || '\' end /* note additional subdirectory */ end /* get next matching file / dir. */ if KEY = 'REXXSAA' then ONE = RxFInfo() else ONE = DosDir( ) end do CWD = 1 to SUB /* for all noted subdirectories: */ if KEY = 'REXXSAA' /* find 1st matching file / dir. */ then ONE = RxFInfo( SUB.CWD || ANY ) else ONE = DosDir( SUB.CWD || ANY ,, 'HSD' ) do while ONE > '' TOP = subword( ONE, 1 + words( ONE ) - 4 ) /* 4 tokens */ ONE = subword( ONE, 1 , words( ONE ) - 4 ) /* ONE path */ if ONE = '.' | ONE = '..' then ONE = '' if FBD > 0 & pos( 'D', right( TOP, 6 )) <> 0 then ONE = '' if FBD < 0 & pos( 'D', right( TOP, 6 )) == 0 then ONE = '' if ONE > '' then do ONE = SUB.CWD || ONE ; NUM = NUM + 1 if ADD then ONE = TOP ONE /* ADD size date time attr */ call value THIS... || '0', NUM /* next NUM */ call value THIS... || NUM, ONE /* item NUM */ end /* get next matching file / dir. */ if KEY = 'REXXSAA' then ONE = RxFInfo() else ONE = DosDir() end end CWD return 0 XDIR: procedure /* DOS REXX portable directory() */ parse source NN . ; if NN == 'DOS' then parse version NN . select when arg() > 1 then return abs( /** error 40 **/ ) when NN <> 'REXXSAA' & arg() = 0 then return directory() when NN <> 'REXXSAA' then return directory( arg( 1 )) when arg() = 0 then nop /* PC DOS REXXSAA get dir. */ otherwise /* PC DOS REXXSAA set dir. */ parse arg NN /* adding point D: => D:. */ if pos( ':', NN ) = length( NN ) then NN = NN || '.' if RxChDir( NN ) = 0 then do NN = left( NN, pos( ':', NN )) if NN <> '' then call RxChDrv NN end /* RxChDrv() error ignored */ else return '' /* RxChDir() failure => '' */ end return RxGetDrv() || RxGetDir() 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 */ 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 */