home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 18 REXX / 18-REXX.zip / instfont.zip / FixFont3.cmd < prev    next >
OS/2 REXX Batch file  |  1996-10-16  |  22KB  |  642 lines
  1. /*------------------------------------------------------------------------*\
  2. |                                                                          |
  3. |           FIXFONT3.CMD - Version 1.0 - Version Date 1996-08-11           |
  4. |                                                                          |
  5. \*------------------------------------------------------------------------*/
  6. /*
  7.  
  8.    Remove any non-existing TrueType fonts from all WIN.INI & ATM.INI files
  9.  
  10. */
  11. GBL. = ''             /* initialize stem */
  12. parse Arg             GBL.CommandLine 
  13. parse Version         GBL.RexxVersion,
  14.                       GBL.RexxVersionLevel,
  15.                       GBL.RexxVersionDay,
  16.                       GBL.RexxVersionMonth,
  17.                       GBL.RexxVersionYear    .
  18. parse Source          GBL.OperatingSystem,
  19.                       GBL.CallingEnvironment,
  20.                       GBL.ProgramPathAndName   /* case is unreliable */   
  21.  
  22. parse value DATE('S') with,
  23.    year +4,
  24.    mm   +2,
  25.    dd
  26.  
  27. GBL.List            = 'GBL. crlf'
  28. GBL.Environment     = 'OS2ENVIRONMENT'
  29. GBL.BootDrive       = LEFT( VALUE( 'RUNWORKPLACE',, GBL.Environment ), 2 )
  30. GBL.CurrentDate     = mm || '/' || dd || '/' || year
  31. GBL.Hostname        = VALUE( 'MACHINENAME',, GBL.Environment )
  32. GBL.Ramdrive        = VALUE( 'RAMDRIVE',, GBL.Environment )
  33. GBL.ProgramVersion  = 1.0           /* version / mod of this program */
  34. GBL.ProgramName     = STRIP( FILESPEC( 'N', GBL.ProgramPathAndName ) )
  35. GBL.ProgramPath     = STRIP( FILESPEC( 'D', GBL.ProgramPathAndName ) ||,
  36.                              FILESPEC( 'P', GBL.ProgramPathAndName ) )
  37.  
  38. parse var GBL.ProgramName,
  39.    GBL.ProgramFn  '.',
  40.    GBL.ProgramFe 
  41. GBL.ProgramFe  = TRANSLATE( GBL.ProgramFe  )
  42. call TIME 'R'                    /* reset elapsed timer - sssss.uuuuu */
  43. say 'Begin' GBL.ProgramFn || '.' || GBL.ProgramFe  'at' TIME('N')
  44.  
  45. /*------------------------*\
  46. |  Enable trap processing  |
  47. |    if REXXLIB present    |
  48. \*------------------------*/
  49.    SIGNAL ON ERROR
  50.    SIGNAL ON FAILURE
  51.    SIGNAL ON HALT
  52.    SIGNAL ON NOVALUE
  53.    SIGNAL ON SYNTAX
  54.  
  55. crlf = '0D0A'x
  56. GBL.font_home_path = 'M:\FONTS\'
  57.  
  58. GBL.LogFile  =,
  59.    GBL.ProgramPath  ||,
  60.    GBL.ProgramFn    || '.LOG'
  61. if STREAM( GBL.LogFile, 'C', 'QUERY EXISTS' ) ¬= '' then
  62.    do
  63.       log_line = crlf || COPIES( '=', 76 )
  64.       call LINEOUT GBL.LogFile, log_line
  65.    end
  66. log_line = GBL.ProgramFn || '.' || GBL.ProgramFe || ' Started on' DATE() 'at' TIME() ' CPU:' GBL.Hostname '-' GBL.OperatingSystem
  67. call LINEOUT GBL.LogFile, log_line
  68.  
  69. /*-----------------------------------------------*\
  70. |  Table of path for all WIN.INI & ATM.INI files  |
  71. \*-----------------------------------------------*/
  72. p=0
  73. /*
  74. p=p+1; path_table.p = 'C:\WIN-311\'
  75. p=p+1; path_table.p = 'D:\OS2\MDOS\WINOS2\'
  76. p=p+1; path_table.p = 'F:\OS2\MDOS\WINOS2\'
  77. p=p+1; path_table.p = 'G:\OS2\MDOS\WINOS2\'
  78. p=p+1; path_table.p = 'H:\OS2\MDOS\WINOS2\'
  79. */
  80. p=p+1; path_table.p = 'I:\OS2\MDOS\WINOS2\'
  81.        path_table.0 = p
  82.  
  83. do p = 1 to path_table.0
  84.    call PROCESS_ATM_INI path_table.p || 'ATM.INI'
  85.    call PROCESS_WIN_INI path_table.p || 'WIN.INI'
  86. end
  87.  
  88. call STREAM GBL.LogFile, 'C', 'CLOSE'
  89.  
  90. call EOJ 0
  91.  
  92. /*------------------------------------------------------------------------*\
  93. |                                                                          |
  94. |      Create archive with numeric file extension for specified file       |
  95. |                                                                          |
  96. \*------------------------------------------------------------------------*/
  97. CREATE_ARCHIVE:
  98.    Procedure expose,
  99.       (GBL.List)
  100.  
  101. parse ARG original_path_and_file_name
  102.  
  103. original_path =,
  104.    FILESPEC( 'D', original_path_and_file_name ) ||,
  105.    FILESPEC( 'P', original_path_and_file_name )
  106. parse value FILESPEC( 'N', original_path_and_file_name ) with,
  107.    original_fn '.' original_fe
  108.  
  109. next_sequential_value = 0
  110. call SysFileTree original_path || original_fn || '.*', 'stem', 'O'
  111. do s = 1 to stem.0
  112.    parse value FILESPEC( 'N', stem.s ) with,
  113.       stem_fn '.' stem_fe
  114.    if DATATYPE( stem_fe ) ¬= 'NUM' then iterate s
  115.    if stem_fe >= next_sequential_value then
  116.       do
  117.          next_sequential_value = stem_fe + 1
  118.       end
  119. end
  120.  
  121. new_path_and_file_name =,
  122.    original_path || original_fn || '.' || RIGHT( next_sequential_value, 3, '0' )
  123. call DOSCOPY original_path_and_file_name, new_path_and_file_name, 'R'
  124. if RESULT ¬= 0 then
  125.    do
  126.       log_line =,
  127.          'Unable to copy' original_path_and_file_name 'to' new_path_and_file_name
  128.       call LINEOUT GBL.LogFile, log_line
  129.       say log_line
  130.       call EOJ
  131.    end
  132.  
  133. return
  134.  
  135. /*------------------------------------------------------------------------*\
  136. |                                                                          |
  137. |                    Process ATM.INI in specified path                     |
  138. |                                                                          |
  139. \*------------------------------------------------------------------------*/
  140. PROCESS_ATM_INI:
  141.    Procedure expose,
  142.       (GBL.List)
  143.  
  144. parse ARG atm_ini_path_and_file_name
  145.  
  146. atm_ini_change_count = 0
  147.  
  148. /*-------------*\
  149. |  Get ATM.INI  |
  150. \*-------------*/
  151. atm_size = STREAM( atm_ini_path_and_file_name, 'C', 'QUERY SIZE' )
  152. if atm_size = '' then
  153.    do
  154.       log_line =,
  155.          'Unable to locate' atm_ini_path_and_file_name
  156.       call LINEOUT GBL.LogFile, log_line
  157.       return
  158.    end
  159.  
  160. atm_area = CHARIN( atm_ini_path_and_file_name, 1, atm_size )
  161. call STREAM atm_ini_path_and_file_name, 'C', 'CLOSE'
  162. uppercase_atm_area = TRANSLATE( atm_area )
  163.  
  164. /*--------------------*\
  165. |  Check QLCDir value  |
  166. \*--------------------*/
  167. qlc_dir_arg = 'QLCDIR='
  168. qlc_dir_beg = POS( crlf || qlc_dir_arg, uppercase_atm_area )
  169. if qlc_dir_beg = 0 then
  170.    do
  171.       log_line =,
  172.          'Unable to locate' qlc_dir_arg 'in' atm_ini_path_and_file_name
  173.       call LINEOUT GBL.LogFile, log_line
  174.       say log_line
  175.       return
  176.    end
  177. qlc_dir_beg = qlc_dir_beg + LENGTH(qlc_dir_arg) + 2
  178. qlc_dir_end = POS( crlf, uppercase_atm_area, qlc_dir_beg )
  179. uppercase_qlc_dir_value =,
  180.    SUBSTR( uppercase_atm_area, qlc_dir_beg, qlc_dir_end - qlc_dir_beg )
  181. new_qlc_dir_value =,
  182.    GBL.font_home_path || 'PSFONTS'
  183. if uppercase_qlc_dir_value ¬= new_qlc_dir_value then
  184.    do
  185.       atm_area =,
  186.          DELSTR( atm_area, qlc_dir_beg, LENGTH(uppercase_qlc_dir_value) )
  187.       atm_area =,
  188.          INSERT( new_qlc_dir_value, atm_area, qlc_dir_beg - 1 )
  189.       uppercase_atm_area = TRANSLATE( atm_area )
  190.       atm_ini_change_count = atm_ini_change_count + 1
  191.    end
  192.  
  193. /*---------------------*\
  194. |  Check PFM_DIR value  |
  195. \*---------------------*/
  196. pfm_dir_arg = 'PFM_DIR='
  197. pfm_dir_beg = POS( crlf || pfm_dir_arg, uppercase_atm_area )
  198. if pfm_dir_beg = 0 then
  199.    do
  200.       log_line =,
  201.          'Unable to locate' pfm_dir_arg 'in' atm_ini_path_and_file_name
  202.       call LINEOUT GBL.LogFile, log_line
  203.       say log_line
  204.       return
  205.    end
  206. pfm_dir_beg = pfm_dir_beg + LENGTH(pfm_dir_arg) + 2
  207. pfm_dir_end = POS( crlf, uppercase_atm_area, pfm_dir_beg )
  208. uppercase_pfm_dir_value =,
  209.    SUBSTR( uppercase_atm_area, pfm_dir_beg, pfm_dir_end - pfm_dir_beg )
  210. new_pfm_dir_value =,
  211.    GBL.font_home_path || 'PSFONTS\PFM'
  212. if uppercase_pfm_dir_value ¬= new_pfm_dir_value then
  213.    do
  214.       atm_area =,
  215.          DELSTR( atm_area, pfm_dir_beg, LENGTH(uppercase_pfm_dir_value) )
  216.       atm_area =,
  217.          INSERT( new_pfm_dir_value, atm_area, pfm_dir_beg - 1 )
  218.       uppercase_atm_area = TRANSLATE( atm_area )
  219.  
  220.       /*-----------------------*\
  221.       |  Replace all PFM paths  |
  222.       \*-----------------------*/
  223.       pfm_ptr = LENGTH(atm_area)
  224.       do forever
  225.          pfm_ptr = LASTPOS( uppercase_pfm_dir_value, uppercase_atm_area, pfm_ptr )
  226.          if pfm_ptr = 0 then leave
  227.          atm_area =,
  228.             DELSTR( atm_area, pfm_ptr, LENGTH(uppercase_pfm_dir_value) )
  229.          atm_area =,
  230.             INSERT( new_pfm_dir_value, atm_area, pfm_ptr -1 )
  231.       end
  232.  
  233.       uppercase_atm_area = TRANSLATE( atm_area )
  234.       atm_ini_change_count = atm_ini_change_count + 1
  235.    end
  236.  
  237. /*---------------------*\
  238. |  Check PFB_DIR value  |
  239. \*---------------------*/
  240. pfb_dir_arg = 'PFB_DIR='
  241. pfb_dir_beg = POS( crlf || pfb_dir_arg, uppercase_atm_area )
  242. if pfb_dir_beg = 0 then
  243.    do
  244.       log_line =,
  245.          'Unable to locate' pfb_dir_arg 'in' atm_ini_path_and_file_name
  246.       call LINEOUT GBL.LogFile, log_line
  247.       say log_line
  248.       return
  249.    end
  250. pfb_dir_beg = pfb_dir_beg + LENGTH(pfb_dir_arg) + 2
  251. pfb_dir_end = POS( crlf, uppercase_atm_area, pfb_dir_beg )
  252. uppercase_pfb_dir_value =,
  253.    SUBSTR( uppercase_atm_area, pfb_dir_beg, pfb_dir_end - pfb_dir_beg )
  254. new_pfb_dir_value =,
  255.    GBL.font_home_path || 'PSFONTS'
  256. if uppercase_pfb_dir_value ¬= new_pfb_dir_value then
  257.    do
  258.       atm_area =,
  259.          DELSTR( atm_area, pfb_dir_beg, LENGTH(uppercase_pfb_dir_value) )
  260.       atm_area =,
  261.          INSERT( new_pfb_dir_value, atm_area, pfb_dir_beg - 1 )
  262.       uppercase_atm_area = TRANSLATE( atm_area )
  263.  
  264.       /*-----------------------*\
  265.       |  Replace all PFB paths  |
  266.       \*-----------------------*/
  267.       pfb_ptr = LENGTH(atm_area)
  268.       do forever
  269.          pfb_ptr = LASTPOS( uppercase_pfb_dir_value, uppercase_atm_area, pfb_ptr )
  270.          if pfb_ptr = 0 then leave
  271.          atm_area =,
  272.             DELSTR( atm_area, pfb_ptr, LENGTH(uppercase_pfb_dir_value) )
  273.          atm_area =,
  274.             INSERT( new_pfb_dir_value, atm_area, pfb_ptr -1 )
  275.       end
  276.  
  277.       uppercase_atm_area = TRANSLATE( atm_area )
  278.       atm_ini_change_count = atm_ini_change_count + 1
  279.    end
  280.  
  281. if atm_ini_change_count = 0 then
  282.    do
  283.       return
  284.    end
  285.  
  286. call CREATE_ARCHIVE atm_ini_path_and_file_name
  287.  
  288. call SysFileDelete atm_ini_path_and_file_name
  289. call CHAROUT atm_ini_path_and_file_name, atm_area
  290. call STREAM  atm_ini_path_and_file_name, 'C', 'CLOSE'
  291.  
  292. log_line =,
  293.    atm_ini_path_and_file_name 'updated'
  294. call LINEOUT GBL.LogFile, log_line
  295.  
  296. /*---------------------------------------------*\
  297. |  Delete the ATMFONTS.QLC entry, if it exists  |
  298. \*---------------------------------------------*/
  299. call SysFileDelete new_qlc_dir_value || '\ATMFONTS.QLC'
  300. call SysFileDelete uppercase_qlc_dir_value || '\ATMFONTS.QLC'
  301.  
  302. return
  303.  
  304. /*------------------------------------------------------------------------*\
  305. |                                                                          |
  306. |                    Process WIN.INI in specified path                     |
  307. |                                                                          |
  308. \*------------------------------------------------------------------------*/
  309. PROCESS_WIN_INI:
  310.    Procedure expose,
  311.       (GBL.List)
  312.  
  313. parse ARG win_ini_path_and_file_name
  314.  
  315. win_ini_change_count = 0
  316. win_ini_path =,
  317.    FILESPEC( 'D', win_ini_path_and_file_name ) ||,
  318.    FILESPEC( 'P', win_ini_path_and_file_name )
  319.  
  320. /*-------------*\
  321. |  Get WIN.INI  |
  322. \*-------------*/
  323. win_size = STREAM( win_ini_path_and_file_name, 'C', 'QUERY SIZE' )
  324. if win_size = '' then
  325.    do
  326.       log_line =,
  327.          'Unable to locate' win_ini_path_and_file_name
  328.       call LINEOUT GBL.LogFile, log_line
  329.       return
  330.    end
  331.  
  332. win_area = CHARIN( win_ini_path_and_file_name, 1, win_size )
  333. call STREAM win_ini_path_and_file_name, 'C', 'CLOSE'
  334. uppercase_win_area = TRANSLATE( win_area )
  335.  
  336. font_stanza_arg = '[FONTS]'
  337. font_stanza_beg = POS( crlf || font_stanza_arg, uppercase_win_area )
  338. if font_stanza_beg = 0 then
  339.    do
  340.       log_line =,
  341.          'Unable to locate' font_stanza_arg 'in' win_ini_path_and_file_name
  342.       call LINEOUT GBL.LogFile, log_line
  343.       return
  344.    end
  345. font_stanza_beg = font_stanza_beg + LENGTH(font_stanza_arg) + 2
  346. font_stanza_end =,
  347.    POS( crlf || '[', uppercase_win_area || crlf || '[', font_stanza_beg )
  348. drop uppercase_win_area
  349.  
  350. /*-----------------------------------------*\
  351. |  Replace FOT font entries & delete .TTF   |
  352. |  & .FOT files if they exist in home path  |
  353. \*-----------------------------------------*/
  354. line_beg_ptr = font_stanza_end
  355. do do_loop_1 = 1
  356.    line_beg_ptr = LASTPOS( crlf, win_area, line_beg_ptr - 2 ) + 2
  357.    if line_beg_ptr < font_stanza_beg then leave do_loop_1
  358.    line_end_ptr = POS( crlf, win_area, line_beg_ptr )
  359.  
  360.    fot_line =,
  361.       SUBSTR( win_area, line_beg_ptr, line_end_ptr - line_beg_ptr )
  362.  
  363.    parse value fot_line with,
  364.       fot_description '=' fot_path_and_file_name
  365.  
  366.    fot_path =,
  367.       FILESPEC( 'D', fot_path_and_file_name ) ||,
  368.       FILESPEC( 'P', fot_path_and_file_name )
  369.    fot_name =,
  370.       FILESPEC( 'N', fot_path_and_file_name )
  371.    parse upper value fot_name with,
  372.       fot_fn '.' fot_fe
  373.  
  374.    if fot_fe ¬= 'FOT' then iterate do_loop_1
  375.  
  376.    /*-----------------------------------*\
  377.    |  Be sure that font is in home path  |
  378.    \*-----------------------------------*/
  379.    fot_path = GBL.font_home_path || 'TRUETYPE\'
  380.    fot_path_and_file_name =,
  381.       fot_path || fot_name
  382.  
  383.    /*-----------------------------------------*\
  384.    |  Delete existing TTF string from WIN.INI  |
  385.    \*-----------------------------------------*/
  386.    win_area =,
  387.       DELSTR( win_area, line_beg_ptr, line_end_ptr - line_beg_ptr + 2 )
  388.    win_ini_change_count = win_ini_change_count + 1
  389.  
  390.    /*------------------------------*\
  391.    |  Be sure that FOT file exists  |
  392.    \*------------------------------*/
  393.    if STREAM( fot_path_and_file_name, 'C', 'QUERY EXISTS' ) = '' then
  394.       do
  395.          log_line =,
  396.             fot_line,
  397.             'removed from',
  398.             win_ini_path_and_file_name
  399.          call LINEOUT GBL.LogFile, log_line
  400.          iterate do_loop_1
  401.       end
  402.  
  403.    new_fot_line =,
  404.       fot_description || '=' || fot_path_and_file_name
  405.    win_area =,
  406.       INSERT( new_fot_line || crlf, win_area, line_beg_ptr - 1 )
  407.  
  408. end
  409.  
  410. if win_ini_change_count > 0 then
  411.    do
  412.       call CREATE_ARCHIVE win_ini_path_and_file_name
  413.       call SysFileDelete  win_ini_path_and_file_name
  414.       call CHAROUT win_ini_path_and_file_name, win_area
  415.       call STREAM  win_ini_path_and_file_name, 'C', 'CLOSE'
  416.       log_line =,
  417.          win_ini_path_and_file_name 'updated'
  418.       call LINEOUT GBL.LogFile, log_line
  419.    end
  420.  
  421. return
  422.  
  423.  
  424. !tr!=VALUE('TRACE',, GBL.Environment); if !tr!<>'' then do;say 'Trace' !tr! 'started'; TRACE(!tr!);nop;end
  425. /*------------------------------------------------------------------------*\
  426. |                                                                          |
  427. |                                End of Job                                |
  428. |                                                                          |
  429. \*------------------------------------------------------------------------*/
  430. EOJ:
  431.    Procedure expose,
  432.       GBL.
  433.  
  434. if ARG() = 0 then
  435.    eoj_rc = 0
  436. else
  437.    eoj_rc = ARG(1)
  438.  
  439. elapsed_time = TIME('E')            /* get elapsed time - sssss.uuuuu */
  440. parse value elapsed_time with seconds '.' micro_seconds
  441. if LEFT( micro_seconds, 1, 1 ) >= 5 then
  442.    seconds = seconds + 1
  443. ss = FORMAT( seconds // 60, 2 )
  444. minutes = ( seconds - ss ) / 60
  445. mm = FORMAT( minutes // 60, 2 )
  446. hh = FORMAT( ( minutes - mm ) / 60, 2 )
  447. duration = hh':'mm':'ss
  448.  
  449. say 'EOJ   ' || GBL.ProgramFn || '.' || GBL.ProgramFe 'at' TIME('N') ||,
  450.     ', duration' TRANSLATE( duration, '0', ' ' )
  451. exit eoj_rc
  452.  
  453. /*------------------------------------------------------------------------*\
  454. |                                                                          |
  455. |                              Trap Routines                               |
  456. |                                                                          |
  457. \*------------------------------------------------------------------------*/
  458. ERROR:       call TRAP_PROCESSING_01   SIGL, 'ERROR',   RC
  459. FAILURE:     call TRAP_PROCESSING_01   SIGL, 'FAILURE', RC
  460. HALT:        call TRAP_PROCESSING_01   SIGL, 'HALT',    ''
  461. LOGIC_ERROR: call TRAP_PROCESSING_01   SIGL, 'LOGIC',   ARG( 1 )
  462. NOVALUE:     call TRAP_PROCESSING_01   SIGL, 'NOVALUE', ''
  463. SYNTAX:      call TRAP_PROCESSING_01   SIGL, 'SYNTAX',  RC
  464.  
  465. TRAP_PROCESSING_01:
  466.    SIGNAL ON ERROR   name TRAP_PROCESSING_02 /* prevent recursion */
  467.    SIGNAL ON FAILURE name TRAP_PROCESSING_02 /* prevent recursion */
  468.    SIGNAL ON HALT    name TRAP_PROCESSING_02 /* prevent recursion */
  469.    SIGNAL ON NOVALUE name TRAP_PROCESSING_02 /* prevent recursion */
  470.    SIGNAL ON SYNTAX  name TRAP_PROCESSING_02 /* prevent recursion */
  471.    ?Trap.   = ''     /* Revised 98/12/18 */
  472.    TRAP_DMP = ''     /* .DMP path & file name */
  473.    TRAP_DMP_TIMESTAMP = DATE( ) || COPIES(' ', 2 ) || LEFT( TIME('L'),11 )
  474.  
  475. /*---------------------*\
  476. |  Program path & name  |
  477. \*---------------------*/
  478. parse Source  ?Trap.?OperatingSystem . ?Trap.?ProgramPathAndFileName
  479. parse Version ?Trap.?RexxVersion
  480.  
  481. ?Trap.?LineNumber = ARG( 1 )
  482. if POS( ':', ?Trap.?ProgramPathAndFileName ) > 0 then
  483.    /* get source line if it is available */
  484.    do ?T = 1
  485.       TRAP_SOURCE_LINE.?T =  SOURCELINE( ?Trap.?LineNumber )
  486.       TRAP_SOURCE_LINE.0  = ?T
  487.       if TRAP_SOURCE_LINE.?T == '' then
  488.          do
  489.             TRAP_SOURCE_LINE.?T = 'Source is not available'
  490.             leave
  491.          end
  492.       ?Trap.?LineNumber   = ?Trap.?LineNumber + 1
  493.       if RIGHT( TRAP_SOURCE_LINE.?T, 1 ) ¬== ',' then
  494.          do
  495.             leave
  496.          end
  497.    end
  498. else
  499.    /* program is running in macrospace */
  500.    do
  501.       ?Trap.?ProgramPathAndFileName =,
  502.          STRIP( DIRECTORY( ), 'T', '\' ) || '\' ||,
  503.          ?Trap.?ProgramPathAndFileName
  504.       TRAP_SOURCE_LINE.1 = 'Source line is not available.'
  505.       TRAP_SOURCE_LINE.0 = 1
  506.    end
  507.  
  508. parse value FILESPEC( 'N', ?Trap.?ProgramPathAndFileName ) with,
  509.    ?Trap.?Fn '.' ?Trap.?Fe
  510. TRAP_DMP =,
  511.    FILESPEC( 'D', ?Trap.?ProgramPathAndFileName ) ||,
  512.    FILESPEC( 'P', ?Trap.?ProgramPathAndFileName ) ||,
  513.    ?Trap.?Fn || '.' || 'DMP'
  514.  
  515. /*-------------------------------------------*\
  516. |  Determine whether ANSII or VX-REXX output  |
  517. \*-------------------------------------------*/
  518. ?Trap.?VXREXX = ( RxFuncQuery( 'VRWindow' ) = 0 )
  519. if ?Trap.?VXREXX then
  520.    do
  521.       /* see if Primary Window handle exists */
  522.       ?Trap.?VXREXX = ( LEFT( VRWindow( ), 1 ) = '?' )
  523.    end
  524.  
  525. /*------------------------------------------*\
  526. |  Check for reason NOT to create .DMP file  |
  527. \*------------------------------------------*/
  528. select
  529.    when ARG( 2 ) = 'HALT' then
  530.       do
  531.          TRAP_DMP = ''
  532.       end
  533.    when POS( ':', TRAP_DMP ) = 0 then
  534.       do
  535.          TRAP_DMP = ''
  536.       end
  537.    when ABBREV( ?Trap.?RexxVersion, 'OBJREXX' ) then
  538.       do
  539.          if RxFuncQuery( 'SysDumpVariables' ) <> 0 then
  540.             do
  541.                TRAP_DMP = ''
  542.             end
  543.       end
  544.    when ?Trap.?OperatingSystem = 'OS/2' then
  545.       do
  546.          if RxFuncQuery( 'VARDUMP' ) <> 0 then
  547.             do
  548.                TRAP_DMP = ''
  549.             end
  550.       end
  551.    otherwise
  552.       do
  553.          nop
  554.       end
  555. end
  556.  
  557. /*------------------------*\
  558. |  Build trap message box  |
  559. \*------------------------*/
  560. ?DBL.H     = 'CD'x                 /* ═ double line - horizontal   */
  561. ?DBL.V     = 'BA'x                 /* ║ double line - vertical     */
  562. ?DBL.BL    = 'C8'x                 /* ╚ double line - bottom left  */
  563. ?DBL.BR    = 'BC'x                 /* ╝ double line - bottom right */
  564. ?DBL.TL    = 'C9'x                 /* ╔ double line - top left     */
  565. ?DBL.TR    = 'BB'x                 /* ╗ double line - top right    */
  566. if ?Trap.?OperatingSystem ¬== 'WindowsNT' then
  567.    do
  568.       ?Trap.?RED = '1B'x || '[1;37;41m'  /* bright white on red    */
  569.       ?Trap.?DUL = '1B'x || '[0m'        /* reset to normal        */
  570.    end
  571. ?Trap.?Margin = COPIES( ' ', 2 )
  572.  
  573. TRAP_ERROR_DESCRIPTION =,
  574.    'Error line = ' || ARG( 1 ) || '; ' || ARG( 2 ) || ' trap caught'
  575. if ARG( 3 ) <> '' then
  576.    TRAP_ERROR_DESCRIPTION = TRAP_ERROR_DESCRIPTION ||,
  577.       '  Return code = ' || ARG( 3 )
  578.  
  579. ?T=0
  580. ?T=?T+1; ?Trap.?line.?T = ?Trap.?Fn'.'?Trap.?Fe
  581. ?T=?T+1; ?Trap.?line.?T = TRAP_ERROR_DESCRIPTION
  582. if TRAP_DMP <> '' then
  583.    do
  584. ?T=?T+1; ?Trap.?line.?T = ''
  585. ?T=?T+1; ?Trap.?line.?T = 'See: ' || TRAP_DMP
  586.    end
  587. ?T=?T+1; ?Trap.?line.?T = ''
  588. ?T=?T+1; ?Trap.?line.?T = 'Source line(s) at time of trap:'
  589. do ?S = 1 to TRAP_SOURCE_LINE.0
  590.    ?T=?T+1; ?Trap.?line.?T = ?Trap.?Margin || TRAP_SOURCE_LINE.?S
  591. end
  592.          ?Trap.?line.0 = ?T
  593. if ?Trap.?VXREXX then
  594.    do
  595.       ?Trap.?PrimaryWindowHandle = VRWindow( )
  596.       call VRSet  ?Trap.?PrimaryWindowHandle,,
  597.                   'BackColor',      'White',,
  598.                   'ForeColor',      'Red',,
  599.                   ''
  600.  
  601.       call VRMessageStem ?Trap.?PrimaryWindowHandle,,
  602.                          '?Trap.?line.',,
  603.                          CENTER( ?Trap.?Fn 'Fatal error', 74 ),,
  604.                          'E'
  605.    end
  606. else
  607.    do
  608.       ?Trap.?Width = MAX( 74, LENGTH( TRAP_ERROR_DESCRIPTION ) )
  609.       say ?Trap.?RED || ?DBL.TL || COPIES( ?DBL.H,?Trap.?Width + 2 ) || ?DBL.TR || ?Trap.?DUL
  610.       say ?Trap.?RED || ?DBL.V  || COPIES( ' ',   ?Trap.?Width + 2 ) || ?DBL.V  || ?Trap.?DUL
  611.       do ?T = 1 to ?Trap.?line.0
  612.       say ?Trap.?RED || ?DBL.V    LEFT( ?Trap.?line.?T, ?Trap.?Width )   ?DBL.V  || ?Trap.?DUL
  613.       end
  614.       say ?Trap.?RED || ?DBL.V  || COPIES( ' ',   ?Trap.?Width + 2 ) || ?DBL.V  || ?Trap.?DUL
  615.       say ?Trap.?RED || ?DBL.BL || COPIES( ?DBL.H,?Trap.?Width + 2 ) || ?DBL.BR || ?Trap.?DUL
  616.    end
  617.  
  618. /*---------------------------------*\
  619. |  Create .DMP file if appropriate  |
  620. \*---------------------------------*/
  621. if TRAP_DMP <> '' then
  622.    do
  623.       /* remove meaningless labels from dump for clarity */
  624.       drop ( GBL.DumpExclusionList )
  625.       drop ?dbl. ?Trap. ?S ?T ?tr?
  626.       call SysFileDelete TRAP_DMP
  627.       select
  628.          when RxFuncQuery( 'VARDUMP' ) == 0 then
  629.             do
  630.                call VARDUMP TRAP_DMP  /* write variables to program.DMP file */
  631.             end
  632.          when RxFuncQuery( 'SysDumpVariables' ) == 0 then
  633.             do
  634.                call SysDumpVariables TRAP_DMP  /* write variables to program.DMP file */
  635.             end
  636.          otherwise; nop
  637.       end
  638.    end
  639.  
  640. TRAP_PROCESSING_02:
  641.    exit 255
  642.