home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
OS/2 Shareware BBS: 18 REXX
/
18-REXX.zip
/
filechar.zip
/
filechar.cmd
< prev
next >
Wrap
OS/2 REXX Batch file
|
2001-10-07
|
11KB
|
211 lines
/* determine valid file char.s on FAT resp. HPFS depending on codepage: */
call trace 'O' /* for filters no SET RXTRACE=ON */
signal on novalue name TRAP ; signal on syntax name TRAP
signal on failure name TRAP ; signal on halt name TRAP
HPFS. = '' ; HPFS.0 = 0 ; HPFS.. = 'D:\TMP\' /* HPFS directory */
OFAT. = '' ; OFAT.0 = 0 ; OFAT.. = 'F:\TMP\' /* FAT directory */
LINE.0 = 1 ; parse source LINE.1
LINE.. = 'STDERR' /* show progress dots on STDERR: */
if PROC() = 3 then LINE.. = '\DEV\NUL'
ARG = translate( strip( arg( 1 ))) /* accept option - (other: help) */
select /* introduced by - or / (DOSish) */
when ARG = '' then COLS = 80 /* use 80 - 6 + 5 = 79 columns */
when ARG = '--' then COLS = 255 /* use 255 - 6 + 7 = 256 columns */
when ARG = '/-' then COLS = 255 /* 7 = 5 + 2 CR LF */
when pos( left( ARG, 1 ), '-/' ) > 0 then do
parse source . . ARG
call NEXT 'usage:' ARG '--'
call NEXT 'as in:' ARG '-- >FILECHAR.437'
call NEXT ' or:' ARG
call NEXT 'as in:' ARG '| MORE'
call NEXT
call NEXT 'The 1st form uses all characters (long lines),'
call NEXT 'The 2nd form splits result lines at column 80 '
call NEXT 'skipping characters 0 .. 9 for console output.'
call NEXT 'Character mapping depends on current codepage:'
call NEXT 'CHCP 437 maps upto 6 char.s in one, 850 upto 3.'
call NEXT
call NEXT 'Testing FAT characters in file' TAKE( OFAT.., '?' )
call NEXT ' resp. HPFS characters in file' TAKE( HPFS.., '?' )
exit SHOW()
end
otherwise exit TRAP( 'unknown "' || ARG || '": use "-h" for help' )
end
call UTIL 'SysFileDelete' /* unlike "wild" '@DEL ---?---$' */
call UTIL 'SysFileTree' /* unlike stream query TRUENAME */
call charout LINE.., 'SPACE can only be used within names '
call lineout LINE.., '(HPFS: POINT cannot be used as last char.),'
call charout LINE.., 'result depends on codepage' /* disclaimer */
do J = 1 to 255 /* 1st loop: erase all ---?---$ */
if J // 16 = 1 then call charout LINE.., '.' /* show progress */
NEXT = substr( xrange(), J + 1, 1 ) /* omit NUL error */
call SysFileDelete TAKE( HPFS.., NEXT )
call SysFileDelete TAKE( OFAT.., NEXT )
end J
do J = 1 to 255 /* 2nd loop: write all ---?---$ */
if J // 16 = 1 then call charout LINE.., '.' /* show progress */
NEXT = substr( xrange(), J + 1, 1 ) /* omit NUL error */
if COLS = 80 & sign( pos( NEXT, '0123456789' )) then iterate J
if TEST( 'HPFS.', NEXT ) & NEXT > ' ' then HPFS.! = HPFS.! || NEXT
if TEST( 'OFAT.', NEXT ) & NEXT > ' ' then OFAT.! = OFAT.! || NEXT
end J /* HPFS = FAT plus +,.;=[] known */
call AKAS 'HPFS.', COLS /* 3rd loop: list HPFS ---?---$ */
call AKAS 'OFAT.', COLS /* 4th loop: list FAT ---?---$ */
call lineout LINE.., '' /* terminate progress indicator */
exit SHOW.DOWN()
TEST: procedure expose OFAT. HPFS. /* 2nd loop: write all ---?---$ */
parse arg STEM, NEXT
FILE = TAKE( value( STEM || '.' ), NEXT )
call charout FILE, NEXT
call charout FILE
call SysFileTree FILE, 'X' /* get TRUENAME of all ---?---$ */
if X.0 = 0 then return 1 /* skip invalid file characters */
parse var X.1 . . X.0 . X.1 /* get rid of date, time, attr.s */
call value STEM || '0', max( value( STEM || '0' ), X.0 )
X.1 = substr( strip( X.1 ), length( strip( X.1 )) - 4, 1 )
if verify( X.1, value( STEM || '1' )) > 0 /* 4 trailing ---$ */
then call value STEM || '1', value( STEM || '1' ) || X.1
return 0 /* ignore duplicated translation */
AKAS: procedure expose OFAT. HPFS. LINE.
parse arg STEM, COLS /* get translations of ---?---$ */
LAST = value( STEM || '0' ) /* 6 E or I a.k.a.s for CHCP 437 */
do J = 1 to length( value( STEM || '1' ))
NEXT = substr( value( STEM || '1' ), J, 1 )
FILE = TAKE( value( STEM || '.' ), NEXT ) ; K = 1 + 1
if J // 16 = 1 then call charout LINE.., '.' /* show progress */
do L = 1 to LAST /* add all translated characters */
C = ' ' /* additional line pad character */
if sign( chars( FILE )) then do
C = charin( FILE ) /* get next translated character */
if C = NEXT then iterate L /* add only translated character */
end
call value STEM || K, value( STEM || K ) || C ; K = K + 1
end L
call charout FILE ; call SysFileDelete FILE
end J
K = value( STEM || '1' ) ; J = COLS - 6
do while K <> ''
call NEXT left( STEM, 4 ) left( K, J ) ; K = substr( K, J + 1 ) /* split line(s) for more char.s */
do L = 2 to LAST /* shown a.k.a.s depend on CHCP: */
C = left( value( STEM || L ), J )
if C <> '' then call NEXT ' aka' C
call value STEM || L, substr( value( STEM || L ), J + 1 )
end L
end
return NEXT( ' not' left( value( STEM || '!' ), J ))
TAKE: procedure /* file name pattern = ---?---$ */
return arg( 1) || '---' || arg( 2 ) || '---$'
NEXT: procedure expose LINE. /* note next global output LINE. */
L = LINE.0 + 1 ; LINE.0 = L ; LINE.L = arg( 1 ) ; return L
SHOW: procedure expose LINE. /* trying PMREXX RxMessageBox() */
R = lineout( LINE.. ) /* close whatever LOGfile LINE.. */
if PROC() = 3 then R = 25 /* assume max. 24 message lines */
if LINE.0 < 2 then return 0
if LINE.0 > R then return SHOW.DOWN()
R = LINE.2 /* x2c(0) confuses RxMessageBox: */
do L = 3 to LINE.0 ; R = R || x2c( 0A ) || LINE.L ; end L
R = translate( R, d2c( 248 ), x2c( 0 ))
signal on syntax name SHOW.DOWN
return RxMessageBox( R, LINE.1, 'OK', 'WARNING' )
SHOW.DOWN: /* no PM REXX or too many lines: */
do L = 1 to LINE.0 ; say LINE.L ; end L
if PROC() < 3 then pull ; return 1
PROC: procedure /* avoid "unknown function" TRAP */
parse source OS . /* for REXXSAA portability abuse */
if OS <> 'OS/2' then return 1 /* the now obsolete 1: real mode */
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'
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 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 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 */