/* TVLOCAL.CMD requires: */ /* TVRX.DLL TVFS REXX interface in LIBPATH */ /* TVLINK.EXE TVFS link (for "M:\WP ROOT. SF") in PATH */ /* TVCTL.EXE TVFS control program already detached */ /* TVLOCAL.CMD usage: */ /* TVLOCAL TVMOUNT M: as general purpose mount disk */ /* and link all local drives incl CD ROM but */ /* excl. floppies as M: directories, adding */ /* a local "M:\WP ROOT. SF" file link */ /* TVLOCAL arg (any non-blank argument): does the same, */ /* and (re)creates a TVLOCAL WPS object with */ /* a reference in on the desktop */ /* CAVEAT: TVRX.DLL can't handle blanks in file names, therefore */ /* TVSAVE (or TVCTL -s) and TVRESTOR (or TVCTL -r) fail */ /* with the virtual (but essential) "WP ROOT. SF" link. */ /* More precisely TVSAVE (or TVCTL -s) create a restore script as */ /* usual, but this script can't be used by TVRESTOR (or TVCTL -r) */ /* if it contains blanks in file names: you may edit it manually. */ DISK = 'M:' /* TVFS M: <= LASTDRIVE is visible in VDM */ TVFS = 'E:\apps\etc' /* some root files are redirected to TVFS */ signal on novalue name TRAP ; signal on syntax name TRAP signal on failure name TRAP ; signal on halt name TRAP call UTIL 'SysDriveMap' ; call UTIL 'SysCreateShadow' call UTIL 'SysDriveInfo' ; call UTIL 'SysSetIcon' if RxFuncQuery( 'TvLoadFuncs' ) then do if RxFuncAdd( 'TvLoadFuncs', 'TVRX', 'TvLoadFuncs' ) then exit TRAP( 'cannot load TVRX->TvLoadFuncs' ) end rc = TvLoadFuncs() /* ignore any concurrency */ select when rc = 0 then INIT = 1 /* ok., can unload at exit */ when rc = 30 then INIT = 0 /* undocumented, maybe ok. */ otherwise exit TRAP( 'cannot init TVRX.DLL [' rc ']' ) end call TvUmount DISK /* unmount any old TVFS M: */ rc = TvMount( '-c0' DISK ) /* -c0: use no TVFS cache */ if rc <> 0 then exit TRAP( 'cannot mount drive' DISK '[' rc ']' ) L = SysDriveMap( /**/, 'Local' ) do while L > '' parse var L D L /* determine drive label M */ parse value SysDriveInfo( D ) with X . . M if X = '' then do /* fails if harddisk error */ call WARN 'drive' D 'not ready and skipped' ; iterate end X = '"*/:<>?\|' || xrange( d2c( 0 ), d2c( 31 )) /* HPFS- */ M = translate( M, copies( '!', length( X )), X ) /* trans */ X = ' +,.;=[]' /* FAT- */ M = translate( M, copies( '_', length( X )), X ) /* trans */ if length( M ) > 8 then M = left( insert( '.', M, 8 ), 12 ) if length( M ) = 0 then M = 'NoNameCD.' || left( D, 1 ) M = DISK || '\' || strip( M ) D = D || '\' ; rc = TvLink( '-drwnt' M D ) if rc <> 0 then exit TRAP( 'cannot link' M '->' D '[' rc ']' ) end call LINK 'nemo', 'nemo.tre' call LINK 'find', 'nemo.fnd' call LINK 'tree', 'treeinfo.ncd' call LINK 'root', 'WP ROOT. SF' call LINK 'data', 'EA DATA. SF' if INIT then call TvDropFuncs if arg( 1 ) = '' then exit 0 if SysCreateShadow( MAKE( 'TvLink Local' ), '' ) then exit 0 else exit TRAP( 'cannot create shadow' ) LINK: procedure expose TVFS DISK D = TVFS || '\tvfs' || arg( 1 ) || '.' || left( DISK, 1 ) M = '"' || DISK || '\' || arg( 2 ) || '"' address CMD '@TvLink -frwnt' M D ; if rc = 0 then return 0 exit TRAP( 'cannot link' M '->' D ) /* see , (c) F. Ellermann */ WARN: procedure /* try RxMessageBox, then STDERR */ parse source . . THIS ; signal on syntax name WARN.TRAP return ( RxMessageBox( arg( 1 ), THIS, /**/, 'HAND' ) <> 1 ) WARN.TRAP: parse version THIS . ; signal on syntax name TRAP if THIS = 'REXXSAA' /* fails if no more file handle: */ then return lineout( 'STDERR' , arg( 1 )) else return lineout( '\dev\con', arg( 1 )) MAKE: procedure /* recreate or update WPS object */ /* 1st arg: optional object title, default name of source */ /* 2nd arg: optional start arg.s, use '[txt]' if interactive */ /* 3rd arg: optional start directory, default TMP environment */ TMP = value( 'TMP',, 'OS2ENVIRONMENT' ) if TMP = '' then TMP = directory() call UTIL 'SysCreateObject' ; call UTIL 'SysGetEA' parse upper source . . SRC ; POS = lastpos( '\', SRC ) TXT = substr( SRC, POS + 1 ) ; DIR = left( SRC, POS ) OBJ = '<' || TXT || '>' ; POS = lastpos( '.', TXT ) TXT = left( TXT, POS - 1 ) ; NEW = 0 ICO = stream( DIR || TXT || '.ICO', 'c', 'query exists' ) if ICO = '' & SysGetEA( SRC, '.ICON', 'POS' ) = 0 then do call UTIL 'SysTempFileName' ; call UTIL 'SysFileDelete' signal on notready name TRAP ; SET = substr( POS, 5 ) NEW = ( length( SET ) = c2d( reverse( substr( POS, 3, 2 )))) NEW = NEW & abbrev( POS, x2c( 'F9FF' )) if NEW then do /* SysTempFileName error ignored */ ICO = SysTempFileName( TMP || '\TMP?????.ICO' ) call charout ICO, SET ; call charout ICO end end if arg( 3, 'O' ) then DIR = TMP ; else DIR = arg( 3 ) if arg( 1, 'E' ) then TXT = arg( 1 ) SET = 'EXENAME=*;PARAMETERS=/C' strip( SRC arg( 2 )) SET = SET || ';MINIMIZED=YES;PROGTYPE=PM' if ICO <> '' then SET = SET || ';ICONFILE=' || ICO SET = SET || ';STARTUPDIR=' || DIR || ';OBJECTID=' || OBJ || ';' POS = '' POS = SysCreateObject( 'WPProgram', TXT, POS, SET, 'Update' ) if NEW then call SysFileDelete ICO if POS then return OBJ /* ready to create shadow etc. */ else exit TRAP( 'fatal - cannot update' OBJ ) 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 */