home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 18 REXX / 18-REXX.zip / filechar.zip / filechar.cmd < prev    next >
OS/2 REXX Batch file  |  2001-10-07  |  11KB  |  211 lines
  1. /* determine valid file char.s on FAT resp. HPFS depending on codepage: */
  2.  
  3.    call trace 'O'                      /* for filters no SET RXTRACE=ON */
  4.    signal on novalue name TRAP   ;     signal on syntax name TRAP
  5.    signal on failure name TRAP   ;     signal on halt   name TRAP
  6.  
  7.    HPFS. = ''  ;  HPFS.0 = 0  ;  HPFS.. = 'D:\TMP\'   /* HPFS directory */
  8.    OFAT. = ''  ;  OFAT.0 = 0  ;  OFAT.. = 'F:\TMP\'   /*  FAT directory */
  9.    LINE.0 = 1  ;  parse source LINE.1
  10.    LINE.. = 'STDERR'                   /* show progress dots on STDERR: */
  11.    if PROC() = 3 then LINE.. = '\DEV\NUL'
  12.  
  13.    ARG = translate( strip( arg( 1 )))  /* accept option - (other: help) */
  14.    select                              /* introduced by - or / (DOSish) */
  15.       when ARG = ''   then COLS =  80  /* use  80 - 6 + 5 =  79 columns */
  16.       when ARG = '--' then COLS = 255  /* use 255 - 6 + 7 = 256 columns */
  17.       when ARG = '/-' then COLS = 255  /*               7 = 5 + 2 CR LF */
  18.       when pos( left( ARG, 1 ), '-/' ) > 0 then do
  19.          parse source . . ARG
  20.          call NEXT 'usage:' ARG '--'
  21.          call NEXT 'as in:' ARG '-- >FILECHAR.437'
  22.          call NEXT '   or:' ARG
  23.          call NEXT 'as in:' ARG '| MORE'
  24.          call NEXT
  25.          call NEXT 'The 1st form uses all characters (long lines),'
  26.          call NEXT 'The 2nd form splits result lines at column 80 '
  27.          call NEXT 'skipping characters 0 .. 9 for console output.'
  28.          call NEXT 'Character mapping depends on current codepage:'
  29.          call NEXT 'CHCP 437 maps upto 6 char.s in one, 850 upto 3.'
  30.          call NEXT
  31.          call NEXT 'Testing FAT characters in file' TAKE( OFAT.., '?' )
  32.          call NEXT ' resp. HPFS characters in file' TAKE( HPFS.., '?' )
  33.          exit SHOW()
  34.       end
  35.       otherwise exit TRAP( 'unknown "' || ARG || '": use "-h" for help' )
  36.    end
  37.  
  38.    call UTIL 'SysFileDelete'           /* unlike "wild" '@DEL ---?---$' */
  39.    call UTIL 'SysFileTree'             /* unlike stream query TRUENAME  */
  40.  
  41.    call charout LINE.., 'SPACE can only be used within names '
  42.    call lineout LINE.., '(HPFS: POINT cannot be used as last char.),'
  43.    call charout LINE.., 'result depends on codepage'     /* disclaimer  */
  44.  
  45.    do J = 1 to 255                     /* 1st loop: erase all ---?---$  */
  46.       if J // 16 = 1 then call charout LINE.., '.'    /* show progress  */
  47.       NEXT = substr( xrange(), J + 1, 1 )             /* omit NUL error */
  48.       call SysFileDelete TAKE( HPFS.., NEXT )
  49.       call SysFileDelete TAKE( OFAT.., NEXT )
  50.    end J
  51.  
  52.    do J = 1 to 255                     /* 2nd loop: write all ---?---$  */
  53.       if J // 16 = 1 then call charout LINE.., '.'    /* show progress  */
  54.       NEXT = substr( xrange(), J + 1, 1 )             /* omit NUL error */
  55.       if COLS = 80 & sign( pos( NEXT, '0123456789' )) then iterate J
  56.       if TEST( 'HPFS.', NEXT ) & NEXT > ' ' then HPFS.! = HPFS.! || NEXT
  57.       if TEST( 'OFAT.', NEXT ) & NEXT > ' ' then OFAT.! = OFAT.! || NEXT
  58.    end J                               /* HPFS = FAT plus +,.;=[] known */
  59.  
  60.    call AKAS 'HPFS.', COLS             /* 3rd loop: list HPFS ---?---$  */
  61.    call AKAS 'OFAT.', COLS             /* 4th loop: list  FAT ---?---$  */
  62.    call lineout LINE.., ''             /* terminate progress indicator  */
  63.    exit SHOW.DOWN()
  64.  
  65. TEST: procedure expose OFAT. HPFS.     /* 2nd loop: write all ---?---$  */
  66.    parse arg STEM, NEXT
  67.    FILE = TAKE( value( STEM || '.' ), NEXT )
  68.    call charout FILE, NEXT
  69.    call charout FILE
  70.    call SysFileTree FILE, 'X'          /* get TRUENAME of all ---?---$  */
  71.    if X.0 = 0 then return 1            /* skip invalid file characters  */
  72.  
  73.    parse var X.1 . . X.0 . X.1         /* get rid of date, time, attr.s */
  74.    call value STEM || '0', max( value( STEM || '0' ), X.0 )
  75.    X.1 = substr( strip( X.1 ), length( strip( X.1 )) - 4, 1 )
  76.    if verify( X.1, value( STEM || '1' )) > 0       /*  4 trailing ---$  */
  77.       then call value STEM || '1', value( STEM || '1' ) || X.1
  78.    return 0                            /* ignore duplicated translation */
  79.  
  80. AKAS: procedure expose OFAT. HPFS. LINE.
  81.    parse arg STEM, COLS                /* get translations of ---?---$  */
  82.    LAST = value( STEM || '0' )         /* 6 E or I a.k.a.s for CHCP 437 */
  83.  
  84.    do J = 1 to length( value( STEM || '1' ))
  85.       NEXT = substr(   value( STEM || '1' ), J, 1 )
  86.       FILE = TAKE( value( STEM || '.' ), NEXT )          ;  K = 1 + 1
  87.       if J // 16 = 1 then call charout LINE.., '.'    /* show progress  */
  88.       do L = 1 to LAST                 /* add all translated characters */
  89.          C = ' '                       /* additional line pad character */
  90.          if sign( chars( FILE )) then do
  91.             C = charin( FILE )         /* get next translated character */
  92.             if C = NEXT then iterate L /* add only translated character */
  93.          end
  94.          call value STEM || K, value( STEM || K ) || C   ;  K = K + 1
  95.       end L
  96.       call charout FILE ;              call SysFileDelete FILE
  97.    end J
  98.  
  99.    K = value( STEM || '1' )   ;        J = COLS - 6
  100.  
  101.    do while K <> ''
  102.       call NEXT left( STEM, 4 ) left( K, J ) ;     K = substr( K, J + 1 )           /* split line(s) for more char.s */
  103.       do L = 2 to LAST                 /* shown a.k.a.s depend on CHCP: */
  104.          C = left( value( STEM || L ), J )
  105.          if C <> '' then call NEXT ' aka' C
  106.          call value STEM || L, substr( value( STEM || L ), J + 1 )
  107.       end L
  108.    end
  109.  
  110.    return NEXT( ' not' left( value( STEM || '!' ), J ))
  111.  
  112. TAKE: procedure                        /* file name pattern = ---?---$  */
  113.    return arg( 1) || '---' || arg( 2 ) || '---$'
  114.  
  115. NEXT: procedure expose LINE.     /* note next global output LINE. */
  116.    L = LINE.0 + 1 ;  LINE.0 = L  ;  LINE.L = arg( 1 ) ;  return L
  117.  
  118. SHOW: procedure expose LINE.     /* trying PMREXX RxMessageBox()  */
  119.    R = lineout( LINE.. )         /* close whatever LOGfile LINE.. */
  120.    if PROC() = 3  then R = 25    /* assume max. 24 message lines  */
  121.    if LINE.0 < 2  then return 0
  122.    if LINE.0 > R  then return SHOW.DOWN()
  123.    R = LINE.2                    /* x2c(0) confuses RxMessageBox: */
  124.    do L = 3 to LINE.0   ;  R = R || x2c( 0A ) || LINE.L  ;  end L
  125.    R = translate( R, d2c( 248 ), x2c( 0 ))
  126.    signal on syntax name SHOW.DOWN
  127.    return RxMessageBox( R, LINE.1, 'OK', 'WARNING' )
  128. SHOW.DOWN:                       /* no PM REXX or too many lines: */
  129.    do L = 1 to LINE.0   ;  say LINE.L  ;  end L
  130.    if PROC() < 3 then pull             ;  return 1
  131.  
  132. PROC: procedure                  /* avoid "unknown function" TRAP */
  133.    parse source OS .             /* for REXXSAA portability abuse */
  134.    if OS <> 'OS/2' then return 1 /* the now obsolete 1: real mode */
  135.  
  136.    OS = 'ProcessType'            /* assume Sys... = RxProcessType */
  137.    if RxFuncQuery( 'Sys' || OS ) = 0 then return SysProcessType()
  138.    if RxFuncAdd(   'Sys' || OS, 'RxUtils', 'Rx' || OS ) = 0 then do
  139.       signal on syntax name PROC.TRAP  ;  return SysProcessType()
  140.    end                           /* tries RxUtils only once, else */
  141. PROC.TRAP:                       /* force RexxUtil SysProcessType */
  142.    call  RxFuncDrop 'SysProcessType'
  143.    call        UTIL 'SysProcessType'   ;  return SysProcessType()
  144.  
  145. UTIL: procedure                  /* load necessary RexxUtil entry */
  146.    if RxFuncQuery(  arg( 1 )) then
  147.       if RxFuncAdd( arg( 1 ), 'RexxUtil', arg( 1 )) then
  148.          exit TRAP( "can't add RexxUtil"  arg( 1 ))
  149.    return 0
  150.  
  151. TRAP:                            /* select REXX exception handler */
  152.    call trace 'O' ;  trace N           /* don't trace interactive */
  153.    parse source TRAP                   /* source on separate line */
  154.    TRAP = x2c( 0D ) || right( '+++', 10 ) TRAP || x2c( 0D0A )
  155.    TRAP = TRAP || right( '+++', 10 )   /* = standard trace prefix */
  156.    TRAP = TRAP condition( 'c' ) 'trap:' condition( 'd' )
  157.    select
  158.       when wordpos( condition( 'c' ), 'ERROR FAILURE' ) > 0 then do
  159.          if condition( 'd' ) > ''      /* need an additional line */
  160.             then TRAP = TRAP || x2c( 0D0A ) || right( '+++', 10 )
  161.          TRAP = TRAP '(RC' rc || ')'   /* any system error codes  */
  162.          if condition( 'c' ) = 'FAILURE' then rc = -3
  163.       end
  164.       when wordpos( condition( 'c' ), 'HALT SYNTAX'   ) > 0 then do
  165.          if condition( 'c' ) = 'HALT' then rc = 4
  166.          if condition( 'd' ) > '' & condition( 'd' ) <> rc then do
  167.             if condition( 'd' ) <> errortext( rc ) then do
  168.                TRAP = TRAP || x2c( 0D0A ) || right( '+++', 10 )
  169.                TRAP = TRAP errortext( rc )
  170.             end                        /* future condition( 'd' ) */
  171.          end                           /* may use errortext( rc ) */
  172.          else  TRAP = TRAP errortext( rc )
  173.          rc = -rc                      /* rc < 0: REXX error code */
  174.       end
  175.       when condition( 'c' ) = 'NOVALUE'  then rc = -2 /* dubious  */
  176.       when condition( 'c' ) = 'NOTREADY' then rc = -1 /* dubious  */
  177.       otherwise                        /* force non-zero whole rc */
  178.          if datatype( value( 'RC' ), 'W' ) = 0 then rc = 1
  179.          if condition() = '' then TRAP = TRAP arg( 1 )
  180.    end                                 /* direct: TRAP( message ) */
  181.  
  182.    TRAP = TRAP || x2c( 0D0A ) || format( sigl, 6 )
  183.    signal on syntax name TRAP.SIGL     /* throw syntax error 3... */
  184.    if 0 < sigl & sigl <= sourceline()  /* if no handle for source */
  185.       then TRAP = TRAP '*-*' strip( sourceline( sigl ))
  186.       else TRAP = TRAP '+++ (source line unavailable)'
  187. TRAP.SIGL:                             /* ...catch syntax error 3 */
  188.    if abbrev( right( TRAP, 2 + 6 ), x2c( 0D0A )) then do
  189.       TRAP = TRAP '+++ (source line unreadable)'   ;  rc = -rc
  190.    end
  191.    select
  192.       when 0 then do                   /* in pipes STDERR: output */
  193.          parse version TRAP.REXX . .   /* REXX/Personal: \dev\con */
  194.          signal on syntax name TRAP.FAIL
  195.          if TRAP.REXX = 'REXXSAA'      /* fails if no more handle */
  196.             then call lineout 'STDERR'  , TRAP
  197.             else call lineout '\dev\con', TRAP
  198.       end
  199.       when 1 then do                   /* OS/2 PM: RxMessageBox() */
  200.          signal on syntax name TRAP.FAIL
  201.          call RxMessageBox ,           /* fails if not in PMREXX  */
  202.             translate( TRAP, ' ', x2c( 0D )), , 'CANCEL', 'WARNING'
  203.       end                              /* replace any CR by blank */
  204.       otherwise   say TRAP ; trace ?L  /* interactive Label trace */
  205.    end
  206.  
  207.    if condition() = 'SIGNAL' then signal TRAP.EXIT
  208. TRAP.CALL:  return rc                  /* continue after CALL ON  */
  209. TRAP.FAIL:  say TRAP ;  rc = 0 - rc    /* force TRAP error output */
  210. TRAP.EXIT:  exit   rc                  /* exit for any SIGNAL ON  */
  211.