/* WindowsNT or OS/2 REXX: show disk usage and file system type */ signal on novalue name TRAP ; signal on syntax name TRAP signal on failure name TRAP ; signal on halt name TRAP call UTIL 'SysFileSystemType' ; arg FROM LAST call UTIL 'SysDriveInfo' ; parse source . . SELF call UTIL 'SysDriveMap' ; numeric digits 12 if LAST = '' then LAST = FROM ; if LAST = '' then LAST = 'Z' if FROM = '' then FROM = 'C' ; TEXT = '' if LAST < FROM then exit WAIT( 'usage:' SELF '[from [to]]' ) | 1 do THIS = c2d( left( FROM, 1 )) to c2d( left( LAST, 1 )) CHAR = d2c( THIS ) DISK = SysDriveInfo( CHAR ) if DISK = '' then do /* no media, show drive map info */ DISK = CHAR || ':' right( 'n/a ', 59 ) select when abbrev( SysDriveMap( CHAR, 'local' ), CHAR ) then INFO = 'local' when abbrev( SysDriveMap( CHAR, 'remote' ), CHAR ) then INFO = 'remote' /* when abbrev( SysDriveMap( CHAR, 'detached' ), CHAR ) then INFO = 'detached' *//* disabled for ooRexx 3.1 */ otherwise iterate THIS end /* INFO should be a VOLume LABEL */ end /* with 11 bytes, but here I get */ else do /* 3 leading + 2 trailing spaces */ parse var DISK DISK FREE SIZE INFO USED = format( 100 -100 * FREE / SIZE, 3, 1 ) FREE = format( FREE / ( 1024 * 1024 ), 6, 2 ) SIZE = format( SIZE / ( 1024 * 1024 ), 6, 2 ) DISK = DISK USED || '% used,' DISK = DISK SIZE 'MB total,' DISK = DISK FREE 'MB free, ' DISK = DISK left( SysFileSystemType( CHAR ), 6 ) end TEXT = TEXT || x2c( 0D0A ) || DISK left( INFO, 16 ) end THIS if TEXT = '' then exit WAIT( SELF FROM LAST 'error' ) | 1 else exit WAIT( TEXT ) /* see , (c) F. Ellermann */ WAIT: procedure /* get OKay (or CANCEL) answer: */ KEY = PROC() ; OUT = 'STDERR' select when KEY = 1 then do /* 1 (real) obsolete: here DOS */ parse version KEY . . /* REXX/Personal has no STDERR: */ if KEY <> 'REXXSAA' then OUT = '\dev\con' end when KEY = 3 then do /* 3 (PM) RxMessageBox() output */ parse source KEY ; KEY = centre( KEY, 100 ) /* HACK */ KEY = RxMessageBox( arg( 1 ), KEY, 'OKCANCEL', 'ASTERISK' ) return KEY = 1 | KEY = 6 | KEY = 8 end /* 0 (fullscreen) and 2 (window) */ when KEY < 4 then call UTIL 'SysGetKey' otherwise nop /* 4 (detached) tested in AKEY() */ end call charout OUT, arg( 1 ) || x2c( 7 ) do until c2d( KEY ) <> 0 & c2d( KEY ) <> 224 KEY = AKEY() end call lineout OUT, '' /* hardwiring F3 '=', Alt-F4 'k' */ return KEY <> x2c( 1B ) & KEY <> '=' & KEY <> 'k' AKEY: procedure /* keyboard char. input function */ KEY = PROC() if KEY == 4 then return x2c( 1B ) /* 4: detached */ if KEY <> 1 then return SysGetKey( 'NoEcho' ) parse version KEY . . /* 1: DOS REXX */ if KEY == 'REXXSAA' then return RxGetKey( 'NoEcho' ) else return right( INKEY(), 1 ) PROC: procedure /* avoid "unknown function" TRAP */ parse source OS . /* 1: real mode, 2: text window */ if OS <> 'OS/2' then return 1 + ( OS = 'WindowsNT' ) OS = 'ProcessType' /* assume Sys... = RxProcessType */ if RxFuncQuery( 'Sys' || OS ) = 0 then return SysProcessType() if RxFuncAdd( 'Sys' || OS, 'RxUtils', 'Rx' || OS ) = 0 then do signal on syntax name PROC.TRAP ; return SysProcessType() end /* tries RxUtils only once, else */ PROC.TRAP: /* force RexxUtil SysProcessType */ call RxFuncDrop 'SysProcessType' ; signal on syntax name TRAP call UTIL 'SysProcessType' ; return SysProcessType() 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 1 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 */