home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / netdor3.zip / TOOLS / IMPIT.CMD < prev    next >
OS/2 REXX Batch file  |  1996-04-04  |  121KB  |  3,722 lines
  1. /*****************************************************************************
  2.  *                       IMPIT - IMP Installation Tool                       *
  3.  *                 T. Bridgman / T. Rogers - CORE at WATSON                  *
  4.  *                   (Change history is at bottom of file)                   *
  5.  *****************************************************************************
  6.  *                    Licensed Materials-Property of IBM                     *
  7.  *               5604-472 (c) Copyright IBM Corporation, 1993                *
  8.  *                           All rights reserved.                            *
  9.  *                  US Government Users Restricted Rights -                  *
  10.  *                 Use, duplication or disclosure restricted                 *
  11.  *                by GSA ADP Schedule Contract with IBM Corp.                *
  12.  *****************************************************************************/
  13. trace 'O'
  14. trace 'E'
  15. call   on halt
  16. signal on novalue
  17. signal on syntax
  18. Globals = 'Opts. Imp. File.'
  19.  
  20. parse source . How .
  21. Opts. = 0
  22. Opts.!CmdMode = (How = 'COMMAND')
  23. if Opts.!CmdMode
  24.   then do
  25.     say
  26.     say 'ITL Interpreter'
  27.   end
  28. parse arg File.0In Extra '/' Opts
  29. Rtn = 'IMPIT'
  30. if abbrev(File.0In, '?') | Extra <> ''
  31.   then signal Tell
  32.  
  33. call Initialize
  34. call AddImp
  35. call Msg 'ImpIt complete.'
  36. exit 0
  37.  
  38. Initialize: procedure expose (Globals) Opts Opts.
  39. Opts.0Echo = 'VERBOSE'
  40. Opts.0NoPause = \Opts.!CmdMode
  41. do while Opts <> ''
  42.   parse upper var Opts OKey '/' Opts
  43. /**** PTR 10249 start ****/
  44.   parse var OKey OKey Extra ':' OVal
  45.   if OVal = ''
  46.     then OVal = Extra
  47.     else if Extra <> ''
  48.       then say 'Warning: Unexpected argument "'Extra'" ignored.'
  49. /**** PTR 10249 end ****/
  50.   OVal = strip(OVal)
  51.   select
  52.     when abbrev('FORCE', OKey)
  53.       then Opts.0Force = 1
  54.     when abbrev('UPDATE', OKey)
  55.       then Opts.0Update = 1
  56.     when abbrev('RUN', OKey)
  57.       then do
  58.         Opts.0Run = 1
  59.         Opts.0RunFile = OVal
  60.       end
  61.     when abbrev('NOBACKUP', Okey)
  62.       then Opts.0NoBackup = 1
  63.     when OKey = 'COREFIX' | OKey = 'NOPAUSE'
  64.       then Opts.0NoPause = 1
  65.     otherwise
  66.       call EMsg 'Unrecognized option' OKey OVal 'specified.'
  67.   end
  68. end
  69.  
  70. call ImpInit
  71. if Opts.!CmdMode
  72.   then do
  73.     say 'Version' ImpVersion()
  74.     say
  75.   end
  76.  
  77. if Opts.0Run
  78.   then do
  79.     OutC = RunTagFile(Opts.0RunFile)
  80.     if \Opts.0NoPause
  81.       then call rxPause 'Installation complete.  Press any key to exit.'
  82.     exit OutC
  83.   end
  84. if File.0In = ''
  85.   then signal Tell
  86.  
  87. say 'IMP Installation Tool'
  88. File.0Backup = XFilespec('QPATH', File.0In)
  89. if File.0Backup = ''
  90.   then File.0Backup = '.'
  91.  
  92. if \rxFileExist(File.0In)
  93.   then if rxFileExist(File.0In'.CMD')
  94.     then File.0In = File.0In'.CMD'
  95.     else call EMsg 'Input file' File.0In 'does not exist.'
  96. call Msg 'Reading' File.0In'...'
  97. call ReadFile File.0In
  98. if result <> 0
  99.   then say 'Error' result 'reading file.'
  100. return 0
  101.  
  102. AddImp: procedure expose (Globals)
  103. if Find(':IMP:', 'ALL+') = 0
  104.   then do
  105.     parse value GetLine() with ':IMP:' PgmVer ':'
  106.     if PgmVer = ImpVersion() & \Opts.0Force
  107.       then call EMsg File.0In 'already contains IMP' PgmVer 'routines.'
  108.     call Msg 'Deleting IMP' PgmVer 'routines...'
  109.     call DelBlock '.', 'BOTTOM'
  110.   end
  111.   else if Find('IMPINIT:', 'ALL+', 'BEGIN') = 0
  112.     then call EMsg 'IMP header not found, but IMP routines seem to be',
  113.         'present.  Check file and try again.'
  114.     else if Opts.0Update
  115.       then call EMsg File.0In 'does not contain IMP routines.'
  116.  
  117. do II = Imp.0File.0 to 1 by -1
  118.   if Imp.0File.0 <> ''
  119.     then leave
  120. end
  121. if Opts.0NoBackup
  122.   then BkUp = 'NOBACKUP'
  123.   else BkUp = 2
  124. RetC = WriteFile(File.0Backup, BkUp, Opts.0Echo)
  125.  
  126. if SetCurL('BOTTOM') = 255
  127.   then call EMsg File.0In 'does not contain a program.'
  128. RetC = rxRead(Imp.0Me, 'IMPIT')
  129. RetC = rxGrep(':IMP:'ImpVersion()':', Imp.0Me, 'TEMP', 'N')
  130. parse var Temp.1 L1 .
  131. call Msg 'Adding IMP' ImpVersion() 'routines...'
  132. L1 = L1 - 1
  133. ImpIt.L1 = ''
  134. RetC = rxWrite(File.0In, 'IMPIT', ImpIt.0, L1, 'A')
  135. call Msg File.0In 'written successfully.'
  136. /**
  137. call Msg 'Tokenizing file...'
  138. 'CALL' File.0In '//T'
  139. **/
  140. return 0
  141.  
  142. Msg:
  143. parse arg Msg
  144. if Opts.0Echo = 'VERBOSE'
  145.   then say Msg
  146. return 0
  147.  
  148. EMsg:
  149. parse arg Msg
  150. say Msg
  151. exit 2
  152.  
  153. Tell:
  154. say
  155. say ' IMPIT - ITL Interpreter'
  156. say
  157. say ' Syntax:  IMPIT /R:itlfile [/NOPAUSE]'
  158. say
  159. say ' itlfile  - ITL program to execute.'
  160. say ' /NOPAUSE - Don''t pause after execution.'
  161. if abbrev(File.0In, '??') then do
  162. say
  163. say copies('-', 79)
  164. say ' IMPIT as IMP Routine Installation Tool'
  165. say
  166. say ' Syntax:  IMPIT sourcefile [/Force] [/Update] [/NOBACKUP]'
  167. say
  168. say ' /Force    - Force IMP update even if version number hasn''t changed.'
  169. say ' /Update   - Update IMP routines only if they exist.'
  170. say ' /NOBACKUP - Don''t make a backup of sourcefile.'
  171. end
  172. exit 0
  173.  
  174. /** :IMP:2.46: **************************************************************
  175.  *                                                                          *
  176.  * Installation/Modification Routines (IMP)                                 *
  177.  *                                                                          *
  178.  ****************************************************************************/
  179. call ImpError 'No exit statement in IMP program!'
  180.  
  181. /****************************************************************************
  182.  * IMPINIT                                                                  *
  183.  * Initialize RXUTILS if they are not initialized.                          *
  184.  * Initialize REXXUTIL if running under OS/2 2.0.                           *
  185.  * Initialize IMP control variables (all under IMP. stem):                  *
  186.  *  0Init      IMPINIT performed flag;  set to 1                            *
  187.  *  0Mod       Buffer modified flag;  set to 0                              *
  188.  *  0FileName  Name of file in buffer (null if no file)                     *
  189.  *  0BackDir   Name of backup directory (null if not specified)             *
  190.  *  0BackType  Type of backup (UNIQUE, nnn)                                 *
  191.  *  0CurL      Ptr to file buffer;  set to 1                                *
  192.  *  0Version   IMP version number (x.yy)                                    *
  193.  *  0File.     The file buffer                                              *
  194.  *  0Me        Name of the running program                                  *
  195.  *  0BTypes    List of valid backup types                                   *
  196.  *  0Digits    0-9                                                          *
  197.  ****************************************************************************/
  198. ImpInit:
  199. Rtn = 'ImpInit'
  200. if symbol('GLOBALS') = 'LIT'
  201.   then Globals = 'Imp.'
  202.   else do
  203.     Adds = 'Imp.'
  204.     do while Adds <> ''
  205.       parse upper var Adds Add Adds
  206.       if wordpos(Add, translate(Globals)) = 0
  207.         then Globals = Globals Add
  208.     end
  209.   end
  210.  
  211. parse upper arg InFile, Imp.0BackDir, Imp.0BackType
  212.  
  213. if value('IMP.0INIT') = 1             /* Previous init */
  214.   then call ImpError 'Multiple calls to IMPINIT.'
  215. Imp.0BTypes = 'UNIQUE NAME'
  216. Imp.0Digits = '0123456789'
  217. if Imp.0BackType <> ''
  218.   then if \CheckBackupType(Imp.0BackType)
  219.     then call ImpError 'Bad argument:' Imp.0BackType
  220.  
  221. call RxUtilsInit
  222. '@ECHO OFF'
  223. Imp.0Mod      = 0
  224. Imp.0Init     = 1
  225. Imp.0PosStack = ''
  226. Imp.0FileName = ''
  227. Imp.0Verbose  = 0
  228. Imp.0StrRep   = 1
  229. if symbol('OPTS.0NOPAUSE') = 'VAR'
  230.   then Imp.0ErrPause = \Opts.0NoPause
  231.   else Imp.0ErrPause = 0
  232. if rxUtilsVer() >= 1.70
  233.   then Imp.0BDr = rxBootDrive()
  234.   else if rxOS2Ver() < 2.0
  235.     then Imp.0BDr = 'C:'
  236.     else Imp.0BDr = left(value('COMSPEC',,'OS2ENVIRONMENT'), 2)
  237. parse upper source . . Imp.0Me
  238. RetC = rxGrep(':IMP:', Imp.0Me, 'TEMP')
  239. do I = 1 to Temp.0
  240.   parse var Temp.I ':IMP:' Imp.0Version ':'
  241.   if datatype(Imp.0Version) = 'NUM'
  242.     then leave
  243. end
  244.  
  245. if Imp.0BackDir <> ''
  246.   then if \CheckBackupDir(Imp.0BackDir)
  247.     then do
  248.       say 'Backup directory' Imp.0BackDir 'not found.  Using' Imp.0BDr 'instead.'
  249.       Imp.0BackDir = Imp.0BDr
  250.     end
  251. if Imp.0BackType = ''
  252.   then Imp.0BackType = 'U'
  253. if InFile <> ''
  254.   then do
  255.     OutC = ReadFile(InFile)
  256.     Imp.0CurL = 1
  257.   end
  258.   else do
  259.     Imp.0File.0 = 0
  260.     Imp.0CurL = 0
  261.     OutC = 255
  262.   end
  263. return OutC
  264.  
  265. /****************************************************************************
  266.  * IMPITLINIT                                                               *
  267.  * Add variables for ITL support.                                           *
  268.  ****************************************************************************/
  269. ImpITLInit: procedure expose (Globals)
  270. parse upper arg ModFileSpec ., OtherArgs
  271. Imp.!ITLActive = 1
  272. if ModFileSpec = 'QUEUE'
  273.   then do
  274.     parse var OtherArgs Who PreQ .
  275.     if Who = ''
  276.       then call ImpError 'Caller not specified on /R:QUEUE.'
  277.     if PreQ = ''
  278.       then PreQ = 0
  279.     if queued() <= PreQ
  280.       then call ImpError 'No lines queued.'
  281.     do I = 1 while queued() > PreQ
  282.       parse pull Imp.0Mods.I
  283.     end
  284.     Imp.0Mods.0 = I-1
  285.     Imp.0ItlMe = Who
  286.     Imp.!QItlMe = ''
  287.     Opts.0NoPause = 1
  288.   end
  289.   else do
  290.     if rxFileExist(ModFileSpec)
  291.       then ModFile = ModFileSpec
  292.       else if rxFileExist(ModFileSpec'.ITL')
  293.         then ModFile = ModFileSpec'.ITL'
  294.         else do
  295.           ModFile = rxSearchPath('DPATH', ModFileSpec)
  296.           if ModFile = ''
  297.             then ModFile = rxSearchPath('DPATH', ModFileSpec'.ITL')
  298.         end
  299.     if ModFile = ''
  300.       then call ImpError 'ITL file' ModFileSpec 'does not exist.'
  301.  
  302.     Imp.0ItlMe = XFileSpec('NAME', ModFile)
  303.     call rxTree ModFile, 'TEMP.', 'FO'
  304.     Imp.!QITLMe = Temp.1
  305.     call RxRead ModFile, 'Imp.0Mods'
  306.   end
  307.  
  308. Imp.0Verbose   = 0       /* No verbose messages */
  309. Imp.0StrRep    = 0       /* String replacement off */
  310. Imp.0ErrorMode = 'HALT'  /* Halt on error */
  311. Imp.0Error     = ''      /* Error result */
  312. Imp.0TrVal     = 'O'     /* Tracing off */
  313. Imp.0ItlResult = ''      /* Result from EVAL */
  314. Imp.!ItlZipDir = '.'     /* Zip file directory */
  315. if symbol('IMP.0ORG.0') = 'VAR'
  316.   then do II = 1 to Imp.0Org.0
  317.     Var = Imp.0Org.II
  318.     drop Imp.0Rep.Var
  319.   end
  320. Imp.0Org.0 = 0           /* Source replace strings */
  321.  
  322. /*
  323. Imp.0Rep.0 = 0           /* Target replace strings */
  324. */
  325. Imp.0RepStart = '{'      /* List of start characters of replace strings */
  326. Imp.0IfStack.0 = 0
  327. Imp.0IfScan = 0
  328. Imp.0ITLLog = ''         /* Name of log file */
  329. Imp.0NullEnv = 1         /* Null env var error flag */
  330.  
  331. call ITLReplaceStringAdd '{NULL}', d2c(0)
  332. call ITLReplaceStringAdd '{SOURCE.DIR}', XFileSpec('QPATH', Imp.!QItlMe)
  333. call ITLReplaceStringAdd '{COMMA}', ','
  334. call ITLReplaceStringAdd '{SP}', ' '
  335. call ITLReplaceStringAdd '{AMP}', '&'
  336. call ITLReplaceStringAdd '{OS2VER}', rxOs2Ver()
  337. call ITLReplaceStringAdd '{BOOT.DRIVE}', Imp.0BDr
  338.  
  339. call ITLReplaceStringAdd2 '{CMLIB.DRIVE}',,
  340.     left(rxSearchPath('PATH', 'STARTCM.CMD'), 2)
  341. LDr = left(rxSearchPath('PATH', 'NET.EXE'), 2)
  342. if LDr <> '' then do
  343.   call ITLReplaceStringAdd '{IBMLAN.DRIVE}', LDr
  344.   call RxGrep 'COMPUTERNAME =', LDr'\IBMLAN\IBMLAN.INI', 'GStem.'
  345.   if GStem.0 <> 0 then do
  346.     parse var GStem.1 'COMPUTERNAME =' Req .
  347.     call ITLReplaceStringAdd '{WKSNAME}', Req
  348.   end
  349. end
  350. else do
  351.   call ITLReplaceStringAdd '{WKSNAME}', ''
  352.   call ITLReplaceStringAdd '{DOMNAME}', ''
  353. end
  354.  
  355. /**** PTR 10128 start ****/
  356. call ITLReplaceStringAdd '{CORE.INI}', CoreData('COREINI')
  357. call ITLReplaceStringAdd '{NETDOOR.INI}', CoreData('COREINI')
  358. call ITLReplaceStringAdd '{CORE.DIR}', CoreData('COREDIR')
  359. call ITLReplaceStringAdd '{NETDOOR.REMOTE}', CoreData('COREDIR')
  360. call ITLReplaceStringAdd '{USER.DIR}', CoreData('USERDIR')
  361. call ITLReplaceStringAdd '{NETDOOR.LOCAL}', CoreData('USERDIR')
  362. call ITLReplaceStringAdd '{USER.DATA}', CoreData('DATADIR')
  363. call ITLReplaceStringAdd '{NETDOOR.DATA}', CoreData('DATADIR')
  364. call ITLReplaceStringAdd '{TEMP.DIR}', CoreData('TEMPDIR')
  365. call ITLReplaceStringAdd '{NETDOOR.TEMP}', CoreData('TEMPDIR')
  366. call ITLReplaceStringAdd '{IMP.VERSION}', Imp.0Version
  367. /**** PTR 10128 end ****/
  368. return 0
  369.  
  370. /****************************************************************************
  371.  *ITLREPLACESTRINGADD source, target                                        *
  372.  ****************************************************************************/
  373. ITLReplaceStringAdd: procedure expose (Globals)
  374. parse arg Source, Target
  375. if Source = ''
  376.   then call ITLErr 'Null source string specified.'
  377.   else do
  378.     Source = translate(strip(Source))
  379.     if pos(left(Source, 1), Imp.0RepStart) = 0
  380.       then Imp.0RepStart = Imp.0RepStart||left(Source, 1)
  381.     if symbol('IMP.0REP.SOURCE') = 'LIT'
  382.       then call rxStemInsert 'Imp.0Org.', Imp.0Org.0 + 1, Source
  383.     Imp.0Rep.Source = Target
  384.   end
  385. return 0
  386.  
  387. ITLReplaceStringAdd2: procedure expose (Globals)
  388. parse arg Source, Target
  389. return ITLReplaceStringAdd(Source, strip(Target))
  390.  
  391. /****************************************************************************
  392.  * CHECKBACKUPTYPE                                                          *
  393.  * Check for valid backup type - return 1 if good 0 o/w                     *
  394.  ****************************************************************************/
  395. CheckBackupType: procedure expose (Globals)
  396. parse arg BackType '=' BackArg
  397. GoodType = (verify(BackType, Imp.0Digits) = 0) | BackType = 'NOBACKUP'
  398. do I = 1 to words(Imp.0BTypes) while \GoodType
  399.   GoodType = abbrev(word(Imp.0BTypes, I), BackType)
  400. end
  401. if GoodType & abbrev('NAME', BackType)
  402.   then GoodType = (BackArg <> '')
  403. return GoodType
  404.  
  405. /****************************************************************************
  406.  * CHECKBACKUPDIR                                                           *
  407.  * Check for existing backup drive - return 1 if good 0 o/w                 *
  408.  ****************************************************************************/
  409. CheckBackupDir: procedure expose (Globals)
  410. parse arg Dir .
  411. return rxDirExist(Dir) | Dir = '.'
  412.  
  413. /****************************************************************************
  414.  * RXUTILSINIT                                                              *
  415.  * Register all RXUTILS functions if they don't appear to be registered.    *
  416.  * Register all REXXUTILS functions if we're on 2.0.                        *
  417.  ****************************************************************************/
  418. RxUtilsInit: procedure expose (Globals)
  419. Rtn = 'RxUtilsInit'
  420. if rxfuncquery('RXLISTFUNCS')
  421.   then do
  422.     call rxfuncadd 'RXUTILSVER', 'RXUTILS', 'RXUTILSVER'
  423.     if rxfuncquery('RXUTILSVER')
  424.       then call ImpError 'RXUTILS not available or downlevel.'
  425.       else do
  426.         Temp = rxUtilsVer()
  427.         if Temp < 1.70
  428.           then call ImpError 'RXUTILS version 1.70 required,' Temp 'found.'
  429.       end
  430.  
  431.     call rxfuncadd 'RXLISTFUNCS', 'RXUTILS', 'RXLISTFUNCS'
  432.     call rxListFuncs 'LIST'
  433.     do I = 1 to words(List)
  434.       Func = word(List, I)
  435.       call rxfuncadd Func, 'RXUTILS', Func
  436.     end
  437.   end
  438.  
  439. call rxfuncadd 'RXCOUINFO', 'COUENV', 'RXCOUINFO'
  440. Syntax.Ref = 'NOCOUENV'
  441. call rxCouInfo 'VER'
  442. drop Syntax.Ref
  443.  
  444. call rxfuncadd 'RXCOUCOPY', 'COUCOPY', 'RXCOUCOPY'
  445. call rxfuncadd 'RXCOUDELETE', 'COUCOPY', 'RXCOUDELETE'
  446. call rxfuncadd 'RXCOUDELETEALL', 'COUCOPY', 'RXCOUDELETEALL'
  447. call rxfuncadd 'RXCOUASSOCIATEAPPFILE', 'COUCOPY', 'RXCOUASSOCIATEAPPFILE'
  448. call rxfuncadd 'RXCOUREMOVEAPPFILE', 'COUCOPY', 'RXCOUREMOVEAPPFILE'
  449. return 0
  450.  
  451. /****************************************************************************
  452.  * ADDLOCALFILES - Add to local file list                                   *
  453.  *   1.  Ini, App, 'AUTOUP', LocFile, SrcFile                               *
  454.  *   2.  Ini, App, LocFile                                                  *
  455.  *   3.  Ini, App, Dir, LocFileList                                         *
  456.  ****************************************************************************/
  457. AddLocalFiles: procedure expose (Globals)
  458. Rtn = 'AddLocalFiles'
  459. parse arg Ini, App, Dir, FileList, SrcFile
  460. if Ini = '' | App = '' | Dir = ''
  461.   then call ImpError 'Invalid arguments.'
  462. AutoUp = (translate(Dir) = 'AUTOUP')
  463. if AutoUp
  464.   then if FileList = '' | SrcFile = ''
  465.     then call ImpError 'Invalid arguments.'
  466.     else do
  467.       Dir = FileList
  468.       FileList = ''
  469.     end
  470. if FileList = ''
  471.   then if rxFileExist(Dir)
  472.     then do
  473.       FileList = filespec('NAME', Dir)
  474.       Dir = XFileSpec('QPATH', Dir)
  475.     end
  476.     else call ImpError 'Local file' Dir 'does not exist.'
  477. App = translate(App)
  478. if right(Dir, 1) <> '\'
  479.   then Dir = Dir'\'
  480. List = IniGet(Ini, 'LocalFiles', App, 'ITLERREXIT ENDNULL')
  481. Files = ''
  482. Entry. = '?'
  483. do while List <> ''
  484.   parse var List Entry '0'x List
  485.   parse var Entry Local '|' Src
  486.   Entry.Local = Src
  487.   Files = Files||Local'|'
  488. end
  489. do while FileList <> ''
  490.   parse var FileList File FileList
  491.   File = Dir||File
  492.   if Entry.File = '?'
  493.     then do
  494.       Entry.File = SrcFile
  495.       Files = Files'|'File
  496.     end
  497.     else if SrcFile <> '' & Entry.File <> SrcFile
  498.       then Entry.File = SrcFile
  499. end
  500. List = ''
  501. do while Files <> ''
  502.   parse var Files File '|' Files
  503.   if File <> ''
  504.     then List = List||File'|'Entry.File'0'x
  505. end
  506. Res = IniSet(Ini, 'LocalFiles', App, List, 'ITLERREXIT')
  507. return 0
  508.  
  509. /****************************************************************************
  510.  * DELLOCALFILES - Delete locally installed files                           *
  511.  ****************************************************************************/
  512. DelLocalFiles: procedure expose (Globals)
  513. Rtn = 'DelLocalFiles'
  514. if arg() < 1 | arg() > 2
  515.   then call ItlErr 'Invalid arguments.'
  516.  
  517. if arg() = 1
  518.   then parse arg App
  519.   else parse arg Ini, App
  520. App = translate(App)
  521. XC = 0
  522.  
  523. if arg() = 1
  524.   then do
  525.     Defer = 0
  526.     Res = rxCouDeleteAll(App, Defer)
  527.     if abbrev(Res, 'ERROR:')
  528.       then XC = 100 + substr(Res, 7)
  529.   end
  530.   else do
  531.     List = IniGet(Ini, 'LocalFiles', App, 'ITLERREXIT')
  532.     Count = 0
  533.     do while List <> ''
  534.       parse var List File '0'x List
  535.       parse var File File '|'
  536.       if rxFileExist(File)
  537.         then Res = rxDelete(File)
  538.         else Res = 0
  539.       if Res <> 0
  540.         then Count = Count + 1
  541.     end
  542.     call rxOs2Ini Ini, 'LocalFiles', App, '$RXDEL'
  543.     if Count > 0
  544.       then XC = 1000 + Count
  545.       else XC = 0
  546.   end
  547. return XC
  548.  
  549. /****************************************************************************
  550.  * AT n | TOP | BOTTOM                                                      *
  551.  ****************************************************************************/
  552. At: procedure expose (Globals)
  553. Rtn = 'AT'
  554. if Imp.0File.0 = 0
  555.   then return 255
  556. parse arg Where
  557. if Where = 'BOTTOM'
  558.   then Where = Imp.0File.0
  559.   else if Where = 'TOP'
  560.     then Where = 1
  561. if \datatype(Where, 'N')
  562.   then call ImpError 'Invalid line number' Where'.'
  563. return (Imp.0CurL = Where)
  564.  
  565. /****************************************************************************
  566.  * CHANGE Target, New, Scope, Direction                                     *
  567.  ****************************************************************************/
  568. Change: procedure expose (Globals)
  569. Rtn = 'CHANGE'
  570. parse arg Target, New, Scope Ex1, Dir Ex2
  571. if Scope = '' then Scope = 'FIRST'
  572. if Dir = '' then Dir = 'LEFT'
  573. if wordpos(Scope, 'FIRST ALL') = 0 | wordpos(Dir, 'LEFT RIGHT') = 0 | Ex1 Ex2 <> ''
  574.   then call ImpError 'Bad arguments:' Scope',' Dir
  575. if Imp.0File.0 = 0
  576.   then return 255
  577. CL = Imp.0CurL
  578. Temp = ChangeStr(Imp.0File.CL, Target, New, Scope, Dir)
  579. if Temp <> Imp.0File.CL
  580.   then do
  581.     Imp.0Mod = 1
  582.     Imp.0File.CL = Temp
  583.     return 0
  584.   end
  585.   else return 1
  586. /**
  587. WorkLine = Imp.0File.CL
  588. if Dir = 'RIGHT'
  589.   then do
  590.     Target = reverse(Target)
  591.     New = reverse(New)
  592.     WorkLine = reverse(WorkLine)
  593.   end
  594. LT = length(Target)
  595. Found = 0
  596. do forever
  597.   Temp = translate(WorkLine)
  598.   Index = pos(Target, Temp)
  599.   if Index = 0
  600.     then leave
  601.   Found = 1
  602.   WorkLine = left(WorkLine, Index-1)||New||substr(WorkLine, Index + LT)
  603.   if Scope <> 'ALL'
  604.     then leave
  605. end
  606. if Dir = 'RIGHT'
  607.   then Imp.0File.CL = reverse(WorkLine)
  608.   else Imp.0File.CL = WorkLine
  609. Imp.0Mod = Found
  610. return \(Found)
  611. */
  612.  
  613. /****************************************************************************
  614.  * CHANGESTR String, Target, New, Scope, Direction                          *
  615.  ****************************************************************************/
  616. ChangeStr: procedure expose (Globals)
  617. Rtn = 'ChangeStr'
  618. parse arg WorkLine, Target, New, Scope Ex1, Dir Ex2
  619. if Scope = '' then Scope = 'FIRST'
  620. if Dir = '' then Dir = 'LEFT'
  621. if WorkLine = '' | Target = '' | wordpos(Scope, 'FIRST ALL') = 0 |,
  622.     wordpos(Dir, 'LEFT RIGHT') = 0 | Ex1 Ex2 <> ''
  623.   then call ImpError 'Bad arguments:' WorkLine',' Target',' Scope Ex1',' Dir Ex2
  624. Target = translate(Target)
  625. if Dir = 'RIGHT'
  626.   then do
  627.     Target = reverse(Target)
  628.     New = reverse(New)
  629.     WorkLine = reverse(WorkLine)
  630.   end
  631. LT = length(Target)
  632. Found = 0
  633. do forever
  634.   Temp = translate(WorkLine)
  635.   Index = pos(Target, Temp)
  636.   if Index = 0
  637.     then leave
  638.   Found = 1
  639.   WorkLine = left(WorkLine, Index-1)||New||substr(WorkLine, Index + LT)
  640.   if Scope <> 'ALL'
  641.     then leave
  642. end
  643. if Dir = 'RIGHT'
  644.   then return reverse(WorkLine)
  645.   else return WorkLine
  646.  
  647. /****************************************************************************
  648.  * CMDCOMPARE cmd1, cmd2, ABBREV                                            *
  649.  ****************************************************************************/
  650. CmdCompare: procedure expose (Globals)
  651. Rtn = 'CmdCompare'
  652. parse upper arg Cmd.1, Cmd.2, Abbrev .
  653. if Cmd.1 = ''
  654.   then call ImpError 'Bad arguments: cmd not specified.'
  655. Abbrev = abbrev('ABBREV', Abbrev)
  656. if Cmd.2 = ''
  657.   then Cmd.2 = translate(GetLine())
  658. do I = 1 to 2
  659.   Cmd.I = strip(Cmd.I, 'L')
  660.   if abbrev(space(Cmd.I, 0), 'PATH=') | abbrev(space(Cmd.I, 0), 'DPATH=')
  661.     then Cmd.I = 'SET' Cmd.I
  662.   if word(Cmd.I, 1) = 'SET' & pos('=', Cmd.I) <> 0
  663.     then do
  664.       parse var Cmd.I A '=' B
  665.       if pos('PATH', A) = 1
  666.         then if right(strip(B), 1) <> ';'
  667.           then B = strip(B)';'
  668.       Cmd.I = space(A)'='||B
  669.     end
  670.     else if pos('=', Cmd.I) <> 0
  671.       then do
  672.         parse var Cmd.I A '=' B
  673.         Cmd.I = space(A)'='space('B')
  674.       end
  675.       else Cmd.I = space(B)
  676. end
  677. if Abbrev
  678.   then return (abbrev(Cmd.2, Cmd.1))
  679.   else return (Cmd.1 = Cmd.2)
  680.  
  681. /****************************************************************************
  682.  * COPYFILE source, destination, [opt], [appname]                           *
  683.  ****************************************************************************/
  684. CopyFile: procedure expose (Globals)
  685. Rtn = 'COPYFILE'
  686. parse arg Source, Dest, Opt .
  687. Opt = translate(Opt)
  688. if Source = '' | Dest = ''
  689.   then call ImpError 'Bad aruments:  source and target must be specified.'
  690. if verify(Source||Dest, '?*', 'M') > 0
  691.   then call ImpError 'Bad aruments:  wild cards are not supported.'
  692. if Opt <> '' & wordpos(Opt, 'NEWONLY REPLACEONLY COUCOPY') = 0
  693.   then call ImpError 'Unrecognized option' Opt'.'
  694. CouCopy = (Opt = 'COUCOPY')
  695. if CouCopy
  696.   then do
  697.     parse arg , , , AppName ., AutoUp ., Defer .
  698.     Defer = (Defer = 1)
  699.     AutoUp = (AutoUp = 1)
  700.   end
  701.   else if pos('[', Source||Dest) > 0
  702.     then call ImpError 'Invalid chars in source or target.'
  703.  
  704. XC = 0
  705. if CouCopy
  706.   then do
  707.     Res = rxCouCopy(Source, Dest, Defer, AppName, AutoUp)
  708.     if abbrev(Res, 'ERROR:')
  709.       then XC = 100 + substr(Res, 7)
  710.   end
  711.   else do
  712.     if right(Dest, 1) = '\' & length(Dest) <> 3
  713.       then Dest = strip(Dest, 'T', '\')
  714.     if rxDirExist(Dest)
  715.       then Dest = strip(Dest, 'T', '\')'\'filespec('NAME', Source)
  716.     select
  717.       when Opt = 'NEWONLY'
  718.         then CopyIt = \rxFileExist(Dest)
  719.       when Opt = 'REPLACEONLY'
  720.         then CopyIt = rxFileExist(Dest)
  721.       otherwise
  722.         CopyIt = 1
  723.     end
  724.     if CopyIt
  725.       then CopyIt = rxFileExist(Source)
  726.     if CopyIt
  727.       then do
  728.         'COPY /B' Source Dest '>NUL 2>&1'
  729.         XC = (rc <> 0)
  730.       end
  731.   end
  732. return XC
  733.  
  734. /****************************************************************************
  735.  * COREDATA datatype                                                        *
  736.  ****************************************************************************/
  737. CoreData: procedure expose (Globals)
  738. Rtn = 'CoreData'
  739. parse upper arg Data .
  740. TrailSlash = 1
  741. select
  742.   when Data = 'COREDIR'
  743.     then Act = rxCouInfo('GET', 'REMOTE')
  744.   when Data = 'DATADIR'
  745.     then do
  746.       Act = rxCouInfo('GET', 'DATA')
  747.       TrailSlash = 0
  748.     end
  749.   when Data = 'TEMPDIR'
  750.     then do
  751.       Act = rxCouInfo('GET', 'TEMP')
  752.       TrailSlash = 0
  753.     end
  754.   when Data = 'USERDIR'
  755.     then Act = rxCouInfo('GET', 'LOCAL')
  756.   when Data = 'COREINI'
  757.     then do
  758.       Act = rxCouInfo('GET', 'INIFILE')
  759.       TrailSlash = 0
  760.     end
  761.   otherwise call ImpError 'Bad argument:' Data'.'
  762. end
  763. Act = translate(left(Act, 1))||substr(Act, 2)
  764. if TrailSlash & right(Act, 1) <> '\'
  765.   then Act = Act'\'
  766. return Act
  767.  
  768. /****************************************************************************
  769.  * CURLN                                                                    *
  770.  ****************************************************************************/
  771. CurLn: procedure expose (Globals)
  772. Rtn = 'CurLn'
  773. Imp.0CurL = min(Imp.0CurL, Imp.0File.0)
  774. return Imp.0CurL
  775.  
  776. /****************************************************************************
  777.  * DELBLOCK Start, End                                                      *
  778.  ****************************************************************************/
  779. DelBlock: procedure expose (Globals)
  780. Rtn = 'DelBlock'
  781. if Imp.0File.0 = 0
  782.   then return 255
  783. parse upper arg LStart, LEnd
  784. if LStart = '.' | LStart = 'CURLN'   /* . = Compatibility w/ pre 2.14 */
  785.   then LStart = Imp.0CurL
  786. if LEnd = 'CURLN'
  787.   then LEnd = Imp.0CurL
  788. if datatype(LStart) <> 'NUM' | (datatype(LEnd) <> 'NUM' & LEnd <> 'BOTTOM')
  789.   then call ImpError 'Bad arguments:' LStart',' LEnd
  790. if LEnd = 'BOTTOM'
  791.   then do
  792.     Imp.0File.0 = LStart - 1
  793.     Imp.0CurL = min(Imp.0CurL, LStart - 1)
  794.   end
  795.   else do I = min(LEnd, Imp.0File.0) to LStart by -1
  796.     call rxStemDelete('IMP.0FILE', I)
  797.   end
  798. Imp.0Mod = 1
  799. return 0
  800.  
  801. /****************************************************************************
  802.  * DELLINE [BACKUP]                                                         *
  803.  ****************************************************************************/
  804. DelLine: procedure expose (Globals)
  805. Rtn = 'DelLine'
  806. parse upper arg Opt
  807. if Imp.0File.0 = 0
  808.   then RetC = 255
  809.   else do
  810.     RetC = rxStemDelete('IMP.0FILE', Imp.0CurL)
  811.     if RetC <> 0 then call ImpError '*' RetC
  812.     Imp.0CurL = min(Imp.0CurL, Imp.0File.0)
  813.     if Opt = 'BACKUP'
  814.       then if Imp.0CurL <> Imp.0File.0
  815.         then Imp.0CurL = max(Imp.0CurL - 1, 1)
  816.     RetC = 0
  817.     Imp.0Mod = 1
  818.   end
  819. return RetC
  820.  
  821. /****************************************************************************
  822.  * DELPATH path, dir                                                        *
  823.  ****************************************************************************/
  824. DelPath: procedure expose (Globals)
  825. Rtn = 'DelPath'
  826. parse upper arg Path, Dir ';'
  827. Dir = translate(Dir)
  828. if Imp.0File.0 = 0
  829.   then return 255
  830. if Path <> 'LIBPATH'
  831.   then Path = 'SET' Path
  832. Where = FindIt(Path, 1, Imp.0File.0, 1, 'BEGIN', 1)
  833. /*** PTR 10300 start ***/
  834. if Where = 0
  835.   then do
  836.     if Path = 'SET PATH' | Path = 'SET DPATH'
  837.       then Where = FindIt(word(Path, 2), 1, Imp.0File.0, 1, 'BEGIN', 1)
  838.     if Where = 0
  839.       then return 1
  840.       else parse var Imp.0File.Where . Data
  841.   end
  842.   else parse var Imp.0File.Where '=' Data
  843. /*** PTR 10300 end ***/
  844. if right(Data, 1) <> ';'
  845.   then Data = Data';'
  846. TestLine = translate(Data)
  847. if abbrev(TestLine, Dir';')
  848.   then Offset = 1
  849.   else Offset = pos(';'Dir';', TestLine)
  850. if Offset > 0
  851.   then do
  852.      if Offset > 1
  853.        then OffSet = Offset + 1
  854.     Data = delstr(Data, Offset, length(Dir)+1)
  855.     Imp.0File.Where = Path'='Data
  856.     Imp.0Mod = 1
  857.   end
  858. return 0
  859.  
  860. /****************************************************************************
  861.  * DELSTRING Target                                                         *
  862.  ****************************************************************************/
  863. DelString: procedure expose (Globals)
  864. Rtn = 'DelString'
  865. parse upper arg Target
  866. if Imp.0File.0 = 0
  867.   then RetC = 255
  868.   else do
  869.     CL = Imp.0CurL
  870.     Start = pos(Target, translate(Imp.0File.CL))
  871.     if Start = 0
  872.       then RetC = 1
  873.       else do
  874.         Imp.0File.CL = delstr(Imp.0File.CL, Start, length(Target))
  875.         RetC = 0
  876.         Imp.0Mod = 1
  877.       end
  878.   end
  879. return RetC
  880.  
  881. /****************************************************************************
  882.  * DISCARDFILE                                                              *
  883.  ****************************************************************************/
  884. DiscardFile: procedure expose (Globals)
  885. Rtn = 'DiscardFile'
  886. Imp.0File.0 = 0
  887. Imp.0Mod = 0
  888. Imp.0Filename = ''
  889. return 0
  890.  
  891. /****************************************************************************
  892.  * ECHOFILE                                                                 *
  893.  ****************************************************************************/
  894. EchoFile: procedure expose (Globals)
  895. Rtn = 'EchoFile'
  896. parse arg Start ., End .
  897. if Start = ''
  898.   then Start = 1
  899.   else Start = max(Start, 1)
  900. if End = ''
  901.   then End = Imp.0File.0
  902.   else End = min(End, Imp.0File.0)
  903. Pad = length(End)
  904. say
  905. do I = Start to End
  906.   if I = Imp.0CurL
  907.     then Pref = '*'
  908.     else Pref = ' '
  909.   say Pref||left(I, Pad)':' Imp.0File.I
  910. end
  911. return 0
  912.  
  913. /****************************************************************************
  914.  * ERASEFILE file                                                           *
  915.  ****************************************************************************/
  916. EraseFile: procedure expose (Globals)
  917. Rtn = 'EraseFile'
  918. parse arg File .
  919. return RxDelete(File)
  920.  
  921. /****************************************************************************
  922.  * FILECHANGED                                                              *
  923.  ****************************************************************************/
  924. FileChanged: procedure expose (Globals)
  925. Rtn = 'FileChanged'
  926. return Imp.0Mod
  927.  
  928. /****************************************************************************
  929.  * FILETYPE [type]                                                          *
  930.  ****************************************************************************/
  931. FileType: procedure expose (Globals)
  932. Rtn = 'FileType'
  933. KnownTypes = 'REXX BATCH CONFIG IBMLAN PROTOCOL'
  934. parse arg TestType Extra
  935. if TestType = ''
  936.   then return XXFileType()
  937.   else if wordpos(TestType, KnownTypes) = 0 | Extra <> ''
  938.     then call ImpError 'Bad argument:' TestType Extra
  939.     else return (TestType = XXFileType())
  940.  
  941. /****************************************************************************
  942.  * XXFILETYPE                                                               *
  943.  ****************************************************************************/
  944. XXFileType: procedure expose (Globals)
  945. InFile = translate(FileSpec('NAME', Imp.0FileName))
  946. select
  947.   when InFile = 'CONFIG.SYS'
  948.     then return 'CONFIG'
  949.   when InFile = 'IBMLAN.INI'
  950.     then return 'IBMLAN'
  951.   when InFile = 'PROTOCOL.INI'
  952.     then return 'PROTOCOL'
  953.   when XFilespec('FEXT', InFile) = 'CMD'
  954.     then do
  955.       if Imp.0File.0 > 0
  956.         then if abbrev(Imp.0File.1, '/'||'*')
  957.           then return 'REXX'
  958.       return 'BATCH'
  959.     end
  960.   otherwise
  961.     return 'TEXT'
  962. end
  963.  
  964. /****************************************************************************
  965.  * FIND Target, Scope, [Position]                                           *
  966.  ****************************************************************************/
  967. Find: procedure expose (Globals)
  968. Rtn =  'Find'
  969. parse upper arg Target, Scope, Position
  970. if Imp.0File.0 = 0
  971.   then return 255
  972.  
  973. if Position <> '' & wordpos(Position, 'BEGIN END ALL') = 0
  974.   then call ImpError 'Illegal position' Position'.'
  975. CL = Imp.0CurL
  976. select
  977.   when Scope = '' | Scope = '+' then do
  978.     FStart = CL + 1
  979.     FEnd = Imp.0File.0
  980.     FIncr = 1
  981.   end
  982.   when Scope = 'ALL+' then do
  983.     FStart = 1
  984.     FEnd = Imp.0File.0
  985.     FIncr = 1
  986.   end
  987.   when Scope = '-' then do
  988.     FStart = CL - 1
  989.     FEnd = 1
  990.     FIncr = -1
  991.   end
  992.   when Scope = 'ALL-' then do
  993.     FStart = Imp.0File.0
  994.     FEnd = 1
  995.     FIncr = -1
  996.   end
  997.   otherwise
  998.     call ImpError 'Illegal scope' Scope'.'
  999. end /* select */
  1000.  
  1001. Imp.0Find.0Target = Target
  1002. Imp.0Find.0FStart = FStart
  1003. Imp.0Find.0FEnd = FEnd
  1004. Imp.0Find.0FIncr = FIncr
  1005. Imp.0Find.0Position = Position
  1006.  
  1007. Where = FindIt(Target, FStart, FEnd, FIncr, Position)
  1008. if Where = 0
  1009.   then RetC = 1
  1010.   else do
  1011.     RetC = 0
  1012.     Imp.0CurL = Where
  1013.   end
  1014. return RetC
  1015.  
  1016. /****************************************************************************
  1017.  * FINDNEXT                                                                 *
  1018.  ****************************************************************************/
  1019. FindNext: procedure expose (Globals)
  1020. Rtn = 'FindNext'
  1021. if Imp.0File.0 = 0
  1022.   then RetC = 255
  1023.   else do
  1024.     Imp.0Find.0FStart = Imp.0CurL + Imp.0Find.0FIncr
  1025.     Where = FindIt(Imp.0Find.0Target, Imp.0Find.0FStart, Imp.0Find.0FEnd,,
  1026.         Imp.0Find.0FIncr, Imp.0Find.0Position)
  1027.     if Where = 0
  1028.       then RetC = 1
  1029.       else do
  1030.         RetC = 0
  1031.         Imp.0CurL = Where
  1032.       end
  1033.   end
  1034. return RetC
  1035.  
  1036. /****************************************************************************
  1037.  * FINDIT Target, StartL, EndL, Increment, Position, XTest                  *
  1038.  ****************************************************************************/
  1039. FindIt: procedure expose (Globals) Rtn
  1040. Rtn = Rtn '(Engine)'
  1041. parse arg Target, FStart, FEnd, FIncr, Position, XTest
  1042. Found = 0
  1043. Target = translate(Target)
  1044. FEnd = min(FEnd, Imp.0File.0)
  1045. XTest = (Xtest = 1)
  1046. if XTest
  1047.   then Target = space(strip(Target))
  1048. do I = FStart to FEnd by FIncr
  1049.   if XTest
  1050.     then TestLine = translate(space(strip(Imp.0File.I)))
  1051.     else TestLine = translate(strip(Imp.0File.I))
  1052.   if pos(Target, TestLine) = 0
  1053.     then iterate
  1054.   select
  1055.     when Position = ''
  1056.       then Found = 1
  1057.     when Position = 'BEGIN' & abbrev(TestLine, Target)
  1058.       then Found = 1
  1059.     when Position = 'END' & abbrev(reverse(TestLine), reverse(Target))
  1060.       then Found = 1
  1061.     when Position = 'ALL' & Target = TestLine
  1062.       then Found = 1
  1063.     otherwise nop
  1064.   end /* select */
  1065.   if Found
  1066.     then leave
  1067. end /* do */
  1068. Rtn = word(Rtn, 1)
  1069. if Found
  1070.   then return I
  1071.   else return 0
  1072.  
  1073. /****************************************************************************
  1074.  * GETDISK label [, name]                                                   *
  1075.  ****************************************************************************/
  1076. GetDisk: procedure expose (Globals)
  1077. Label = translate(arg(1))
  1078. Name = arg(2)
  1079. if Name = ''
  1080.   then Name = 'the disk labeled "'Label'"'
  1081.   else Name = '"'Name'"'
  1082. parse upper value rxDriveInfo('A:') with 'LABEL=' DLabel 'FREE='
  1083. do while DLabel <> Label
  1084.   say 'Please insert' Name 'in drive A:.'
  1085.   call rxPause 'Press any key when ready.'
  1086.   parse upper value rxDriveInfo('A:') with 'LABEL=' DLabel 'FREE='
  1087. end
  1088. return 0
  1089.  
  1090. /****************************************************************************
  1091.  * GETLINE linenum                                                          *
  1092.  ****************************************************************************/
  1093. GetLine: procedure expose (Globals)
  1094. Rtn = 'GetLine'
  1095. parse arg LineNum .
  1096. if LineNum = ''
  1097.   then LineNum = Imp.0CurL
  1098. if LineNum < 1 | LineNum > Imp.0File.0
  1099.   then return ''
  1100.   else return Imp.0File.LineNum
  1101.  
  1102. /****************************************************************************
  1103.  * IMPVERSION                                                               *
  1104.  ****************************************************************************/
  1105. IMPVersion: procedure expose (Globals)
  1106. Rtn = 'ImpVersion'
  1107. return Imp.0Version
  1108.  
  1109. /****************************************************************************
  1110.  * INIGET file, app, key, [ENDNULL] [ERREXIT] [ITLERREXIT]                  *
  1111.  ****************************************************************************/
  1112. IniGet: procedure expose (Globals)
  1113. Rtn = 'IniGet'
  1114. parse arg File, App, Key, Flags
  1115. Flags = translate(Flags)
  1116. EndNull = wordpos('ENDNULL', Flags) > 0
  1117. ErrExit = wordpos('ERREXIT', Flags) > 0
  1118. ITLErrExit = wordpos('ITLERREXIT', Flags) > 0
  1119. Res = rxOs2Ini(File, App, Key)
  1120. select
  1121.   when Res = '$INIERROR'
  1122.     then if ErrExit
  1123.       then call ImpError 'Error reading INI file' File'.'
  1124.       else if ITLErrExit
  1125.         then call ITLErr 'Error reading INI file' File'.'
  1126.         else Res = ''
  1127.   when Res = '$RXERROR'
  1128.     then Res = ''
  1129.   otherwise nop
  1130. end
  1131. if EndNull & Res <> '' & right(Res, 1) <> '0'x
  1132.   then Res = Res '0'x
  1133. return Res
  1134.  
  1135. /****************************************************************************
  1136.  * INISET file, app, key, val, [ERREXIT] [ITLERREXIT]                       *
  1137.  ****************************************************************************/
  1138. IniSet: procedure expose (Globals)
  1139. Rtn = 'IniSet'
  1140. parse arg File, App, Key, KVal, Flags
  1141. Flags = translate(Flags)
  1142. EndNull = wordpos('ENDNULL', Flags) > 0
  1143. ErrExit = wordpos('ERREXIT', Flags) > 0
  1144. ITLErrExit = wordpos('ITLERREXIT', Flags) > 0
  1145. Res = rxOs2Ini(File, App, Key, KVal)
  1146. if Res = '$INIERROR'
  1147.   then if ErrExit
  1148.     then call ImpError 'Error writing INI file' File'.'
  1149.     else if ITLErrExit
  1150.       then call ITLErr 'Error writing INI file' File'.'
  1151.       else Res = 2
  1152.   else Res = 0
  1153. return Res
  1154.  
  1155. /****************************************************************************
  1156.  * INSBLANK linenum                                                         *
  1157.  ****************************************************************************/
  1158. InsBlank: procedure expose (Globals)
  1159. Rtn = 'InsBlank'
  1160. parse arg Where
  1161. OutC = InsLine('', Where, 1)
  1162. if OutC = 0 & Where = 'BEFORE'
  1163.   then call SetCurL('DOWN')
  1164. return OutC
  1165.  
  1166. /****************************************************************************
  1167.  * INSLINE newline, linenum, InsBlankFlag                                   *
  1168.  ****************************************************************************/
  1169. InsLine: procedure expose (Globals)
  1170. Rtn = 'InsLine'
  1171. parse arg NewLine, Where LineNum, Blank
  1172. Blank = (Blank = 1)
  1173. if Where = ''
  1174.   then Where = 'AFTER'
  1175.   else Where = translate(Where)
  1176. if LineNum = '' then LineNum = Imp.0CurL
  1177. if verify(LineNum, Imp.0Digits) <> 0  | wordpos(Where, 'BEFORE AFTER') = 0
  1178.   then call ImpError 'Bad arguments:' NewLine',' Where LineNum
  1179. select
  1180.   when Imp.0File.0 = 0
  1181.     then LineNum = 1
  1182.   when Where = 'AFTER'
  1183.     then LineNum = Linenum + 1
  1184.   otherwise nop
  1185. end
  1186. if Blank
  1187.   then do
  1188.     L1 = max(LineNum - 1, 1)
  1189.     L2 = min(LineNum + 1, Imp.0File.0)
  1190.     if strip(Imp.0File.L1) = '' | strip(Imp.0File.LineNum) = '' |,
  1191.         strip(Imp.0File.L2 = '')
  1192.       then return 1
  1193.   end
  1194. LineNum = max(1, min(LineNum, Imp.0File.0 +1))
  1195. RetC = rxStemInsert('IMP.0FILE', LineNum, NewLine)
  1196. if RetC <> 0 then call ImpError '*' RetC
  1197. Imp.0CurL = LineNum
  1198. Imp.0Mod = 1
  1199. return 0
  1200.  
  1201. /****************************************************************************
  1202.  * INSPATH path, dir, pos, CREATE [loc], GOTO                                *
  1203.  ****************************************************************************/
  1204. InsPath: procedure expose (Globals)
  1205. Rtn = 'InsPath'
  1206. parse arg Path, Dir ';', Posn, Create AddLn, Goto
  1207. parse upper var Posn Posn STarget OrClause
  1208. Create = abbrev('CREATE', translate(Create), 1)
  1209. Goto = abbrev('GOTO', translate(Goto), 1)
  1210.  
  1211. if Path = '' | Dir = '' | Posn = '' | wordpos(Posn, 'BEGIN END BEFORE AFTER') = 0
  1212.   then call ImpError 'Bad arguments:' Path',' Dir',' Posn'.'
  1213. if OrClause <> '' & word(OrClause, 1) <> 'OR'
  1214.   then call ImpError 'Bad argument:' Posn STarget OrClause
  1215.  
  1216. if Imp.0File.0 = 0 & \Create
  1217.   then return 255
  1218. if \abbrev(translate(Path), 'SET') & Path <> 'LIBPATH'
  1219. /**
  1220.   then if \(Path = 'LIBPATH' | (FileType('BATCH') & wordpos(Path, 'PATH DPATH) > 0))
  1221. **/
  1222.     then Path = 'SET' Path
  1223.  
  1224. TestPath = ''
  1225. Where = FindIt(Path, 1, Imp.0File.0, 1, 'BEGIN', 1)
  1226. if Where > 0
  1227.   then parse upper var Imp.0File.Where Testpath '='
  1228. do while (Where <> 0) & (translate(Path) <> TestPath)
  1229.   Where = FindIt(Path, Where+1, Imp.0File.0, 1, 'BEGIN', 1)
  1230.   if Where > 0
  1231.     then parse upper var Imp.0File.Where Testpath '='
  1232. end
  1233.  
  1234. /*** PTR 10300 start ***/
  1235. if Where = 0
  1236.   then if Path = 'SET PATH' | Path = 'SET DPATH'
  1237.     then do
  1238.       Path2 = word(Path, 2)   
  1239.       Where = FindIt(Path2, 1, Imp.0File.0, 1, 'BEGIN', 1)
  1240.       if Where > 0
  1241.         then if pos('=', Imp.0File.Where) > 0
  1242.           then parse upper var Imp.0File.Where Testpath '='
  1243.           else parse upper var Imp.0File.Where Testpath .
  1244.       do while (Where <> 0) & (translate(Path2) <> TestPath)
  1245.         Where = FindIt(word(Path, 2), Where+1, Imp.0File.0, 1, 'BEGIN', 1)
  1246.         if Where > 0
  1247.           then if pos('=', Imp.0File.Where) > 0
  1248.             then parse upper var Imp.0File.Where Testpath '='
  1249.             else parse upper var Imp.0File.Where Testpath .
  1250. /*** PTR 10300 end ***/
  1251.       end
  1252.     end
  1253. if Where = 0
  1254.   then if Create
  1255.     then do
  1256.       if AddLn = ''
  1257.         then AddLn = Imp.0File.0 + 1
  1258.         else if \datatype('+'AddLn'.', 'W')
  1259.           then AddLn = FindIt(AddLn, 1, Imp.0File.0, 1, '', 1) + 1
  1260.       if AddLn = 0
  1261.         then AddLn = Imp.0File.0 + 1
  1262.         else AddLn = min(AddLn, Imp.0File.0 + 1)
  1263.       call rxStemInsert 'IMP.0FILE', AddLn, Path'='Dir
  1264.       if Goto
  1265.         then Imp.0CurL = AddLn
  1266.       Imp.0Mod = 1
  1267.       OutC = 0
  1268.     end
  1269.     else OutC = 1
  1270.   else do
  1271.     EqSign = (pos('=', Imp.0File.Where) > 0)
  1272.     if EqSign
  1273.       then parse var Imp.0File.Where Prefix '=' TestLn
  1274.       else parse var Imp.0File.Where Prefix TestLn
  1275.     Prefix = strip(Prefix, 'T')
  1276.     if EqSign
  1277.       then Prefix = Prefix'='
  1278.       else Prefix = Prefix' '
  1279.     TestLn = strip(space(TestLn, 0))
  1280.     if right(TestLn, 1) <> ';' & TestLn <> ''
  1281.       then TestLn = TestLn';'
  1282.     UTestLn = translate(TestLn)
  1283.     UDir = translate(Dir)
  1284.     if pos(';'UDir';', ';'UTestLn) = 0
  1285.       then do
  1286.         if STarget <> ''
  1287.           then Offset = pos(';'STarget';', ';'UTestLn)
  1288.           else Offset = 0
  1289.         NewCond = (OrClause <> '' & Offset = 0 & wordpos(Posn, 'BEFORE AFTER') > 0)
  1290.         select
  1291.           when NewCond
  1292.             then do
  1293.               parse var OrClause 'OR' OrClause
  1294.               call InsPath Path, Dir, OrClause, Create AddLn, Goto
  1295.             end
  1296.           when Posn = 'BEGIN' | (Posn = 'BEFORE' & Offset = 0)
  1297.               then Imp.0File.Where = Prefix||Dir';'TestLn
  1298.           when Posn = 'END' | (Posn = 'AFTER' & Offset = 0)
  1299.             then Imp.0File.Where = Prefix||TestLn||Dir';'
  1300.           otherwise do
  1301.             if Posn = 'AFTER'
  1302.               then Offset = Offset + pos(';', substr(TestLn, Offset))
  1303.             Imp.0File.Where = Prefix||left(TestLn, Offset-1)||Dir';'||,
  1304.                 substr(TestLn, Offset)
  1305.           end
  1306.         end /* select */
  1307.         Imp.0Mod = 1
  1308.       end
  1309.     if Goto
  1310.       then Imp.0CurL = Where
  1311.     OutC = 0
  1312.   end
  1313. return OutC
  1314.  
  1315. /****************************************************************************
  1316.  * INSUNIQUE new, where [target], testmode                                  *
  1317.  ****************************************************************************/
  1318. InsUnique: procedure expose (Globals)
  1319. Rtn = 'InsUnique'
  1320. parse arg New, Where Target, Test ., Control .
  1321. if Where = ''
  1322.   then Where = 'AFTER'
  1323.   else Where = translate(Where)
  1324. if Test = ''
  1325.   then Test = 'EXACT'
  1326.   else Test = translate(Test)
  1327. Control = translate(Control)
  1328. if wordpos(Test, 'EXACT COMPRESS PREFIX') = 0 |,
  1329.     wordpos(Where, 'AFTER BEFORE TOP BOTTOM') = 0 |,
  1330.     (Control <> '' & wordpos(Control, 'NEWONLY REPLACEONLY') = 0)
  1331.   then call ImpError 'Bad arguments:' Where',' Test
  1332. Compress = (Test <> 'EXACT')
  1333. FLn = FindIt(New, 1, Imp.0File.0, 1, 'ALL', Compress)
  1334. if FLn <> 0
  1335.   then do
  1336.     call SetCurL FLn
  1337.     return 1
  1338.   end
  1339.  
  1340. if Test = 'PREFIX'
  1341.   then do
  1342.     XTest = 'IFS DEVICE CALL DEVINFO RUN CALL'
  1343.     parse upper var New Word1 .
  1344.     if pos('=', Word1) > 0
  1345.       then parse var Word1 Word1 '='
  1346.     if Word1 = 'SET'
  1347.       then do
  1348.         parse upper var New STarget '='
  1349.         STarget = STarget'='
  1350.       end
  1351.       else if wordpos(Word1, XTest) = 0
  1352.         then STarget = Word1
  1353.         else STarget = word(New, 1)
  1354.     SOpt = 'BEGIN'
  1355.   end
  1356.   else do
  1357.     STarget = New
  1358.     SOpt = 'ALL'
  1359.   end
  1360.  
  1361. if Control <> ''
  1362.   then do
  1363.     call SavePos
  1364.     Found = (Find(STarget, 'ALL+', SOpt) = 0)
  1365.     call RestorePos
  1366.     DoIt = ((Control = 'NEWONLY') & \Found) | ((Control = 'REPLACEONLY') & Found)
  1367.   end
  1368.   else DoIt = 1
  1369.  
  1370. if \DoIt
  1371.   then return 2
  1372.  
  1373. if Control <> 'NEWONLY'
  1374.   then call RemAll STarget, 'ALL-', SOpt
  1375.  
  1376. if Where = 'TOP' | Where = 'BOTTOM'
  1377.   then do
  1378.     call SetCurL Where
  1379.     if Where = 'TOP'
  1380.       then Where = 'BEFORE'
  1381.       else Where = 'AFTER'
  1382.   end
  1383.   else if Target <> ''
  1384.     then do
  1385.       Target = FindIt(Target, 1, Imp.0File.0, 1, '', 0)
  1386.       if Target = 0
  1387.         then Target = ''
  1388.     end
  1389. OutC = InsLine(New, Where Target)
  1390. return OutC
  1391.  
  1392. /****************************************************************************
  1393.  * INSSTRING new, target, where                                             *
  1394.  ****************************************************************************/
  1395. InsString: procedure expose (Globals)
  1396. Rtn = 'InsString'
  1397. parse arg New, Target, Where
  1398. if Imp.0File.0 = 0
  1399.   then return 255
  1400. Where = translate(Where)
  1401. if Where <> '' & Where <> 'BEFORE' & Where <> 'AFTER'
  1402.   then call ImpError 'Illegal position' Where'.'
  1403. CL = Imp.0CurL
  1404. Target = translate(Target)
  1405. Index = pos(Target, translate(Imp.0File.CL))
  1406. if Index = 0
  1407.   then RetC = 1
  1408.   else do
  1409.     if Where <> 'BEFORE'
  1410.       then Index = Index + length(Target)
  1411.     A = left(Imp.0File.CL, Index-1)
  1412.     B = substr(Imp.0File.CL, Index)
  1413.     Imp.0File.CL = A||New||B
  1414.     RetC = 0
  1415.     Imp.0Mod = 1
  1416.   end
  1417. return RetC
  1418.  
  1419. /****************************************************************************
  1420.  * MOVEFILE source, target                                                  *
  1421.  ****************************************************************************/
  1422. MoveFile: procedure expose (Globals)
  1423. Rtn = 'MoveFile'
  1424. parse arg Source, Target
  1425. if rxOS2Ver = 1.1 | left(Source, 3) <> left(Target, 3) |,
  1426.     pos('\\', left(Source,2)||left(Target,2)) <> 0
  1427.   then if CopyFile(Source, Target) = 0
  1428.     then do
  1429.       'ERASE' Source '> NUL 2>&1'
  1430.       OutC = 2 * (rc <> 0)
  1431.     end
  1432.     else OutC = 1
  1433.   else do
  1434.     'MOVE' Source Target '> NUL 2>&1'
  1435.     OutC = rc
  1436.   end
  1437. return OutC
  1438.  
  1439. /****************************************************************************
  1440.  * NAMEFILE filename                                                        *
  1441.  ****************************************************************************/
  1442. NameFile: procedure expose (Globals)
  1443. Rtn = 'NameFile'
  1444. parse arg Name .
  1445. if \rxDirExist(XFileSpec('QPATH', Name))
  1446.   then return 1
  1447. Imp.0FileName = Name
  1448. Imp.0Mod = (Imp.0Mod | Imp.0File.0 > 0)
  1449. return 0
  1450.  
  1451. /****************************************************************************
  1452.  * NUMLINES
  1453.  ****************************************************************************/
  1454. NumLines: procedure expose (Globals)
  1455. Rtn = 'NumLines'
  1456. return Imp.0File.0
  1457.  
  1458. /****************************************************************************
  1459.  * READFILE FileName                                                        *
  1460.  ****************************************************************************/
  1461. ReadFile: procedure expose (Globals)
  1462. Rtn = 'ReadFile'
  1463. parse arg InFile .
  1464. if InFile = ''
  1465.   then call ImpError 'Bad argument: input file not specified.'
  1466. if Imp.0FileName <> ''
  1467.   then if Imp.0Mod
  1468.     then call ImpError 'Attempt to read file' InFile';' Imp.0FileName 'in',
  1469.         'storage modified and not saved.'
  1470. Imp.0Mod = 0
  1471. Imp.0FileName = InFile
  1472. Imp.0CurL = 0
  1473. XCode = 0
  1474. if rxFileExist(InFile)
  1475.   then do
  1476.     RetC = rxRead(InFile, 'IMP.0FILE')
  1477.     if RetC <> 0
  1478.       then XCode = 1
  1479.       else Imp.0CurL = 1
  1480.   end
  1481.   else do
  1482.     Imp.0File.0 = 0
  1483.     XCode = 255
  1484.   end
  1485. call SetComment 'IMP'
  1486. return XCode
  1487.  
  1488. /****************************************************************************
  1489.  * REMLINE                                                                  *
  1490.  ****************************************************************************/
  1491. RemLine: procedure expose (Globals)
  1492. Rtn = 'RemLine'
  1493. parse arg RLine
  1494. RMode = (RLine <> '')  /* Add remark mode */
  1495. if \RMode
  1496.   then if Imp.0File.0 = 0
  1497.     then return 255
  1498.     else do
  1499.       CL = Imp.0CurL
  1500.       RLine = Imp.0File.CL
  1501.     end
  1502. First = translate(word(RLine, 1))
  1503. Last = translate(word(RLine, words(RLine)))
  1504. if Imp.0Cmt2 = ''
  1505.   then RemIt = \abbrev(First, Imp.0Cmt1)
  1506.   else RemIt = \abbrev(First, Imp.0Cmt1),
  1507.       & \abbrev(reverse(Last), reverse(Imp.0Cmt2))
  1508. if RemIt
  1509.   then do
  1510.     RLine = strip(RLine, 'T')
  1511.     if abbrev(RLine, copies(' ', length(Imp.0Cmt1)+1))
  1512.       then RLine = overlay(Imp.0Cmt1' ', RLine)
  1513.       else RLine = Imp.0Cmt1 strip(RLine, 'L')
  1514.     if RMode
  1515.       then RLine = RLine Imp.0Cmt2
  1516.       else RLine = RLine Imp.0CmtD Imp.0Cmt2
  1517.   end
  1518. if RMode
  1519.   then return RLine
  1520.   else if RLine <> Imp.0File.CL
  1521.     then do
  1522.       Imp.0File.CL = RLine
  1523.       Imp.0Mod = 1
  1524.       OutC = 0
  1525.     end
  1526.     else OutC = 0
  1527. return OutC
  1528.  
  1529. /****************************************************************************
  1530.  * REMALL target, scope, position, exceptions                               *
  1531.  ****************************************************************************/
  1532. RemAll: procedure expose (Globals)
  1533. Rtn = 'RemAll'
  1534. parse arg Target, Scope ., Pos ., XList
  1535. call ImpFindArgs 'PUSH'
  1536. RetC = Find(Target, Scope, Pos)
  1537. XC = RetC
  1538. do while RetC = 0
  1539.   if \wordpos(Imp.0CurL, XList)
  1540.     then call RemLine
  1541.   RetC = FindNext()
  1542. end
  1543. call ImpFindArgs 'POP'
  1544. return XC
  1545.  
  1546. /****************************************************************************
  1547.  * SETCOMMENT                                                               *
  1548.  ****************************************************************************/
  1549. SetComment: procedure expose (Globals)
  1550. Rtn = 'SetComment'
  1551. parse arg Func, P1, P2
  1552. select
  1553.   when Func = 'SET'
  1554.     then do
  1555.       Imp.0Cmt1 = P1
  1556.       Imp.0Cmt2 = P2
  1557.     end
  1558.   when Func = 'DESC'
  1559.     then if P1  = ''
  1560.       then Imp.0CmtD = ''
  1561.       else Imp.0CmtD = '-' P1
  1562.   when Func = 'IMP'
  1563.     then do
  1564.       Type = FileType()
  1565.       parse value '' with Imp.0Cmt1 Imp.0Cmt2 Imp.0CmtD
  1566.       select
  1567.         when Type = 'BATCH' | Type = 'CONFIG'
  1568.           then Imp.0Cmt1 = 'REM'
  1569.         when Type = 'REXX'
  1570.           then do
  1571.             Imp.0Cmt1 = '/'"*"; Imp.0Cmt2 = '*'"/"
  1572.           end
  1573.         when Type = 'IBMLAN' | Type = 'PROTOCOL'
  1574.           then Imp.0Cmt1 = ';'
  1575.         otherwise nop
  1576.       end
  1577.     end
  1578.   otherwise
  1579.     call ImpError 'Invalid argument' Func
  1580. end
  1581. return 0
  1582.  
  1583. /****************************************************************************
  1584.  * IMPFINDARGS                                                              *
  1585.  ****************************************************************************/
  1586. ImpFindArgs: procedure expose (Globals)
  1587. parse upper arg Op .
  1588. if Op = 'PUSH'
  1589.   then if symbol('IMP.0FIND.0TARGET') = 'VAL'
  1590.     then do
  1591.       Imp.0Save.0Target   = Imp.0Find.0Target
  1592.       Imp.0Save.0FStart   = Imp.0Find.0FStart
  1593.       Imp.0Save.0FEnd     = Imp.0Find.0FEnd
  1594.       Imp.0Save.0FIncr    = Imp.0Find.0FIncr
  1595.       Imp.0Save.0Position = Imp.0Find.0Position
  1596.     end
  1597.   else if symbol('IMP.0SAVE.0TARGET') = 'VAL'
  1598.     then do
  1599.       Imp.0Find.0Target   = Imp.0Save.0Target
  1600.       Imp.0Find.0FStart   = Imp.0Save.0FStart
  1601.       Imp.0Find.0FEnd     = Imp.0Save.0FEnd
  1602.       Imp.0Find.0FIncr    = Imp.0Save.0FIncr
  1603.       Imp.0Find.0Position = Imp.0Save.0Position
  1604.     end
  1605. return
  1606.  
  1607. /****************************************************************************
  1608.  * REPLACE NewLine                                                          *
  1609.  ****************************************************************************/
  1610. Replace: procedure expose (Globals)
  1611. Rtn = 'REPLACE'
  1612. parse arg NewLine
  1613. if Imp.0File.0 = 0
  1614.   then RetC = 255
  1615.   else do
  1616.     Temp = Imp.0CurL
  1617.     Imp.0File.Temp = NewLine
  1618.     RetC = 0
  1619.     Imp.0Mod = 1
  1620.   end
  1621. return RetC
  1622.  
  1623. /****************************************************************************
  1624.  * REPLACEFILE source, target                                               *
  1625.  ****************************************************************************/
  1626. ReplaceFile: procedure expose (Globals)
  1627. Rtn = 'ReplaceFile'
  1628. parse arg Source, Target, Opts
  1629. if pos('?', Source) + pos('*', Source) > 0
  1630.   then return ReplaceFileWild(Source, Target)
  1631. if \rxFileExist(Source)
  1632.   then return 2
  1633. if \rxFileExist(Target)
  1634.   then if rxDirExist(Target)
  1635.     then if right(Target, 1) = '\'
  1636.       then Target = Target||filespec('NAME', Source)
  1637.       else Target = Target'\'filespec('NAME', Source)
  1638.     else do
  1639.       TargetPath = XFileSpec('QPATH', Target)
  1640.       if length(TargetPath) > 3
  1641.         then TargetPath = strip(TargetPath, 'T', '\')
  1642.       if \rxDirExist(TargetPath)
  1643.         then return 3
  1644.     end
  1645.  
  1646. call rxTree Target, 'TAR.', 'FT'
  1647. if Tar.0 = 0
  1648.   then CopyIt = 1
  1649.   else do
  1650.     call rxTree Source, 'SRC.', 'FT'
  1651.     CopyIt = word(Src.1, 1) > word(Tar.1, 1)
  1652.   end
  1653.  
  1654. if CopyIt
  1655.   then do
  1656.     'COPY' Source Target '> NUL 2>&1'
  1657.     OutC = rc
  1658.   end
  1659.   else OutC = 0
  1660. return (OutC <> 0)
  1661.  
  1662. ReplaceFileWild: procedure expose (Globals)
  1663. Rtn = 'ReplaceFile'
  1664. parse arg Source, Target
  1665. SDir = left(Source, max(3, lastpos('\', Source)-1))
  1666. call rxMkDir Target
  1667. if \rxDirExist(SDir) | \rxDirExist(Target)
  1668.   then return 2
  1669. 'REPLACE' Source Target '/U'
  1670. OutC = (rc > 1)
  1671. 'REPLACE' Source Target '/A'
  1672. OutC = OutC | (rc > 1)
  1673. return OutC
  1674.  
  1675. /****************************************************************************
  1676.  * RESTOREPOS                                                               *
  1677.  ****************************************************************************/
  1678. RestorePos: procedure expose (Globals)
  1679. Rtn = 'RestorePos'
  1680. if Imp.0PosStack = ''
  1681.   then call ImpError 'PosStack underflow.'
  1682. parse var Imp.0PosStack Imp.0CurL Imp.0PosStack
  1683. return 0
  1684.  
  1685. /****************************************************************************
  1686.  * SAVEPOS                                                                  *
  1687.  ****************************************************************************/
  1688. SavePos: procedure expose (Globals)
  1689. Rtn = 'SavePos'
  1690. Imp.0PosStack = Imp.0PosStack Imp.0CurL
  1691. return 0
  1692.  
  1693. /****************************************************************************
  1694.  * SETCURL Where                                                            *
  1695.  ****************************************************************************/
  1696. SetCurL: procedure expose (Globals)
  1697. Rtn = 'SetCurL'
  1698. parse upper arg Where
  1699. select
  1700.   when Where = 'BOTTOM'
  1701.     then where = Imp.0File.0
  1702.   when Where = 'TOP'
  1703.     then do
  1704.       Type = FileType()
  1705.       if Type = 'TEXT'
  1706.         then Where = 1
  1707.         else do
  1708.           Nest = (wordpos(Type, 'REXX') > 0)
  1709.           Where = XXScanCmt(1, Imp.0Cmt1, Imp.0Cmt2, Nest)
  1710.         end
  1711.     end
  1712.   when Where = 'DOWN'
  1713.     then Where = Imp.0CurL + 1
  1714.   when Where = 'UP'
  1715.     then Where = Imp.0CurL - 1
  1716.   otherwise nop
  1717. end
  1718. if \datatype(Where, 'N')
  1719.   then call ImpError 'Illegal line number' Where'.'
  1720. if Imp.0File.0 = 0
  1721.   then RetC = 255
  1722.   else if Where > Imp.0File.0
  1723.     then RetC = 1
  1724.     else do
  1725.       RetC = 0
  1726.       Imp.0CurL = Where
  1727.     end
  1728. return RetC
  1729.  
  1730. /* Return Line number of first non-comment line on or after Start */
  1731. XXScanCmt: procedure expose (Globals)
  1732. parse arg Start, Cmt1 . , Cmt2 ., Nest
  1733. if Nest
  1734.   then do
  1735.     Count = 0
  1736.     do I = Start to Imp.0File.0 until Count <= 0
  1737.       Last = 0
  1738.       do until PS = 0 & PE = 0
  1739.         PS = pos(Cmt1, Imp.0File.I, Last+1)
  1740.         PE = pos(Cmt2, Imp.0File.I, Last+1)
  1741.         if PS = 0 & PE = 0
  1742.           then iterate
  1743.         if PS > 0
  1744.           then if PE = 0 | PS < PE
  1745.             then do
  1746.               Last = PS
  1747.               Count = Count + 1
  1748.               iterate
  1749.             end
  1750.         Last = PE
  1751.         Count = Count - 1
  1752.       end
  1753.     end I
  1754.     I = min(I + 1, Imp.0File.0)
  1755.   end
  1756.   else do I = Start to Imp.0File.0 while abbrev(translate(Imp.0File.I), Cmt1)
  1757.     nop
  1758.   end
  1759. return I
  1760.  
  1761. /****************************************************************************
  1762.  * WRITEFILE                                                                *
  1763.  ****************************************************************************/
  1764. WriteFile: procedure expose (Globals)
  1765. Rtn = 'WriteFile'
  1766. parse value '' with BackDir BackType
  1767. if arg() = 1
  1768.   then parse upper arg Echo .
  1769.   else parse upper arg BackDir, BackType ., Echo .
  1770. Echo = abbrev('VERBOSE', Echo, 1)
  1771. if \Imp.0Mod
  1772.   then do
  1773.     if Echo
  1774.       then say 'No changes made - file not written.'
  1775.     return 1
  1776.   end
  1777.  
  1778. if BackDir = ''
  1779.   then BackDir = Imp.0BackDir
  1780.   else if \CheckBackupDir(BackDir)
  1781.     then do
  1782.       say 'Backup directory' BackDir 'not found.'
  1783.       BackDir = Imp.0BackDir
  1784.     end
  1785. if BackDir = ''
  1786.   then do
  1787.     say 'No default backup directory specified.  Using' Imp.0BDr'.'
  1788.     BackDir = Imp.0BDr
  1789.   end
  1790.  
  1791. if BackType = '' | \CheckBackupType(BackType)
  1792.   then BackType = Imp.0BackType
  1793.  
  1794. parse var BackType BackType '=' BackArg
  1795. BackFile = BackDir
  1796. if right(BackFile, 1) <> '\'
  1797.   then BackFile = BackFile'\'
  1798. FN = filespec('NAME', Imp.0FileName)
  1799. LastDot = lastpos('.', FN)
  1800. if LastDot = 0
  1801.   then BackFile = BackFile||FN'.'
  1802.   else BackFile = BackFile||left(FN, LastDot)
  1803.  
  1804. select
  1805.   when verify(BackType, Imp.0Digits) = 0
  1806.     then do
  1807.       call rxTree BackFile'*', 'BACKS.', 'FT'
  1808.       call rxStemSort 'BACKS.', 'A', 1, 14
  1809.       OldBacks = ''
  1810.       do I = 1 to Backs.0
  1811.         OldBack = subword(Backs.I, 4)
  1812.         if verify(XFileSpec('FEXT', OldBack), Imp.0Digits) = 0
  1813.           then OldBacks = OldBacks OldBack
  1814.       end
  1815.       do while words(OldBacks) >= BackType
  1816.         parse var OldBacks OldBack OldBacks
  1817.         call rxDelete OldBack
  1818.       end
  1819.       BackFile = rxTempFileName(BackFile'???', '?')
  1820.     end
  1821.   when abbrev('UNIQUE', BackType)
  1822.     then BackFile = rxTempFileName(BackFile'???', '?')
  1823.   when abbrev('NAME', BackType)
  1824.     then BackFile = BackFile||BackArg
  1825.   when BackType = 'NOBACKUP'
  1826.     then BackFile = ''
  1827. end
  1828.  
  1829. if BackFile <> ''
  1830.   then do
  1831.     if Echo
  1832.       then say 'Backing up' Imp.0FileName 'to' BackFile'...'
  1833.     'COPY' Imp.0FileName BackFile '2>&1 1>NUL | RXQUEUE'
  1834.     if rc <> 0
  1835.       then do
  1836.         parse pull EMsg
  1837.         call ImpError 'Error "'EMsg'" creating backup file' BackFile'.'
  1838.       end
  1839.   end
  1840. if Echo
  1841.   then say 'Writing' Imp.0FileName'...'
  1842. /**
  1843. call ImpSaveEAs Imp.0FileName
  1844. **/
  1845. call rxTree Imp.0FileName, 'TEMP.', 'F'
  1846. call rxTree Imp.0FileName, 'JUNK.', 'F',,'*----'
  1847. RetC = rxWrite(Imp.0FileName, 'IMP.0FILE', Imp.0File.0)
  1848. if RetC <> 0 then call ImpError '*' RetC
  1849. /**
  1850. call ImpRestoreEAs Imp.0FileName
  1851. **/
  1852. if Temp.0 > 0
  1853.   then do
  1854.     Attribs = word(Temp.1, 4)
  1855.     NewAttr = translate(Attribs, '+++++', 'ADHRS', '*')
  1856.     NewAttr = overlay('+', NewAttr, 1)     /* Force "A" bit */
  1857.     call rxTree Imp.0FileName, 'JUNK.', 'F',,NewAttr
  1858.   end
  1859. Imp.0Mod = 0
  1860. return 0
  1861.  
  1862. ImpSaveEAs: procedure expose (Globals) EASave.
  1863. parse arg File
  1864. if rxOs2Ver() >= 2.0
  1865.   then do
  1866.     drop EASave.
  1867.     EASave.0 = 0
  1868.     signal on syntax name ImpSaveEA2
  1869.     call sysQueryEAList File, 'EASAVE.'
  1870.     call ImpSaveEA2
  1871.   end
  1872. return 0
  1873.  
  1874. ImpSaveEA2:
  1875. signal on syntax name syntax
  1876. if EASave.0 = 0
  1877.   then do
  1878.     call rxStemInsert 'EASAVE.', EASave.0+1, '.TYPE'
  1879.     call rxStemInsert 'EASAVE.', EASave.0+1, '.LONGNAME'
  1880.   end
  1881. do I = 1 to EASave.0
  1882.   EA = EASave.I
  1883.   if sysGetEA(File, EA, 'TEMP') = 0
  1884.     then EASave.EA = Temp
  1885.     else EASave.EA = ''
  1886. end
  1887. return 0
  1888.  
  1889. ImpRestoreEAs: procedure expose (Globals) EASave.
  1890. parse arg File
  1891. if rxOs2Ver() >= 2.0
  1892.   then do
  1893.     do I = 1 to EASave.0
  1894.       EA = EASave.I
  1895.       if EASave.EA <> ''
  1896.         then call sysPutEA File, EA, EASave.EA
  1897.     end
  1898.   end
  1899. return 0
  1900.  
  1901. /****************************************************************************
  1902.  * XFILESPEC Option, FileSpec                                               *
  1903.  ****************************************************************************/
  1904. XFileSpec: procedure expose (Globals)
  1905. Rtn = 'XFileSpec'
  1906. if arg() <> 2
  1907.   then call ImpError 'Bad arguments.'
  1908. parse arg Opt, FS
  1909. select
  1910.   when abbrev('QPATH', Opt)
  1911.     then return strip(filespec('D', FS)||filespec('P', FS))
  1912.   when abbrev('FEXT', Opt, 2)
  1913.     then do
  1914.       parse value filespec('N', FS) with '.' Ext
  1915.       return Ext
  1916.     end
  1917.   when abbrev('FNAME', Opt, 2)
  1918.     then do
  1919.       parse value filespec('N', FS) with Name '.'
  1920.       return Name
  1921.     end
  1922.   when abbrev('DRIVE', Opt) | abbrev('PATH', Opt) | abbrev('NAME', Opt)
  1923.     then return filespec(Opt, FS)
  1924.   otherwise call ImpError 'Invalid option' Opt'.'
  1925. end
  1926. return
  1927.  
  1928. /****************************************************************************
  1929.  * ImpError                                                                 *
  1930.  ****************************************************************************/
  1931. ImpError: procedure expose (Globals) Rtn
  1932. parse arg EMsg
  1933. if word(EMsg, 1) = '*'
  1934.   then EMsg = 'Unxepected error' word(EMsg, 2) 'in' Rtn'.'
  1935.   else if symbol('RTN') = 'VAR'
  1936.     then Emsg = Emsg '('Rtn')'
  1937. if EMsg <> ''
  1938.   then do
  1939.     say EMsg
  1940.     if symbol('Imp.0Org.0') = 'VAR'     /* ITL active? */
  1941.       then do
  1942.         Imp.0ErrorMode = 'CONTINUE'
  1943.         call ItlErr EMsg
  1944.       end
  1945.   end
  1946. if symbol('IMP.0ERRPAUSE') = 'VAR'
  1947.   then if Imp.0ErrPause = 1
  1948.     then call rxPause 'Press any key to exit.'
  1949. exit 2
  1950.  
  1951. /*****************************************************************************
  1952.  * ASKUSER Question, ResponseList, MinLeng, DefaultFlag                      *
  1953.  * Ask the user a question and wait for a valid one word response.  Valid    *
  1954.  * reponses are passed in the ResponseList, and the entered response must be *
  1955.  * of at least the specified minimum length.  If DefaultFlag is 1, the first *
  1956.  * entry of the List will be returned if the user didn't enter anything.     *
  1957.  *                                                                           *
  1958.  * Use LINEIN, rather than pull, to avoid (1) annoying '?' and (2) any stack *
  1959.  * garbage.                                                                  *
  1960.  *****************************************************************************/
  1961. AskUser: procedure expose (Globals)
  1962. trace 'O'
  1963. parse arg Question, ResponseList, MinLeng ., DefaultFlag .
  1964. say Question
  1965. Resp = ''
  1966. Responses. = ''
  1967. do I = 1 to words(ResponseList)
  1968.   Responses.I = word(ResponseList, I)
  1969. end
  1970. do forever
  1971.   Response = translate(strip(linein('STDIN:')))
  1972.   if Response = '' & DefaultFlag = 1
  1973.     then Resp = word(ResponseList, 1)
  1974.     else do I = 1 to words(ResponseList)
  1975.       if abbrev(Responses.I, Response, MinLeng) = 1
  1976.         then do
  1977.           Resp = Responses.I
  1978.           leave
  1979.         end
  1980.     end
  1981.   if Resp <> ''
  1982.     then leave
  1983.     else say 'Invalid input.'
  1984. end /* do forever */
  1985. return Resp
  1986.  
  1987. /*****************************************************************************
  1988.  * RUNTAGFILE itlfile                                                        *
  1989.  *****************************************************************************/
  1990. RunTagFile: procedure expose (Globals)
  1991. parse arg ModFile Rest
  1992. if value('IMP.0INIT') <> 1
  1993.   then call ImpInit
  1994. call ImpITLInit ModFile, Rest
  1995.  
  1996. Syn. = ''
  1997. Syn.ADDOBJECT = 'ADDOBJ'
  1998. Syn.ADDPROGRAM = 'ADDP'
  1999. Syn.EADDPROGRAM = 'EADDP'
  2000. Syn.CHANGEPATH = 'CP'
  2001. Syn.CHDIR = 'CD'
  2002. Syn.CLEARSCREEN = 'CLS'
  2003. Syn.COPYFILE = 'COPY'
  2004. Syn.COMMAND = 'CMD'
  2005. Syn.DELFILE = 'DEL'
  2006. Syn.DELPROGRAM = 'DELP'
  2007. Syn.ENVVAR = 'ENV'
  2008. Syn.MKDIR = 'MD'
  2009. Syn.REMARK = 'REM'
  2010. Syn.REPLACEFILE = 'REPFILE'
  2011. Syn.REPLACESTRING = 'REPSTR'
  2012. Syn.READFILE = 'RF'
  2013. Syn.VERBOSE = 'MSGMODE'
  2014. Syn.VB = 'MSGMODE'
  2015. Syn.WRITEFILE = 'WF'
  2016. OneArg. = 0
  2017. parse value '1' with OneArg.SAY 1 OneArg.EVAL
  2018. NoLook. = 0
  2019. parse value '1' with NoLook.REPSTR 1 NoLook.IF
  2020.  
  2021. Sep = d2c(255)
  2022. do Imp.0PC = 1 to Imp.0Mods.0
  2023.   trace value Imp.0Trval
  2024.   PC = Imp.0PC
  2025.   Line = strip(Imp.0Mods.PC)
  2026.   do PC = PC + 1 while right(Line, 1) = '+'
  2027.     LIne = left(Line, length(Line)-1)||strip(Imp.0Mods.PC)
  2028.   end
  2029.   Imp.0PC = PC - 1
  2030.   parse var Line Key Tail
  2031.   Tail = strip(Tail)
  2032.   if Key = '' | abbrev(Key, '*') | abbrev(Key, ':')
  2033.     then iterate
  2034.   if Imp.0IfScan <> 0
  2035.     then if wordpos(translate(Key), 'IF ELSE ENDIF') = 0
  2036.       then iterate
  2037.   if symbol(Key) = 'BAD'
  2038.     then call ItlErr 'Illegal keyword' Key'.'
  2039.   parse upper value value('SYN.'Key) Key with Key .
  2040.   if \OneArg.Key
  2041.     then Tail = translate(Tail, Sep, ',')
  2042.   if \NoLook.Key
  2043.     then Tail = LookUp(Tail)
  2044.   Arg. = ''
  2045.   do I = 1 to 10 while Tail <> ''
  2046.     parse var Tail Arg.I (Sep) Tail
  2047.     if \OneArg.Key
  2048.       then do
  2049.         Arg.I = strip(Arg.I, 'T')
  2050.         if abbrev(Arg.I, '..') & right(Arg.I, 2) = '..'
  2051.           then Arg.I = strip(Arg.I,,'.')
  2052.           else Arg.I = strip(Arg.I)
  2053.       end
  2054.   end
  2055.   if Tail <> ''
  2056.     then call ItlErr 'Too many arguments specified.'
  2057.   NewLine = RunCmd(Key, Arg.1, Arg.2, Arg.3, Arg.4, Arg.5, Arg.6, Arg.7,,
  2058.       Arg.8, Arg.9, Arg.10)
  2059.   if left(NewLine, 1) = '!'
  2060.     then return substr(NewLine, 2)
  2061.   if NewLine > 0
  2062.     then Imp.0PC = NewLine
  2063. end
  2064. if Imp.0IfScan <> 0
  2065.   then call ItlErr 'ENDIF not found.'
  2066. return 0
  2067.  
  2068. RunCmd: procedure expose (Globals)
  2069. Key = arg(1)
  2070. /*
  2071. if Imp.0IfScan <> 0
  2072.   then if wordpos(Key, 'IF ELSE ENDIF') = 0
  2073.     then return 0
  2074. */
  2075. signal on syntax name TagError
  2076. trace value Imp.0TrVal
  2077. interpret "OutC = ITL!"Key"(arg(2), arg(3), arg(4), arg(5), arg(6), arg(7),",
  2078.     "arg(8), arg(9), arg(10), arg(11))"
  2079. return OutC
  2080.  
  2081. TagError:
  2082. if rc = 43
  2083.   then if word(sourceline(sigl), 1) = 'interpret'
  2084.     then do
  2085.       Imp.0ErrorMode = 'HALT'
  2086.       call ItlErr 'Unknown ITL tag:' Key
  2087.       exit 255
  2088.     end
  2089. call ITLsyntax d2c(0), sigl
  2090. exit 255
  2091.  
  2092. /** Add INI entry **/
  2093. ITL!ADDINI: procedure expose (Globals)
  2094. parse arg File, App, Key, Val, ROpt .
  2095. File = translate(strip(File))
  2096. App = strip(App)
  2097. Key = strip(Key)
  2098. Val = strip(Val)
  2099. ROpt = translate(ROpt)
  2100. if (wordpos(File, 'USER SYSTEM') = 0 & pos('\', File) = 0)
  2101.   then parse value RxSearchPath('DPATH', File) File with File .
  2102. /*** PTR 103 start ***/
  2103. if (ROpt <> '') & (wordpos(ROpt, 'NEWONLY REPLACEONLY') = 0)
  2104. /*** PTR 103 end ***/
  2105.   then call ITLErr 'Invalid argument' ROpt
  2106. if translate(Val) = '$RXDEL'
  2107.   then ROpt = 'REPLACEONLY'
  2108. Exists = (rxOs2Ini(File, App, Key) <> '$RXERROR')
  2109. if (ROpt = '' | (ROpt = 'NEWONLY' & \Exists) |,
  2110.     (ROpt = 'REPLACEONLY' & Exists))
  2111.   then do
  2112.     call ITLSay 'Setting' App'/'Key '->' Val 'in' File 'file...'
  2113.     Res = RxOs2Ini(File, App, Key, Val)
  2114.     if Res <> ''
  2115.       then call ITLErr 'Error' Res 'writing to INI file' File'.'
  2116.   end
  2117. return 0
  2118.  
  2119. /** Add to local file list **/
  2120. ITL!ADDLOCAL: procedure expose (Globals)
  2121. parse arg Ini, App, Dir, FileList, Source
  2122. parse arg App, Source, Dest, AutoUpdate
  2123. XC = AddLocalFiles(Ini, App, Dir, FileList, Source)
  2124. if XC <> 0
  2125.   then call ItlErr 'Error' XC 'from AddLocalFiles.'
  2126. return 0
  2127.  
  2128. /** Delete a list of local files **/
  2129. ITL!DELLOCAL: procedure expose (Globals)
  2130. /***** PTR 10017 start *****/
  2131. if arg(1) = '' | arg(3) <> ''
  2132. /***** PTR 10017 end *****/
  2133.   then call ItlErr 'Invalid number of arguments.'
  2134. XC = DelLocalFiles(arg(1), arg(2))
  2135. if XC <> 0
  2136.   then call ItlErr 'Error' XC 'from DelLocalFiles.'
  2137. return 0
  2138.  
  2139. /** Create an OS/2 2.0 Object **/
  2140. ITL!ADDOBJ: procedure expose (Globals)
  2141. parse arg ClassName, Title, Location, Setup, Duplicate, TryDel
  2142. if Duplicate = ''  /* SysCreateObject bug -- can't be null */
  2143.   then Duplicate = 'R'
  2144.   else Duplicate = translate(Duplicate)
  2145. TryDel = (TryDel <> '') & \abbrev(Duplicate, 'F')
  2146. P = pos('OBJECTID', translate(Setup))
  2147. if P > 0
  2148.   then parse value substr(Setup, P) with '=' ObjId ';'
  2149.   else ObjId = ''
  2150.  
  2151. call ITLSay 'Creating' ClassName 'object "'Title'" in "'Location'".'
  2152. call ITLSay '('Duplicate',' Setup')'
  2153. if rxOs2ver() < 2.0
  2154.   then call ITLErr 'AddObject requires OS/2 2.0 or greater.'
  2155. XC = SysCreateObject(ClassName, Title, Location, Setup, Duplicate)
  2156.  
  2157. /* Test if folder object is viable */
  2158. if XC = 1 & ClassName = 'WPFolder' & ObjId <> ''
  2159.   then do
  2160.     XC = SysCreateObject('WPAbstract', 'Test', ObjId,,
  2161.         'OBJECTID=<CORE_TESTOBJ>;', 'R')
  2162.     call SysDestroyObject '<CORE_TESTOBJ>'
  2163.   end
  2164.  
  2165. if XC <> 1 & TryDel
  2166.   then do
  2167.     if ObjId <> ''
  2168.       then do
  2169.         call ItlSay 'Object' ObjId 'could not be created.  Deleting...'
  2170.         if SysDestroyObject(ObjId)
  2171.           then do
  2172.             call ItlSay 'Retrying creation...'
  2173.             XC = SysCreateObject(ClassName, Title, Location, Setup, Duplicate)
  2174.           end
  2175.           else call ItlSay 'Object could not be deleted.'
  2176.       end
  2177.   end
  2178. if XC <> 1
  2179.   then if abbrev(Duplicate, 'F') 
  2180.     then call ItlSay 'Object' Title 'could not be created.  May already',
  2181.         'exist.'
  2182.     else call ITLErr 'Object' Title 'could not be created.'
  2183. return 0
  2184.  
  2185. FolderId: procedure expose (Globals)
  2186. parse arg FldName, Root
  2187. parse source . How Me
  2188. Cmd = (How = 'COMMAND')
  2189. if pos('\', Me) > 0
  2190.   then do
  2191.     MyPath = left(Me, max(3, lastpos('\', Me)-1))
  2192.     call setlocal
  2193.     call value 'PATH', MyPath';'value('PATH',,'OS2ENVIRONMENT'), 'OS2ENVIRONMENT'
  2194.   end
  2195. FldPath = ''
  2196. SynRef = 'QDESKTOP'
  2197. if Root = ''
  2198.   then Root = 'QDESKTOP'()
  2199. drop SynRef
  2200. if right(Root, 1) <> '\'
  2201.   then Root = Root'\'
  2202. FldName = strip(strip(FldName),,'"')
  2203. if Root <> ''
  2204.   then do
  2205.     call SysFileTree Root'*', 'DIRS.', 'DSO'
  2206.     do I = 1 to Dirs.0 while FldPath = ''
  2207.       if SysGetEA(Dirs.I, '.LONGNAME', 'NAME') = 0
  2208.         then if substr(Name, 5) == FldName
  2209.           then FldPath = Dirs.I
  2210.     end
  2211.   end
  2212. if Cmd
  2213.   then if FldPath = ''
  2214.     then say 'The directory for "'FldName'" could not be determined.'
  2215.     else say 'The "'FldName'" directory is "'FldPath'".'
  2216. return FldPath
  2217.  
  2218. DesktopId: procedure expose (Globals)
  2219. parse upper source . How Me
  2220. parse upper arg Opt Extra
  2221. Valid = 'SWITCH'
  2222. if (Opt <> '' & wordpos(Opt, Valid) = 0) | Extra <> ''
  2223.   then signal Tell
  2224. Cmd = (How = 'COMMAND')
  2225. if pos('\', Me) > 0
  2226.   then do
  2227.     MyPath = left(Me, max(3, lastpos('\', Me)-1))
  2228.     call setlocal
  2229.     call value 'PATH', MyPath';'value('PATH',,'OS2ENVIRONMENT'), 'OS2ENVIRONMENT'
  2230.   end
  2231. Desktop = GetPath('<WP_DESKTOP>')
  2232. if Desktop = ''   /* Second attempt if first fails */
  2233.   then do
  2234.     SynRef = 'BOOTDRIVE'
  2235.     BDr = SysBootDrive()
  2236.     SynRef = 'QFOLDER'
  2237.     Desktop = 'QFOLDER'('OS/2 2.0 Desktop', BDr'\')
  2238.     if Desktop = ''   /* Third attempt (for 2.1 systems) if 3rd fails */
  2239.       then Desktop = 'QFOLDER'('Desktop', BDr'\')
  2240.     drop SynRef
  2241.   end
  2242. call endlocal
  2243. if Cmd
  2244.   then if Desktop = ''
  2245.     then say 'The active OS/2 desktop directory could not be located!'
  2246.     else do
  2247.       say 'The active OS/2 desktop directory is "'Desktop'".'
  2248.       if Opt = 'SWITCH'
  2249.         then call directory Desktop
  2250.     end
  2251. return Desktop
  2252.  
  2253. GetPath: procedure
  2254. parse arg ObjId
  2255. GpiNode = substr(sysIni('USER', 'PM_Workplace:Location', ObjId), 1, 2)
  2256. if GetNodes() <> 0
  2257.   then say 'Warning: Could not locate the node table.'
  2258. GP = ''
  2259. do GPI = 1 to Nodes.0
  2260.   if substr(Nodes.GPI, 7, 2) = GpiNode
  2261.     then do
  2262.       GP = substr(Nodes.GPI, 33, length(Nodes.GPI)-33)  /* Name of desktop */
  2263.       GPParent = substr(Nodes.GPI, 9, 2)
  2264.       do until GPParent = '0000'x
  2265.         do GPL = 1 to Nodes.0
  2266.           if substr(Nodes.GPL, 7, 2) = GPParent
  2267.             then do                               /* Qualified name of desktop */
  2268.               GP = substr(Nodes.GPL, 33, length(Nodes.GPL)-33)'\'GP
  2269.               GPParent = substr(Nodes.GPL, 9, 2)
  2270.               leave GPL
  2271.             end
  2272.         end
  2273.       end
  2274.       leave GPI
  2275.     end
  2276. end
  2277. return GP
  2278.  
  2279. GetNodes: procedure expose Nodes.
  2280. Handles = sysIni('SYSTEM', 'PM_Workplace:ActiveHandles', 'HandlesAppName')
  2281. if abbrev(Handles, 'ERROR:')    /* No service pack */
  2282.   then Handles = 'PM_Workplace:Handles'
  2283. Block1 = ''
  2284. parse value '0' with 1 Nodes. 1 I 1 L
  2285. do I = 1 to 999
  2286.   Block = sysIni('SYSTEM', Handles, 'BLOCK'I)
  2287.   if abbrev(Block, 'ERROR:')
  2288.     then if I = 1
  2289.       then return 10  /* could not locate NODE table */
  2290.       else leave
  2291.     else Block1 = Block1||Block
  2292. end I
  2293. do until L >= length(Block1)
  2294.   if substr(Block1, L+5, 4) = 'DRIV'
  2295.     then do
  2296.       XL = pos('00'x||'NODE'||'01'x, Block1, L+5) - L
  2297.       if XL <= 0
  2298.         then leave
  2299.       L = L + XL
  2300.       iterate
  2301.     end
  2302.     else if substr(Block1, L+1, 4) = 'DRIV'
  2303.       then do
  2304.         XL = pos('00'x||'NODE'||'01'x, Block1, L+1) - L
  2305.         if XL <= 0
  2306.           then leave
  2307.         L = L + XL
  2308.         iterate
  2309.       end
  2310.       else do
  2311.         Data = substr(Block1, L+1, 32)
  2312.         XL = c2d(substr(Block1, L+31, 1))
  2313.         if XL <= 0
  2314.           then leave
  2315.         Data = Data||substr(Block1, L+33, XL+1)
  2316.         L = L + length(Data)
  2317.       end
  2318.   I = I + 1
  2319.   Nodes.I = Data
  2320. end
  2321. Nodes.0 = I
  2322. return 0
  2323.  
  2324. /** Add program entry **/
  2325. ITL!ADDP: procedure expose (Globals)
  2326. parse arg Group, Title, ROpt .
  2327.  
  2328. ObjectMode = (rxOs2Ver() >= 2.0)
  2329. Conv1.EXE = 'EXENAME'
  2330. Conv1.PARAMS = 'PARAMETERS'
  2331. Conv1.WORKDIR = 'STARTUPDIR'
  2332. Conv1.ICONFILE = 'ICONFILE'
  2333.  
  2334. Info.1 = 'TITLE='Title
  2335. Info.0 = 1
  2336. Setup = 'OBJECTID=<'Title'>;'
  2337. Used = 'TITLE'
  2338. EndFound = 0
  2339. do J = Imp.0PC+1 until (EndFound | J > Imp.0Mods.0)
  2340.   parse value LookUp(Imp.0Mods.J) with Attr . '=' AttrVal
  2341.   Attr = translate(Attr)
  2342.   if abbrev('EADDPROGRAM', Attr, 5)
  2343.     then do
  2344.       EndFound = 1
  2345.       iterate
  2346.     end
  2347.   if AttrVal = ''
  2348.     then call ITLErr 'Null value specified for' Attr 'attribute.'
  2349.   if wordpos(Attr, Used) <> 0
  2350.     then call ITLErr 'Duplicate' Attr 'attribute in ADDPROGRAM record.'
  2351.     else do
  2352.       Used = Used Attr
  2353.       select
  2354.         when \ObjectMode
  2355.           then call rxStemInsert 'INFO', Info.0 + 1, Attr'='AttrVal
  2356.         when wordpos(Attr, 'EXE PARAMS WORKDIR ICONFILE') > 0
  2357.           then Setup = Setup||Conv1.Attr'='AttrVal';'
  2358.         when wordpos(Attr, 'VISIBILITY XYSIZE') > 0
  2359.           then nop
  2360.         when Attr = 'TYPE'
  2361.           then do
  2362.             select
  2363.               when wordpos(AttrVal, 'FULLSCREEN PM') > 0
  2364.                 then nop
  2365.               when AttrVal = 'VIOWINDOW'
  2366.                 then AttrVal = 'WINDOWABLEVIO'
  2367.               when AttrVal = 'READ'
  2368.                 then AttrVal = 'VDM'
  2369.               otherwise AttrVal = ''
  2370.             end
  2371.             if AttrVal <> ''
  2372.               then Setup = Setup||'PROGTYPE='AttrVal';'
  2373.           end
  2374.         when Attr = 'XYSTYLE'
  2375.           then do while AttrVal <> ''
  2376.             parse var AttrVal Temp . ',' AttrVal
  2377.             if wordpos(Temp, 'NOAUTOCLOSE MINIMIZED MAXIMIZED') > 0
  2378.               then Setup = Setup||Temp'=YES;'
  2379.           end
  2380.         otherwise call ITLErr 'Illegal ADDPROGRAM attribute' Attr'.'
  2381.       end
  2382.     end
  2383. end /* do */
  2384. if \EndFound
  2385.   then call ITLErr 'No EADDPROGRAM tag found.'
  2386. if wordpos('EXE', Used) = 0
  2387.   then call ITLErr 'No EXE attribute found in ADDPROGRAM record.'
  2388.   else do
  2389.     if ObjectMode
  2390.       then do
  2391.         GroupId = FolderId(Group)
  2392.         if GroupId = ''
  2393.           then do
  2394.             call SysCreateObject 'WPFolder', Group, '<WP_DESKTOP>', 'ICONFILE=;'
  2395.             GroupId = FolderId(Group)
  2396.             if GroupId = ''
  2397.               then GroupId = '<WP_DESKTOP>'
  2398.           end
  2399.         XC = ITL!AddObj('WPProgram', Title, Groupid, Setup)
  2400.       end
  2401.       else do
  2402.         Exists = (rxQueryProgram('USER', Group, Title, 'TRASH') = 0)
  2403.         if ROpt = '' | (ROpt = 'REPLACEONLY' & Exists) |,
  2404.             (ROpt = 'NEWONLY' & \Exists)
  2405.           then do
  2406.             call ITLSay 'Adding' Title 'program to' Group 'group...'
  2407.             call RxDeleteProgram , Group, Title
  2408.             call RxAddProgram , Group, 'INFO.'
  2409.           end
  2410.       end
  2411.   end
  2412. return J
  2413.  
  2414. ITL!EADDP: procedure expose (Globals)
  2415. call ITLErr 'EADDPROGRAM found outside of ADDPROGRAM record.'
  2416. return 0
  2417.  
  2418. /*** Ask the user a question ***/
  2419. ITL!ASK: procedure expose (Globals)
  2420. parse arg Prompt, VarName, Valid, NoConf, Lower
  2421. Valid = translate(strip(Valid))
  2422. NoConf = (NoConf <> '')
  2423. Lower = (Lower <> '')
  2424. VarName = strip(VarName)
  2425. Key = 'N'
  2426. do until (Key = 'Y')
  2427.   call rxSay Prompt ' '
  2428.   parse linein Resp
  2429.   if \Lower
  2430.     then Resp = translate(Resp)
  2431.   if Valid = '' | wordpos(Resp, Valid) > 0
  2432.     then if NoConf
  2433.       then Key = 'Y'
  2434.       else do
  2435.         call rxSay 'You entered "'Resp'" - Is this correct (Y/N)? '
  2436.         do until pos(Key, 'YN') > 0
  2437.           parse upper linein Key .
  2438.           Key = left(Key, 1)
  2439.         end
  2440.       end
  2441.     else do
  2442.       call beep 200, 150
  2443.       say 'Valid responses are:' Valid'.'
  2444.     end
  2445.   if Key = 'N'
  2446.     then say
  2447. end
  2448. call ITLReplaceStringAdd '{'VarName'}', Resp
  2449. return 0
  2450.  
  2451. /*** Change directory ***/
  2452. ITL!CD: procedure expose (Globals)
  2453. parse arg NewDir
  2454. if rxDirExist(NewDir)
  2455.   then call directory NewDir
  2456.   else call ITLErr 'Directory' NewDir 'does not exist.'
  2457. return 0
  2458.  
  2459. /** Copy file **/
  2460. ITL!COPY: procedure expose (Globals)
  2461. parse arg Src, Dst, Opt, App, AutoUp, Defer
  2462. /**** PTR 10011 start ****/
  2463. if Opt <> 'COUCOPY'
  2464.   then if \rxFileExist(Src)
  2465.     then call ItlErr 'Source file' Src 'does not exist.'
  2466. /**** PTR 10011 end ****/
  2467. if Opt = ''
  2468.   then call ITLSay 'Copying' Src 'to 'Dst'...'
  2469.   else if Opt = 'COUCOPY'
  2470.     then call ITLSay 'Copying' Src 'to 'Dst '(COUCOPY:'AutoUp','Defer')...'
  2471.     else call ITLSay 'Copying' Src 'to 'Dst '('Opt')...'
  2472. RetC = CopyFile(Src, Dst, Opt, App, AutoUp, Defer)
  2473. if RetC <> 0
  2474.   then call ITLErr 'Error' RetC 'copying' Src 'to' Dst'.'
  2475. return 0
  2476.  
  2477. /**********************************************************
  2478. * CopyDir src, trg                                        *
  2479. *                                                         *
  2480. * Copies directories, formats screen output.              *
  2481. *                                                         *
  2482. * Return:  0 = Successful completion.                     *
  2483. *          2 = Source directory does not exist.           *
  2484. *          3 = Target directory could not be created.     *
  2485. *          4 = Certain files or directories could         *
  2486. *               not be copied.                            *
  2487. *          5 = Max number of copy errors encountered      *
  2488. *               and copy was aborted.                     *
  2489. *          6 = Not enough space on target                 *
  2490. **********************************************************/
  2491. ITL!COPYDIR: procedure expose (Globals)
  2492.  parse upper arg src, trg .
  2493.  
  2494.  /*******************************************************/
  2495.  /** Check and condition input params.                 **/
  2496.  /*******************************************************/
  2497.  if RxDirExist(src)=0 then do
  2498.    IMP.0ItlResult = 2;  return 0
  2499.  end
  2500.  if trg='' then trg='.'
  2501.  if RxDirExist(trg)=0 then call RxMkDir(trg)
  2502.  if RxDirExist(trg)=0 then do
  2503.    IMP.0ItlResult = 3;  return 0
  2504.  end
  2505.  if right(src,1)<>'\' then src=src'\'
  2506.  if right(trg,1)<>'\' then trg=trg'\'
  2507.  
  2508.  /*******************************************************/
  2509.  /** Setup vars and scan source directory tree.        **/
  2510.  /*******************************************************/
  2511.  call RxCurPos 4, 0
  2512.  call RxSay ' Scanning source directory tree...'
  2513.  call RxTree src'*.*', 'source.', 'SB'
  2514.  call RxStemSort 'source.', , 38
  2515.  call RxSay 'done'
  2516.  off = length(src)+38
  2517.  RetC = 0
  2518.  Errors = 0;
  2519.  j=1
  2520.  
  2521.  /*************************************/
  2522.  /* Determine number of bytes to copy */
  2523.  /*************************************/
  2524.  BytesCopied=0
  2525.  BytesToBeCopied=0
  2526.  do i=1 to source.0
  2527.      parse var source.i . . size .
  2528.      BytesToBeCopied = BytesToBeCopied + size
  2529.  end
  2530.  
  2531.  /********************************************/
  2532.  /* Make sure there is enough room on target */
  2533.  /********************************************/
  2534.  if substr(trg, 2, 1)=':' then
  2535.    trgdrv = left(trg, 2)
  2536.  else
  2537.    trgdrv=left(directory(),2)
  2538.   parse upper value rxDriveInfo(trgdrv) with 'LABEL=' DLabel 'FREE='free .
  2539.   if BytesToBeCopied>free then do
  2540.     say 'Error - Not enough room to copy files.'
  2541.     IMP.0ItlResult = 6;  return 0
  2542.   end
  2543.  
  2544.  call !StatusBar 22, 5, 70, BytesCopied, BytesToBeCopied
  2545.  call RxCurState 'OFF'
  2546.  
  2547.  /*******************************************************/
  2548.  /** Process all source entries.                       **/
  2549.  /*******************************************************/
  2550.  do i=1 to source.0
  2551.  
  2552.    /************************************************/
  2553.    /** Clear screen after every 13 files copied.  **/
  2554.    /** (Avoids scrolling).                        **/
  2555.    /************************************************/
  2556.    if j=14 then do
  2557.      do j=0 to 13
  2558.        call RxCurPos 4+j, 0
  2559.        call RxSay copies(' ', 80)
  2560.      end
  2561.      j=0
  2562.    end
  2563.  
  2564.    /***********************************************/
  2565.    /** Reset screen pos and get cur file spec.   **/
  2566.    /***********************************************/
  2567.    call RxCurPos 4+j, 0
  2568.    file = substr(source.i, off)  /* Get file spec */
  2569.  
  2570.    /************************************************/
  2571.    /** Check if its a directory and create it if  **/
  2572.    /** needed.                                    **/
  2573.    /************************************************/
  2574.    if substr(source.i, 32, 1)='D' then do
  2575.      if RxDirExist(trg||file)=0 then do
  2576.        call RxSay '  Creating directory 'trg||file'...'
  2577.        myRc = RxMkDir(trg||file)
  2578.        if myRc<>0 then do
  2579.          say d2c(7)'rc='myRC
  2580.          RetC = 4
  2581.        end
  2582.        else
  2583.          say 'ok'
  2584.        j=j+1
  2585.      end
  2586.    end
  2587.  
  2588.    /************************************************/
  2589.    /** If not a directory, then it is a file, thus**/
  2590.    /** copy it.                                   **/
  2591.    /************************************************/
  2592.    else do
  2593.      call RxSay '      Copying 'trg||file'...'
  2594.      'COPY 'src||file' 'trg||file'>nul 2>&1'
  2595.      if RC<>0 then do
  2596.        if RxFileExist(trg||file)=1 then
  2597.           call RxTree trg||file, 'stem.', 'F', '*****', '-*---'
  2598.        'COPY 'src||file' 'trg||file'>nul 2>&1'
  2599.      end
  2600.      if RC<>0 then do
  2601.        say d2c(7)'rc='RC
  2602.        RetC = 4
  2603.        Errors= Errors+1
  2604.      end
  2605.      else do
  2606.        say 'ok'
  2607.        BytesCopied = BytesCopied + word(source.i, 3)
  2608.      end
  2609.      j=j+1
  2610.    end
  2611.  
  2612.    /************************************************/
  2613.    /** Update status bar after every file         **/
  2614.    /************************************************/
  2615.    call !StatusBar 22, 5, 70, BytesCopied, BytesToBeCopied
  2616.  
  2617.    /************************************************/
  2618.    /** Check Errors                               **/
  2619.    /************************************************/
  2620.    if Errors=10 then do
  2621.      call RxSay '      Maximum file copy errors reached.  Aborting...'
  2622.      call RxSleep 2
  2623.      IMP.0ItlResult = 5;  return 0
  2624.    end
  2625.  end
  2626.  call RxCurState 'ON'
  2627.  if (rc=0) then BytesCopied = BytesToBeCopied
  2628.  call !StatusBar 22, 5, 70, BytesCopied, BytesToBeCopied
  2629.  IMP.0ItlResult = RetC
  2630. return 0
  2631.  
  2632. /**********************************************************
  2633. * !StatusBar                                              *
  2634. *                                                         *
  2635. * Purpose:                                                *
  2636. *   Used by DirCopy() to draw a status bar.               *
  2637. **********************************************************/
  2638. !StatusBar: procedure expose (Globals)
  2639.  parse arg row, col, len, size, total .
  2640.  
  2641.  Meg =   '1024000'
  2642.  inc = trunc(total/(len-2), 2)    /* Get increment            */
  2643.  if size=0 then size=1            /* Do not allow / by 0      */
  2644.  num = trunc(size/inc)            /* Get number of increments */
  2645.  if num>len-2 then num=len-2      /* Check for overflow       */
  2646.  call RxCurPos row, col
  2647.  call RxSay d2c(192)||copies(d2c(196), len-2)||d2c(217)
  2648.  call RxCurPos row-1, col
  2649.  call RxSay d2c(179)||copies(d2c(219), num)||copies(' ', len-2-num)||d2c(179)
  2650.  call RxCurPos row-2, col
  2651.  call RxSay d2c(218)||copies(d2c(196), len-2)||d2c(191)
  2652.  call RxCurPos row-3, col
  2653.  call RxSay 'Progress:'||right('Copied 'trunc(size/Meg,2)' of',
  2654.      trunc(total/Meg,2)' Megabytes', 61)
  2655. return
  2656.  
  2657. /** Clear the screen **/
  2658. ITL!CLS: procedure expose (Globals)
  2659. '@CLS'   /* Safer than RxCls which doesn't support ANSI */
  2660. return 0
  2661.  
  2662. /** Add any command or statement **/
  2663. ITL!CMD: procedure expose (Globals)
  2664. parse arg Cmd, Pos String, RemStr, Control
  2665. RemStr = strip(RemStr)
  2666. if FileType('REXX') & pos(left(Cmd, 1), '"'||"'") = 0
  2667.   then Cmd = "'"Cmd"'"
  2668. call ITLSay 'Inserting command:' Cmd'...'
  2669. if FileType('CONFIG') | FileType('IBMLAN') | FileType('PROTOCOL')
  2670.   then call InsUnique Cmd, Pos String, 'PREFIX', Control
  2671.   else call InsUnique Cmd, Pos String, 'COMPRESS', Control
  2672. if RemStr <> ''
  2673.   then call RemAll RemStr, 'ALL+', ,CurLn()
  2674. return 0
  2675.  
  2676. /** Change path statment **/
  2677. ITL!CP: procedure expose (Globals)
  2678. parse arg Path . , Dir, Ctrl, Force
  2679. Force = (translate(Force) = 'FORCE')
  2680. if Ctrl = ''
  2681.   then Ctrl = 'BEGIN'
  2682.   else Ctrl = translate(Ctrl)
  2683. if wordpos(word(Ctrl,1), 'BEGIN END DELETE BEFORE AFTER') = 0
  2684.   then call ITLErr 'Invalid argument' Ctrl
  2685. Dir = strip(Dir, 'T', ';')
  2686. Where = Imp.0CurL + 1
  2687. if Force & Ctrl <> 'DELETE'
  2688.   then call ITL!CP Path, Dir, 'DELETE'
  2689. if Ctrl = 'DELETE'
  2690.   then do
  2691.     call ITLSay 'Deleting' Dir 'from' Path'...'
  2692.     call DelPath Path, Dir
  2693.   end
  2694.   else do
  2695.     if length(Dir) > 3
  2696.       then Dir = strip(Dir, 'T', '\')
  2697.     call ITLSay 'Inserting' Dir 'into' Path'...'
  2698.     call InsPath Path, Dir, Ctrl, 'CREATE' Where, 'GOTO'
  2699.   end
  2700. return 0
  2701.  
  2702. /*** Delete a file ***/
  2703. ITL!DEL: procedure expose (Globals)
  2704. if abbrev(space(translate(arg(1)),0), 'DIR=')
  2705.   then do
  2706.     parse arg '=' Dir
  2707.     if right(Dir, 1) <> '\'
  2708.       then Dir = Dir'\'
  2709.     Start = 2
  2710.   end
  2711.   else do
  2712.     Dir = ''
  2713.     Start = 1
  2714.   end
  2715.  
  2716. do I = Start while arg(I) <> ''
  2717.   File = Dir||arg(I)
  2718. /*** PTR 102 start */
  2719.   call rxTree File, 'TEMP.', 'F', , '-----'
  2720.   if Temp.0 > 0
  2721.     then do I = 1 to Temp.0
  2722.       Temp.I = subword(Temp.I, 5)
  2723. /*** PTR 102 end ***/
  2724.       call ITLSay 'Deleting file' Temp.I'...'
  2725.       rc = rxDelete(Temp.I)
  2726.       if rc <> 0
  2727.         then call ItlErr 'Error' rc 'deleting' Temp.I'.'
  2728.     end
  2729.     else call ITLSay 'File to be deleted ('File') does not exist.'
  2730. end
  2731. return 0
  2732.  
  2733. /** Delete a program entry **/
  2734. ITL!DELP: procedure expose (Globals)
  2735. parse arg Group, Title
  2736. if Title = '' & pos('\', Group) > 0
  2737.   then parse var Group Group '\' Title
  2738. if Group = '' | Title = ''
  2739.   then call ITLErr 'DELP:  Required argument missing.'
  2740. call ITLSay 'Deleting program entry' Group'/'Title'.'
  2741. rc = rxDeleteProgram('USER', Group, Title)
  2742. if rc <> 0 & rc <> 4
  2743.   then call ItlSay 'Error' rc 'deleting' Group'/'Program
  2744. return 0
  2745.  
  2746. /** Add any environment variable statement **/
  2747. ITL!ENV: procedure expose (Globals)
  2748. parse arg Env . , Val, Pos STarget
  2749. Val = strip(Val)
  2750. STarget = strip(STarget)
  2751. Pos = translate(Pos)
  2752. if Pos = 'REMOVE' | Pos = 'DELETE'
  2753.   then do
  2754.     call ITLSay 'Removing SET' Env'...'
  2755.     call RemAll 'SET' Env'='
  2756.   end
  2757.   else do
  2758.     call ITLSay 'Adding SET' Env'='Val'...'
  2759.     call InsUnique 'SET' Env'='Val, Pos STarget, 'PREFIX'
  2760.   end
  2761. return 0
  2762.  
  2763. /** Set ERRORMODE **/
  2764. ITL!ERRORMODE: procedure expose (Globals)
  2765. parse upper arg EMode EArg .
  2766. if wordpos(EMode, 'CONTINUE HALT QUIET RESULT NULLENV') = 0 |,
  2767.     (EArg <> '' & wordpos(EArg, '0 1') = 0)
  2768.   then call ITLErr 'Invalid ERRORMODE:' EMode EArg
  2769.   else select
  2770.       when EMode = 'NULLENV'
  2771.         then Imp.0NullEnv = (EArg = 1)
  2772.       otherwise do
  2773.         Imp.0ErrorMode = EMode
  2774.         if EMode = 'RESULT'
  2775.           then Imp.0Error = ''
  2776.       end
  2777.   end
  2778. return 0
  2779.  
  2780. /** Set MSGMODE **/
  2781. ITL!MSGMODE: procedure expose (Globals)
  2782. parse upper arg Opt ., Log
  2783. Log = strip(Log)
  2784. if Opt <> ''
  2785.   then if wordpos(Opt, 'ON OFF') <> 0
  2786.     then do
  2787.       call ITLSay 'Turning message mode' Opt'...'
  2788.       Imp.0Verbose = (Opt = 'ON')
  2789.     end
  2790.     else call ITLErr 'Invalid MSGMODE setting' Opt'.'
  2791. if Log <> ''
  2792.   then do
  2793.     call ITLSay 'Setting log file to "'Log'"...'
  2794.     Imp.0ITLLog = Log
  2795.     call ITLSay copies('-', 70)
  2796.   end
  2797. return 0
  2798.  
  2799.  
  2800. /** Evaluate an arbitrary expression **/
  2801. ITL!EVAL: procedure expose (Globals)
  2802. parse arg Expr
  2803. call ITLSay 'Executing' Expr'...'
  2804. if left(Expr, 1) = "'" & right(Expr, 1) = "'"
  2805.   then do
  2806.     strip(Expr, 'B', "'")  /* Strip quotes and pass to OS/2 */
  2807.     Imp.0ItlResult = rc
  2808.   end
  2809.   else do
  2810.     Forbidden = 'EXIT ITERATE LEAVE PROCEDURE RETURN SIGNAL'
  2811. /*
  2812.     Keywords = 'ADDRESS ARG CALL DO DROP IF INTERPRET NOP NUMERIC OPTIONS',
  2813.         'PARSE PULL PUSH QUEUE SAY SELECT TRACE'
  2814. */
  2815.     W1 = translate(word(Expr, 1))
  2816.     if wordpos(W1, Forbidden) > 0
  2817.       then call ItlErr 'Illegal keyword' W1 'to EVAL.'
  2818.       else do
  2819.         if pos('(', W1) > 0
  2820.           then do
  2821.             parse upper var W1 W1 '('
  2822.             if verify(W1, 'ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789!?_') = 0
  2823.               then Expr = 'result =' Expr
  2824.           end
  2825.         signal off novalue
  2826.         signal off error
  2827.         signal on syntax name syntax
  2828.         interpret Expr
  2829.         if symbol('RC') = 'VAR'
  2830.           then call ItlSay 'Error' rc 'evaluating' Expr
  2831.         signal on novalue
  2832.         signal on error
  2833.         if symbol('RESULT') = 'LIT'
  2834.           then Imp.0ItlResult = ''
  2835.           else Imp.0ItlResult = result
  2836.       end
  2837.   end
  2838. call ITLSay '... "'Imp.0ItlResult'"'
  2839. return 0
  2840.  
  2841. /**
  2842. ITL!EVAL: procedure expose (Globals)
  2843. parse arg Expr
  2844. call ITLSay 'Executing' Expr'...'
  2845. if left(Expr, 1) = "'" & right(Expr, 1) = "'"
  2846.   then do
  2847.     strip(Expr, 'B', "'")  /* Strip quotes and pass to OS/2 */
  2848.     Temp = rc
  2849.   end
  2850.   else interpret "Temp =" Expr
  2851. Imp.0ItlResult = Temp
  2852. call ITLSay '...' Temp
  2853. return 0
  2854. **/
  2855.  
  2856. /** Exit **/
  2857. ITL!EXIT: procedure expose (Globals)
  2858. parse value arg(1) '0' with OutC .
  2859. call ITLSay 'Exiting - rc('OutC')'
  2860. return '!'OutC
  2861.  
  2862. /** FIND **/
  2863. ITL!FIND: procedure expose (Globals)
  2864. parse upper arg Target, SMode ., MMode .
  2865. call ITLSay 'Searching for' Target'...'
  2866. Imp.0ItlResult =  Find(Target, SMode, MMode)
  2867. return 0
  2868.  
  2869. /** Goto **/
  2870. ITL!GOTO: procedure expose (Globals)
  2871. parse upper arg Label .
  2872. if Label = ''
  2873.   then call ITLErr 'Null label passed to GOTO.'
  2874. if Left(Label, 1) <> ':'
  2875.   then Label = ':'Label
  2876. call ITLSay 'Branching to' Label'...'
  2877. call rxStemGrep Label, 'IMP.0MODS.', 'TEMP.', 'N'
  2878. do J = 1 to Temp.0
  2879.   if translate(word(Temp.J, 2)) = Label
  2880.     then return word(Temp.J, 1)
  2881. end
  2882. call ItlErr 'Label' Label 'not found.'
  2883. return 0
  2884.  
  2885. /** IF **/
  2886. ITL!IF: procedure expose (Globals)
  2887. parse upper arg Expr
  2888. IfNum = Imp.0IfStack.0 + 1
  2889. Imp.0IfStack.0 = IfNum
  2890. if Imp.0IfScan <> 0
  2891.   then return 0
  2892.  
  2893. Temp = 'IF ('Expr')'
  2894. Expr = LookUp(Expr)
  2895. Temp = Temp '('Expr')'
  2896. interpret "Bool = ("Expr")"                                                                                                                                                                                                                                   
  2897. call ITLSay copies(' ', (IfNum-1) * 2)Temp '::' Bool'...'
  2898. if wordpos(Bool, '0 1') = 0
  2899.   then call ITLErr 'Result ('Bool') not boolean.'
  2900. Imp.0IfStack.IfNum = Bool
  2901. if \Bool
  2902.   then Imp.0IfScan = IfNum
  2903. return 0
  2904.  
  2905. ITL!ENDIF: procedure expose (Globals)
  2906. IfNum = Imp.0IfStack.0
  2907. if IfNum < 1
  2908.   then call ITLErr 'ENDIF encountered outside IF.'
  2909.   else do
  2910.     Imp.0IfStack.0 = IfNum - 1
  2911.     if Imp.0IfScan <> 0
  2912.       then if Imp.0IfScan = IfNum
  2913.         then Imp.0IfScan = 0
  2914.     if Imp.0IfScan = 0
  2915.       then call ItlSay copies(' ', (IfNum-1) * 2)'...ENDIF'
  2916. return 0
  2917.  
  2918. ITL!ELSE: procedure expose (Globals)
  2919. IfNum = Imp.0IfStack.0
  2920. if IfNum < 1
  2921.   then call ItlErr 'ELSE encounted outside IF.'
  2922.   else do
  2923.     call ItlSay copies(' ', (IfNum-1) * 2)'...ELSE...'
  2924.     If Imp.0IfScan <> 0
  2925.       then if Imp.0IfScan = IfNum
  2926.         then Imp.0IfScan = 0
  2927.         else nop
  2928.       else Imp.0IfScan = IfNum
  2929.   end
  2930. return 0
  2931.  
  2932. /** Make a directory **/
  2933. ITL!MD: procedure expose (Globals)
  2934. parse arg Dir       /* May contain embedded blanks */
  2935. Dir = strip(Dir)
  2936. call ITLSay 'Making directory 'Dir'...'
  2937. I = lastpos('"', Dir)
  2938. do while I > 0
  2939.   Dir = delstr(Dir, I, 1)
  2940.   I = lastpos('"', Dir)
  2941. end
  2942. I = pos('\', Dir)
  2943. do while I <> 0
  2944.   call ITL!!MD2(left(Dir, I-1))
  2945.   I = pos('\', Dir, I+1)
  2946. end
  2947. call ITL!!MD2 Dir
  2948. return 0
  2949.  
  2950. ITL!!MD2: procedure expose (Globals)
  2951. parse arg Dir
  2952. if \(length(Dir) = '2' & right(Dir, 1) = ':') & \rxDirExist(Dir)
  2953.   then do
  2954.     rc = rxMkDir(Dir)
  2955.     if rc <> 0
  2956.       then call ITLErr 'Error' rc 'creating' Dir'.'
  2957.   end
  2958. return 0
  2959.  
  2960. /** Check numerical parameter **/
  2961. ITL!NUMCHK: procedure expose (Globals)
  2962. parse arg NParm Bit . , Min . , Max . , Set .
  2963. BitMode = (Bit <> '')
  2964. NParm = translate(NParm)
  2965. if BitMode
  2966.   then Desc = NParm 'bit' Bit
  2967.   else Desc = NParm
  2968. call ITLSay 'Checking numerical parameter' Desc '('Min','Max'):'Set'...'
  2969. Found = 0
  2970. Done = 0
  2971. if Find(NParm, 'ALL+', 'BEGIN') = 0
  2972.   then do until Found | Done
  2973.     OldLine = GetLine()
  2974.     parse upper var OldLine TestParm . '=' OrigVal .
  2975.     Found = (TestParm = NParm)
  2976.     if \Found
  2977.       then Done = (FindNext() <> 0)
  2978.   end
  2979. If Found
  2980.   then if Bit <> ''
  2981.     then do
  2982.       TestVal = substr(OrigVal, Bit+1, 1)
  2983.       if TestVal = ''
  2984.         then do
  2985.           call ItlSay '...bit' Bit 'does not exist.'
  2986.           TestVal = -999999
  2987.         end
  2988.     end
  2989.     else TestVal = OrigVal
  2990. if Found
  2991.   then do
  2992.     parse value Set Max Min with Set .
  2993.     parse value Min TestVal with Min .
  2994.     parse value Max TestVal with Max .
  2995.     if (TestVal < Min) | (TestVal > Max)
  2996.       then do
  2997.         call RemLine
  2998.         call ITLSay '...'Desc '=' TestVal '- changed to' Set'.'
  2999.         if Bit <> ''
  3000.           then Set = overlay(Set, OrigVal, Bit+1)
  3001.         call InsLine ChangeStr(OldLine, OrigVal, Set)
  3002.       end
  3003.       else call ITLSay '...'Desc '=' TestVal '- okay.'
  3004.   end
  3005.   else if Bit = '' & Set <> ''
  3006.     then do
  3007.       call ITLSay NParm 'not found in file -- adding.'
  3008.       call ITL!CMD NParm'='Set
  3009.     end
  3010.     else call ITLErr NParm 'not found in file.'
  3011. return 0
  3012.  
  3013. ITL!OPTIONS: procedure expose (Globals)
  3014. parse upper arg Opt OptVal
  3015. select
  3016.   when Opt = 'EXITPAUSE'
  3017.     then if wordpos(OptVal, 'YES NO') = 0
  3018.       then call ILTErr 'Invalid option value:' Opt
  3019.       else Imp.0ErrPause = (OptVal = 'YES')
  3020.   otherwise call ITLErr 'Invalid option:' Opt
  3021. end
  3022. return 0
  3023.  
  3024. /** Add a remark statement **/
  3025. ITL!REM: procedure expose (Globals)
  3026. parse arg New, Pos Target, Blank .
  3027. parse upper value Pos 'AFTER' with Pos .
  3028. New = RemLine(New)
  3029. call ITLSay 'Inserting remark:' New'...'
  3030. call InsUnique New, Pos Target, 'COMPRESS'
  3031. if translate(Blank) = 'BLANK'
  3032.   then call InsBlank 'BEFORE'
  3033. return 0
  3034.  
  3035. /** Remark all strings **/
  3036. ITL!REMALL: procedure expose (Globals)
  3037. parse arg String, Del
  3038. Del = (translate(Del) = 'DELETE')
  3039. if Del
  3040.   then do
  3041.     call ITLSay 'Deleting all lines containing "'String'"...'
  3042.     More = (Find(String, 'ALL+') = 0)
  3043.     do while More
  3044.       call DelLine 'BACKUP'
  3045.       More = (FindNext() = 0)
  3046.     end
  3047.   end
  3048.   else do
  3049.     call ITLSay 'Remarking all lines containing "'String'"...'
  3050.     call RemAll String, 'ALL+'
  3051.   end
  3052. return 0
  3053.  
  3054. /** Replace a file (if needed) **/
  3055. ITL!REPFILE: procedure expose (Globals)
  3056. parse arg Src, Dst, Opts
  3057. Src = strip(Src)
  3058. Dst = strip(Dst)
  3059. if Src = '' | Dst = ''
  3060.   then call ITLErr 'Source and target must be specified.'
  3061. /**
  3062. if pos('?', Src Dst) + pos('*', Src Dst) > 0
  3063.   then call ITLErr 'Wildcard characters are not supported by REPFILE.'
  3064.  **/
  3065. call ITLSay 'Replacing' Src 'to' Dst'...'
  3066. RetC = ReplaceFile(Src, Dst, Opts)
  3067. if RetC <> 0
  3068.   then call ITLErr 'Error' RetC 'replacing' Src 'to' Dst'.'
  3069. return 0
  3070.  
  3071. /** Turn on/off string replacement **/
  3072. ITL!REPSTR: procedure expose (Globals)
  3073. parse arg Opt, Str2
  3074. Opt = translate(strip(Opt))
  3075. if Str2 = ''
  3076.   then if wordpos(Opt, 'ON OFF') <> 0
  3077.     then do
  3078.       call ITLSay 'Turning string replacement' Opt'...'
  3079.       Imp.0StrRep = (Opt = 'ON')
  3080.     end
  3081.     else call ITLErr 'Invalid REPSTR argument' Opt'.'
  3082.   else do
  3083.     Str2 = LookUp(strip(Str2))
  3084.     if Opt = ''
  3085.       then call ITLErr 'First REPSTR argument resolved to null.'
  3086.       else if Opt = Str2
  3087.         then call ITLErr 'REPSTR source and target are the same.'
  3088.         else do
  3089.           call ITLSay 'Replace String ['Opt'|'Str2']'
  3090.           call ITLReplaceStringAdd Opt, Str2
  3091.         end
  3092.   end
  3093. return 0
  3094.  
  3095. /** Read a file **/
  3096. ITL!RF: procedure expose (Globals)
  3097. parse arg File
  3098. call ITLSay 'Reading 'file'...'
  3099. call ReadFile File
  3100. call SetComment 'DESC', '('Imp.0ITLMe date()')'
  3101. return 0
  3102.  
  3103. /* Display information for the edification of the user */
  3104. ITL!SAY: procedure expose (Globals)
  3105. call ITLSay arg(1), 'FORCE'
  3106. return 0
  3107.  
  3108. /** Sleep a specified number of seconds **/
  3109. ITL!SLEEP: procedure expose (Globals)
  3110. parse arg Secs .
  3111. call RxSleep Secs
  3112. return 0
  3113.  
  3114. /** Synchronization services **/
  3115. ITL!SYNCH: procedure expose (Globals)
  3116. parse arg Point .
  3117. if verify(Point, '0123456789') = 0
  3118.   then call ItlSay '***** Synch point' Point 'encountered.'
  3119. return 0
  3120.  
  3121. /** Write file **/
  3122. ITL!WF: procedure expose (Globals)
  3123. if FileChanged()
  3124.   then do
  3125.     parse arg Backdir, BackType
  3126.     call ITLSay 'Writing file ('BackDir BackType')...'
  3127.     if Imp.0Verbose
  3128.       then call WriteFile BackDir, BackType, 'VERBOSE'
  3129.       else call WriteFile BackDir, BackType
  3130.   end
  3131.   else call ITLSay 'File not changed - no write performed.'
  3132. return 0
  3133.  
  3134. ITL!TRACE: procedure expose (Globals)
  3135. parse arg Imp.0TrVal .
  3136. return 0
  3137.  
  3138. ITL!COREINSTDIRCHECK: procedure expose (Globals)
  3139. parse upper arg Drive ., Dir ., Label ., MsgOffset .
  3140. if Drive = '' | Dir = '' | Label = '' | MsgOffset = ''
  3141.   then call ITLErr 'Bad DIRCHECK arguments.'
  3142. call ItlSay 'Checking for' Label '('Dir','MsgOffset') in drive' Drive'...'
  3143. Label = strip(strip(Label),,'"')
  3144. App = 'CREQINST'
  3145. Msg = 560 + MsgOffset
  3146. Imp.!ItlZipDir = Dir
  3147. do while \rxDirExist(Imp.!ItlZipDir)
  3148.   call rxOS2Ini 'USER', App, 'CMD', 'DISK|'Drive'|'Label'|'Msg
  3149.   say '[*CMD*]'
  3150.   do until Done
  3151.     call rxsleep 1
  3152.     Done = (IniGet('USER', App, 'CMD') = '')
  3153.   end
  3154. end
  3155. return 0
  3156.  
  3157. ITL!COREINSTUNZIP: procedure expose (Globals)
  3158. parse upper arg ZipFile, TargetDir, FileList, ZipArgs, TempDir
  3159. if ZipFile = '' | TargetDir = '' | FileList = ''
  3160.   then call ITLErr 'Bad UNZIP arguments.'
  3161. ZipArgs = arg(4)   /* Get mixed case copy */
  3162. if TempDir <> ''
  3163.   then if \rxDirExist(TempDir)
  3164.     then do
  3165.       call ItlErr 'Temp directory' TempDir 'does not exist.'
  3166.       return 0
  3167.     end
  3168. if \rxFileExist(ZipFile)
  3169.   then if rxFileExist(Imp.!ItlZipDir'\'ZipFile)
  3170.     then ZipFile = Imp.!ItlZipDir'\'ZipFile
  3171.     else do
  3172.       call ItlErr 'File' ZipFile 'does not exist.'
  3173.       return 0
  3174.     end
  3175.  
  3176. if TempDir <> ''
  3177.   then do  /* Unpack to staged copy via COUCOPY */
  3178.     call ItlSay 'Unzipping' ZipFile '('FileList') to' TargetDir 'via',
  3179.         TempDir '('ZipArgs')...'
  3180.     Res = Itl!!RunCmd('PKUNZIP2' ZipArgs ZipFile TempDir FileList)
  3181. /**** PTR 107 start ****/
  3182.     call ITL!CoreInstUnzipErrCheck Res
  3183. /**** PTR 107 end ****/
  3184.     TempDir = strip(TempDir, 'T', '\')
  3185.     do while FileList <> ''
  3186.       parse var FileList File FileList
  3187.       if abbrev(File, '"')
  3188.         then do
  3189.           parse var FileList FileRest '"' FileList
  3190.           File = File||FileRest
  3191.         end
  3192. /**** PTR 10215 start ****/
  3193.       FileName = filespec('NAME', File)
  3194.       File = TempDir'\'FileName
  3195.       Res = rxCouCopy(File, TargetDir'\'FileName)
  3196. /**** PTR 10215 end *****/
  3197.       if abbrev(Res, 'ERROR:')
  3198.         then call ItlErr 'Error' Res 'from COUCOPY.'
  3199.       call rxDelete File
  3200.     end
  3201.   end
  3202.   else do /* Direct unpack */
  3203.     call ItlSay 'Unzipping' ZipFile '('FileList') to' TargetDir,
  3204.         '('ZipArgs')...'
  3205.     Res = Itl!!RunCmd('PKUNZIP2' ZipArgs ZipFile TargetDir FileList)
  3206. /**** PTR 107 start ****/
  3207.     call ITL!CoreInstUnzipErrCheck Res
  3208. /**** PTR 107 end ****/
  3209.   end
  3210. return 0
  3211.  
  3212. /**** PTR 107 start ****/
  3213. ITL!COREINSTUNZIPERRCHECK: procedure expose(Globals)
  3214. parse arg Res
  3215. If Res = ''
  3216.   then call ItlErr 'Output from PKUNZIP2 vanished!'
  3217.   else do
  3218.     ErrSum = ''
  3219.     E11 = 0
  3220.     W10 = 0
  3221.     Temp = Res
  3222.     do while Temp <> ''
  3223.       parse var Temp '(E' ECode ')' Temp
  3224.       if ECode <> '' & verify(ECode, '0123456789') = 0
  3225.         then if ECode = 11
  3226.           then E11 = 1
  3227.           else ErrSum = ErrSum 'E'ECode
  3228.     end
  3229.     Temp = Res
  3230.     do while Temp <> ''
  3231.       parse var Temp '(W' WCode ')' Temp
  3232.       if WCode <> '' & verify(WCode, '0123456789') = 0
  3233.         then if WCode = 10
  3234.           then W10 = 1
  3235.           else ErrSum = ErrSum 'W'WCode
  3236.     end
  3237.     if ErrSum <> ''
  3238.       then call ItlErr 'An error occurred unpacking files ('strip(ErrSum)')'
  3239.       else if E11
  3240.         then if W10
  3241.           then call ITL!CoreInstMsgBox 'Install Warning', 'Some files could',
  3242.               'not be unpacked because the target files are in use.'
  3243.           else call ItlErr 'Expected file(s) were not found.'
  3244.   end
  3245. return
  3246. /**** PTR 107 end ****/
  3247.  
  3248. ITL!COREINSTCREATEALIAS: procedure expose (Globals)
  3249. parse arg Server, AliasName, PhysPath, Comment, WhenShare, NoRetry
  3250. NoRetry = (NoRetry = 1)
  3251. if Server = '' | AliasName = '' | PhysPath = '' | Comment = ''
  3252.   then call ITLErr 'Bad CreateAlias arguments.'
  3253. if WhenShare = ''
  3254.   then WhenShare = 'STARTUP'
  3255. call ItlSay 'Creating \\'Server'\'AliasName '=' PhysPath '('Comment')...'
  3256. PreQ = queued()
  3257. call Itl!!RunCmd 'NET ALIAS' AliasName '/DELETE'
  3258. Res = Itl!!RunCmd('NET ALIAS' AliasName '\\'Server PhysPath '/W:'WhenShare,
  3259.     '/R:"'Comment'" /UN')
  3260. /**** PTR 10241 start ****/
  3261. if pos('SYS0005', Res) > 0
  3262.   then call ItlErr 'Access denied modifying access control.  The',
  3263.       'userid and password being may not have administrator',
  3264.       'authority on the domain controller.'
  3265. /**** PTR 10241 end ****/
  3266. if pos('NET2788', Res) > 0
  3267.   then do
  3268.     call ItlSay 'An alias for' PhysPath 'already exists.  Locating...'
  3269.     OldALias = ''
  3270.     PreQ = queued()
  3271.     Aliases = ''
  3272.     'NET ALIAS 2>NUL | RXQUEUE /LIFO'
  3273.     do while queued() > PreQ
  3274.       pull Name Type .
  3275.       if Type = 'FILES'
  3276.         then Aliases = Aliases Name
  3277.     end
  3278.     do while Aliases <> '' & OldAlias = ''
  3279.       parse var Aliases Name Aliases
  3280.       'NET ALIAS' Name '2>NUL | RXQUEUE /LIFO'
  3281.       I. = ''
  3282.       do while queued() > PreQ
  3283.         pull Tag ':' I.Tag
  3284.       end
  3285.       if I.PATH = PhysPath
  3286.         then OldAlias = I.ALIAS
  3287.     end
  3288.     if OldAlias = ''
  3289.       then call ItlErr 'An alias for' PhysPath 'already exists, but could',
  3290.           'not be identified.'
  3291.       else if NoRetry
  3292.         then call ItlErr 'Alias' OldAlias 'already exists for' PhysPath',',
  3293.             'but could not be removed.'
  3294.         else do
  3295.           call Itl!!RunCmd 'NET ALIAS' OldAlias '/DELETE'
  3296.           call ITL!COREINSTCREATEALIAS Server, AliasName, PhysPath, Comment,,
  3297.               WhenShare, 1
  3298.         end
  3299.   end
  3300. return 0
  3301.  
  3302. ITL!COREINSTCREATEACP: procedure expose (Globals)
  3303. parse upper arg PhysPaths, Names, Permissions
  3304. if PhysPaths = '' | Names = '' | Permissions = ''
  3305.   then call ItlErr 'Bad CreateACP arguments.'
  3306. call ItlSay 'Giving' Permissions 'access to' PhysPaths 'for' Names'...'
  3307. do I = 1 to words(PhysPaths)
  3308.   PhysPath = word(PhysPaths, I)
  3309.   if pos(':', PhysPath) = 0
  3310.     then do
  3311.       Temp = left(PhysPath, 1)':'
  3312.       do J = 2 to length(PhysPath)
  3313.         Temp = Temp substr(PhysPath, J, 1)':'
  3314.       end
  3315.       return (ITL!COREINSTCREATEACP(Temp, Names, Permissions))
  3316.     end
  3317.     else do
  3318.       if length(PhysPath) = 1
  3319.         then PhysPath = PhysPath':'
  3320.       do J = 1 to words(Names)
  3321.         Name = word(Names, J)
  3322. /**** PTR 10241 start ****/
  3323.         Res = Itl!!RunCmd('NET ACCESS' PhysPath '/ADD' Name':'Permissions)
  3324.         if pos('SYS0005', Res) > 0
  3325.           then call ItlErr 'Access denied modifying access control.  The',
  3326.               'userid and password being may not have administrator',
  3327.               'authority on the domain controller.'
  3328.         if pos('NET3502', Res) > 0
  3329.           then call ItlErr 'Unexpected OS/2 error modifying access control.'
  3330.         if pos('NET2225', Res) > 0
  3331.           then if pos('NET3739', Itl!!RunCmd('NET ACCESS' PhysPath '/GRANT',
  3332.               Name':'Permissions)) > 0
  3333.             then call Itl!!RunCmd 'NET ACCESS' PhysPath '/CHANGE',
  3334.                 Name':'Permissions
  3335. /**** PTR 10241 end ****/
  3336.       end J
  3337.     end
  3338. end I
  3339. return 0
  3340.  
  3341. ITL!COREINSTDELETEACP: procedure expose (Globals)
  3342. parse upper arg PhysPath, DelTree
  3343. if PhysPath = ''
  3344.   then call ItlErr 'Bad DeleteACP arguments.'
  3345. DelTree = (DelTree = 'TREE')
  3346. if DelTree
  3347.   then call ItlSay 'Deleting ACP for' PhysPath 'and subtree...'
  3348.   else call ItlSay 'Deleting ACP for' PhysPath'...'
  3349. Res = Itl!!RunCmd('NET ACCESS' PhysPath '/DELETE')
  3350. /**** PTR 10241 start ****/
  3351. if pos('SYS0005', Res) > 0
  3352.   then call ItlErr 'Access denied modifying access control.  The',
  3353.       'userid and password being may not have administrator',
  3354.       'authority on the domain controller.'
  3355. /**** PTR 10241 end ****/
  3356. if DelTree
  3357.   then do
  3358.     PreQ = queued()
  3359.     'NET ACCESS' PhysPath '/TREE 2>&1 | RXQUEUE /FIFO'
  3360.     do while queued() > PreQ
  3361.       pull Line '('
  3362.       if abbrev(Line, PhysPath)
  3363.         then call Itl!!RunCmd 'NET ACCESS' strip(Line) '/DELETE'
  3364.     end
  3365.   end
  3366. return 0
  3367.  
  3368. ITL!COREINSTMSGBOX: procedure expose (Globals)
  3369. parse arg Title, Msg
  3370. App = 'CREQINST'
  3371. NoInt = value('COU.NOINT',,'OS2ENVIRONMENT') <> ''
  3372. VState = Imp.0Verbose
  3373. Imp.0Verbose = \(NoInt)
  3374. call ItlSay '[' Title ']'
  3375. call ItlSay Msg
  3376. Imp.0Verbose = VState
  3377. if \NoInt
  3378.   then do
  3379.     call rxOS2Ini 'USER', App, 'CMD', 'MSGBOX|INFO|'Title'|'Msg||d2c(0)
  3380.     say '[*CMD*]'
  3381.     do until Done
  3382.       call rxsleep 1
  3383.       Done = (IniGet('USER', App, 'CMD') = '')
  3384.     end
  3385.   end
  3386. return 0
  3387.  
  3388. ITL!!RUNCMD: procedure expose (Globals)
  3389. parse arg Cmd
  3390. call ItlSay 'Executing "'Cmd'"...'
  3391. PreQ = queued()
  3392. Res = ''
  3393. Cmd '2>&1 | RXQUEUE /FIFO'
  3394. if queued() > PreQ
  3395.   then do
  3396.     do PreQ    /* Shuffle previously queued lines to bottom */
  3397.       parse pull Line
  3398.       queue Line
  3399.     end
  3400.     do while queued() > PreQ
  3401.       parse pull Line
  3402.       Res = Res||Line||'0'x
  3403.       call ItlSay '>' Line
  3404.     end
  3405.   end
  3406. call ItlSay '> RC('rc')'
  3407. return Res
  3408.  
  3409. /*****************************************************************************
  3410.  * LookUp                                                                    *
  3411.  *****************************************************************************/
  3412. LookUp: procedure expose (Globals)
  3413. /* trace value imp.0trval */
  3414. parse arg Str
  3415. TStr = translate(Str)
  3416. if Imp.0StrRep & verify(TStr, Imp.0RepStart, 'MATCH') <> 0
  3417.   then do I = 1 to Imp.0Org.0
  3418.     if pos(Imp.0Org.I, translate(Str)) <> 0
  3419.       then do
  3420.         Temp = Imp.0Org.I
  3421.         Str = ChangeStr(Str, Imp.0Org.I, value('IMP.0REP.TEMP'), 'ALL', 'LEFT')
  3422.       end
  3423.   end
  3424.  
  3425. FuncList = 'VAL ENV RESULT INIVAL GETLINE COUINFO'
  3426. ScanStart = 1
  3427. AmpPos = pos('&', Str)
  3428. do while AmpPos <> 0
  3429.   P1 = left(Str, AmpPos - 1)
  3430.   P2 = substr(Str, AmpPos + 1)
  3431.   parse upper var P2 Func '('
  3432.   if Func = '' | left(Func, 1) = ' ' | right(Func, 1) = ' ' |,
  3433.       wordpos(Func, FuncList) = 0
  3434.     then do
  3435.       ScanStart = AmpPos + 1
  3436.       AmpPos = pos('&', Str, ScanStart)
  3437.       iterate
  3438.     end
  3439.   if pos(')', P2) = 0
  3440.     then call ITLErr 'Closing parenthesis not found.'
  3441.   parse var P2 '(' FuncArg ')' P2
  3442.   select
  3443.     when Func = 'VAL'
  3444.       then do
  3445.         FuncArg = translate(FuncArg)
  3446.         if symbol('IMP.0REP.FUNCARG') = 'VAR'
  3447.           then FuncArg = Imp.0Rep.FuncArg
  3448.           else call ITLErr 'VAL:' FuncArg 'has not been defined.'
  3449.       end
  3450.     when Func = 'ENV'
  3451.       then do
  3452.         if pos('<', FuncArg) = 0
  3453.           then NullEnv = Imp.0NullEnv
  3454.           else parse var FuncArg FuncArg '<' NullEnv '>'
  3455.         FuncRes = value(FuncArg,,'OS2ENVIRONMENT')
  3456.         if FuncRes = ''
  3457.           then if NullEnv
  3458.             then call ITLSay "ENV: Variable" FuncArg "resolved to ''."
  3459.             else do
  3460.               call ITLErr 'ENV: Variable' FuncArg 'not defined.'
  3461.               FuncRes = FuncArg
  3462.             end
  3463.         FuncArg = FuncRes
  3464.       end
  3465.     when Func = 'RESULT'
  3466.       then if translate(FuncArg) = 'ERROR'
  3467.         then FuncArg = Imp.0Error
  3468.         else FuncArg = Imp.0ItlResult
  3469.     when Func = 'GETLINE'
  3470.       then FuncArg = GetLine(FuncArg)
  3471.     when Func = 'INIVAL'
  3472.       then do
  3473.         parse var FuncArg File '/' App '/' Key
  3474.         FuncArg = strip(rxOs2Ini(File, App, Key),,d2c(0))
  3475.         if abbrev(FuncArg, '$RXERROR')
  3476.           then FuncArg = ''
  3477.       end
  3478.     when Func = 'COUINFO'
  3479.       then FuncArg = GetCouInfo(FuncArg)
  3480.     otherwise call ITLErr 'Unknown ITL function:' Func'.'
  3481.   end
  3482.   Str = P1||FuncArg||P2
  3483.   AmpPos = pos('&', Str, ScanStart)
  3484. end
  3485. return Str
  3486.  
  3487. GetCouInfo: procedure expose (Globals)
  3488. signal on syntax name GetCouInfo2
  3489. Res = rxCouInfo('GET', arg(1))
  3490. return Res
  3491.  
  3492. GetCouInfo2:
  3493. call ItlErr 'Bad COUINFO parameter "'arg(1)'".'
  3494. return ''
  3495.  
  3496. /*****************************************************************************
  3497.  * ITLSAY msg                                                                *
  3498.  *****************************************************************************/
  3499. ITLSay: procedure expose (Globals)
  3500. parse arg Msg.1, Force
  3501. Msg.1 = translate(Msg.1, ' ', '0'x)
  3502. if Imp.0Verbose | (Force = 'FORCE')
  3503.   then say Msg.1
  3504. if Imp.0ITLLog <> ''
  3505.   then do
  3506.     Msg.0 = 1
  3507.     Msg.1 = Imp.0PC':'Msg.1
  3508.     RetC = rxWrite(Imp.0ITLLog, 'MSG.',,,'A')
  3509.     if RetC <> 0
  3510.       then call ITLErr 'Error' RetC 'writing to' Imp.0ITLLog'.'
  3511.   end
  3512. return 0
  3513.  
  3514. /*****************************************************************************
  3515.  * ITLERR emsg                                                               *
  3516.  *****************************************************************************/
  3517. ITLErr: procedure expose (Globals)
  3518. parse arg Msg.1
  3519. signal off novalue
  3520. Msg = Msg.1
  3521. Msg.1 = '(line' Imp.0PC')' Msg.1
  3522. if Imp.0ITLLog <> ''
  3523.   then do
  3524.     Msg.0 = 1
  3525.     RetC = rxWrite(Imp.0ITLLog, 'MSG.',,,'A')
  3526.     if RetC <> 0
  3527.       then say 'Error' RetC 'writing to' Imp.0ITLLog' - Logging disabled.'
  3528.   end
  3529. if Imp.0ErrorMode <> 'QUIET'
  3530.   then say Msg.1
  3531. if Imp.0ErrorMode = 'RESULT'
  3532.   then Imp.0Error = Msg
  3533. if Imp.0ErrorMode = 'HALT'
  3534.   then call ImpError ''
  3535. return 0
  3536.  
  3537. /*****************************************************************************
  3538.  *                              ERROR HANDLERS                               *
  3539.  *****************************************************************************/
  3540. Halt:
  3541. Where = SigL
  3542. /**
  3543. call off halt
  3544. if abbrev(stream('STDIN:', 'C', 'CLOSE'), 'READY')
  3545.   then Response = AskUser('Halt detected.  Do you want to abort?',,
  3546.       'NO YES', 1, 0)
  3547.   else do
  3548.     Response = 'NO'
  3549.     say 'Could not close stdin.  Unconditional abort.'
  3550.   end
  3551. if Response = 'NO'
  3552.   then call on halt
  3553.   else do
  3554. **/
  3555.     say 'Execution halted by user at line' Where'.'
  3556.     exit 255
  3557. /**
  3558.   end
  3559. **/
  3560. return
  3561.  
  3562. ITLSyntax:
  3563. Syntax:
  3564. signal off error; signal off failure; signal off halt
  3565. signal off novalue; signal off notready; signal off syntax
  3566. if arg(1) = d2c(0)
  3567.   then Where = arg(2)
  3568.   else Where = SigL
  3569. /**
  3570. call BugInit
  3571. **/
  3572. select
  3573.   when Syntax.Ref = 'NOCOUENV'
  3574.     then Msg999 = '>> COUENV.DLL not found.'
  3575.   otherwise
  3576.     Msg999 = '>> Syntax error' rc '('errortext(rc)') raised in line' Where
  3577. end
  3578. signal DebugExit
  3579.  
  3580. Novalue:
  3581. Where = SigL
  3582. signal off error; signal off failure; signal off halt
  3583. signal off novalue; signal off notready; signal off syntax
  3584. Msg999 = '>> Novalue error' condition('D') 'raised in line' Where
  3585. signal DebugExit
  3586.  
  3587. DebugExit:
  3588. if Imp.!ItlActive = 1
  3589.   then do
  3590.     Imp.0ErrorMode = 'CONTINUE'
  3591.     call ItlErr Msg999
  3592.   end
  3593.   else say Msg999
  3594. Line = sourceline(Where)
  3595. say 'Line reads: "'Line'"'
  3596. if wordpos('EXPR', translate(Line)) > 0
  3597.   then say 'Expr =' Expr
  3598. say
  3599. say 'Please notify the developers!  Press <Enter> to exit.'
  3600. if translate(linein('STDIN:')) = '/D'
  3601.   then do
  3602.     trace ?i
  3603.     nop
  3604.   end
  3605. exit 255
  3606.  
  3607. /*
  3608.  * Change History:
  3609.  * (Previous history in \COREUTIL\IMPIT.HST)
  3610.  * 30 Sep 91 - 2.20 - Remove CMD file tokenization
  3611.  *                  - bug fix - multiple ITL files mangled string lookup table.
  3612.  *                  - bug fix - standalone & in boolean seen as function start.
  3613.  * 15 Oct 91 - 2.21 - bug: ITL CMD not inserting unique lines.
  3614.  *                  - SAY not being added to log file.
  3615.  *                  - bug: DELFILE syntax error
  3616.  *                  - change default setting for 0NullEnv to 1.
  3617.  *                  - Force INSLINE value to be inside file range.
  3618.  *                  - SOURCE.DIR not correct path to ITL file.
  3619.  * 16 Oct 91 - 2.22 - Add &INIVAL() function.
  3620.  *                  - Add support for wild cards to REPLACEFILE.
  3621.  *                  - bug: force INSLINE value to be at least 1.
  3622.  *                  - bug: adding line at EOF added it at line EOF-1.
  3623.  *                  - changed EVAL to handle calls which don't return a value.
  3624.  *                  - Give better error message for no closing parenthesis.
  3625.  *                  - Pause before exiting on ITL errors.
  3626.  * 13 Nov 91 - 2.23 - Add OPTIONS EXITPAUSE.
  3627.  *  2 Jan 92        - Fix COMPUTERNAME for OS/2 2.0.
  3628.  * 27 Jan 92 - 2.24 - Add {BOOT.DRIVE} replace string.
  3629.  *  3 Feb 92 - 2.25 - Correct BOOT.DRIVE for down-level systems.
  3630.  *  3 Mar 92 - 2.26 - bug: FINDIT could die if lines were deleted in FindNext loop.
  3631.  *  6 Mar 92 - 2.27 - bug: REPFILE would not create files in root directory.
  3632.  * 10 Mar 92 - 2.28 - Add /NOPAUSE option to force no pause on exit.
  3633.  *                  - Add error checking in ADDINI.
  3634.  * 19 Mar 92 - 2.29 - bug: CHANGEPATH w/ target could cause syntax error.
  3635.  *                  - bug: WRITEFILE n kept n+1 backup copies.
  3636.  *                  - Make informed guess if 2.0 boot drive can't be determined.
  3637.  * 26 Mar 92 - 2.30 - Add {OS2VER} Replace String.
  3638.  *  3 Apr 92        - ADDINI was not uppercasing file name before checking.
  3639.  *  6 Apr 92 - 2.31 - Add DELP/DELPROGRAM to delete program entry.
  3640.  *                  - Add FORCE option to CP to delete and readd entry.
  3641.  * 22 Apr 92 - 2.32 - bug: DelPath died if dir entry was first in path.
  3642.  *                  - Mark current line in ECHOFILE display.
  3643.  *                  - bug: Targets on INSUNIQUE were getting ignored.
  3644.  * 25 Apr 92        - Strip trailing backslash, if needed, from CP insertions.
  3645.  *  8 May 92        - Add RXCADD initialization, if available.
  3646.  * 18 May 92 - 2.33 - bug: REMLINE would add REM even if it already existed.
  3647.  *                  - EOF before ENDIF did not raise an error condition.
  3648.  * 20 May 92        - Remove all hardcoded C: occurances.
  3649.  * 21 May 92   2.34 - Add more RXCADD support.
  3650.  *                  - Add INIGET and INISET IMP functions.
  3651.  *                  - Add ADDLOCAL and DELLOCAL ITL functions.
  3652.  *                  - Add DIR= option to ITL DELFILE function.
  3653.  *                  - Add REMOVE option to ITL ENVVAR function.
  3654.  *                  - Add NOCONF parameter to ASK.
  3655.  * 23 Jun 92        - Add workaround for NOVALUE error in REXX20 2.01.
  3656.  *  7 Jul 92        - Reworked InsUnique prefix processing to handle RUN=
  3657.  *                    and CALL= properly.
  3658.  * 14 Jul 92        - Make comments generated by our code look nicer.
  3659.  * 15 Jul 92        - bug: 14 Jul mod broke InsUnique.
  3660.  *                  - Allow ".." delimitters to arguments to enclose leading/
  3661.  *                    trailing spaces.
  3662.  *                  - Translate nulls to spaces in ITLSAY.
  3663.  * 28 Jul 92        - bug: {SOURCE.DIR} repstr not always set properly.
  3664.  *                  - bug: REPFILE (ITL) did not report all errors returned by
  3665.  *                    REPLACEFILE (IMP).
  3666.  *  5 Jul 92        - Add DPATH searching for ITL file.
  3667.  *                  - bug: Incorrect interpreter error when ADDP nested in IF stmt.
  3668.  * 11 Aug 92        - Display IMP version at startup.
  3669.  * 13 Aug 92        - Added LOWER (5th) parameter to ASK.
  3670.  * 26 Aug 92 - 2.35 - bug: INSPATH "AFTER target" placed entry incorrectly if target
  3671.  *                    did not exist.
  3672.  *                  - Add multiple targets to INSPATH.
  3673.  *                  - Add REPLACEONLY and NEWONLY options to IMP InsUnique and ITL
  3674.  *                    COMMAND.
  3675.  * 17 Sep 92        - Ignore double quotes in ITL MD directory specification.
  3676.  *  1 Oct 92        - READFILE returned too early if file empty.
  3677.  *  5 Oct 92 - 2.36 - AddObject added for OS/2 2.0 systems.
  3678.  *                  - AddProgram calls converted to ADDOBJ calls on 2.0 systems.
  3679.  *                  - bug: Recursive call to CP would not find traget line.
  3680.  * 19 Oct 92 - 2.37 - Allows ITL commands to be run from the REXX queue.
  3681.  *                  - Adds (undocumented) DELETE option to REMALL.
  3682.  * 29 Oct 92        - Add SYNCH nop for later implementation.
  3683.  * 10 Dec 92 - 2.38 - Remove RXCADD knowlegde.  Direct ITL calls not supported from
  3684.  *                    COREADD.
  3685.  * 18 Dec 92 - 2.39 - bug: WF before RF would cause novalue error.
  3686.  *                  - bug: CMD at TOP would break REXX execs
  3687.  *                  - TOP now goes to 1st non-comment line.  Use 1 for line 1.
  3688.  *                  - bug: ImpError novalue error under some conditions.
  3689.  *  4 Jan 93        - bug: NOVALUE error when ITL embedded in a CMD file.
  3690.  * 18 Jan 93        - bug: WF would fail if file had attributes of R, S, or H.
  3691.  *                  - WF now preserves attributes of file.
  3692.  *                  - WF preserves EAs of original object.
  3693.  *                  - bug: COREDATA used wrong default for CORE.INI location.
  3694.  *  1 Feb 93 - 2.40 - Extend AddLocal to take one filename.
  3695.  *  5 Mar 93        - bug: FORCE on CP had to be in exact case.
  3696.  *                  - bug: REMALL could set mod flag when no mod occurred.
  3697.  *                  - bug: InsString always inserted at end.
  3698.  *  7 Mar 93 - 2.41 - Add AddLocalFiles and DelLocalFiles routines.
  3699.  * 15 Mar 93        - Add PATH & DPATH support to InsPath, DelPath for BATCH types.
  3700.  * 18 Mar 93        - REMALL was returning wrong return code.
  3701.  * 19 Mar 93        - Add NAME=xxx backup type.
  3702.  *  1 Apr 93        - ImpError now writes to ITL log if ITL is active.
  3703.  *                  - Readd undocumented DELETE option to REMALL.
  3704.  * 20 Apr 93        - Allow trailing semicolon on CP dir spec.
  3705.  * 27 Apr 93 - 2.42 - Add COREINST private routines.
  3706.  *                  - Add &COUINFO function.
  3707.  *                  - RF and READFILE were incorrectly handling empty files.
  3708.  * 10 May 93        - bug: empty paths not handled correctly by InsPath.
  3709.  *                  - bug: DelPath mishandled missing semicolon.
  3710.  * 21 May 93 - 2.43 - bug: InsUnique was not handling similar prefixes.
  3711.  *  1 Jun 93        - use RXCOUENV to obtain CORE information.
  3712.  *  4 Jun 93 - 2.44 - Update CopyFile to support RXCOUCOPY.
  3713.  * 28 Jun 93        - bug: RemAll/RemLine would rem REMs.
  3714.  *  7 Jul 93 - 2.45 - disable saving of EAs under OS/2 2.x.
  3715.  *  5 Aug 93        - bug: NUMCHECK died if param missing from file.
  3716.  * 17 Aug 93        - bug: Lowercase call to CP DELETE would fail.
  3717.  * 18 Mar 94        - bug: Changing SET HELP would modify HELPINDEX if it came
  3718.  *                    first in the file.
  3719.  * 31 May 94 - 2.46 - bug: PATH xxx (without equals sign) not handled properly
  3720.  *                    in AUTOEXEC.BAT file.
  3721.  */
  3722.