home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 11 Util / 11-Util.zip / mkwin929.zip / MKWINBAK.CMD < prev    next >
OS/2 REXX Batch file  |  1995-09-20  |  28KB  |  777 lines
  1. /*------------------------------------------------------------------------*\
  2. |                                                                          |
  3. |           MKWINBAK.CMD - Version 1.0 - Version Date 1995-09-29           |
  4. |                 Copyright (c) 1995 by C F S Nevada, Inc.                 |
  5. |                                                                          |
  6. |                 Dick Goran      - Voice      702-732-9616                |
  7. |                                 - FAX        702-732-3847                |
  8. |                                 - CompuServe 71154,2002                  |
  9. |                                 - Internet   dgoran@cfsrexx.com          |
  10. |                                                                          |
  11. |          Produced and distributed by Productivity Solutions, Inc.        |
  12. |                 David Moskowitz - Voice      610-631-5685                |
  13. |                                 - FAX        610-631-0414                |
  14. |                                 - CompuServe 76701,100                   |
  15. |                                 - Internet   davidm@cfsrexx.com          |
  16. |                                                                          |
  17. | ------------------------------------------------------------------------ |
  18. |  Requires: REXXLIB.DLL  - OS/2 REXX external function library            |
  19. |                           (c) Copyright 1992-95 Quercus Systems          |
  20. \*------------------------------------------------------------------------*/
  21. /*
  22.  
  23.    This program can be used to backup \WINOS2 and subordinate directories.
  24.    At the same time, it creates R-WINOS2.CMD which will restore the WINOS2
  25.    to its original contents (including subdirectories).
  26.  
  27.    It calculates the required space and allows the user to select the
  28.    drive and path where the backup repository will be created.
  29.  
  30.    The backup repository will be created only if it does not exist.
  31.    This will generally be a on-time task.
  32.  
  33.    The restore procedure, R-WINOS2.CMD, may be run as desired.
  34.  
  35. */
  36.  
  37.    SIGNAL ON ERROR                  /* trap object time errors     */
  38.    SIGNAL ON FAILURE                /* trap object time errors     */
  39.    SIGNAL ON HALT                   /* trap object time errors     */
  40.    SIGNAL ON NOVALUE                /* trap object time errors     */
  41.    SIGNAL ON SYNTAX                 /* trap object time errors     */
  42.  
  43. GBL. = ''             /* initialize stem */
  44. parse Arg             GBL.command_line
  45. parse Version         GBL.REXX_version .
  46. parse Source          GBL.operating_system,
  47.                       GBL.calling_environment,
  48.                       GBL.program_path_and_name
  49. GBL.package_name    = 'MKWINOS2'
  50. GBL.environment     = 'OS2ENVIRONMENT'
  51. GBL.boot_drive      = LEFT( VALUE( 'RUNWORKPLACE',, GBL.environment ), 2 )
  52. GBL.program_version = 1.0           /* version / mod of this program */
  53. GBL.program_name    = FILESPEC( 'N', GBL.program_path_and_name )
  54. GBL.program_path    = FILESPEC( 'D', GBL.program_path_and_name ) ||,
  55.                       FILESPEC( 'P', GBL.program_path_and_name )
  56.  
  57. parse var GBL.program_name,
  58.    GBL.program_fn '.',
  59.    GBL.program_fe
  60.  
  61. GBL.bksp               = '08'x
  62. GBL.progress_list      = "─\|/"
  63. GBL.progress_subscript = 1
  64. GBL.list =,
  65.    'crlf',
  66.    ''
  67.  
  68. crlf = '0D0A'x
  69.  
  70. call TIME 'E'                       /* set elapsed timer - sssss.uuuuu */
  71. say 'Begin' TRANSLATE( GBL.program_name ) 'at' TIME('N')
  72. call REGISTER_REQUIRED_FUNCTIONS
  73.  
  74. /*------------------------------------*\
  75. |  Get WINOS2 path & file system type  |
  76. \*------------------------------------*/
  77. GBL.WINOS2_path =,
  78.    STRIP( SysIni( 'USER', 'PM_INSTALL', 'WINOS2_LOCATION' ), 'T', '00'x ) || '\'
  79. GBL.WINOS2_file_system =,
  80.    DOSFILESYS( FILESPEC( 'D', GBL.WINOS2_path ) )
  81.  
  82. /*-------------------*\
  83. |  Define file names  |
  84. \*-------------------*/
  85. GBL.R_WINOS2_yes =,
  86.    GBL.program_path ||,
  87.    'R-WINOS2.YES'                   /* YES reply file */
  88. GBL.R_WINOS2_file =,
  89.    GBL.program_path ||,
  90.    'R-WINOS2.CMD'                   /* restore procedural CMD file */
  91.  
  92. /*-------------------------------------------*\
  93. |  Check for prior execution of this program  |
  94. \*-------------------------------------------*/
  95. if STREAM( GBL.R_WINOS2_yes, 'C', 'QUERY EXISTS' ) ¬= '' then
  96.    do
  97.       say ''
  98.       say '   This program has previously been run. Running it again can result'
  99.       say '   in an ambiguous tree structure subordinate to' GBL.WINOS2_path
  100.       say ''
  101.       say '   To override this check and allow this program to run, you must first'
  102.       say '   manually delete' GBL.R_WINOS2_yes 'then rerun this program.'
  103.       say ''
  104.       call EOJ
  105.    end
  106.  
  107. /*------------------------------------*\
  108. |  Calculate required repository size  |
  109. \*------------------------------------*/
  110. GBL.repository_size = 0
  111.  
  112. call SysFileTree GBL.WINOS2_path || '*.*', 'WINOS2_stem', 'S'
  113. if WINOS2_stem.0 = 0 then
  114.    do
  115.       say '   Unable to locate any files in ' || GBL.WINOS2_path
  116.       call EOJ                      /* should not occur */
  117.    end
  118.  
  119. /* Put directory entries first */
  120. directory_indicator_pos = WORDINDEX( WINOS2_stem.1, 4 ) + 1
  121. path_and_name_pos       = WORDINDEX( WINOS2_stem.1, 5 )
  122. call ARRAYSORT 'WINOS2_stem', 1, WINOS2_stem.0,,
  123.                directory_indicator_pos,   1, 'D', 'C',,
  124.                path_and_name_pos,       100, 'A', 'C'
  125.  
  126. /* Tally rounded up size */
  127. do s = 1 to WINOS2_stem.0
  128.    parse value WINOS2_stem.s with,
  129.       stem_date,
  130.       stem_time,
  131.       stem_size,
  132.       stem_attr,
  133.       stem_path_and_file_name
  134.    stem_path_and_file_name = STRIP( stem_path_and_file_name )
  135.  
  136.    if SUBSTR( stem_attr, 2, 1 ) ¬= 'D' then
  137.       do
  138.          /* use an excessive amount for safety */
  139.          rounded_size =,
  140.             ( ( stem_size + 4095 ) % 4096 ) * 4096
  141.          GBL.repository_size = GBL.repository_size + rounded_size
  142.       end
  143. end
  144.  
  145. /*--------------------------------------------*\
  146. |  Build list of drives that have enough room  |
  147. |     HPFS or FAT if WINOS2 on FAT             |
  148. |     HPFS only   if WINOS2 on HPFS            |
  149. \*--------------------------------------------*/
  150. potential_drive_list = SysDriveMap()
  151. useable_drive_list   = ''
  152.  
  153. do w = 1 to WORDS( potential_drive_list )
  154.    drive_letter_colon = WORD( potential_drive_list, w )
  155.    if WORD( SysDriveInfo( drive_letter_colon ), 2 ) < GBL.repository_size then
  156.       do
  157.          iterate w
  158.       end
  159.    if GBL.WINOS2_file_system = 'HPFS',
  160.             &,
  161.       DOSFILESYS( drive_letter_colon ) ¬= 'HPFS' then
  162.       do
  163.          iterate w
  164.       end
  165.    useable_drive_list =,
  166.       useable_drive_list ||,
  167.       drive_letter_colon || ' '
  168. end
  169.  
  170. if useable_drive_list = '' then
  171.    do
  172.       say '   Unable to find any drives with adequate space to create WINOS2 backup'
  173.       say '   ' || EDIT( GBL.repository_size ) || ' bytes required'
  174.       call EOJ
  175.    end
  176.  
  177. /*-------------------------------------------------*\
  178. |  Query user for drive & path to store repository  |
  179. \*-------------------------------------------------*/
  180. call CHAROUT 'CON:',,
  181.              COPIES( ' ', 3 ) ||,
  182.              'The following drives have adequate room to contain your WINOS2 backup.' || crlf ||,
  183.              COPIES( ' ', 3 ) || 'Enter a drive letter and path for the WINOS2 repository from one of ' || crlf ||,
  184.              COPIES( ' ', 3 ) || 'the following drives. The directory will be created for you.' || crlf ||,
  185.              COPIES( ' ', 6 ) || useable_drive_list || '  '
  186.  
  187. do forever
  188.    pull reply
  189.    if LENGTH( reply ) = 1 then
  190.       do
  191.          reply = reply || ':'
  192.       end
  193.    drive_ptr = WORDPOS( FILESPEC( 'D', reply ), useable_drive_list )
  194.    if drive_ptr > 0,
  195.          &,
  196.       LENGTH( reply ) > 2 then
  197.       do
  198.          call CHAROUT 'CON:', crlf
  199.          leave
  200.       end
  201.    call CHAROUT 'CON:',,
  202.                 COPIES( ' ', 9 ) || 'invalid entry, retry   '
  203. end
  204.  
  205. /*-----------------------------*\
  206. |  Confirm building repository  |
  207. \*-----------------------------*/
  208. if RIGHT( reply, 1 ) ¬= '\' then
  209.    do
  210.       reply = reply || '\'
  211.    end
  212. GBL.repository_path =,
  213.    FILESPEC( 'D', reply ) ||,
  214.    FILESPEC( 'P', reply )
  215.  
  216. if DOSISDIR( STRIP( GBL.repository_path, 'T', '\' ) ) then
  217.    do
  218.       call CHAROUT 'CON:',,
  219.                    COPIES( ' ', 3 ) ||,
  220.                    GBL.repository_path ||,
  221.                    ' already exists, should it be overwritten? '
  222.       pull reply
  223.       if LEFT( reply, 1 ) = 'Y' then
  224.          do
  225.             call DELETE_TREE
  226.          end
  227.       else
  228.          do
  229.             reply = 'BYPASS'
  230.          end
  231.    end
  232.  
  233. if reply ¬= 'BYPASS' then
  234.    do
  235.       call COPY_TREE
  236.    end
  237.  
  238. /*------------------------------------------------------------------------*\
  239. |                                                                          |
  240. |         Build procedural R-WINOS2.CMD file - not a REXX program          |
  241. |                                                                          |
  242. \*------------------------------------------------------------------------*/
  243. /*------------------------------------------*\
  244. |  Build YES data file for DEL *.* response  |
  245. \*------------------------------------------*/
  246. call SysFileDelete GBL.R_WINOS2_yes
  247. call LINEOUT GBL.R_WINOS2_yes, 'Y'
  248. call STREAM GBL.R_WINOS2_yes, 'C', 'CLOSE'
  249.  
  250. /*-------------------------*\
  251. |  Check for skeleton data  |
  252. |    created by MKWINOS2    |
  253. \*-------------------------*/
  254. begin_marker = 'REM  BEG:'
  255. end_marker   = 'REM  END:'
  256.  
  257. GBL.R_WINOS2_size = STREAM( GBL.R_WINOS2_file, 'C', 'QUERY SIZE' )
  258.  
  259. if GBL.R_WINOS2_size > 0 then
  260.    do
  261.       GBL.R_WINOS2_area = CHARIN( GBL.R_WINOS2_file, 1, GBL.R_WINOS2_size )
  262.       call STREAM GBL.R_WINOS2_file, 'C', 'CLOSE'
  263.  
  264.       /*--------------------------------*\
  265.       |  Get paths inserted by MKWINOS2  |
  266.       \*--------------------------------*/
  267.       begin_marker_pos = POS( begin_marker, GBL.R_WINOS2_area )
  268.       if begin_marker = 0 then
  269.          do
  270.             say '   ' || GBL.R_WINOS2_file || ' has been unrecognizeably altered'
  271.             say '   Please read the MKWINOS2 documentation!'
  272.             call EOJ
  273.          end
  274.       next_line_pos = POS( crlf, GBL.R_WINOS2_area, begin_marker_pos ) + 2
  275.  
  276.       end_marker_pos = POS( end_marker, GBL.R_WINOS2_area )
  277.       if end_marker = 0 then
  278.          do
  279.             say '   ' || GBL.R_WINOS2_file || ' has been unrecognizeably altered'
  280.             say '   Please read the MKWINOS2 documentation!'
  281.             call EOJ
  282.          end
  283.       end_line_begin_pos = LASTPOS( crlf, GBL.R_WINOS2_area, end_marker_pos ) + 2
  284.  
  285.       if end_line_begin_pos ¬= next_line_pos then
  286.          do
  287.             GBL.R_WINOS2_area =,
  288.                SUBSTR( GBL.R_WINOS2_area,,
  289.                        next_line_pos,,
  290.                        end_line_begin_pos - next_line_pos )
  291.          end
  292.       else
  293.          do
  294.             GBL.R_WINOS2_area = ''
  295.          end
  296.    end
  297.  
  298. l=0
  299. l=l+1; line.l = '@ECHO off'
  300. l=l+1; line.l = 'ECHO ╔════════════════════════════╗'
  301. l=l+1; line.l = 'ECHO ║ Restore WINOS2 directories ║'
  302. l=l+1; line.l = 'ECHO ╚════════════════════════════╝'
  303. l=l+1; line.l = 'SET  WINOS2_path=' || GBL.WINOS2_path
  304. l=l+1; line.l = 'SET  WINOS2_backup_path=' || GBL.repository_path
  305. l=l+1; line.l = 'IF EXIST %WINOS2_backup_path%WIN.INI GOTO STEP01'
  306. l=l+1; line.l = 'ECHO Unable to locate %WINOS2_backup_path%WIN.INI, restore cancelled'
  307. l=l+1; line.l = 'GOTO EOJ'
  308. l=l+1; line.l = ''
  309. l=l+1; line.l = ':STEP01'
  310. l=l+1; line.l = 'ECHO Recreate '                   ||,
  311.                       GBL.WINOS2_path     || '*.*' ||,
  312.                       ' from '                     ||,
  313.                       GBL.repository_path || '*.*'
  314. l=l+1; line.l = 'ECHO (OK to rerun as desired - altered dynamically by MKWINOS2)'
  315.  
  316. l=l+1; line.l = ' '
  317. l=l+1; line.l = 'ECHO.'
  318. l=l+1; line.l = 'ECHO Restoring %WINOS2_path%'
  319. l=l+1; line.l = 'DEL  %WINOS2_path%*.* <' || GBL.R_WINOS2_yes || ' 2>nul'
  320. l=l+1; line.l = 'COPY %WINOS2_backup_path%*.* %WINOS2_path%*.* 1>nul'
  321.  
  322. l=l+1; line.l = ' '
  323. l=l+1; line.l = 'ECHO.'
  324. l=l+1; line.l = 'ECHO Restoring %WINOS2_path%SYSTEM\'
  325. l=l+1; line.l = 'DEL  %WINOS2_path%SYSTEM\*.* <' || GBL.R_WINOS2_yes || ' 2>nul'
  326. l=l+1; line.l = 'COPY %WINOS2_backup_path%SYSTEM\*.* %WINOS2_path%SYSTEM\*.* 1>nul'
  327.  
  328. l=l+1; line.l = ' '
  329. l=l+1; line.l = 'REM' COPIES( '*', 76 )
  330. l=l+1; line.l = 'REM  Do NOT alter any data between the BEG: & END: lines'
  331. l=l+1; line.l = 'REM  BEG: additional directories - set dynamically by MKWINOS2'
  332.  
  333. if GBL.R_WINOS2_area ¬= '' then
  334.    do
  335.       /* strip trailing crlf to prevent double occurrence */
  336.       l=l+1; line.l = LEFT( GBL.R_WINOS2_area, LENGTH( GBL.R_WINOS2_area ) - 2 )
  337.    end
  338.  
  339. l=l+1; line.l = 'REM  END: additional directories - set dynamically by MKWINOS2'
  340. l=l+1; line.l = 'REM' COPIES( '*', 76 )
  341.  
  342. l=l+1; line.l = ' '
  343. l=l+1; line.l = ':EOJ'
  344. l=l+1; line.l = 'SET  WINOS2_path='
  345. l=l+1; line.l = 'SET  WINOS2_backup_path='
  346.        line.0 = l
  347.  
  348. call SysFileDelete GBL.R_WINOS2_file
  349. do l = 1 to line.0
  350.    call LINEOUT GBL.R_WINOS2_file, line.l
  351. end
  352. call STREAM GBL.R_WINOS2_file, 'C', 'CLOSE'
  353.  
  354. call STREAM 'CON:', 'C', 'CLOSE'
  355.  
  356. call EOJ 0
  357.  
  358.  
  359. /*------------------------------------------------------------------------*\
  360. |                                                                          |
  361. |     Copy all \WINOS2 files and subordinate directories to repository     |
  362. |                                                                          |
  363. \*------------------------------------------------------------------------*/
  364. COPY_TREE:
  365.    Procedure expose,
  366.       GBL. (GBL.list),
  367.       WINOS2_stem.
  368.  
  369.  
  370. call CHAROUT 'CON:', '   Copying '       ||,
  371.                      GBL.WINOS2_path     ||,
  372.                      ' to '              ||,
  373.                      GBL.repository_path ||,
  374.                      '  '
  375. call SysCurState 'OFF'
  376.  
  377. /* make top level directory */
  378. call SysMkDir STRIP( GBL.repository_path, 'T', '\' )
  379.  
  380. do s = 1 to WINOS2_stem.0
  381.    call WRITE_PROGRESS_INDICATOR
  382.    parse value WINOS2_stem.s with,
  383.       stem_date,
  384.       stem_time,
  385.       stem_size,
  386.       stem_attr,
  387.       stem_path_and_file_name
  388.    stem_path_and_file_name = STRIP( stem_path_and_file_name )
  389.  
  390.    parse value stem_path_and_file_name with,
  391.       (GBL.WINOS2_path),
  392.       tail_path_and_name
  393.  
  394.    if SUBSTR( stem_attr, 2, 1 ) = 'D' then
  395.       do
  396.          call SysMkDir GBL.repository_path || tail_path_and_name
  397.       end
  398.    else
  399.       do
  400.          call DOSCOPY stem_path_and_file_name,,
  401.                       GBL.repository_path || tail_path_and_name,,
  402.                       'R'
  403.       end
  404. end
  405. call CHAROUT 'CON:', ' ' || crlf
  406. call SysCurState 'ON'
  407.  
  408. return
  409.  
  410. /*------------------------------------------------------------------------*\
  411. |                                                                          |
  412. |  Delete all files and directories in and subordinate to specified path   |
  413. |                                                                          |
  414. \*------------------------------------------------------------------------*/
  415. DELETE_TREE:
  416.    Procedure expose,
  417.       GBL. (GBL.list)
  418.  
  419. call SysFileTree GBL.repository_path || '*.*', 'd_stem', 'S'
  420. if d_stem.0 = 0 then
  421.    do
  422.       call SysRmDir GBL.repository_path
  423.       return
  424.    end
  425.  
  426. /* Put directory entries last */
  427. directory_indicator_pos = WORDINDEX( d_stem.1, 4 ) + 1
  428. call ARRAYSORT 'd_stem', 1, d_stem.0,,
  429.                directory_indicator_pos,   1, 'A', 'C'
  430.  
  431. call CHAROUT 'CON:', '   Deleting contents of ' ||,
  432.                      GBL.repository_path        ||,
  433.                      '  '
  434. call SysCurState 'OFF'
  435.  
  436. do s = 1 to d_stem.0
  437.    call WRITE_PROGRESS_INDICATOR
  438.    parse value d_stem.s with,
  439.       stem_date,
  440.       stem_time,
  441.       stem_size,
  442.       stem_attr,
  443.       stem_path_and_file_name
  444.    stem_path_and_file_name = STRIP( stem_path_and_file_name )
  445.  
  446.    if SUBSTR( stem_attr, 2, 1 ) ¬= 'D' then
  447.       do
  448.          call SysFileDelete stem_path_and_file_name
  449.       end
  450.    else
  451.       do
  452.          call SysRmDir stem_path_and_file_name
  453.       end
  454. end
  455.  
  456. call CHAROUT 'CON:', ' ' || crlf
  457. call SysCurState 'ON'
  458.  
  459. return
  460.  
  461. /*------------------------------------------------------------------------*\
  462. |                                                                          |
  463. |                            EDIT REXX function                            |
  464. |                                                                          |
  465. \*------------------------------------------------------------------------*/
  466. EDIT:
  467.    Procedure
  468.  
  469. /* first time here, build translate tables */
  470. SIGNAL OFF NOVALUE
  471. if LEFT(e1, 1) <> '01'x then
  472.    do
  473.       e1 = XRANGE('01'x, '19'x)
  474.       e2 = XRANGE('01'x, '03'x) || '19'x ||,
  475.            XRANGE('04'x, '06'x) || '19'x ||,
  476.            XRANGE('07'x, '09'x) || '19'x ||,
  477.            XRANGE('0A'x, '0C'x) || '19'x ||,
  478.            XRANGE('0D'x, '0F'x) || '19'x ||,
  479.            XRANGE('10'x, '12'x) || '19'x ||,
  480.            XRANGE('13'x, '15'x) || '19'x ||,
  481.            XRANGE('16'x, '18'x)
  482.       /* get punctuation characters from INI file  */
  483.       decimal  = STRIP( SysIni( 'USER',,
  484.                                 'PM_National',,
  485.                                 'sDecimal' ), 'T', '00'x )
  486.       thousand = STRIP( SysIni( 'USER',,
  487.                                 'PM_National',,
  488.                                 'sThousand' ), 'T', '00'x )
  489.    end
  490. SIGNAL ON NOVALUE
  491.  
  492. /* return BAD if non-numeric data */
  493. if DATATYPE( ARG(1) ) <> 'NUM' then
  494.    return 'BAD'
  495.  
  496. /* test and save sign value along with absolute numeric value */
  497. if SIGN( ARG(1) ) <> '-1' then
  498.    sign_character = ''
  499. else
  500.    sign_character = '-'
  501. absolute_value = ABS( ARG(1) )
  502.  
  503. /* test for and save decimal value indicator */
  504. decimal_position = POS( decimal, absolute_value )
  505.  
  506. if decimal_position = 0 then
  507.    source = RIGHT( absolute_value, LENGTH(e1) - 1 ) || ' '
  508. else
  509.    source = RIGHT( LEFT( absolute_value, decimal_position - 1 ), LENGTH(e1) - 1 ) || ' '
  510.  
  511. if decimal_position = 0 then
  512.    edited_number =,
  513.       STRIP( TRANSLATE( TRANSLATE( e2, source, e1), ',', ' '), 'B', ',')
  514. else
  515.    edited_number =,
  516.       STRIP( TRANSLATE( TRANSLATE( e2, source, e1), ',', ' '), 'B', ','),
  517.                       || RIGHT( absolute_value,,
  518.                                 LENGTH(absolute_value) - decimal_position + 1)
  519. return sign_character || edited_number
  520.  
  521. !tr!=VALUE('TRACE',,'OS2Environment'); if !tr!<>'' then do;TRACE(!tr!);nop;end
  522. /*------------------------------------------------------------------------*\
  523. |                                                                          |
  524. |                                End of Job                                |
  525. |                                                                          |
  526. \*------------------------------------------------------------------------*/
  527. EOJ:
  528.    Procedure expose,
  529.       GBL.
  530.  
  531. if ARG() = 0 then
  532.    eoj_rc = 0
  533. else
  534.    eoj_rc = ARG(1)
  535.  
  536. elapsed_time = TIME('E')            /* get elapsed time - sssss.uuuuu */
  537. parse value elapsed_time with seconds '.' micro_seconds
  538. if LEFT( micro_seconds, 1, 1 ) >= 5 then
  539.    seconds = seconds + 1
  540. ss = FORMAT( seconds // 60, 2 )
  541. minutes = ( seconds - ss ) / 60
  542. mm = FORMAT( minutes // 60, 2 )
  543. hh = FORMAT( ( minutes - mm ) / 60, 2 )
  544. duration = hh':'mm':'ss
  545.  
  546. program_name = TRANSLATE( FILESPEC( 'N', GBL.program_path_and_name ) )
  547. say 'End  ' program_name 'at' TIME('N') ||,
  548.     ', duration' TRANSLATE( duration, '0', ' ' )
  549. exit eoj_rc
  550.  
  551. /*------------------------------------------------------------------------*\
  552. |                                                                          |
  553. |                   Register external function routines                    |
  554. |                                                                          |
  555. \*------------------------------------------------------------------------*/
  556. REGISTER_REQUIRED_FUNCTIONS:
  557.    Procedure expose,
  558.       GBL.
  559.  
  560. /*----------------------------------------*\
  561. |  Load REXXUtil External Function Module  |
  562. \*----------------------------------------*/
  563. module             = 'REXXUTIL'
  564. entry_name         = 'SysLoadFuncs'
  565. function_name      = 'SysLoadFuncs'
  566. anticipated_return = ''
  567. call REGISTER_ROUTINE function_name, module, entry_name, anticipated_return
  568.  
  569. /*-----------------------------------*\
  570. |  Load the REXXLIB Function Package  |
  571. \*-----------------------------------*/
  572. if GBL.REXX_version = 'REXX/Personal' then
  573.    do
  574.       module = 'qrexxlib'
  575.    end
  576. else
  577.    do
  578.       module = 'rexxlib'
  579.    end
  580. entry_name         = 'rexxlibregister'
  581. function_name      = 'RexxLibRegister'
  582. anticipated_return = '1'
  583. call REGISTER_ROUTINE function_name, module, entry_name, anticipated_return
  584.  
  585. /*-----------------------------*\
  586. |  Determine Warp vs. non-Warp  |
  587. \*-----------------------------*/
  588. GBL.warp = 0
  589. if SYSINI( 'USER', 'PM_Workplace:Location', '<WP_LAUNCHPAD>' ) ¬= '' then
  590.    do
  591.       GBL.warp = 1
  592.    end
  593.  
  594. return
  595.  
  596.  
  597. /*---------------------*\
  598. |  Register Subroutine  |
  599. \*---------------------*/
  600. REGISTER_ROUTINE:
  601.    Procedure
  602.  
  603. parse ARG  function_name,,
  604.            module,,
  605.            entry_name,,
  606.            anticipated_return
  607.  
  608. if RxFuncQuery(function_name) = 0 then return      /* function registered */
  609.  
  610. if LENGTH(module) > 8 then
  611.    do
  612.       dll_drive = FILESPEC( 'D', module )
  613.       dll_path  = STRIP( FILESPEC( 'P', module ), 'T', '\' )
  614.       module    = FILESPEC( 'N', module )
  615.       '@' || dll_drive
  616.       '@cd' dll_drive || dll_path
  617.    end
  618. else
  619.    do
  620.       dll_drive = ''
  621.    end
  622.  
  623. parse var module module_fname '.' module_fext
  624. if RxFuncAdd( function_name, module_fname, entry_name ) = 0 then
  625.    do
  626.       register_call = 'call' function_name
  627.       interpret register_call
  628.       if WORD( RESULT, 1 ) <> WORD( anticipated_return, 1 ) then
  629.          do
  630.             Say function_name 'returned' RESULT '-',
  631.                                          anticipated_return 'was expected'
  632.             exit 255
  633.          end
  634.    end
  635. else
  636.    do
  637.       Say 'RxFuncAdd returned' RESULT 'registering' module
  638.       exit 254
  639.    end
  640. if dll_drive <> '' then
  641.    do
  642.       Parse Source . . GBL.program_path_and_name
  643.       '@' || LEFT( GBL.program_path_and_name, 2 )
  644.    end
  645. return
  646.  
  647.  
  648. /*------------------------------------------------------------------------*\
  649. |                                                                          |
  650. |                    Write twirling progress indicator                     |
  651. |                                                                          |
  652. \*------------------------------------------------------------------------*/
  653. WRITE_PROGRESS_INDICATOR:
  654.    Procedure expose,
  655.       GBL.
  656.  
  657. call CHAROUT "CON:", SUBSTR( GBL.progress_list,,
  658.                              GBL.progress_subscript,,
  659.                              1 ) || GBL.bksp
  660. GBL.progress_subscript = GBL.progress_subscript + 1
  661. if GBL.progress_subscript > LENGTH( GBL.progress_list ) then
  662.    do
  663.       GBL.progress_subscript = 1
  664.    end
  665.  
  666. return
  667.  
  668. /*------------------------------------------------------------------------*\
  669. |                                                                          |
  670. |                              Trap Routines                               |
  671. |                                                                          |
  672. \*------------------------------------------------------------------------*/
  673. ERROR:   call TRAP_PROCESSING SIGL, 'ERROR',   RC
  674. FAILURE: call TRAP_PROCESSING SIGL, 'FAILURE', RC
  675. HALT:    call TRAP_PROCESSING SIGL, 'HALT',    ''
  676. NOVALUE: call TRAP_PROCESSING SIGL, 'NOVALUE', ''
  677. SYNTAX:  call TRAP_PROCESSING SIGL, 'SYNTAX',  RC
  678.  
  679. /* Rev. 95/07/29 */
  680. TRAP_PROCESSING:
  681.    parse Source . . TRAP.path_and_program
  682.    trap.line_nbr = ARG(1)
  683.    if POS( ':', TRAP.path_and_program ) > 0 then
  684.       /* get source line if it is available */
  685.       do t = 1
  686.          trap_source_line.t =  SOURCELINE( trap.line_nbr )
  687.          trap_source_line.0 = t
  688.          trap.line_nbr      = trap.line_nbr + 1
  689.          if RIGHT( trap_source_line.t, 1 ) ¬= ',' then
  690.             do
  691.                leave
  692.             end
  693.       end
  694.    else
  695.       /* program is running in macrospace */
  696.       do
  697.          TRAP.path_and_program = VALUE( 'TEMP',, 'OS2ENVIRONMENT' ) ||,
  698.                                  '\' || TRAP.path_and_program
  699.          trap_source_line.1 = 'Source line is not available.'
  700.          trap_source_line.0 = 1
  701.       end
  702.  
  703.    parse value FILESPEC( 'N', TRAP.path_and_program ) with,
  704.       TRAP.fn '.' TRAP.fe
  705.    trap_file_name = FILESPEC( 'D', TRAP.path_and_program ) ||,
  706.                     FILESPEC( 'P', TRAP.path_and_program ) ||,
  707.                     TRAP.fn || '.' || 'DMP'
  708.  
  709.    /*------------------------------------------*\
  710.    |  check for reason not to create .DMP file  |
  711.    \*------------------------------------------*/
  712.    if ARG(2) = '----' then
  713.       do
  714.          trap_file_name = ''
  715.       end
  716.    if RxFuncQuery( 'VARDUMP' ) <> 0 then
  717.       do
  718.          trap_file_name = ''
  719.       end
  720.    if POS( ':', trap_file_name ) = 0 then
  721.       do
  722.          trap_file_name = ''
  723.       end
  724.  
  725.    /*------------------------*\
  726.    |  Build trap message box  |
  727.    \*------------------------*/
  728.    dbl.h    = 'CD'x                 /* ═ double line - horizontal   */
  729.    dbl.v    = 'BA'x                 /* ║ double line - vertical     */
  730.    dbl.bl   = 'C8'x                 /* ╚ double line - bottom left  */
  731.    dbl.br   = 'BC'x                 /* ╝ double line - bottom right */
  732.    dbl.tl   = 'C9'x                 /* ╔ double line - top left     */
  733.    dbl.tr   = 'BB'x                 /* ╗ double line - top right    */
  734.    trap.red = '1B'x || '[1;37;41m'  /* bright white on red          */
  735.    trap.dul = '1B'x || '[0m'        /* reset to normal              */
  736.  
  737.    say ' '
  738.    trap_error_description =,
  739.       'Error line = ' || ARG(1) ||,
  740.       '; ' ||,
  741.       ARG(2) ||,
  742.       ' error.'
  743.    if ARG(3) <> '' then
  744.       trap_error_description = trap_error_description ||,
  745.                                '  Return code = ' || ARG(3)
  746.    trap.width = MAX( 74, LENGTH( trap_error_description ) )
  747.    say trap.red || dbl.tl || COPIES( dbl.h,trap.width + 2 ) || dbl.tr || trap.dul
  748.    say trap.red || dbl.v  || COPIES( ' ',  trap.width + 2 ) || dbl.v  || trap.dul
  749.    say trap.red || dbl.v CENTER( TRAP.fn'.CMD',trap.width )    dbl.v  || trap.dul
  750.    say trap.red || dbl.v CENTER( trap_error_description, trap.width ) dbl.v || trap.dul
  751.    if trap_file_name <> '' then
  752.       do
  753.    say trap.red || dbl.v  || COPIES( ' ',  trap.width + 2 ) || dbl.v  || trap.dul
  754.    say trap.red || dbl.v     CENTER( 'See: ' || trap_file_name,,
  755.                                      trap.width )  dbl.v  || trap.dul
  756.       end
  757.    say trap.red || dbl.v  || COPIES( ' ',  trap.width + 2 ) || dbl.v  || trap.dul
  758.    say trap.red || dbl.bl || COPIES( dbl.h,trap.width + 2 ) || dbl.br || trap.dul
  759.    say trap.red || COPIES( ' ', trap.width + 4 ) || trap.dul
  760.    say trap.red || LEFT( 'Source line(s) at time of trap:', trap.width + 4 ) || trap.dul
  761.    do t = 1 to trap_source_line.0
  762.       say trap.red || LEFT( '   ' || trap_source_line.t, trap.width + 4 ) || trap.dul
  763.    end
  764.    say trap.red || COPIES( ' ', trap.width + 4 ) || trap.dul
  765.  
  766.    /*---------------------------------*\
  767.    |  Create .DMP file if appropriate  |
  768.    \*---------------------------------*/
  769.    if trap_file_name <> '' then
  770.       do
  771.          call SysFileDelete trap_file_name
  772.          /* remove meaningless labels from dump for clarity */
  773.          drop dbl. TRAP. RC RESULT SIGL !tr!
  774.          call VARDUMP trap_file_name  /* write variables to program.DMP file */
  775.       end
  776.    exit 253
  777.