/* ?:\OS2\BOOT\ALTF1BOT.SCR created reflecting all existing */ /* ?:\OS2\BOOT\ALTF1?.CMD (excl. general ALTF1.CMD) plus */ /* ?:\OS2\BOOT\CONFIG.? (excl. general choice Alt-F1 V) */ signal on novalue name TRAP ; signal on syntax name TRAP signal on failure name TRAP ; signal on halt name TRAP call UTIL 'SysFileDelete' ; call UTIL 'SysFileTree' K = directory() BOOT = directory( BOOT() || '\OS2\BOOT' ) call directory K /* return to CWD */ if BOOT = '' then exit TRAP( 'boot directory not found' ) call SysFileTree BOOT || '\CONFIG.?', 'ALT', 'FO' do N = 1 to ALT.0 C = translate( right( ALT.N, 1 )) ALT..C = ALT.N ALT.N = C end N call SysFileTree BOOT || '\ALTF1?.CMD', 'ADD', 'FO' do N = 1 to ADD.0 if ADD.N = BOOT || '\ALTF1.CMD' then iterate C = translate( left( right( ADD.N, 5 ), 1 )) if symbol( 'ALT..' || C ) = 'VAR' then iterate K = ALT.0 + 1 ; ALT.0 = K /* really new */ ALT..C = ADD.N ; ALT.K = C /* add to ALT */ end N N = 25 /* boot menu lines */ K = BOOT || '\ALTF1TOP.SCR' /* shown TOP lines */ if lines( K ) > 0 then do until lines( K ) = 0 call linein K ; N = N - 1 end else exit TRAP( K 'not found' ) K = BOOT || '\ALTF1MID.SCR' /* shown MID lines */ if lines( K ) > 0 then do until lines( K ) = 0 C = translate( left( strip( linein( K )), 1 )) if symbol( 'ALT..' || C ) = 'VAR' then ALT..C = '' /* skip in BOT */ else N = N - 1 /* oops */ end else exit TRAP( K 'not found' ) K = BOOT || '\ALTF1BOT.SCR' ; call SysFileDelete K do L = 1 to ALT.0 until N = 0 C = ALT.L if ALT..C = '' then iterate L /* show in MID */ call SysFileTree ALT..C, 'ADD', 'T' parse var ADD.1 YY '/' MM '/' DD '/' HH '/' ADD.1 ADD.1 = DD || '.' || MM || '.' || YY HH || ':' || ADD.1 call lineout K, ' ' C || ')' strip( left( ADD.1, 73 )) N = N - 1 end L if arg( 1 ) = '' then exit 0 /* any arg.: recreate WPS object */ call UTIL 'SysCreateShadow' if SysCreateShadow( MAKE( 'Alt F1 Bot.Scr' ), '' ) then exit 0 else exit TRAP( 'cannot create shadow' ) /* see , (c) F. Ellermann */ 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 ) BOOT: procedure /* avoid "unknown function" TRAP */ OS = 'BootDrive' /* assume Sys... = RxBootDrive() */ if RxFuncQuery( 'Sys' || OS ) = 0 then return SysBootDrive() if RxFuncAdd( 'Sys' || OS, 'RxUtils', 'Rx' || OS ) = 0 then do signal on syntax name BOOT.TRAP ; return SysBootDrive() end /* tries RxUtils only once, else */ BOOT.TRAP: /* force RexxUtil SysBootDrive() */ call RxFuncDrop 'SysBootDrive' ; signal on syntax name TRAP call UTIL 'SysBootDrive' ; return SysBootDrive() 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 */