/*****************************************************************************
 *                       IMPIT - IMP Installation Tool                       *
 *                 T. Bridgman / T. Rogers - CORE at WATSON                  *
 *                   (Change history is at bottom of file)                   *
 *****************************************************************************
 *                    Licensed Materials-Property of IBM                     *
 *               5604-472 (c) Copyright IBM Corporation, 1993                *
 *                           All rights reserved.                            *
 *                  US Government Users Restricted Rights -                  *
 *                 Use, duplication or disclosure restricted                 *
 *                by GSA ADP Schedule Contract with IBM Corp.                *
 *****************************************************************************/
trace 'O'
trace 'E'
call   on halt
signal on novalue
signal on syntax
Globals = 'Opts. Imp. File.'

parse source . How .
Opts. = 0
Opts.!CmdMode = (How = 'COMMAND')
if Opts.!CmdMode
  then do
    say
    say 'ITL Interpreter'
  end
parse arg File.0In Extra '/' Opts
Rtn = 'IMPIT'
if abbrev(File.0In, '?') | Extra <> ''
  then signal Tell

call Initialize
call AddImp
call Msg 'ImpIt complete.'
exit 0

Initialize: procedure expose (Globals) Opts Opts.
Opts.0Echo = 'VERBOSE'
Opts.0NoPause = \Opts.!CmdMode
do while Opts <> ''
  parse upper var Opts OKey '/' Opts
/**** PTR 10249 start ****/
  parse var OKey OKey Extra ':' OVal
  if OVal = ''
    then OVal = Extra
    else if Extra <> ''
      then say 'Warning: Unexpected argument "'Extra'" ignored.'
/**** PTR 10249 end ****/
  OVal = strip(OVal)
  select
    when abbrev('FORCE', OKey)
      then Opts.0Force = 1
    when abbrev('UPDATE', OKey)
      then Opts.0Update = 1
    when abbrev('RUN', OKey)
      then do
        Opts.0Run = 1
        Opts.0RunFile = OVal
      end
    when abbrev('NOBACKUP', Okey)
      then Opts.0NoBackup = 1
    when OKey = 'COREFIX' | OKey = 'NOPAUSE'
      then Opts.0NoPause = 1
    otherwise
      call EMsg 'Unrecognized option' OKey OVal 'specified.'
  end
end

call ImpInit
if Opts.!CmdMode
  then do
    say 'Version' ImpVersion()
    say
  end

if Opts.0Run
  then do
    OutC = RunTagFile(Opts.0RunFile)
    if \Opts.0NoPause
      then call rxPause 'Installation complete.  Press any key to exit.'
    exit OutC
  end
if File.0In = ''
  then signal Tell

say 'IMP Installation Tool'
File.0Backup = XFilespec('QPATH', File.0In)
if File.0Backup = ''
  then File.0Backup = '.'

if \rxFileExist(File.0In)
  then if rxFileExist(File.0In'.CMD')
    then File.0In = File.0In'.CMD'
    else call EMsg 'Input file' File.0In 'does not exist.'
call Msg 'Reading' File.0In'...'
call ReadFile File.0In
if result <> 0
  then say 'Error' result 'reading file.'
return 0

AddImp: procedure expose (Globals)
if Find(':IMP:', 'ALL+') = 0
  then do
    parse value GetLine() with ':IMP:' PgmVer ':'
    if PgmVer = ImpVersion() & \Opts.0Force
      then call EMsg File.0In 'already contains IMP' PgmVer 'routines.'
    call Msg 'Deleting IMP' PgmVer 'routines...'
    call DelBlock '.', 'BOTTOM'
  end
  else if Find('IMPINIT:', 'ALL+', 'BEGIN') = 0
    then call EMsg 'IMP header not found, but IMP routines seem to be',
        'present.  Check file and try again.'
    else if Opts.0Update
      then call EMsg File.0In 'does not contain IMP routines.'

do II = Imp.0File.0 to 1 by -1
  if Imp.0File.0 <> ''
    then leave
end
if Opts.0NoBackup
  then BkUp = 'NOBACKUP'
  else BkUp = 2
RetC = WriteFile(File.0Backup, BkUp, Opts.0Echo)

if SetCurL('BOTTOM') = 255
  then call EMsg File.0In 'does not contain a program.'
RetC = rxRead(Imp.0Me, 'IMPIT')
RetC = rxGrep(':IMP:'ImpVersion()':', Imp.0Me, 'TEMP', 'N')
parse var Temp.1 L1 .
call Msg 'Adding IMP' ImpVersion() 'routines...'
L1 = L1 - 1
ImpIt.L1 = ''
RetC = rxWrite(File.0In, 'IMPIT', ImpIt.0, L1, 'A')
call Msg File.0In 'written successfully.'
/**
call Msg 'Tokenizing file...'
'CALL' File.0In '//T'
**/
return 0

Msg:
parse arg Msg
if Opts.0Echo = 'VERBOSE'
  then say Msg
return 0

EMsg:
parse arg Msg
say Msg
exit 2

Tell:
say
say ' IMPIT - ITL Interpreter'
say
say ' Syntax:  IMPIT /R:itlfile [/NOPAUSE]'
say
say ' itlfile  - ITL program to execute.'
say ' /NOPAUSE - Don''t pause after execution.'
if abbrev(File.0In, '??') then do
say
say copies('-', 79)
say ' IMPIT as IMP Routine Installation Tool'
say
say ' Syntax:  IMPIT sourcefile [/Force] [/Update] [/NOBACKUP]'
say
say ' /Force    - Force IMP update even if version number hasn''t changed.'
say ' /Update   - Update IMP routines only if they exist.'
say ' /NOBACKUP - Don''t make a backup of sourcefile.'
end
exit 0

/** :IMP:2.46: **************************************************************
 *                                                                          *
 * Installation/Modification Routines (IMP)                                 *
 *                                                                          *
 ****************************************************************************/
call ImpError 'No exit statement in IMP program!'

/****************************************************************************
 * IMPINIT                                                                  *
 * Initialize RXUTILS if they are not initialized.                          *
 * Initialize REXXUTIL if running under OS/2 2.0.                           *
 * Initialize IMP control variables (all under IMP. stem):                  *
 *  0Init      IMPINIT performed flag;  set to 1                            *
 *  0Mod       Buffer modified flag;  set to 0                              *
 *  0FileName  Name of file in buffer (null if no file)                     *
 *  0BackDir   Name of backup directory (null if not specified)             *
 *  0BackType  Type of backup (UNIQUE, nnn)                                 *
 *  0CurL      Ptr to file buffer;  set to 1                                *
 *  0Version   IMP version number (x.yy)                                    *
 *  0File.     The file buffer                                              *
 *  0Me        Name of the running program                                  *
 *  0BTypes    List of valid backup types                                   *
 *  0Digits    0-9                                                          *
 ****************************************************************************/
ImpInit:
Rtn = 'ImpInit'
if symbol('GLOBALS') = 'LIT'
  then Globals = 'Imp.'
  else do
    Adds = 'Imp.'
    do while Adds <> ''
      parse upper var Adds Add Adds
      if wordpos(Add, translate(Globals)) = 0
        then Globals = Globals Add
    end
  end

parse upper arg InFile, Imp.0BackDir, Imp.0BackType

if value('IMP.0INIT') = 1             /* Previous init */
  then call ImpError 'Multiple calls to IMPINIT.'
Imp.0BTypes = 'UNIQUE NAME'
Imp.0Digits = '0123456789'
if Imp.0BackType <> ''
  then if \CheckBackupType(Imp.0BackType)
    then call ImpError 'Bad argument:' Imp.0BackType

call RxUtilsInit
'@ECHO OFF'
Imp.0Mod      = 0
Imp.0Init     = 1
Imp.0PosStack = ''
Imp.0FileName = ''
Imp.0Verbose  = 0
Imp.0StrRep   = 1
if symbol('OPTS.0NOPAUSE') = 'VAR'
  then Imp.0ErrPause = \Opts.0NoPause
  else Imp.0ErrPause = 0
if rxUtilsVer() >= 1.70
  then Imp.0BDr = rxBootDrive()
  else if rxOS2Ver() < 2.0
    then Imp.0BDr = 'C:'
    else Imp.0BDr = left(value('COMSPEC',,'OS2ENVIRONMENT'), 2)
parse upper source . . Imp.0Me
RetC = rxGrep(':IMP:', Imp.0Me, 'TEMP')
do I = 1 to Temp.0
  parse var Temp.I ':IMP:' Imp.0Version ':'
  if datatype(Imp.0Version) = 'NUM'
    then leave
end

if Imp.0BackDir <> ''
  then if \CheckBackupDir(Imp.0BackDir)
    then do
      say 'Backup directory' Imp.0BackDir 'not found.  Using' Imp.0BDr 'instead.'
      Imp.0BackDir = Imp.0BDr
    end
if Imp.0BackType = ''
  then Imp.0BackType = 'U'
if InFile <> ''
  then do
    OutC = ReadFile(InFile)
    Imp.0CurL = 1
  end
  else do
    Imp.0File.0 = 0
    Imp.0CurL = 0
    OutC = 255
  end
return OutC

/****************************************************************************
 * IMPITLINIT                                                               *
 * Add variables for ITL support.                                           *
 ****************************************************************************/
ImpITLInit: procedure expose (Globals)
parse upper arg ModFileSpec ., OtherArgs
Imp.!ITLActive = 1
if ModFileSpec = 'QUEUE'
  then do
    parse var OtherArgs Who PreQ .
    if Who = ''
      then call ImpError 'Caller not specified on /R:QUEUE.'
    if PreQ = ''
      then PreQ = 0
    if queued() <= PreQ
      then call ImpError 'No lines queued.'
    do I = 1 while queued() > PreQ
      parse pull Imp.0Mods.I
    end
    Imp.0Mods.0 = I-1
    Imp.0ItlMe = Who
    Imp.!QItlMe = ''
    Opts.0NoPause = 1
  end
  else do
    if rxFileExist(ModFileSpec)
      then ModFile = ModFileSpec
      else if rxFileExist(ModFileSpec'.ITL')
        then ModFile = ModFileSpec'.ITL'
        else do
          ModFile = rxSearchPath('DPATH', ModFileSpec)
          if ModFile = ''
            then ModFile = rxSearchPath('DPATH', ModFileSpec'.ITL')
        end
    if ModFile = ''
      then call ImpError 'ITL file' ModFileSpec 'does not exist.'

    Imp.0ItlMe = XFileSpec('NAME', ModFile)
    call rxTree ModFile, 'TEMP.', 'FO'
    Imp.!QITLMe = Temp.1
    call RxRead ModFile, 'Imp.0Mods'
  end

Imp.0Verbose   = 0       /* No verbose messages */
Imp.0StrRep    = 0       /* String replacement off */
Imp.0ErrorMode = 'HALT'  /* Halt on error */
Imp.0Error     = ''      /* Error result */
Imp.0TrVal     = 'O'     /* Tracing off */
Imp.0ItlResult = ''      /* Result from EVAL */
Imp.!ItlZipDir = '.'     /* Zip file directory */
if symbol('IMP.0ORG.0') = 'VAR'
  then do II = 1 to Imp.0Org.0
    Var = Imp.0Org.II
    drop Imp.0Rep.Var
  end
Imp.0Org.0 = 0           /* Source replace strings */

/*
Imp.0Rep.0 = 0           /* Target replace strings */
*/
Imp.0RepStart = '{'      /* List of start characters of replace strings */
Imp.0IfStack.0 = 0
Imp.0IfScan = 0
Imp.0ITLLog = ''         /* Name of log file */
Imp.0NullEnv = 1         /* Null env var error flag */

call ITLReplaceStringAdd '{NULL}', d2c(0)
call ITLReplaceStringAdd '{SOURCE.DIR}', XFileSpec('QPATH', Imp.!QItlMe)
call ITLReplaceStringAdd '{COMMA}', ','
call ITLReplaceStringAdd '{SP}', ' '
call ITLReplaceStringAdd '{AMP}', '&'
call ITLReplaceStringAdd '{OS2VER}', rxOs2Ver()
call ITLReplaceStringAdd '{BOOT.DRIVE}', Imp.0BDr

call ITLReplaceStringAdd2 '{CMLIB.DRIVE}',,
    left(rxSearchPath('PATH', 'STARTCM.CMD'), 2)
LDr = left(rxSearchPath('PATH', 'NET.EXE'), 2)
if LDr <> '' then do
  call ITLReplaceStringAdd '{IBMLAN.DRIVE}', LDr
  call RxGrep 'COMPUTERNAME =', LDr'\IBMLAN\IBMLAN.INI', 'GStem.'
  if GStem.0 <> 0 then do
    parse var GStem.1 'COMPUTERNAME =' Req .
    call ITLReplaceStringAdd '{WKSNAME}', Req
  end
end
else do
  call ITLReplaceStringAdd '{WKSNAME}', ''
  call ITLReplaceStringAdd '{DOMNAME}', ''
end

/**** PTR 10128 start ****/
call ITLReplaceStringAdd '{CORE.INI}', CoreData('COREINI')
call ITLReplaceStringAdd '{NETDOOR.INI}', CoreData('COREINI')
call ITLReplaceStringAdd '{CORE.DIR}', CoreData('COREDIR')
call ITLReplaceStringAdd '{NETDOOR.REMOTE}', CoreData('COREDIR')
call ITLReplaceStringAdd '{USER.DIR}', CoreData('USERDIR')
call ITLReplaceStringAdd '{NETDOOR.LOCAL}', CoreData('USERDIR')
call ITLReplaceStringAdd '{USER.DATA}', CoreData('DATADIR')
call ITLReplaceStringAdd '{NETDOOR.DATA}', CoreData('DATADIR')
call ITLReplaceStringAdd '{TEMP.DIR}', CoreData('TEMPDIR')
call ITLReplaceStringAdd '{NETDOOR.TEMP}', CoreData('TEMPDIR')
call ITLReplaceStringAdd '{IMP.VERSION}', Imp.0Version
/**** PTR 10128 end ****/
return 0

/****************************************************************************
 *ITLREPLACESTRINGADD source, target                                        *
 ****************************************************************************/
ITLReplaceStringAdd: procedure expose (Globals)
parse arg Source, Target
if Source = ''
  then call ITLErr 'Null source string specified.'
  else do
    Source = translate(strip(Source))
    if pos(left(Source, 1), Imp.0RepStart) = 0
      then Imp.0RepStart = Imp.0RepStart||left(Source, 1)
    if symbol('IMP.0REP.SOURCE') = 'LIT'
      then call rxStemInsert 'Imp.0Org.', Imp.0Org.0 + 1, Source
    Imp.0Rep.Source = Target
  end
return 0

ITLReplaceStringAdd2: procedure expose (Globals)
parse arg Source, Target
return ITLReplaceStringAdd(Source, strip(Target))

/****************************************************************************
 * CHECKBACKUPTYPE                                                          *
 * Check for valid backup type - return 1 if good 0 o/w                     *
 ****************************************************************************/
CheckBackupType: procedure expose (Globals)
parse arg BackType '=' BackArg
GoodType = (verify(BackType, Imp.0Digits) = 0) | BackType = 'NOBACKUP'
do I = 1 to words(Imp.0BTypes) while \GoodType
  GoodType = abbrev(word(Imp.0BTypes, I), BackType)
end
if GoodType & abbrev('NAME', BackType)
  then GoodType = (BackArg <> '')
return GoodType

/****************************************************************************
 * CHECKBACKUPDIR                                                           *
 * Check for existing backup drive - return 1 if good 0 o/w                 *
 ****************************************************************************/
CheckBackupDir: procedure expose (Globals)
parse arg Dir .
return rxDirExist(Dir) | Dir = '.'

/****************************************************************************
 * RXUTILSINIT                                                              *
 * Register all RXUTILS functions if they don't appear to be registered.    *
 * Register all REXXUTILS functions if we're on 2.0.                        *
 ****************************************************************************/
RxUtilsInit: procedure expose (Globals)
Rtn = 'RxUtilsInit'
if rxfuncquery('RXLISTFUNCS')
  then do
    call rxfuncadd 'RXUTILSVER', 'RXUTILS', 'RXUTILSVER'
    if rxfuncquery('RXUTILSVER')
      then call ImpError 'RXUTILS not available or downlevel.'
      else do
        Temp = rxUtilsVer()
        if Temp < 1.70
          then call ImpError 'RXUTILS version 1.70 required,' Temp 'found.'
      end

    call rxfuncadd 'RXLISTFUNCS', 'RXUTILS', 'RXLISTFUNCS'
    call rxListFuncs 'LIST'
    do I = 1 to words(List)
      Func = word(List, I)
      call rxfuncadd Func, 'RXUTILS', Func
    end
  end

call rxfuncadd 'RXCOUINFO', 'COUENV', 'RXCOUINFO'
Syntax.Ref = 'NOCOUENV'
call rxCouInfo 'VER'
drop Syntax.Ref

call rxfuncadd 'RXCOUCOPY', 'COUCOPY', 'RXCOUCOPY'
call rxfuncadd 'RXCOUDELETE', 'COUCOPY', 'RXCOUDELETE'
call rxfuncadd 'RXCOUDELETEALL', 'COUCOPY', 'RXCOUDELETEALL'
call rxfuncadd 'RXCOUASSOCIATEAPPFILE', 'COUCOPY', 'RXCOUASSOCIATEAPPFILE'
call rxfuncadd 'RXCOUREMOVEAPPFILE', 'COUCOPY', 'RXCOUREMOVEAPPFILE'
return 0

/****************************************************************************
 * ADDLOCALFILES - Add to local file list                                   *
 *   1.  Ini, App, 'AUTOUP', LocFile, SrcFile                               *
 *   2.  Ini, App, LocFile                                                  *
 *   3.  Ini, App, Dir, LocFileList                                         *
 ****************************************************************************/
AddLocalFiles: procedure expose (Globals)
Rtn = 'AddLocalFiles'
parse arg Ini, App, Dir, FileList, SrcFile
if Ini = '' | App = '' | Dir = ''
  then call ImpError 'Invalid arguments.'
AutoUp = (translate(Dir) = 'AUTOUP')
if AutoUp
  then if FileList = '' | SrcFile = ''
    then call ImpError 'Invalid arguments.'
    else do
      Dir = FileList
      FileList = ''
    end
if FileList = ''
  then if rxFileExist(Dir)
    then do
      FileList = filespec('NAME', Dir)
      Dir = XFileSpec('QPATH', Dir)
    end
    else call ImpError 'Local file' Dir 'does not exist.'
App = translate(App)
if right(Dir, 1) <> '\'
  then Dir = Dir'\'
List = IniGet(Ini, 'LocalFiles', App, 'ITLERREXIT ENDNULL')
Files = ''
Entry. = '?'
do while List <> ''
  parse var List Entry '0'x List
  parse var Entry Local '|' Src
  Entry.Local = Src
  Files = Files||Local'|'
end
do while FileList <> ''
  parse var FileList File FileList
  File = Dir||File
  if Entry.File = '?'
    then do
      Entry.File = SrcFile
      Files = Files'|'File
    end
    else if SrcFile <> '' & Entry.File <> SrcFile
      then Entry.File = SrcFile
end
List = ''
do while Files <> ''
  parse var Files File '|' Files
  if File <> ''
    then List = List||File'|'Entry.File'0'x
end
Res = IniSet(Ini, 'LocalFiles', App, List, 'ITLERREXIT')
return 0

/****************************************************************************
 * DELLOCALFILES - Delete locally installed files                           *
 ****************************************************************************/
DelLocalFiles: procedure expose (Globals)
Rtn = 'DelLocalFiles'
if arg() < 1 | arg() > 2
  then call ItlErr 'Invalid arguments.'

if arg() = 1
  then parse arg App
  else parse arg Ini, App
App = translate(App)
XC = 0

if arg() = 1
  then do
    Defer = 0
    Res = rxCouDeleteAll(App, Defer)
    if abbrev(Res, 'ERROR:')
      then XC = 100 + substr(Res, 7)
  end
  else do
    List = IniGet(Ini, 'LocalFiles', App, 'ITLERREXIT')
    Count = 0
    do while List <> ''
      parse var List File '0'x List
      parse var File File '|'
      if rxFileExist(File)
        then Res = rxDelete(File)
        else Res = 0
      if Res <> 0
        then Count = Count + 1
    end
    call rxOs2Ini Ini, 'LocalFiles', App, '$RXDEL'
    if Count > 0
      then XC = 1000 + Count
      else XC = 0
  end
return XC

/****************************************************************************
 * AT n | TOP | BOTTOM                                                      *
 ****************************************************************************/
At: procedure expose (Globals)
Rtn = 'AT'
if Imp.0File.0 = 0
  then return 255
parse arg Where
if Where = 'BOTTOM'
  then Where = Imp.0File.0
  else if Where = 'TOP'
    then Where = 1
if \datatype(Where, 'N')
  then call ImpError 'Invalid line number' Where'.'
return (Imp.0CurL = Where)

/****************************************************************************
 * CHANGE Target, New, Scope, Direction                                     *
 ****************************************************************************/
Change: procedure expose (Globals)
Rtn = 'CHANGE'
parse arg Target, New, Scope Ex1, Dir Ex2
if Scope = '' then Scope = 'FIRST'
if Dir = '' then Dir = 'LEFT'
if wordpos(Scope, 'FIRST ALL') = 0 | wordpos(Dir, 'LEFT RIGHT') = 0 | Ex1 Ex2 <> ''
  then call ImpError 'Bad arguments:' Scope',' Dir
if Imp.0File.0 = 0
  then return 255
CL = Imp.0CurL
Temp = ChangeStr(Imp.0File.CL, Target, New, Scope, Dir)
if Temp <> Imp.0File.CL
  then do
    Imp.0Mod = 1
    Imp.0File.CL = Temp
    return 0
  end
  else return 1
/**
WorkLine = Imp.0File.CL
if Dir = 'RIGHT'
  then do
    Target = reverse(Target)
    New = reverse(New)
    WorkLine = reverse(WorkLine)
  end
LT = length(Target)
Found = 0
do forever
  Temp = translate(WorkLine)
  Index = pos(Target, Temp)
  if Index = 0
    then leave
  Found = 1
  WorkLine = left(WorkLine, Index-1)||New||substr(WorkLine, Index + LT)
  if Scope <> 'ALL'
    then leave
end
if Dir = 'RIGHT'
  then Imp.0File.CL = reverse(WorkLine)
  else Imp.0File.CL = WorkLine
Imp.0Mod = Found
return \(Found)
*/

/****************************************************************************
 * CHANGESTR String, Target, New, Scope, Direction                          *
 ****************************************************************************/
ChangeStr: procedure expose (Globals)
Rtn = 'ChangeStr'
parse arg WorkLine, Target, New, Scope Ex1, Dir Ex2
if Scope = '' then Scope = 'FIRST'
if Dir = '' then Dir = 'LEFT'
if WorkLine = '' | Target = '' | wordpos(Scope, 'FIRST ALL') = 0 |,
    wordpos(Dir, 'LEFT RIGHT') = 0 | Ex1 Ex2 <> ''
  then call ImpError 'Bad arguments:' WorkLine',' Target',' Scope Ex1',' Dir Ex2
Target = translate(Target)
if Dir = 'RIGHT'
  then do
    Target = reverse(Target)
    New = reverse(New)
    WorkLine = reverse(WorkLine)
  end
LT = length(Target)
Found = 0
do forever
  Temp = translate(WorkLine)
  Index = pos(Target, Temp)
  if Index = 0
    then leave
  Found = 1
  WorkLine = left(WorkLine, Index-1)||New||substr(WorkLine, Index + LT)
  if Scope <> 'ALL'
    then leave
end
if Dir = 'RIGHT'
  then return reverse(WorkLine)
  else return WorkLine

/****************************************************************************
 * CMDCOMPARE cmd1, cmd2, ABBREV                                            *
 ****************************************************************************/
CmdCompare: procedure expose (Globals)
Rtn = 'CmdCompare'
parse upper arg Cmd.1, Cmd.2, Abbrev .
if Cmd.1 = ''
  then call ImpError 'Bad arguments: cmd not specified.'
Abbrev = abbrev('ABBREV', Abbrev)
if Cmd.2 = ''
  then Cmd.2 = translate(GetLine())
do I = 1 to 2
  Cmd.I = strip(Cmd.I, 'L')
  if abbrev(space(Cmd.I, 0), 'PATH=') | abbrev(space(Cmd.I, 0), 'DPATH=')
    then Cmd.I = 'SET' Cmd.I
  if word(Cmd.I, 1) = 'SET' & pos('=', Cmd.I) <> 0
    then do
      parse var Cmd.I A '=' B
      if pos('PATH', A) = 1
        then if right(strip(B), 1) <> ';'
          then B = strip(B)';'
      Cmd.I = space(A)'='||B
    end
    else if pos('=', Cmd.I) <> 0
      then do
        parse var Cmd.I A '=' B
        Cmd.I = space(A)'='space('B')
      end
      else Cmd.I = space(B)
end
if Abbrev
  then return (abbrev(Cmd.2, Cmd.1))
  else return (Cmd.1 = Cmd.2)

/****************************************************************************
 * COPYFILE source, destination, [opt], [appname]                           *
 ****************************************************************************/
CopyFile: procedure expose (Globals)
Rtn = 'COPYFILE'
parse arg Source, Dest, Opt .
Opt = translate(Opt)
if Source = '' | Dest = ''
  then call ImpError 'Bad aruments:  source and target must be specified.'
if verify(Source||Dest, '?*', 'M') > 0
  then call ImpError 'Bad aruments:  wild cards are not supported.'
if Opt <> '' & wordpos(Opt, 'NEWONLY REPLACEONLY COUCOPY') = 0
  then call ImpError 'Unrecognized option' Opt'.'
CouCopy = (Opt = 'COUCOPY')
if CouCopy
  then do
    parse arg , , , AppName ., AutoUp ., Defer .
    Defer = (Defer = 1)
    AutoUp = (AutoUp = 1)
  end
  else if pos('[', Source||Dest) > 0
    then call ImpError 'Invalid chars in source or target.'

XC = 0
if CouCopy
  then do
    Res = rxCouCopy(Source, Dest, Defer, AppName, AutoUp)
    if abbrev(Res, 'ERROR:')
      then XC = 100 + substr(Res, 7)
  end
  else do
    if right(Dest, 1) = '\' & length(Dest) <> 3
      then Dest = strip(Dest, 'T', '\')
    if rxDirExist(Dest)
      then Dest = strip(Dest, 'T', '\')'\'filespec('NAME', Source)
    select
      when Opt = 'NEWONLY'
        then CopyIt = \rxFileExist(Dest)
      when Opt = 'REPLACEONLY'
        then CopyIt = rxFileExist(Dest)
      otherwise
        CopyIt = 1
    end
    if CopyIt
      then CopyIt = rxFileExist(Source)
    if CopyIt
      then do
        'COPY /B' Source Dest '>NUL 2>&1'
        XC = (rc <> 0)
      end
  end
return XC

/****************************************************************************
 * COREDATA datatype                                                        *
 ****************************************************************************/
CoreData: procedure expose (Globals)
Rtn = 'CoreData'
parse upper arg Data .
TrailSlash = 1
select
  when Data = 'COREDIR'
    then Act = rxCouInfo('GET', 'REMOTE')
  when Data = 'DATADIR'
    then do
      Act = rxCouInfo('GET', 'DATA')
      TrailSlash = 0
    end
  when Data = 'TEMPDIR'
    then do
      Act = rxCouInfo('GET', 'TEMP')
      TrailSlash = 0
    end
  when Data = 'USERDIR'
    then Act = rxCouInfo('GET', 'LOCAL')
  when Data = 'COREINI'
    then do
      Act = rxCouInfo('GET', 'INIFILE')
      TrailSlash = 0
    end
  otherwise call ImpError 'Bad argument:' Data'.'
end
Act = translate(left(Act, 1))||substr(Act, 2)
if TrailSlash & right(Act, 1) <> '\'
  then Act = Act'\'
return Act

/****************************************************************************
 * CURLN                                                                    *
 ****************************************************************************/
CurLn: procedure expose (Globals)
Rtn = 'CurLn'
Imp.0CurL = min(Imp.0CurL, Imp.0File.0)
return Imp.0CurL

/****************************************************************************
 * DELBLOCK Start, End                                                      *
 ****************************************************************************/
DelBlock: procedure expose (Globals)
Rtn = 'DelBlock'
if Imp.0File.0 = 0
  then return 255
parse upper arg LStart, LEnd
if LStart = '.' | LStart = 'CURLN'   /* . = Compatibility w/ pre 2.14 */
  then LStart = Imp.0CurL
if LEnd = 'CURLN'
  then LEnd = Imp.0CurL
if datatype(LStart) <> 'NUM' | (datatype(LEnd) <> 'NUM' & LEnd <> 'BOTTOM')
  then call ImpError 'Bad arguments:' LStart',' LEnd
if LEnd = 'BOTTOM'
  then do
    Imp.0File.0 = LStart - 1
    Imp.0CurL = min(Imp.0CurL, LStart - 1)
  end
  else do I = min(LEnd, Imp.0File.0) to LStart by -1
    call rxStemDelete('IMP.0FILE', I)
  end
Imp.0Mod = 1
return 0

/****************************************************************************
 * DELLINE [BACKUP]                                                         *
 ****************************************************************************/
DelLine: procedure expose (Globals)
Rtn = 'DelLine'
parse upper arg Opt
if Imp.0File.0 = 0
  then RetC = 255
  else do
    RetC = rxStemDelete('IMP.0FILE', Imp.0CurL)
    if RetC <> 0 then call ImpError '*' RetC
    Imp.0CurL = min(Imp.0CurL, Imp.0File.0)
    if Opt = 'BACKUP'
      then if Imp.0CurL <> Imp.0File.0
        then Imp.0CurL = max(Imp.0CurL - 1, 1)
    RetC = 0
    Imp.0Mod = 1
  end
return RetC

/****************************************************************************
 * DELPATH path, dir                                                        *
 ****************************************************************************/
DelPath: procedure expose (Globals)
Rtn = 'DelPath'
parse upper arg Path, Dir ';'
Dir = translate(Dir)
if Imp.0File.0 = 0
  then return 255
if Path <> 'LIBPATH'
  then Path = 'SET' Path
Where = FindIt(Path, 1, Imp.0File.0, 1, 'BEGIN', 1)
/*** PTR 10300 start ***/
if Where = 0
  then do
    if Path = 'SET PATH' | Path = 'SET DPATH'
      then Where = FindIt(word(Path, 2), 1, Imp.0File.0, 1, 'BEGIN', 1)
    if Where = 0
      then return 1
      else parse var Imp.0File.Where . Data
  end
  else parse var Imp.0File.Where '=' Data
/*** PTR 10300 end ***/
if right(Data, 1) <> ';'
  then Data = Data';'
TestLine = translate(Data)
if abbrev(TestLine, Dir';')
  then Offset = 1
  else Offset = pos(';'Dir';', TestLine)
if Offset > 0
  then do
     if Offset > 1
       then OffSet = Offset + 1
    Data = delstr(Data, Offset, length(Dir)+1)
    Imp.0File.Where = Path'='Data
    Imp.0Mod = 1
  end
return 0

/****************************************************************************
 * DELSTRING Target                                                         *
 ****************************************************************************/
DelString: procedure expose (Globals)
Rtn = 'DelString'
parse upper arg Target
if Imp.0File.0 = 0
  then RetC = 255
  else do
    CL = Imp.0CurL
    Start = pos(Target, translate(Imp.0File.CL))
    if Start = 0
      then RetC = 1
      else do
        Imp.0File.CL = delstr(Imp.0File.CL, Start, length(Target))
        RetC = 0
        Imp.0Mod = 1
      end
  end
return RetC

/****************************************************************************
 * DISCARDFILE                                                              *
 ****************************************************************************/
DiscardFile: procedure expose (Globals)
Rtn = 'DiscardFile'
Imp.0File.0 = 0
Imp.0Mod = 0
Imp.0Filename = ''
return 0

/****************************************************************************
 * ECHOFILE                                                                 *
 ****************************************************************************/
EchoFile: procedure expose (Globals)
Rtn = 'EchoFile'
parse arg Start ., End .
if Start = ''
  then Start = 1
  else Start = max(Start, 1)
if End = ''
  then End = Imp.0File.0
  else End = min(End, Imp.0File.0)
Pad = length(End)
say
do I = Start to End
  if I = Imp.0CurL
    then Pref = '*'
    else Pref = ' '
  say Pref||left(I, Pad)':' Imp.0File.I
end
return 0

/****************************************************************************
 * ERASEFILE file                                                           *
 ****************************************************************************/
EraseFile: procedure expose (Globals)
Rtn = 'EraseFile'
parse arg File .
return RxDelete(File)

/****************************************************************************
 * FILECHANGED                                                              *
 ****************************************************************************/
FileChanged: procedure expose (Globals)
Rtn = 'FileChanged'
return Imp.0Mod

/****************************************************************************
 * FILETYPE [type]                                                          *
 ****************************************************************************/
FileType: procedure expose (Globals)
Rtn = 'FileType'
KnownTypes = 'REXX BATCH CONFIG IBMLAN PROTOCOL'
parse arg TestType Extra
if TestType = ''
  then return XXFileType()
  else if wordpos(TestType, KnownTypes) = 0 | Extra <> ''
    then call ImpError 'Bad argument:' TestType Extra
    else return (TestType = XXFileType())

/****************************************************************************
 * XXFILETYPE                                                               *
 ****************************************************************************/
XXFileType: procedure expose (Globals)
InFile = translate(FileSpec('NAME', Imp.0FileName))
select
  when InFile = 'CONFIG.SYS'
    then return 'CONFIG'
  when InFile = 'IBMLAN.INI'
    then return 'IBMLAN'
  when InFile = 'PROTOCOL.INI'
    then return 'PROTOCOL'
  when XFilespec('FEXT', InFile) = 'CMD'
    then do
      if Imp.0File.0 > 0
        then if abbrev(Imp.0File.1, '/'||'*')
          then return 'REXX'
      return 'BATCH'
    end
  otherwise
    return 'TEXT'
end

/****************************************************************************
 * FIND Target, Scope, [Position]                                           *
 ****************************************************************************/
Find: procedure expose (Globals)
Rtn =  'Find'
parse upper arg Target, Scope, Position
if Imp.0File.0 = 0
  then return 255

if Position <> '' & wordpos(Position, 'BEGIN END ALL') = 0
  then call ImpError 'Illegal position' Position'.'
CL = Imp.0CurL
select
  when Scope = '' | Scope = '+' then do
    FStart = CL + 1
    FEnd = Imp.0File.0
    FIncr = 1
  end
  when Scope = 'ALL+' then do
    FStart = 1
    FEnd = Imp.0File.0
    FIncr = 1
  end
  when Scope = '-' then do
    FStart = CL - 1
    FEnd = 1
    FIncr = -1
  end
  when Scope = 'ALL-' then do
    FStart = Imp.0File.0
    FEnd = 1
    FIncr = -1
  end
  otherwise
    call ImpError 'Illegal scope' Scope'.'
end /* select */

Imp.0Find.0Target = Target
Imp.0Find.0FStart = FStart
Imp.0Find.0FEnd = FEnd
Imp.0Find.0FIncr = FIncr
Imp.0Find.0Position = Position

Where = FindIt(Target, FStart, FEnd, FIncr, Position)
if Where = 0
  then RetC = 1
  else do
    RetC = 0
    Imp.0CurL = Where
  end
return RetC

/****************************************************************************
 * FINDNEXT                                                                 *
 ****************************************************************************/
FindNext: procedure expose (Globals)
Rtn = 'FindNext'
if Imp.0File.0 = 0
  then RetC = 255
  else do
    Imp.0Find.0FStart = Imp.0CurL + Imp.0Find.0FIncr
    Where = FindIt(Imp.0Find.0Target, Imp.0Find.0FStart, Imp.0Find.0FEnd,,
        Imp.0Find.0FIncr, Imp.0Find.0Position)
    if Where = 0
      then RetC = 1
      else do
        RetC = 0
        Imp.0CurL = Where
      end
  end
return RetC

/****************************************************************************
 * FINDIT Target, StartL, EndL, Increment, Position, XTest                  *
 ****************************************************************************/
FindIt: procedure expose (Globals) Rtn
Rtn = Rtn '(Engine)'
parse arg Target, FStart, FEnd, FIncr, Position, XTest
Found = 0
Target = translate(Target)
FEnd = min(FEnd, Imp.0File.0)
XTest = (Xtest = 1)
if XTest
  then Target = space(strip(Target))
do I = FStart to FEnd by FIncr
  if XTest
    then TestLine = translate(space(strip(Imp.0File.I)))
    else TestLine = translate(strip(Imp.0File.I))
  if pos(Target, TestLine) = 0
    then iterate
  select
    when Position = ''
      then Found = 1
    when Position = 'BEGIN' & abbrev(TestLine, Target)
      then Found = 1
    when Position = 'END' & abbrev(reverse(TestLine), reverse(Target))
      then Found = 1
    when Position = 'ALL' & Target = TestLine
      then Found = 1
    otherwise nop
  end /* select */
  if Found
    then leave
end /* do */
Rtn = word(Rtn, 1)
if Found
  then return I
  else return 0

/****************************************************************************
 * GETDISK label [, name]                                                   *
 ****************************************************************************/
GetDisk: procedure expose (Globals)
Label = translate(arg(1))
Name = arg(2)
if Name = ''
  then Name = 'the disk labeled "'Label'"'
  else Name = '"'Name'"'
parse upper value rxDriveInfo('A:') with 'LABEL=' DLabel 'FREE='
do while DLabel <> Label
  say 'Please insert' Name 'in drive A:.'
  call rxPause 'Press any key when ready.'
  parse upper value rxDriveInfo('A:') with 'LABEL=' DLabel 'FREE='
end
return 0

/****************************************************************************
 * GETLINE linenum                                                          *
 ****************************************************************************/
GetLine: procedure expose (Globals)
Rtn = 'GetLine'
parse arg LineNum .
if LineNum = ''
  then LineNum = Imp.0CurL
if LineNum < 1 | LineNum > Imp.0File.0
  then return ''
  else return Imp.0File.LineNum

/****************************************************************************
 * IMPVERSION                                                               *
 ****************************************************************************/
IMPVersion: procedure expose (Globals)
Rtn = 'ImpVersion'
return Imp.0Version

/****************************************************************************
 * INIGET file, app, key, [ENDNULL] [ERREXIT] [ITLERREXIT]                  *
 ****************************************************************************/
IniGet: procedure expose (Globals)
Rtn = 'IniGet'
parse arg File, App, Key, Flags
Flags = translate(Flags)
EndNull = wordpos('ENDNULL', Flags) > 0
ErrExit = wordpos('ERREXIT', Flags) > 0
ITLErrExit = wordpos('ITLERREXIT', Flags) > 0
Res = rxOs2Ini(File, App, Key)
select
  when Res = '$INIERROR'
    then if ErrExit
      then call ImpError 'Error reading INI file' File'.'
      else if ITLErrExit
        then call ITLErr 'Error reading INI file' File'.'
        else Res = ''
  when Res = '$RXERROR'
    then Res = ''
  otherwise nop
end
if EndNull & Res <> '' & right(Res, 1) <> '0'x
  then Res = Res '0'x
return Res

/****************************************************************************
 * INISET file, app, key, val, [ERREXIT] [ITLERREXIT]                       *
 ****************************************************************************/
IniSet: procedure expose (Globals)
Rtn = 'IniSet'
parse arg File, App, Key, KVal, Flags
Flags = translate(Flags)
EndNull = wordpos('ENDNULL', Flags) > 0
ErrExit = wordpos('ERREXIT', Flags) > 0
ITLErrExit = wordpos('ITLERREXIT', Flags) > 0
Res = rxOs2Ini(File, App, Key, KVal)
if Res = '$INIERROR'
  then if ErrExit
    then call ImpError 'Error writing INI file' File'.'
    else if ITLErrExit
      then call ITLErr 'Error writing INI file' File'.'
      else Res = 2
  else Res = 0
return Res

/****************************************************************************
 * INSBLANK linenum                                                         *
 ****************************************************************************/
InsBlank: procedure expose (Globals)
Rtn = 'InsBlank'
parse arg Where
OutC = InsLine('', Where, 1)
if OutC = 0 & Where = 'BEFORE'
  then call SetCurL('DOWN')
return OutC

/****************************************************************************
 * INSLINE newline, linenum, InsBlankFlag                                   *
 ****************************************************************************/
InsLine: procedure expose (Globals)
Rtn = 'InsLine'
parse arg NewLine, Where LineNum, Blank
Blank = (Blank = 1)
if Where = ''
  then Where = 'AFTER'
  else Where = translate(Where)
if LineNum = '' then LineNum = Imp.0CurL
if verify(LineNum, Imp.0Digits) <> 0  | wordpos(Where, 'BEFORE AFTER') = 0
  then call ImpError 'Bad arguments:' NewLine',' Where LineNum
select
  when Imp.0File.0 = 0
    then LineNum = 1
  when Where = 'AFTER'
    then LineNum = Linenum + 1
  otherwise nop
end
if Blank
  then do
    L1 = max(LineNum - 1, 1)
    L2 = min(LineNum + 1, Imp.0File.0)
    if strip(Imp.0File.L1) = '' | strip(Imp.0File.LineNum) = '' |,
        strip(Imp.0File.L2 = '')
      then return 1
  end
LineNum = max(1, min(LineNum, Imp.0File.0 +1))
RetC = rxStemInsert('IMP.0FILE', LineNum, NewLine)
if RetC <> 0 then call ImpError '*' RetC
Imp.0CurL = LineNum
Imp.0Mod = 1
return 0

/****************************************************************************
 * INSPATH path, dir, pos, CREATE [loc], GOTO                                *
 ****************************************************************************/
InsPath: procedure expose (Globals)
Rtn = 'InsPath'
parse arg Path, Dir ';', Posn, Create AddLn, Goto
parse upper var Posn Posn STarget OrClause
Create = abbrev('CREATE', translate(Create), 1)
Goto = abbrev('GOTO', translate(Goto), 1)

if Path = '' | Dir = '' | Posn = '' | wordpos(Posn, 'BEGIN END BEFORE AFTER') = 0
  then call ImpError 'Bad arguments:' Path',' Dir',' Posn'.'
if OrClause <> '' & word(OrClause, 1) <> 'OR'
  then call ImpError 'Bad argument:' Posn STarget OrClause

if Imp.0File.0 = 0 & \Create
  then return 255
if \abbrev(translate(Path), 'SET') & Path <> 'LIBPATH'
/**
  then if \(Path = 'LIBPATH' | (FileType('BATCH') & wordpos(Path, 'PATH DPATH) > 0))
**/
    then Path = 'SET' Path

TestPath = ''
Where = FindIt(Path, 1, Imp.0File.0, 1, 'BEGIN', 1)
if Where > 0
  then parse upper var Imp.0File.Where Testpath '='
do while (Where <> 0) & (translate(Path) <> TestPath)
  Where = FindIt(Path, Where+1, Imp.0File.0, 1, 'BEGIN', 1)
  if Where > 0
    then parse upper var Imp.0File.Where Testpath '='
end

/*** PTR 10300 start ***/
if Where = 0
  then if Path = 'SET PATH' | Path = 'SET DPATH'
    then do
      Path2 = word(Path, 2)   
      Where = FindIt(Path2, 1, Imp.0File.0, 1, 'BEGIN', 1)
      if Where > 0
        then if pos('=', Imp.0File.Where) > 0
          then parse upper var Imp.0File.Where Testpath '='
          else parse upper var Imp.0File.Where Testpath .
      do while (Where <> 0) & (translate(Path2) <> TestPath)
        Where = FindIt(word(Path, 2), Where+1, Imp.0File.0, 1, 'BEGIN', 1)
        if Where > 0
          then if pos('=', Imp.0File.Where) > 0
            then parse upper var Imp.0File.Where Testpath '='
            else parse upper var Imp.0File.Where Testpath .
/*** PTR 10300 end ***/
      end
    end
if Where = 0
  then if Create
    then do
      if AddLn = ''
        then AddLn = Imp.0File.0 + 1
        else if \datatype('+'AddLn'.', 'W')
          then AddLn = FindIt(AddLn, 1, Imp.0File.0, 1, '', 1) + 1
      if AddLn = 0
        then AddLn = Imp.0File.0 + 1
        else AddLn = min(AddLn, Imp.0File.0 + 1)
      call rxStemInsert 'IMP.0FILE', AddLn, Path'='Dir
      if Goto
        then Imp.0CurL = AddLn
      Imp.0Mod = 1
      OutC = 0
    end
    else OutC = 1
  else do
    EqSign = (pos('=', Imp.0File.Where) > 0)
    if EqSign
      then parse var Imp.0File.Where Prefix '=' TestLn
      else parse var Imp.0File.Where Prefix TestLn
    Prefix = strip(Prefix, 'T')
    if EqSign
      then Prefix = Prefix'='
      else Prefix = Prefix' '
    TestLn = strip(space(TestLn, 0))
    if right(TestLn, 1) <> ';' & TestLn <> ''
      then TestLn = TestLn';'
    UTestLn = translate(TestLn)
    UDir = translate(Dir)
    if pos(';'UDir';', ';'UTestLn) = 0
      then do
        if STarget <> ''
          then Offset = pos(';'STarget';', ';'UTestLn)
          else Offset = 0
        NewCond = (OrClause <> '' & Offset = 0 & wordpos(Posn, 'BEFORE AFTER') > 0)
        select
          when NewCond
            then do
              parse var OrClause 'OR' OrClause
              call InsPath Path, Dir, OrClause, Create AddLn, Goto
            end
          when Posn = 'BEGIN' | (Posn = 'BEFORE' & Offset = 0)
              then Imp.0File.Where = Prefix||Dir';'TestLn
          when Posn = 'END' | (Posn = 'AFTER' & Offset = 0)
            then Imp.0File.Where = Prefix||TestLn||Dir';'
          otherwise do
            if Posn = 'AFTER'
              then Offset = Offset + pos(';', substr(TestLn, Offset))
            Imp.0File.Where = Prefix||left(TestLn, Offset-1)||Dir';'||,
                substr(TestLn, Offset)
          end
        end /* select */
        Imp.0Mod = 1
      end
    if Goto
      then Imp.0CurL = Where
    OutC = 0
  end
return OutC

/****************************************************************************
 * INSUNIQUE new, where [target], testmode                                  *
 ****************************************************************************/
InsUnique: procedure expose (Globals)
Rtn = 'InsUnique'
parse arg New, Where Target, Test ., Control .
if Where = ''
  then Where = 'AFTER'
  else Where = translate(Where)
if Test = ''
  then Test = 'EXACT'
  else Test = translate(Test)
Control = translate(Control)
if wordpos(Test, 'EXACT COMPRESS PREFIX') = 0 |,
    wordpos(Where, 'AFTER BEFORE TOP BOTTOM') = 0 |,
    (Control <> '' & wordpos(Control, 'NEWONLY REPLACEONLY') = 0)
  then call ImpError 'Bad arguments:' Where',' Test
Compress = (Test <> 'EXACT')
FLn = FindIt(New, 1, Imp.0File.0, 1, 'ALL', Compress)
if FLn <> 0
  then do
    call SetCurL FLn
    return 1
  end

if Test = 'PREFIX'
  then do
    XTest = 'IFS DEVICE CALL DEVINFO RUN CALL'
    parse upper var New Word1 .
    if pos('=', Word1) > 0
      then parse var Word1 Word1 '='
    if Word1 = 'SET'
      then do
        parse upper var New STarget '='
        STarget = STarget'='
      end
      else if wordpos(Word1, XTest) = 0
        then STarget = Word1
        else STarget = word(New, 1)
    SOpt = 'BEGIN'
  end
  else do
    STarget = New
    SOpt = 'ALL'
  end

if Control <> ''
  then do
    call SavePos
    Found = (Find(STarget, 'ALL+', SOpt) = 0)
    call RestorePos
    DoIt = ((Control = 'NEWONLY') & \Found) | ((Control = 'REPLACEONLY') & Found)
  end
  else DoIt = 1

if \DoIt
  then return 2

if Control <> 'NEWONLY'
  then call RemAll STarget, 'ALL-', SOpt

if Where = 'TOP' | Where = 'BOTTOM'
  then do
    call SetCurL Where
    if Where = 'TOP'
      then Where = 'BEFORE'
      else Where = 'AFTER'
  end
  else if Target <> ''
    then do
      Target = FindIt(Target, 1, Imp.0File.0, 1, '', 0)
      if Target = 0
        then Target = ''
    end
OutC = InsLine(New, Where Target)
return OutC

/****************************************************************************
 * INSSTRING new, target, where                                             *
 ****************************************************************************/
InsString: procedure expose (Globals)
Rtn = 'InsString'
parse arg New, Target, Where
if Imp.0File.0 = 0
  then return 255
Where = translate(Where)
if Where <> '' & Where <> 'BEFORE' & Where <> 'AFTER'
  then call ImpError 'Illegal position' Where'.'
CL = Imp.0CurL
Target = translate(Target)
Index = pos(Target, translate(Imp.0File.CL))
if Index = 0
  then RetC = 1
  else do
    if Where <> 'BEFORE'
      then Index = Index + length(Target)
    A = left(Imp.0File.CL, Index-1)
    B = substr(Imp.0File.CL, Index)
    Imp.0File.CL = A||New||B
    RetC = 0
    Imp.0Mod = 1
  end
return RetC

/****************************************************************************
 * MOVEFILE source, target                                                  *
 ****************************************************************************/
MoveFile: procedure expose (Globals)
Rtn = 'MoveFile'
parse arg Source, Target
if rxOS2Ver = 1.1 | left(Source, 3) <> left(Target, 3) |,
    pos('\\', left(Source,2)||left(Target,2)) <> 0
  then if CopyFile(Source, Target) = 0
    then do
      'ERASE' Source '> NUL 2>&1'
      OutC = 2 * (rc <> 0)
    end
    else OutC = 1
  else do
    'MOVE' Source Target '> NUL 2>&1'
    OutC = rc
  end
return OutC

/****************************************************************************
 * NAMEFILE filename                                                        *
 ****************************************************************************/
NameFile: procedure expose (Globals)
Rtn = 'NameFile'
parse arg Name .
if \rxDirExist(XFileSpec('QPATH', Name))
  then return 1
Imp.0FileName = Name
Imp.0Mod = (Imp.0Mod | Imp.0File.0 > 0)
return 0

/****************************************************************************
 * NUMLINES
 ****************************************************************************/
NumLines: procedure expose (Globals)
Rtn = 'NumLines'
return Imp.0File.0

/****************************************************************************
 * READFILE FileName                                                        *
 ****************************************************************************/
ReadFile: procedure expose (Globals)
Rtn = 'ReadFile'
parse arg InFile .
if InFile = ''
  then call ImpError 'Bad argument: input file not specified.'
if Imp.0FileName <> ''
  then if Imp.0Mod
    then call ImpError 'Attempt to read file' InFile';' Imp.0FileName 'in',
        'storage modified and not saved.'
Imp.0Mod = 0
Imp.0FileName = InFile
Imp.0CurL = 0
XCode = 0
if rxFileExist(InFile)
  then do
    RetC = rxRead(InFile, 'IMP.0FILE')
    if RetC <> 0
      then XCode = 1
      else Imp.0CurL = 1
  end
  else do
    Imp.0File.0 = 0
    XCode = 255
  end
call SetComment 'IMP'
return XCode

/****************************************************************************
 * REMLINE                                                                  *
 ****************************************************************************/
RemLine: procedure expose (Globals)
Rtn = 'RemLine'
parse arg RLine
RMode = (RLine <> '')  /* Add remark mode */
if \RMode
  then if Imp.0File.0 = 0
    then return 255
    else do
      CL = Imp.0CurL
      RLine = Imp.0File.CL
    end
First = translate(word(RLine, 1))
Last = translate(word(RLine, words(RLine)))
if Imp.0Cmt2 = ''
  then RemIt = \abbrev(First, Imp.0Cmt1)
  else RemIt = \abbrev(First, Imp.0Cmt1),
      & \abbrev(reverse(Last), reverse(Imp.0Cmt2))
if RemIt
  then do
    RLine = strip(RLine, 'T')
    if abbrev(RLine, copies(' ', length(Imp.0Cmt1)+1))
      then RLine = overlay(Imp.0Cmt1' ', RLine)
      else RLine = Imp.0Cmt1 strip(RLine, 'L')
    if RMode
      then RLine = RLine Imp.0Cmt2
      else RLine = RLine Imp.0CmtD Imp.0Cmt2
  end
if RMode
  then return RLine
  else if RLine <> Imp.0File.CL
    then do
      Imp.0File.CL = RLine
      Imp.0Mod = 1
      OutC = 0
    end
    else OutC = 0
return OutC

/****************************************************************************
 * REMALL target, scope, position, exceptions                               *
 ****************************************************************************/
RemAll: procedure expose (Globals)
Rtn = 'RemAll'
parse arg Target, Scope ., Pos ., XList
call ImpFindArgs 'PUSH'
RetC = Find(Target, Scope, Pos)
XC = RetC
do while RetC = 0
  if \wordpos(Imp.0CurL, XList)
    then call RemLine
  RetC = FindNext()
end
call ImpFindArgs 'POP'
return XC

/****************************************************************************
 * SETCOMMENT                                                               *
 ****************************************************************************/
SetComment: procedure expose (Globals)
Rtn = 'SetComment'
parse arg Func, P1, P2
select
  when Func = 'SET'
    then do
      Imp.0Cmt1 = P1
      Imp.0Cmt2 = P2
    end
  when Func = 'DESC'
    then if P1  = ''
      then Imp.0CmtD = ''
      else Imp.0CmtD = '-' P1
  when Func = 'IMP'
    then do
      Type = FileType()
      parse value '' with Imp.0Cmt1 Imp.0Cmt2 Imp.0CmtD
      select
        when Type = 'BATCH' | Type = 'CONFIG'
          then Imp.0Cmt1 = 'REM'
        when Type = 'REXX'
          then do
            Imp.0Cmt1 = '/'"*"; Imp.0Cmt2 = '*'"/"
          end
        when Type = 'IBMLAN' | Type = 'PROTOCOL'
          then Imp.0Cmt1 = ';'
        otherwise nop
      end
    end
  otherwise
    call ImpError 'Invalid argument' Func
end
return 0

/****************************************************************************
 * IMPFINDARGS                                                              *
 ****************************************************************************/
ImpFindArgs: procedure expose (Globals)
parse upper arg Op .
if Op = 'PUSH'
  then if symbol('IMP.0FIND.0TARGET') = 'VAL'
    then do
      Imp.0Save.0Target   = Imp.0Find.0Target
      Imp.0Save.0FStart   = Imp.0Find.0FStart
      Imp.0Save.0FEnd     = Imp.0Find.0FEnd
      Imp.0Save.0FIncr    = Imp.0Find.0FIncr
      Imp.0Save.0Position = Imp.0Find.0Position
    end
  else if symbol('IMP.0SAVE.0TARGET') = 'VAL'
    then do
      Imp.0Find.0Target   = Imp.0Save.0Target
      Imp.0Find.0FStart   = Imp.0Save.0FStart
      Imp.0Find.0FEnd     = Imp.0Save.0FEnd
      Imp.0Find.0FIncr    = Imp.0Save.0FIncr
      Imp.0Find.0Position = Imp.0Save.0Position
    end
return

/****************************************************************************
 * REPLACE NewLine                                                          *
 ****************************************************************************/
Replace: procedure expose (Globals)
Rtn = 'REPLACE'
parse arg NewLine
if Imp.0File.0 = 0
  then RetC = 255
  else do
    Temp = Imp.0CurL
    Imp.0File.Temp = NewLine
    RetC = 0
    Imp.0Mod = 1
  end
return RetC

/****************************************************************************
 * REPLACEFILE source, target                                               *
 ****************************************************************************/
ReplaceFile: procedure expose (Globals)
Rtn = 'ReplaceFile'
parse arg Source, Target, Opts
if pos('?', Source) + pos('*', Source) > 0
  then return ReplaceFileWild(Source, Target)
if \rxFileExist(Source)
  then return 2
if \rxFileExist(Target)
  then if rxDirExist(Target)
    then if right(Target, 1) = '\'
      then Target = Target||filespec('NAME', Source)
      else Target = Target'\'filespec('NAME', Source)
    else do
      TargetPath = XFileSpec('QPATH', Target)
      if length(TargetPath) > 3
        then TargetPath = strip(TargetPath, 'T', '\')
      if \rxDirExist(TargetPath)
        then return 3
    end

call rxTree Target, 'TAR.', 'FT'
if Tar.0 = 0
  then CopyIt = 1
  else do
    call rxTree Source, 'SRC.', 'FT'
    CopyIt = word(Src.1, 1) > word(Tar.1, 1)
  end

if CopyIt
  then do
    'COPY' Source Target '> NUL 2>&1'
    OutC = rc
  end
  else OutC = 0
return (OutC <> 0)

ReplaceFileWild: procedure expose (Globals)
Rtn = 'ReplaceFile'
parse arg Source, Target
SDir = left(Source, max(3, lastpos('\', Source)-1))
call rxMkDir Target
if \rxDirExist(SDir) | \rxDirExist(Target)
  then return 2
'REPLACE' Source Target '/U'
OutC = (rc > 1)
'REPLACE' Source Target '/A'
OutC = OutC | (rc > 1)
return OutC

/****************************************************************************
 * RESTOREPOS                                                               *
 ****************************************************************************/
RestorePos: procedure expose (Globals)
Rtn = 'RestorePos'
if Imp.0PosStack = ''
  then call ImpError 'PosStack underflow.'
parse var Imp.0PosStack Imp.0CurL Imp.0PosStack
return 0

/****************************************************************************
 * SAVEPOS                                                                  *
 ****************************************************************************/
SavePos: procedure expose (Globals)
Rtn = 'SavePos'
Imp.0PosStack = Imp.0PosStack Imp.0CurL
return 0

/****************************************************************************
 * SETCURL Where                                                            *
 ****************************************************************************/
SetCurL: procedure expose (Globals)
Rtn = 'SetCurL'
parse upper arg Where
select
  when Where = 'BOTTOM'
    then where = Imp.0File.0
  when Where = 'TOP'
    then do
      Type = FileType()
      if Type = 'TEXT'
        then Where = 1
        else do
          Nest = (wordpos(Type, 'REXX') > 0)
          Where = XXScanCmt(1, Imp.0Cmt1, Imp.0Cmt2, Nest)
        end
    end
  when Where = 'DOWN'
    then Where = Imp.0CurL + 1
  when Where = 'UP'
    then Where = Imp.0CurL - 1
  otherwise nop
end
if \datatype(Where, 'N')
  then call ImpError 'Illegal line number' Where'.'
if Imp.0File.0 = 0
  then RetC = 255
  else if Where > Imp.0File.0
    then RetC = 1
    else do
      RetC = 0
      Imp.0CurL = Where
    end
return RetC

/* Return Line number of first non-comment line on or after Start */
XXScanCmt: procedure expose (Globals)
parse arg Start, Cmt1 . , Cmt2 ., Nest
if Nest
  then do
    Count = 0
    do I = Start to Imp.0File.0 until Count <= 0
      Last = 0
      do until PS = 0 & PE = 0
        PS = pos(Cmt1, Imp.0File.I, Last+1)
        PE = pos(Cmt2, Imp.0File.I, Last+1)
        if PS = 0 & PE = 0
          then iterate
        if PS > 0
          then if PE = 0 | PS < PE
            then do
              Last = PS
              Count = Count + 1
              iterate
            end
        Last = PE
        Count = Count - 1
      end
    end I
    I = min(I + 1, Imp.0File.0)
  end
  else do I = Start to Imp.0File.0 while abbrev(translate(Imp.0File.I), Cmt1)
    nop
  end
return I

/****************************************************************************
 * WRITEFILE                                                                *
 ****************************************************************************/
WriteFile: procedure expose (Globals)
Rtn = 'WriteFile'
parse value '' with BackDir BackType
if arg() = 1
  then parse upper arg Echo .
  else parse upper arg BackDir, BackType ., Echo .
Echo = abbrev('VERBOSE', Echo, 1)
if \Imp.0Mod
  then do
    if Echo
      then say 'No changes made - file not written.'
    return 1
  end

if BackDir = ''
  then BackDir = Imp.0BackDir
  else if \CheckBackupDir(BackDir)
    then do
      say 'Backup directory' BackDir 'not found.'
      BackDir = Imp.0BackDir
    end
if BackDir = ''
  then do
    say 'No default backup directory specified.  Using' Imp.0BDr'.'
    BackDir = Imp.0BDr
  end

if BackType = '' | \CheckBackupType(BackType)
  then BackType = Imp.0BackType

parse var BackType BackType '=' BackArg
BackFile = BackDir
if right(BackFile, 1) <> '\'
  then BackFile = BackFile'\'
FN = filespec('NAME', Imp.0FileName)
LastDot = lastpos('.', FN)
if LastDot = 0
  then BackFile = BackFile||FN'.'
  else BackFile = BackFile||left(FN, LastDot)

select
  when verify(BackType, Imp.0Digits) = 0
    then do
      call rxTree BackFile'*', 'BACKS.', 'FT'
      call rxStemSort 'BACKS.', 'A', 1, 14
      OldBacks = ''
      do I = 1 to Backs.0
        OldBack = subword(Backs.I, 4)
        if verify(XFileSpec('FEXT', OldBack), Imp.0Digits) = 0
          then OldBacks = OldBacks OldBack
      end
      do while words(OldBacks) >= BackType
        parse var OldBacks OldBack OldBacks
        call rxDelete OldBack
      end
      BackFile = rxTempFileName(BackFile'???', '?')
    end
  when abbrev('UNIQUE', BackType)
    then BackFile = rxTempFileName(BackFile'???', '?')
  when abbrev('NAME', BackType)
    then BackFile = BackFile||BackArg
  when BackType = 'NOBACKUP'
    then BackFile = ''
end

if BackFile <> ''
  then do
    if Echo
      then say 'Backing up' Imp.0FileName 'to' BackFile'...'
    'COPY' Imp.0FileName BackFile '2>&1 1>NUL | RXQUEUE'
    if rc <> 0
      then do
        parse pull EMsg
        call ImpError 'Error "'EMsg'" creating backup file' BackFile'.'
      end
  end
if Echo
  then say 'Writing' Imp.0FileName'...'
/**
call ImpSaveEAs Imp.0FileName
**/
call rxTree Imp.0FileName, 'TEMP.', 'F'
call rxTree Imp.0FileName, 'JUNK.', 'F',,'*----'
RetC = rxWrite(Imp.0FileName, 'IMP.0FILE', Imp.0File.0)
if RetC <> 0 then call ImpError '*' RetC
/**
call ImpRestoreEAs Imp.0FileName
**/
if Temp.0 > 0
  then do
    Attribs = word(Temp.1, 4)
    NewAttr = translate(Attribs, '+++++', 'ADHRS', '*')
    NewAttr = overlay('+', NewAttr, 1)     /* Force "A" bit */
    call rxTree Imp.0FileName, 'JUNK.', 'F',,NewAttr
  end
Imp.0Mod = 0
return 0

ImpSaveEAs: procedure expose (Globals) EASave.
parse arg File
if rxOs2Ver() >= 2.0
  then do
    drop EASave.
    EASave.0 = 0
    signal on syntax name ImpSaveEA2
    call sysQueryEAList File, 'EASAVE.'
    call ImpSaveEA2
  end
return 0

ImpSaveEA2:
signal on syntax name syntax
if EASave.0 = 0
  then do
    call rxStemInsert 'EASAVE.', EASave.0+1, '.TYPE'
    call rxStemInsert 'EASAVE.', EASave.0+1, '.LONGNAME'
  end
do I = 1 to EASave.0
  EA = EASave.I
  if sysGetEA(File, EA, 'TEMP') = 0
    then EASave.EA = Temp
    else EASave.EA = ''
end
return 0

ImpRestoreEAs: procedure expose (Globals) EASave.
parse arg File
if rxOs2Ver() >= 2.0
  then do
    do I = 1 to EASave.0
      EA = EASave.I
      if EASave.EA <> ''
        then call sysPutEA File, EA, EASave.EA
    end
  end
return 0

/****************************************************************************
 * XFILESPEC Option, FileSpec                                               *
 ****************************************************************************/
XFileSpec: procedure expose (Globals)
Rtn = 'XFileSpec'
if arg() <> 2
  then call ImpError 'Bad arguments.'
parse arg Opt, FS
select
  when abbrev('QPATH', Opt)
    then return strip(filespec('D', FS)||filespec('P', FS))
  when abbrev('FEXT', Opt, 2)
    then do
      parse value filespec('N', FS) with '.' Ext
      return Ext
    end
  when abbrev('FNAME', Opt, 2)
    then do
      parse value filespec('N', FS) with Name '.'
      return Name
    end
  when abbrev('DRIVE', Opt) | abbrev('PATH', Opt) | abbrev('NAME', Opt)
    then return filespec(Opt, FS)
  otherwise call ImpError 'Invalid option' Opt'.'
end
return

/****************************************************************************
 * ImpError                                                                 *
 ****************************************************************************/
ImpError: procedure expose (Globals) Rtn
parse arg EMsg
if word(EMsg, 1) = '*'
  then EMsg = 'Unxepected error' word(EMsg, 2) 'in' Rtn'.'
  else if symbol('RTN') = 'VAR'
    then Emsg = Emsg '('Rtn')'
if EMsg <> ''
  then do
    say EMsg
    if symbol('Imp.0Org.0') = 'VAR'     /* ITL active? */
      then do
        Imp.0ErrorMode = 'CONTINUE'
        call ItlErr EMsg
      end
  end
if symbol('IMP.0ERRPAUSE') = 'VAR'
  then if Imp.0ErrPause = 1
    then call rxPause 'Press any key to exit.'
exit 2

/*****************************************************************************
 * ASKUSER Question, ResponseList, MinLeng, DefaultFlag                      *
 * Ask the user a question and wait for a valid one word response.  Valid    *
 * reponses are passed in the ResponseList, and the entered response must be *
 * of at least the specified minimum length.  If DefaultFlag is 1, the first *
 * entry of the List will be returned if the user didn't enter anything.     *
 *                                                                           *
 * Use LINEIN, rather than pull, to avoid (1) annoying '?' and (2) any stack *
 * garbage.                                                                  *
 *****************************************************************************/
AskUser: procedure expose (Globals)
trace 'O'
parse arg Question, ResponseList, MinLeng ., DefaultFlag .
say Question
Resp = ''
Responses. = ''
do I = 1 to words(ResponseList)
  Responses.I = word(ResponseList, I)
end
do forever
  Response = translate(strip(linein('STDIN:')))
  if Response = '' & DefaultFlag = 1
    then Resp = word(ResponseList, 1)
    else do I = 1 to words(ResponseList)
      if abbrev(Responses.I, Response, MinLeng) = 1
        then do
          Resp = Responses.I
          leave
        end
    end
  if Resp <> ''
    then leave
    else say 'Invalid input.'
end /* do forever */
return Resp

/*****************************************************************************
 * RUNTAGFILE itlfile                                                        *
 *****************************************************************************/
RunTagFile: procedure expose (Globals)
parse arg ModFile Rest
if value('IMP.0INIT') <> 1
  then call ImpInit
call ImpITLInit ModFile, Rest

Syn. = ''
Syn.ADDOBJECT = 'ADDOBJ'
Syn.ADDPROGRAM = 'ADDP'
Syn.EADDPROGRAM = 'EADDP'
Syn.CHANGEPATH = 'CP'
Syn.CHDIR = 'CD'
Syn.CLEARSCREEN = 'CLS'
Syn.COPYFILE = 'COPY'
Syn.COMMAND = 'CMD'
Syn.DELFILE = 'DEL'
Syn.DELPROGRAM = 'DELP'
Syn.ENVVAR = 'ENV'
Syn.MKDIR = 'MD'
Syn.REMARK = 'REM'
Syn.REPLACEFILE = 'REPFILE'
Syn.REPLACESTRING = 'REPSTR'
Syn.READFILE = 'RF'
Syn.VERBOSE = 'MSGMODE'
Syn.VB = 'MSGMODE'
Syn.WRITEFILE = 'WF'
OneArg. = 0
parse value '1' with OneArg.SAY 1 OneArg.EVAL
NoLook. = 0
parse value '1' with NoLook.REPSTR 1 NoLook.IF

Sep = d2c(255)
do Imp.0PC = 1 to Imp.0Mods.0
  trace value Imp.0Trval
  PC = Imp.0PC
  Line = strip(Imp.0Mods.PC)
  do PC = PC + 1 while right(Line, 1) = '+'
    LIne = left(Line, length(Line)-1)||strip(Imp.0Mods.PC)
  end
  Imp.0PC = PC - 1
  parse var Line Key Tail
  Tail = strip(Tail)
  if Key = '' | abbrev(Key, '*') | abbrev(Key, ':')
    then iterate
  if Imp.0IfScan <> 0
    then if wordpos(translate(Key), 'IF ELSE ENDIF') = 0
      then iterate
  if symbol(Key) = 'BAD'
    then call ItlErr 'Illegal keyword' Key'.'
  parse upper value value('SYN.'Key) Key with Key .
  if \OneArg.Key
    then Tail = translate(Tail, Sep, ',')
  if \NoLook.Key
    then Tail = LookUp(Tail)
  Arg. = ''
  do I = 1 to 10 while Tail <> ''
    parse var Tail Arg.I (Sep) Tail
    if \OneArg.Key
      then do
        Arg.I = strip(Arg.I, 'T')
        if abbrev(Arg.I, '..') & right(Arg.I, 2) = '..'
          then Arg.I = strip(Arg.I,,'.')
          else Arg.I = strip(Arg.I)
      end
  end
  if Tail <> ''
    then call ItlErr 'Too many arguments specified.'
  NewLine = RunCmd(Key, Arg.1, Arg.2, Arg.3, Arg.4, Arg.5, Arg.6, Arg.7,,
      Arg.8, Arg.9, Arg.10)
  if left(NewLine, 1) = '!'
    then return substr(NewLine, 2)
  if NewLine > 0
    then Imp.0PC = NewLine
end
if Imp.0IfScan <> 0
  then call ItlErr 'ENDIF not found.'
return 0

RunCmd: procedure expose (Globals)
Key = arg(1)
/*
if Imp.0IfScan <> 0
  then if wordpos(Key, 'IF ELSE ENDIF') = 0
    then return 0
*/
signal on syntax name TagError
trace value Imp.0TrVal
interpret "OutC = ITL!"Key"(arg(2), arg(3), arg(4), arg(5), arg(6), arg(7),",
    "arg(8), arg(9), arg(10), arg(11))"
return OutC

TagError:
if rc = 43
  then if word(sourceline(sigl), 1) = 'interpret'
    then do
      Imp.0ErrorMode = 'HALT'
      call ItlErr 'Unknown ITL tag:' Key
      exit 255
    end
call ITLsyntax d2c(0), sigl
exit 255

/** Add INI entry **/
ITL!ADDINI: procedure expose (Globals)
parse arg File, App, Key, Val, ROpt .
File = translate(strip(File))
App = strip(App)
Key = strip(Key)
Val = strip(Val)
ROpt = translate(ROpt)
if (wordpos(File, 'USER SYSTEM') = 0 & pos('\', File) = 0)
  then parse value RxSearchPath('DPATH', File) File with File .
/*** PTR 103 start ***/
if (ROpt <> '') & (wordpos(ROpt, 'NEWONLY REPLACEONLY') = 0)
/*** PTR 103 end ***/
  then call ITLErr 'Invalid argument' ROpt
if translate(Val) = '$RXDEL'
  then ROpt = 'REPLACEONLY'
Exists = (rxOs2Ini(File, App, Key) <> '$RXERROR')
if (ROpt = '' | (ROpt = 'NEWONLY' & \Exists) |,
    (ROpt = 'REPLACEONLY' & Exists))
  then do
    call ITLSay 'Setting' App'/'Key '->' Val 'in' File 'file...'
    Res = RxOs2Ini(File, App, Key, Val)
    if Res <> ''
      then call ITLErr 'Error' Res 'writing to INI file' File'.'
  end
return 0

/** Add to local file list **/
ITL!ADDLOCAL: procedure expose (Globals)
parse arg Ini, App, Dir, FileList, Source
parse arg App, Source, Dest, AutoUpdate
XC = AddLocalFiles(Ini, App, Dir, FileList, Source)
if XC <> 0
  then call ItlErr 'Error' XC 'from AddLocalFiles.'
return 0

/** Delete a list of local files **/
ITL!DELLOCAL: procedure expose (Globals)
/***** PTR 10017 start *****/
if arg(1) = '' | arg(3) <> ''
/***** PTR 10017 end *****/
  then call ItlErr 'Invalid number of arguments.'
XC = DelLocalFiles(arg(1), arg(2))
if XC <> 0
  then call ItlErr 'Error' XC 'from DelLocalFiles.'
return 0

/** Create an OS/2 2.0 Object **/
ITL!ADDOBJ: procedure expose (Globals)
parse arg ClassName, Title, Location, Setup, Duplicate, TryDel
if Duplicate = ''  /* SysCreateObject bug -- can't be null */
  then Duplicate = 'R'
  else Duplicate = translate(Duplicate)
TryDel = (TryDel <> '') & \abbrev(Duplicate, 'F')
P = pos('OBJECTID', translate(Setup))
if P > 0
  then parse value substr(Setup, P) with '=' ObjId ';'
  else ObjId = ''

call ITLSay 'Creating' ClassName 'object "'Title'" in "'Location'".'
call ITLSay '('Duplicate',' Setup')'
if rxOs2ver() < 2.0
  then call ITLErr 'AddObject requires OS/2 2.0 or greater.'
XC = SysCreateObject(ClassName, Title, Location, Setup, Duplicate)

/* Test if folder object is viable */
if XC = 1 & ClassName = 'WPFolder' & ObjId <> ''
  then do
    XC = SysCreateObject('WPAbstract', 'Test', ObjId,,
        'OBJECTID=<CORE_TESTOBJ>;', 'R')
    call SysDestroyObject '<CORE_TESTOBJ>'
  end

if XC <> 1 & TryDel
  then do
    if ObjId <> ''
      then do
        call ItlSay 'Object' ObjId 'could not be created.  Deleting...'
        if SysDestroyObject(ObjId)
          then do
            call ItlSay 'Retrying creation...'
            XC = SysCreateObject(ClassName, Title, Location, Setup, Duplicate)
          end
          else call ItlSay 'Object could not be deleted.'
      end
  end
if XC <> 1
  then if abbrev(Duplicate, 'F') 
    then call ItlSay 'Object' Title 'could not be created.  May already',
        'exist.'
    else call ITLErr 'Object' Title 'could not be created.'
return 0

FolderId: procedure expose (Globals)
parse arg FldName, Root
parse source . How Me
Cmd = (How = 'COMMAND')
if pos('\', Me) > 0
  then do
    MyPath = left(Me, max(3, lastpos('\', Me)-1))
    call setlocal
    call value 'PATH', MyPath';'value('PATH',,'OS2ENVIRONMENT'), 'OS2ENVIRONMENT'
  end
FldPath = ''
SynRef = 'QDESKTOP'
if Root = ''
  then Root = 'QDESKTOP'()
drop SynRef
if right(Root, 1) <> '\'
  then Root = Root'\'
FldName = strip(strip(FldName),,'"')
if Root <> ''
  then do
    call SysFileTree Root'*', 'DIRS.', 'DSO'
    do I = 1 to Dirs.0 while FldPath = ''
      if SysGetEA(Dirs.I, '.LONGNAME', 'NAME') = 0
        then if substr(Name, 5) == FldName
          then FldPath = Dirs.I
    end
  end
if Cmd
  then if FldPath = ''
    then say 'The directory for "'FldName'" could not be determined.'
    else say 'The "'FldName'" directory is "'FldPath'".'
return FldPath

DesktopId: procedure expose (Globals)
parse upper source . How Me
parse upper arg Opt Extra
Valid = 'SWITCH'
if (Opt <> '' & wordpos(Opt, Valid) = 0) | Extra <> ''
  then signal Tell
Cmd = (How = 'COMMAND')
if pos('\', Me) > 0
  then do
    MyPath = left(Me, max(3, lastpos('\', Me)-1))
    call setlocal
    call value 'PATH', MyPath';'value('PATH',,'OS2ENVIRONMENT'), 'OS2ENVIRONMENT'
  end
Desktop = GetPath('<WP_DESKTOP>')
if Desktop = ''   /* Second attempt if first fails */
  then do
    SynRef = 'BOOTDRIVE'
    BDr = SysBootDrive()
    SynRef = 'QFOLDER'
    Desktop = 'QFOLDER'('OS/2 2.0 Desktop', BDr'\')
    if Desktop = ''   /* Third attempt (for 2.1 systems) if 3rd fails */
      then Desktop = 'QFOLDER'('Desktop', BDr'\')
    drop SynRef
  end
call endlocal
if Cmd
  then if Desktop = ''
    then say 'The active OS/2 desktop directory could not be located!'
    else do
      say 'The active OS/2 desktop directory is "'Desktop'".'
      if Opt = 'SWITCH'
        then call directory Desktop
    end
return Desktop

GetPath: procedure
parse arg ObjId
GpiNode = substr(sysIni('USER', 'PM_Workplace:Location', ObjId), 1, 2)
if GetNodes() <> 0
  then say 'Warning: Could not locate the node table.'
GP = ''
do GPI = 1 to Nodes.0
  if substr(Nodes.GPI, 7, 2) = GpiNode
    then do
      GP = substr(Nodes.GPI, 33, length(Nodes.GPI)-33)  /* Name of desktop */
      GPParent = substr(Nodes.GPI, 9, 2)
      do until GPParent = '0000'x
        do GPL = 1 to Nodes.0
          if substr(Nodes.GPL, 7, 2) = GPParent
            then do                               /* Qualified name of desktop */
              GP = substr(Nodes.GPL, 33, length(Nodes.GPL)-33)'\'GP
              GPParent = substr(Nodes.GPL, 9, 2)
              leave GPL
            end
        end
      end
      leave GPI
    end
end
return GP

GetNodes: procedure expose Nodes.
Handles = sysIni('SYSTEM', 'PM_Workplace:ActiveHandles', 'HandlesAppName')
if abbrev(Handles, 'ERROR:')    /* No service pack */
  then Handles = 'PM_Workplace:Handles'
Block1 = ''
parse value '0' with 1 Nodes. 1 I 1 L
do I = 1 to 999
  Block = sysIni('SYSTEM', Handles, 'BLOCK'I)
  if abbrev(Block, 'ERROR:')
    then if I = 1
      then return 10  /* could not locate NODE table */
      else leave
    else Block1 = Block1||Block
end I
do until L >= length(Block1)
  if substr(Block1, L+5, 4) = 'DRIV'
    then do
      XL = pos('00'x||'NODE'||'01'x, Block1, L+5) - L
      if XL <= 0
        then leave
      L = L + XL
      iterate
    end
    else if substr(Block1, L+1, 4) = 'DRIV'
      then do
        XL = pos('00'x||'NODE'||'01'x, Block1, L+1) - L
        if XL <= 0
          then leave
        L = L + XL
        iterate
      end
      else do
        Data = substr(Block1, L+1, 32)
        XL = c2d(substr(Block1, L+31, 1))
        if XL <= 0
          then leave
        Data = Data||substr(Block1, L+33, XL+1)
        L = L + length(Data)
      end
  I = I + 1
  Nodes.I = Data
end
Nodes.0 = I
return 0

/** Add program entry **/
ITL!ADDP: procedure expose (Globals)
parse arg Group, Title, ROpt .

ObjectMode = (rxOs2Ver() >= 2.0)
Conv1.EXE = 'EXENAME'
Conv1.PARAMS = 'PARAMETERS'
Conv1.WORKDIR = 'STARTUPDIR'
Conv1.ICONFILE = 'ICONFILE'

Info.1 = 'TITLE='Title
Info.0 = 1
Setup = 'OBJECTID=<'Title'>;'
Used = 'TITLE'
EndFound = 0
do J = Imp.0PC+1 until (EndFound | J > Imp.0Mods.0)
  parse value LookUp(Imp.0Mods.J) with Attr . '=' AttrVal
  Attr = translate(Attr)
  if abbrev('EADDPROGRAM', Attr, 5)
    then do
      EndFound = 1
      iterate
    end
  if AttrVal = ''
    then call ITLErr 'Null value specified for' Attr 'attribute.'
  if wordpos(Attr, Used) <> 0
    then call ITLErr 'Duplicate' Attr 'attribute in ADDPROGRAM record.'
    else do
      Used = Used Attr
      select
        when \ObjectMode
          then call rxStemInsert 'INFO', Info.0 + 1, Attr'='AttrVal
        when wordpos(Attr, 'EXE PARAMS WORKDIR ICONFILE') > 0
          then Setup = Setup||Conv1.Attr'='AttrVal';'
        when wordpos(Attr, 'VISIBILITY XYSIZE') > 0
          then nop
        when Attr = 'TYPE'
          then do
            select
              when wordpos(AttrVal, 'FULLSCREEN PM') > 0
                then nop
              when AttrVal = 'VIOWINDOW'
                then AttrVal = 'WINDOWABLEVIO'
              when AttrVal = 'READ'
                then AttrVal = 'VDM'
              otherwise AttrVal = ''
            end
            if AttrVal <> ''
              then Setup = Setup||'PROGTYPE='AttrVal';'
          end
        when Attr = 'XYSTYLE'
          then do while AttrVal <> ''
            parse var AttrVal Temp . ',' AttrVal
            if wordpos(Temp, 'NOAUTOCLOSE MINIMIZED MAXIMIZED') > 0
              then Setup = Setup||Temp'=YES;'
          end
        otherwise call ITLErr 'Illegal ADDPROGRAM attribute' Attr'.'
      end
    end
end /* do */
if \EndFound
  then call ITLErr 'No EADDPROGRAM tag found.'
if wordpos('EXE', Used) = 0
  then call ITLErr 'No EXE attribute found in ADDPROGRAM record.'
  else do
    if ObjectMode
      then do
        GroupId = FolderId(Group)
        if GroupId = ''
          then do
            call SysCreateObject 'WPFolder', Group, '<WP_DESKTOP>', 'ICONFILE=;'
            GroupId = FolderId(Group)
            if GroupId = ''
              then GroupId = '<WP_DESKTOP>'
          end
        XC = ITL!AddObj('WPProgram', Title, Groupid, Setup)
      end
      else do
        Exists = (rxQueryProgram('USER', Group, Title, 'TRASH') = 0)
        if ROpt = '' | (ROpt = 'REPLACEONLY' & Exists) |,
            (ROpt = 'NEWONLY' & \Exists)
          then do
            call ITLSay 'Adding' Title 'program to' Group 'group...'
            call RxDeleteProgram , Group, Title
            call RxAddProgram , Group, 'INFO.'
          end
      end
  end
return J

ITL!EADDP: procedure expose (Globals)
call ITLErr 'EADDPROGRAM found outside of ADDPROGRAM record.'
return 0

/*** Ask the user a question ***/
ITL!ASK: procedure expose (Globals)
parse arg Prompt, VarName, Valid, NoConf, Lower
Valid = translate(strip(Valid))
NoConf = (NoConf <> '')
Lower = (Lower <> '')
VarName = strip(VarName)
Key = 'N'
do until (Key = 'Y')
  call rxSay Prompt ' '
  parse linein Resp
  if \Lower
    then Resp = translate(Resp)
  if Valid = '' | wordpos(Resp, Valid) > 0
    then if NoConf
      then Key = 'Y'
      else do
        call rxSay 'You entered "'Resp'" - Is this correct (Y/N)? '
        do until pos(Key, 'YN') > 0
          parse upper linein Key .
          Key = left(Key, 1)
        end
      end
    else do
      call beep 200, 150
      say 'Valid responses are:' Valid'.'
    end
  if Key = 'N'
    then say
end
call ITLReplaceStringAdd '{'VarName'}', Resp
return 0

/*** Change directory ***/
ITL!CD: procedure expose (Globals)
parse arg NewDir
if rxDirExist(NewDir)
  then call directory NewDir
  else call ITLErr 'Directory' NewDir 'does not exist.'
return 0

/** Copy file **/
ITL!COPY: procedure expose (Globals)
parse arg Src, Dst, Opt, App, AutoUp, Defer
/**** PTR 10011 start ****/
if Opt <> 'COUCOPY'
  then if \rxFileExist(Src)
    then call ItlErr 'Source file' Src 'does not exist.'
/**** PTR 10011 end ****/
if Opt = ''
  then call ITLSay 'Copying' Src 'to 'Dst'...'
  else if Opt = 'COUCOPY'
    then call ITLSay 'Copying' Src 'to 'Dst '(COUCOPY:'AutoUp','Defer')...'
    else call ITLSay 'Copying' Src 'to 'Dst '('Opt')...'
RetC = CopyFile(Src, Dst, Opt, App, AutoUp, Defer)
if RetC <> 0
  then call ITLErr 'Error' RetC 'copying' Src 'to' Dst'.'
return 0

/**********************************************************
* CopyDir src, trg                                        *
*                                                         *
* Copies directories, formats screen output.              *
*                                                         *
* Return:  0 = Successful completion.                     *
*          2 = Source directory does not exist.           *
*          3 = Target directory could not be created.     *
*          4 = Certain files or directories could         *
*               not be copied.                            *
*          5 = Max number of copy errors encountered      *
*               and copy was aborted.                     *
*          6 = Not enough space on target                 *
**********************************************************/
ITL!COPYDIR: procedure expose (Globals)
 parse upper arg src, trg .

 /*******************************************************/
 /** Check and condition input params.                 **/
 /*******************************************************/
 if RxDirExist(src)=0 then do
   IMP.0ItlResult = 2;  return 0
 end
 if trg='' then trg='.'
 if RxDirExist(trg)=0 then call RxMkDir(trg)
 if RxDirExist(trg)=0 then do
   IMP.0ItlResult = 3;  return 0
 end
 if right(src,1)<>'\' then src=src'\'
 if right(trg,1)<>'\' then trg=trg'\'

 /*******************************************************/
 /** Setup vars and scan source directory tree.        **/
 /*******************************************************/
 call RxCurPos 4, 0
 call RxSay ' Scanning source directory tree...'
 call RxTree src'*.*', 'source.', 'SB'
 call RxStemSort 'source.', , 38
 call RxSay 'done'
 off = length(src)+38
 RetC = 0
 Errors = 0;
 j=1

 /*************************************/
 /* Determine number of bytes to copy */
 /*************************************/
 BytesCopied=0
 BytesToBeCopied=0
 do i=1 to source.0
     parse var source.i . . size .
     BytesToBeCopied = BytesToBeCopied + size
 end

 /********************************************/
 /* Make sure there is enough room on target */
 /********************************************/
 if substr(trg, 2, 1)=':' then
   trgdrv = left(trg, 2)
 else
   trgdrv=left(directory(),2)
  parse upper value rxDriveInfo(trgdrv) with 'LABEL=' DLabel 'FREE='free .
  if BytesToBeCopied>free then do
    say 'Error - Not enough room to copy files.'
    IMP.0ItlResult = 6;  return 0
  end

 call !StatusBar 22, 5, 70, BytesCopied, BytesToBeCopied
 call RxCurState 'OFF'

 /*******************************************************/
 /** Process all source entries.                       **/
 /*******************************************************/
 do i=1 to source.0

   /************************************************/
   /** Clear screen after every 13 files copied.  **/
   /** (Avoids scrolling).                        **/
   /************************************************/
   if j=14 then do
     do j=0 to 13
       call RxCurPos 4+j, 0
       call RxSay copies(' ', 80)
     end
     j=0
   end

   /***********************************************/
   /** Reset screen pos and get cur file spec.   **/
   /***********************************************/
   call RxCurPos 4+j, 0
   file = substr(source.i, off)  /* Get file spec */

   /************************************************/
   /** Check if its a directory and create it if  **/
   /** needed.                                    **/
   /************************************************/
   if substr(source.i, 32, 1)='D' then do
     if RxDirExist(trg||file)=0 then do
       call RxSay '  Creating directory 'trg||file'...'
       myRc = RxMkDir(trg||file)
       if myRc<>0 then do
         say d2c(7)'rc='myRC
         RetC = 4
       end
       else
         say 'ok'
       j=j+1
     end
   end

   /************************************************/
   /** If not a directory, then it is a file, thus**/
   /** copy it.                                   **/
   /************************************************/
   else do
     call RxSay '      Copying 'trg||file'...'
     'COPY 'src||file' 'trg||file'>nul 2>&1'
     if RC<>0 then do
       if RxFileExist(trg||file)=1 then
          call RxTree trg||file, 'stem.', 'F', '*****', '-*---'
       'COPY 'src||file' 'trg||file'>nul 2>&1'
     end
     if RC<>0 then do
       say d2c(7)'rc='RC
       RetC = 4
       Errors= Errors+1
     end
     else do
       say 'ok'
       BytesCopied = BytesCopied + word(source.i, 3)
     end
     j=j+1
   end

   /************************************************/
   /** Update status bar after every file         **/
   /************************************************/
   call !StatusBar 22, 5, 70, BytesCopied, BytesToBeCopied

   /************************************************/
   /** Check Errors                               **/
   /************************************************/
   if Errors=10 then do
     call RxSay '      Maximum file copy errors reached.  Aborting...'
     call RxSleep 2
     IMP.0ItlResult = 5;  return 0
   end
 end
 call RxCurState 'ON'
 if (rc=0) then BytesCopied = BytesToBeCopied
 call !StatusBar 22, 5, 70, BytesCopied, BytesToBeCopied
 IMP.0ItlResult = RetC
return 0

/**********************************************************
* !StatusBar                                              *
*                                                         *
* Purpose:                                                *
*   Used by DirCopy() to draw a status bar.               *
**********************************************************/
!StatusBar: procedure expose (Globals)
 parse arg row, col, len, size, total .

 Meg =   '1024000'
 inc = trunc(total/(len-2), 2)    /* Get increment            */
 if size=0 then size=1            /* Do not allow / by 0      */
 num = trunc(size/inc)            /* Get number of increments */
 if num>len-2 then num=len-2      /* Check for overflow       */
 call RxCurPos row, col
 call RxSay d2c(192)||copies(d2c(196), len-2)||d2c(217)
 call RxCurPos row-1, col
 call RxSay d2c(179)||copies(d2c(219), num)||copies(' ', len-2-num)||d2c(179)
 call RxCurPos row-2, col
 call RxSay d2c(218)||copies(d2c(196), len-2)||d2c(191)
 call RxCurPos row-3, col
 call RxSay 'Progress:'||right('Copied 'trunc(size/Meg,2)' of',
     trunc(total/Meg,2)' Megabytes', 61)
return

/** Clear the screen **/
ITL!CLS: procedure expose (Globals)
'@CLS'   /* Safer than RxCls which doesn't support ANSI */
return 0

/** Add any command or statement **/
ITL!CMD: procedure expose (Globals)
parse arg Cmd, Pos String, RemStr, Control
RemStr = strip(RemStr)
if FileType('REXX') & pos(left(Cmd, 1), '"'||"'") = 0
  then Cmd = "'"Cmd"'"
call ITLSay 'Inserting command:' Cmd'...'
if FileType('CONFIG') | FileType('IBMLAN') | FileType('PROTOCOL')
  then call InsUnique Cmd, Pos String, 'PREFIX', Control
  else call InsUnique Cmd, Pos String, 'COMPRESS', Control
if RemStr <> ''
  then call RemAll RemStr, 'ALL+', ,CurLn()
return 0

/** Change path statment **/
ITL!CP: procedure expose (Globals)
parse arg Path . , Dir, Ctrl, Force
Force = (translate(Force) = 'FORCE')
if Ctrl = ''
  then Ctrl = 'BEGIN'
  else Ctrl = translate(Ctrl)
if wordpos(word(Ctrl,1), 'BEGIN END DELETE BEFORE AFTER') = 0
  then call ITLErr 'Invalid argument' Ctrl
Dir = strip(Dir, 'T', ';')
Where = Imp.0CurL + 1
if Force & Ctrl <> 'DELETE'
  then call ITL!CP Path, Dir, 'DELETE'
if Ctrl = 'DELETE'
  then do
    call ITLSay 'Deleting' Dir 'from' Path'...'
    call DelPath Path, Dir
  end
  else do
    if length(Dir) > 3
      then Dir = strip(Dir, 'T', '\')
    call ITLSay 'Inserting' Dir 'into' Path'...'
    call InsPath Path, Dir, Ctrl, 'CREATE' Where, 'GOTO'
  end
return 0

/*** Delete a file ***/
ITL!DEL: procedure expose (Globals)
if abbrev(space(translate(arg(1)),0), 'DIR=')
  then do
    parse arg '=' Dir
    if right(Dir, 1) <> '\'
      then Dir = Dir'\'
    Start = 2
  end
  else do
    Dir = ''
    Start = 1
  end

do I = Start while arg(I) <> ''
  File = Dir||arg(I)
/*** PTR 102 start */
  call rxTree File, 'TEMP.', 'F', , '-----'
  if Temp.0 > 0
    then do I = 1 to Temp.0
      Temp.I = subword(Temp.I, 5)
/*** PTR 102 end ***/
      call ITLSay 'Deleting file' Temp.I'...'
      rc = rxDelete(Temp.I)
      if rc <> 0
        then call ItlErr 'Error' rc 'deleting' Temp.I'.'
    end
    else call ITLSay 'File to be deleted ('File') does not exist.'
end
return 0

/** Delete a program entry **/
ITL!DELP: procedure expose (Globals)
parse arg Group, Title
if Title = '' & pos('\', Group) > 0
  then parse var Group Group '\' Title
if Group = '' | Title = ''
  then call ITLErr 'DELP:  Required argument missing.'
call ITLSay 'Deleting program entry' Group'/'Title'.'
rc = rxDeleteProgram('USER', Group, Title)
if rc <> 0 & rc <> 4
  then call ItlSay 'Error' rc 'deleting' Group'/'Program
return 0

/** Add any environment variable statement **/
ITL!ENV: procedure expose (Globals)
parse arg Env . , Val, Pos STarget
Val = strip(Val)
STarget = strip(STarget)
Pos = translate(Pos)
if Pos = 'REMOVE' | Pos = 'DELETE'
  then do
    call ITLSay 'Removing SET' Env'...'
    call RemAll 'SET' Env'='
  end
  else do
    call ITLSay 'Adding SET' Env'='Val'...'
    call InsUnique 'SET' Env'='Val, Pos STarget, 'PREFIX'
  end
return 0

/** Set ERRORMODE **/
ITL!ERRORMODE: procedure expose (Globals)
parse upper arg EMode EArg .
if wordpos(EMode, 'CONTINUE HALT QUIET RESULT NULLENV') = 0 |,
    (EArg <> '' & wordpos(EArg, '0 1') = 0)
  then call ITLErr 'Invalid ERRORMODE:' EMode EArg
  else select
      when EMode = 'NULLENV'
        then Imp.0NullEnv = (EArg = 1)
      otherwise do
        Imp.0ErrorMode = EMode
        if EMode = 'RESULT'
          then Imp.0Error = ''
      end
  end
return 0

/** Set MSGMODE **/
ITL!MSGMODE: procedure expose (Globals)
parse upper arg Opt ., Log
Log = strip(Log)
if Opt <> ''
  then if wordpos(Opt, 'ON OFF') <> 0
    then do
      call ITLSay 'Turning message mode' Opt'...'
      Imp.0Verbose = (Opt = 'ON')
    end
    else call ITLErr 'Invalid MSGMODE setting' Opt'.'
if Log <> ''
  then do
    call ITLSay 'Setting log file to "'Log'"...'
    Imp.0ITLLog = Log
    call ITLSay copies('-', 70)
  end
return 0


/** Evaluate an arbitrary expression **/
ITL!EVAL: procedure expose (Globals)
parse arg Expr
call ITLSay 'Executing' Expr'...'
if left(Expr, 1) = "'" & right(Expr, 1) = "'"
  then do
    strip(Expr, 'B', "'")  /* Strip quotes and pass to OS/2 */
    Imp.0ItlResult = rc
  end
  else do
    Forbidden = 'EXIT ITERATE LEAVE PROCEDURE RETURN SIGNAL'
/*
    Keywords = 'ADDRESS ARG CALL DO DROP IF INTERPRET NOP NUMERIC OPTIONS',
        'PARSE PULL PUSH QUEUE SAY SELECT TRACE'
*/
    W1 = translate(word(Expr, 1))
    if wordpos(W1, Forbidden) > 0
      then call ItlErr 'Illegal keyword' W1 'to EVAL.'
      else do
        if pos('(', W1) > 0
          then do
            parse upper var W1 W1 '('
            if verify(W1, 'ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789!?_') = 0
              then Expr = 'result =' Expr
          end
        signal off novalue
        signal off error
        signal on syntax name syntax
        interpret Expr
        if symbol('RC') = 'VAR'
          then call ItlSay 'Error' rc 'evaluating' Expr
        signal on novalue
        signal on error
        if symbol('RESULT') = 'LIT'
          then Imp.0ItlResult = ''
          else Imp.0ItlResult = result
      end
  end
call ITLSay '... "'Imp.0ItlResult'"'
return 0

/**
ITL!EVAL: procedure expose (Globals)
parse arg Expr
call ITLSay 'Executing' Expr'...'
if left(Expr, 1) = "'" & right(Expr, 1) = "'"
  then do
    strip(Expr, 'B', "'")  /* Strip quotes and pass to OS/2 */
    Temp = rc
  end
  else interpret "Temp =" Expr
Imp.0ItlResult = Temp
call ITLSay '...' Temp
return 0
**/

/** Exit **/
ITL!EXIT: procedure expose (Globals)
parse value arg(1) '0' with OutC .
call ITLSay 'Exiting - rc('OutC')'
return '!'OutC

/** FIND **/
ITL!FIND: procedure expose (Globals)
parse upper arg Target, SMode ., MMode .
call ITLSay 'Searching for' Target'...'
Imp.0ItlResult =  Find(Target, SMode, MMode)
return 0

/** Goto **/
ITL!GOTO: procedure expose (Globals)
parse upper arg Label .
if Label = ''
  then call ITLErr 'Null label passed to GOTO.'
if Left(Label, 1) <> ':'
  then Label = ':'Label
call ITLSay 'Branching to' Label'...'
call rxStemGrep Label, 'IMP.0MODS.', 'TEMP.', 'N'
do J = 1 to Temp.0
  if translate(word(Temp.J, 2)) = Label
    then return word(Temp.J, 1)
end
call ItlErr 'Label' Label 'not found.'
return 0

/** IF **/
ITL!IF: procedure expose (Globals)
parse upper arg Expr
IfNum = Imp.0IfStack.0 + 1
Imp.0IfStack.0 = IfNum
if Imp.0IfScan <> 0
  then return 0

Temp = 'IF ('Expr')'
Expr = LookUp(Expr)
Temp = Temp '('Expr')'
interpret "Bool = ("Expr")"                                                                                                                                                                                                                                   
call ITLSay copies(' ', (IfNum-1) * 2)Temp '::' Bool'...'
if wordpos(Bool, '0 1') = 0
  then call ITLErr 'Result ('Bool') not boolean.'
Imp.0IfStack.IfNum = Bool
if \Bool
  then Imp.0IfScan = IfNum
return 0

ITL!ENDIF: procedure expose (Globals)
IfNum = Imp.0IfStack.0
if IfNum < 1
  then call ITLErr 'ENDIF encountered outside IF.'
  else do
    Imp.0IfStack.0 = IfNum - 1
    if Imp.0IfScan <> 0
      then if Imp.0IfScan = IfNum
        then Imp.0IfScan = 0
    if Imp.0IfScan = 0
      then call ItlSay copies(' ', (IfNum-1) * 2)'...ENDIF'
return 0

ITL!ELSE: procedure expose (Globals)
IfNum = Imp.0IfStack.0
if IfNum < 1
  then call ItlErr 'ELSE encounted outside IF.'
  else do
    call ItlSay copies(' ', (IfNum-1) * 2)'...ELSE...'
    If Imp.0IfScan <> 0
      then if Imp.0IfScan = IfNum
        then Imp.0IfScan = 0
        else nop
      else Imp.0IfScan = IfNum
  end
return 0

/** Make a directory **/
ITL!MD: procedure expose (Globals)
parse arg Dir       /* May contain embedded blanks */
Dir = strip(Dir)
call ITLSay 'Making directory 'Dir'...'
I = lastpos('"', Dir)
do while I > 0
  Dir = delstr(Dir, I, 1)
  I = lastpos('"', Dir)
end
I = pos('\', Dir)
do while I <> 0
  call ITL!!MD2(left(Dir, I-1))
  I = pos('\', Dir, I+1)
end
call ITL!!MD2 Dir
return 0

ITL!!MD2: procedure expose (Globals)
parse arg Dir
if \(length(Dir) = '2' & right(Dir, 1) = ':') & \rxDirExist(Dir)
  then do
    rc = rxMkDir(Dir)
    if rc <> 0
      then call ITLErr 'Error' rc 'creating' Dir'.'
  end
return 0

/** Check numerical parameter **/
ITL!NUMCHK: procedure expose (Globals)
parse arg NParm Bit . , Min . , Max . , Set .
BitMode = (Bit <> '')
NParm = translate(NParm)
if BitMode
  then Desc = NParm 'bit' Bit
  else Desc = NParm
call ITLSay 'Checking numerical parameter' Desc '('Min','Max'):'Set'...'
Found = 0
Done = 0
if Find(NParm, 'ALL+', 'BEGIN') = 0
  then do until Found | Done
    OldLine = GetLine()
    parse upper var OldLine TestParm . '=' OrigVal .
    Found = (TestParm = NParm)
    if \Found
      then Done = (FindNext() <> 0)
  end
If Found
  then if Bit <> ''
    then do
      TestVal = substr(OrigVal, Bit+1, 1)
      if TestVal = ''
        then do
          call ItlSay '...bit' Bit 'does not exist.'
          TestVal = -999999
        end
    end
    else TestVal = OrigVal
if Found
  then do
    parse value Set Max Min with Set .
    parse value Min TestVal with Min .
    parse value Max TestVal with Max .
    if (TestVal < Min) | (TestVal > Max)
      then do
        call RemLine
        call ITLSay '...'Desc '=' TestVal '- changed to' Set'.'
        if Bit <> ''
          then Set = overlay(Set, OrigVal, Bit+1)
        call InsLine ChangeStr(OldLine, OrigVal, Set)
      end
      else call ITLSay '...'Desc '=' TestVal '- okay.'
  end
  else if Bit = '' & Set <> ''
    then do
      call ITLSay NParm 'not found in file -- adding.'
      call ITL!CMD NParm'='Set
    end
    else call ITLErr NParm 'not found in file.'
return 0

ITL!OPTIONS: procedure expose (Globals)
parse upper arg Opt OptVal
select
  when Opt = 'EXITPAUSE'
    then if wordpos(OptVal, 'YES NO') = 0
      then call ILTErr 'Invalid option value:' Opt
      else Imp.0ErrPause = (OptVal = 'YES')
  otherwise call ITLErr 'Invalid option:' Opt
end
return 0

/** Add a remark statement **/
ITL!REM: procedure expose (Globals)
parse arg New, Pos Target, Blank .
parse upper value Pos 'AFTER' with Pos .
New = RemLine(New)
call ITLSay 'Inserting remark:' New'...'
call InsUnique New, Pos Target, 'COMPRESS'
if translate(Blank) = 'BLANK'
  then call InsBlank 'BEFORE'
return 0

/** Remark all strings **/
ITL!REMALL: procedure expose (Globals)
parse arg String, Del
Del = (translate(Del) = 'DELETE')
if Del
  then do
    call ITLSay 'Deleting all lines containing "'String'"...'
    More = (Find(String, 'ALL+') = 0)
    do while More
      call DelLine 'BACKUP'
      More = (FindNext() = 0)
    end
  end
  else do
    call ITLSay 'Remarking all lines containing "'String'"...'
    call RemAll String, 'ALL+'
  end
return 0

/** Replace a file (if needed) **/
ITL!REPFILE: procedure expose (Globals)
parse arg Src, Dst, Opts
Src = strip(Src)
Dst = strip(Dst)
if Src = '' | Dst = ''
  then call ITLErr 'Source and target must be specified.'
/**
if pos('?', Src Dst) + pos('*', Src Dst) > 0
  then call ITLErr 'Wildcard characters are not supported by REPFILE.'
 **/
call ITLSay 'Replacing' Src 'to' Dst'...'
RetC = ReplaceFile(Src, Dst, Opts)
if RetC <> 0
  then call ITLErr 'Error' RetC 'replacing' Src 'to' Dst'.'
return 0

/** Turn on/off string replacement **/
ITL!REPSTR: procedure expose (Globals)
parse arg Opt, Str2
Opt = translate(strip(Opt))
if Str2 = ''
  then if wordpos(Opt, 'ON OFF') <> 0
    then do
      call ITLSay 'Turning string replacement' Opt'...'
      Imp.0StrRep = (Opt = 'ON')
    end
    else call ITLErr 'Invalid REPSTR argument' Opt'.'
  else do
    Str2 = LookUp(strip(Str2))
    if Opt = ''
      then call ITLErr 'First REPSTR argument resolved to null.'
      else if Opt = Str2
        then call ITLErr 'REPSTR source and target are the same.'
        else do
          call ITLSay 'Replace String ['Opt'|'Str2']'
          call ITLReplaceStringAdd Opt, Str2
        end
  end
return 0

/** Read a file **/
ITL!RF: procedure expose (Globals)
parse arg File
call ITLSay 'Reading 'file'...'
call ReadFile File
call SetComment 'DESC', '('Imp.0ITLMe date()')'
return 0

/* Display information for the edification of the user */
ITL!SAY: procedure expose (Globals)
call ITLSay arg(1), 'FORCE'
return 0

/** Sleep a specified number of seconds **/
ITL!SLEEP: procedure expose (Globals)
parse arg Secs .
call RxSleep Secs
return 0

/** Synchronization services **/
ITL!SYNCH: procedure expose (Globals)
parse arg Point .
if verify(Point, '0123456789') = 0
  then call ItlSay '***** Synch point' Point 'encountered.'
return 0

/** Write file **/
ITL!WF: procedure expose (Globals)
if FileChanged()
  then do
    parse arg Backdir, BackType
    call ITLSay 'Writing file ('BackDir BackType')...'
    if Imp.0Verbose
      then call WriteFile BackDir, BackType, 'VERBOSE'
      else call WriteFile BackDir, BackType
  end
  else call ITLSay 'File not changed - no write performed.'
return 0

ITL!TRACE: procedure expose (Globals)
parse arg Imp.0TrVal .
return 0

ITL!COREINSTDIRCHECK: procedure expose (Globals)
parse upper arg Drive ., Dir ., Label ., MsgOffset .
if Drive = '' | Dir = '' | Label = '' | MsgOffset = ''
  then call ITLErr 'Bad DIRCHECK arguments.'
call ItlSay 'Checking for' Label '('Dir','MsgOffset') in drive' Drive'...'
Label = strip(strip(Label),,'"')
App = 'CREQINST'
Msg = 560 + MsgOffset
Imp.!ItlZipDir = Dir
do while \rxDirExist(Imp.!ItlZipDir)
  call rxOS2Ini 'USER', App, 'CMD', 'DISK|'Drive'|'Label'|'Msg
  say '[*CMD*]'
  do until Done
    call rxsleep 1
    Done = (IniGet('USER', App, 'CMD') = '')
  end
end
return 0

ITL!COREINSTUNZIP: procedure expose (Globals)
parse upper arg ZipFile, TargetDir, FileList, ZipArgs, TempDir
if ZipFile = '' | TargetDir = '' | FileList = ''
  then call ITLErr 'Bad UNZIP arguments.'
ZipArgs = arg(4)   /* Get mixed case copy */
if TempDir <> ''
  then if \rxDirExist(TempDir)
    then do
      call ItlErr 'Temp directory' TempDir 'does not exist.'
      return 0
    end
if \rxFileExist(ZipFile)
  then if rxFileExist(Imp.!ItlZipDir'\'ZipFile)
    then ZipFile = Imp.!ItlZipDir'\'ZipFile
    else do
      call ItlErr 'File' ZipFile 'does not exist.'
      return 0
    end

if TempDir <> ''
  then do  /* Unpack to staged copy via COUCOPY */
    call ItlSay 'Unzipping' ZipFile '('FileList') to' TargetDir 'via',
        TempDir '('ZipArgs')...'
    Res = Itl!!RunCmd('PKUNZIP2' ZipArgs ZipFile TempDir FileList)
/**** PTR 107 start ****/
    call ITL!CoreInstUnzipErrCheck Res
/**** PTR 107 end ****/
    TempDir = strip(TempDir, 'T', '\')
    do while FileList <> ''
      parse var FileList File FileList
      if abbrev(File, '"')
        then do
          parse var FileList FileRest '"' FileList
          File = File||FileRest
        end
/**** PTR 10215 start ****/
      FileName = filespec('NAME', File)
      File = TempDir'\'FileName
      Res = rxCouCopy(File, TargetDir'\'FileName)
/**** PTR 10215 end *****/
      if abbrev(Res, 'ERROR:')
        then call ItlErr 'Error' Res 'from COUCOPY.'
      call rxDelete File
    end
  end
  else do /* Direct unpack */
    call ItlSay 'Unzipping' ZipFile '('FileList') to' TargetDir,
        '('ZipArgs')...'
    Res = Itl!!RunCmd('PKUNZIP2' ZipArgs ZipFile TargetDir FileList)
/**** PTR 107 start ****/
    call ITL!CoreInstUnzipErrCheck Res
/**** PTR 107 end ****/
  end
return 0

/**** PTR 107 start ****/
ITL!COREINSTUNZIPERRCHECK: procedure expose(Globals)
parse arg Res
If Res = ''
  then call ItlErr 'Output from PKUNZIP2 vanished!'
  else do
    ErrSum = ''
    E11 = 0
    W10 = 0
    Temp = Res
    do while Temp <> ''
      parse var Temp '(E' ECode ')' Temp
      if ECode <> '' & verify(ECode, '0123456789') = 0
        then if ECode = 11
          then E11 = 1
          else ErrSum = ErrSum 'E'ECode
    end
    Temp = Res
    do while Temp <> ''
      parse var Temp '(W' WCode ')' Temp
      if WCode <> '' & verify(WCode, '0123456789') = 0
        then if WCode = 10
          then W10 = 1
          else ErrSum = ErrSum 'W'WCode
    end
    if ErrSum <> ''
      then call ItlErr 'An error occurred unpacking files ('strip(ErrSum)')'
      else if E11
        then if W10
          then call ITL!CoreInstMsgBox 'Install Warning', 'Some files could',
              'not be unpacked because the target files are in use.'
          else call ItlErr 'Expected file(s) were not found.'
  end
return
/**** PTR 107 end ****/

ITL!COREINSTCREATEALIAS: procedure expose (Globals)
parse arg Server, AliasName, PhysPath, Comment, WhenShare, NoRetry
NoRetry = (NoRetry = 1)
if Server = '' | AliasName = '' | PhysPath = '' | Comment = ''
  then call ITLErr 'Bad CreateAlias arguments.'
if WhenShare = ''
  then WhenShare = 'STARTUP'
call ItlSay 'Creating \\'Server'\'AliasName '=' PhysPath '('Comment')...'
PreQ = queued()
call Itl!!RunCmd 'NET ALIAS' AliasName '/DELETE'
Res = Itl!!RunCmd('NET ALIAS' AliasName '\\'Server PhysPath '/W:'WhenShare,
    '/R:"'Comment'" /UN')
/**** PTR 10241 start ****/
if pos('SYS0005', Res) > 0
  then call ItlErr 'Access denied modifying access control.  The',
      'userid and password being may not have administrator',
      'authority on the domain controller.'
/**** PTR 10241 end ****/
if pos('NET2788', Res) > 0
  then do
    call ItlSay 'An alias for' PhysPath 'already exists.  Locating...'
    OldALias = ''
    PreQ = queued()
    Aliases = ''
    'NET ALIAS 2>NUL | RXQUEUE /LIFO'
    do while queued() > PreQ
      pull Name Type .
      if Type = 'FILES'
        then Aliases = Aliases Name
    end
    do while Aliases <> '' & OldAlias = ''
      parse var Aliases Name Aliases
      'NET ALIAS' Name '2>NUL | RXQUEUE /LIFO'
      I. = ''
      do while queued() > PreQ
        pull Tag ':' I.Tag
      end
      if I.PATH = PhysPath
        then OldAlias = I.ALIAS
    end
    if OldAlias = ''
      then call ItlErr 'An alias for' PhysPath 'already exists, but could',
          'not be identified.'
      else if NoRetry
        then call ItlErr 'Alias' OldAlias 'already exists for' PhysPath',',
            'but could not be removed.'
        else do
          call Itl!!RunCmd 'NET ALIAS' OldAlias '/DELETE'
          call ITL!COREINSTCREATEALIAS Server, AliasName, PhysPath, Comment,,
              WhenShare, 1
        end
  end
return 0

ITL!COREINSTCREATEACP: procedure expose (Globals)
parse upper arg PhysPaths, Names, Permissions
if PhysPaths = '' | Names = '' | Permissions = ''
  then call ItlErr 'Bad CreateACP arguments.'
call ItlSay 'Giving' Permissions 'access to' PhysPaths 'for' Names'...'
do I = 1 to words(PhysPaths)
  PhysPath = word(PhysPaths, I)
  if pos(':', PhysPath) = 0
    then do
      Temp = left(PhysPath, 1)':'
      do J = 2 to length(PhysPath)
        Temp = Temp substr(PhysPath, J, 1)':'
      end
      return (ITL!COREINSTCREATEACP(Temp, Names, Permissions))
    end
    else do
      if length(PhysPath) = 1
        then PhysPath = PhysPath':'
      do J = 1 to words(Names)
        Name = word(Names, J)
/**** PTR 10241 start ****/
        Res = Itl!!RunCmd('NET ACCESS' PhysPath '/ADD' Name':'Permissions)
        if pos('SYS0005', Res) > 0
          then call ItlErr 'Access denied modifying access control.  The',
              'userid and password being may not have administrator',
              'authority on the domain controller.'
        if pos('NET3502', Res) > 0
          then call ItlErr 'Unexpected OS/2 error modifying access control.'
        if pos('NET2225', Res) > 0
          then if pos('NET3739', Itl!!RunCmd('NET ACCESS' PhysPath '/GRANT',
              Name':'Permissions)) > 0
            then call Itl!!RunCmd 'NET ACCESS' PhysPath '/CHANGE',
                Name':'Permissions
/**** PTR 10241 end ****/
      end J
    end
end I
return 0

ITL!COREINSTDELETEACP: procedure expose (Globals)
parse upper arg PhysPath, DelTree
if PhysPath = ''
  then call ItlErr 'Bad DeleteACP arguments.'
DelTree = (DelTree = 'TREE')
if DelTree
  then call ItlSay 'Deleting ACP for' PhysPath 'and subtree...'
  else call ItlSay 'Deleting ACP for' PhysPath'...'
Res = Itl!!RunCmd('NET ACCESS' PhysPath '/DELETE')
/**** PTR 10241 start ****/
if pos('SYS0005', Res) > 0
  then call ItlErr 'Access denied modifying access control.  The',
      'userid and password being may not have administrator',
      'authority on the domain controller.'
/**** PTR 10241 end ****/
if DelTree
  then do
    PreQ = queued()
    'NET ACCESS' PhysPath '/TREE 2>&1 | RXQUEUE /FIFO'
    do while queued() > PreQ
      pull Line '('
      if abbrev(Line, PhysPath)
        then call Itl!!RunCmd 'NET ACCESS' strip(Line) '/DELETE'
    end
  end
return 0

ITL!COREINSTMSGBOX: procedure expose (Globals)
parse arg Title, Msg
App = 'CREQINST'
NoInt = value('COU.NOINT',,'OS2ENVIRONMENT') <> ''
VState = Imp.0Verbose
Imp.0Verbose = \(NoInt)
call ItlSay '[' Title ']'
call ItlSay Msg
Imp.0Verbose = VState
if \NoInt
  then do
    call rxOS2Ini 'USER', App, 'CMD', 'MSGBOX|INFO|'Title'|'Msg||d2c(0)
    say '[*CMD*]'
    do until Done
      call rxsleep 1
      Done = (IniGet('USER', App, 'CMD') = '')
    end
  end
return 0

ITL!!RUNCMD: procedure expose (Globals)
parse arg Cmd
call ItlSay 'Executing "'Cmd'"...'
PreQ = queued()
Res = ''
Cmd '2>&1 | RXQUEUE /FIFO'
if queued() > PreQ
  then do
    do PreQ    /* Shuffle previously queued lines to bottom */
      parse pull Line
      queue Line
    end
    do while queued() > PreQ
      parse pull Line
      Res = Res||Line||'0'x
      call ItlSay '>' Line
    end
  end
call ItlSay '> RC('rc')'
return Res

/*****************************************************************************
 * LookUp                                                                    *
 *****************************************************************************/
LookUp: procedure expose (Globals)
/* trace value imp.0trval */
parse arg Str
TStr = translate(Str)
if Imp.0StrRep & verify(TStr, Imp.0RepStart, 'MATCH') <> 0
  then do I = 1 to Imp.0Org.0
    if pos(Imp.0Org.I, translate(Str)) <> 0
      then do
        Temp = Imp.0Org.I
        Str = ChangeStr(Str, Imp.0Org.I, value('IMP.0REP.TEMP'), 'ALL', 'LEFT')
      end
  end

FuncList = 'VAL ENV RESULT INIVAL GETLINE COUINFO'
ScanStart = 1
AmpPos = pos('&', Str)
do while AmpPos <> 0
  P1 = left(Str, AmpPos - 1)
  P2 = substr(Str, AmpPos + 1)
  parse upper var P2 Func '('
  if Func = '' | left(Func, 1) = ' ' | right(Func, 1) = ' ' |,
      wordpos(Func, FuncList) = 0
    then do
      ScanStart = AmpPos + 1
      AmpPos = pos('&', Str, ScanStart)
      iterate
    end
  if pos(')', P2) = 0
    then call ITLErr 'Closing parenthesis not found.'
  parse var P2 '(' FuncArg ')' P2
  select
    when Func = 'VAL'
      then do
        FuncArg = translate(FuncArg)
        if symbol('IMP.0REP.FUNCARG') = 'VAR'
          then FuncArg = Imp.0Rep.FuncArg
          else call ITLErr 'VAL:' FuncArg 'has not been defined.'
      end
    when Func = 'ENV'
      then do
        if pos('<', FuncArg) = 0
          then NullEnv = Imp.0NullEnv
          else parse var FuncArg FuncArg '<' NullEnv '>'
        FuncRes = value(FuncArg,,'OS2ENVIRONMENT')
        if FuncRes = ''
          then if NullEnv
            then call ITLSay "ENV: Variable" FuncArg "resolved to ''."
            else do
              call ITLErr 'ENV: Variable' FuncArg 'not defined.'
              FuncRes = FuncArg
            end
        FuncArg = FuncRes
      end
    when Func = 'RESULT'
      then if translate(FuncArg) = 'ERROR'
        then FuncArg = Imp.0Error
        else FuncArg = Imp.0ItlResult
    when Func = 'GETLINE'
      then FuncArg = GetLine(FuncArg)
    when Func = 'INIVAL'
      then do
        parse var FuncArg File '/' App '/' Key
        FuncArg = strip(rxOs2Ini(File, App, Key),,d2c(0))
        if abbrev(FuncArg, '$RXERROR')
          then FuncArg = ''
      end
    when Func = 'COUINFO'
      then FuncArg = GetCouInfo(FuncArg)
    otherwise call ITLErr 'Unknown ITL function:' Func'.'
  end
  Str = P1||FuncArg||P2
  AmpPos = pos('&', Str, ScanStart)
end
return Str

GetCouInfo: procedure expose (Globals)
signal on syntax name GetCouInfo2
Res = rxCouInfo('GET', arg(1))
return Res

GetCouInfo2:
call ItlErr 'Bad COUINFO parameter "'arg(1)'".'
return ''

/*****************************************************************************
 * ITLSAY msg                                                                *
 *****************************************************************************/
ITLSay: procedure expose (Globals)
parse arg Msg.1, Force
Msg.1 = translate(Msg.1, ' ', '0'x)
if Imp.0Verbose | (Force = 'FORCE')
  then say Msg.1
if Imp.0ITLLog <> ''
  then do
    Msg.0 = 1
    Msg.1 = Imp.0PC':'Msg.1
    RetC = rxWrite(Imp.0ITLLog, 'MSG.',,,'A')
    if RetC <> 0
      then call ITLErr 'Error' RetC 'writing to' Imp.0ITLLog'.'
  end
return 0

/*****************************************************************************
 * ITLERR emsg                                                               *
 *****************************************************************************/
ITLErr: procedure expose (Globals)
parse arg Msg.1
signal off novalue
Msg = Msg.1
Msg.1 = '(line' Imp.0PC')' Msg.1
if Imp.0ITLLog <> ''
  then do
    Msg.0 = 1
    RetC = rxWrite(Imp.0ITLLog, 'MSG.',,,'A')
    if RetC <> 0
      then say 'Error' RetC 'writing to' Imp.0ITLLog' - Logging disabled.'
  end
if Imp.0ErrorMode <> 'QUIET'
  then say Msg.1
if Imp.0ErrorMode = 'RESULT'
  then Imp.0Error = Msg
if Imp.0ErrorMode = 'HALT'
  then call ImpError ''
return 0

/*****************************************************************************
 *                              ERROR HANDLERS                               *
 *****************************************************************************/
Halt:
Where = SigL
/**
call off halt
if abbrev(stream('STDIN:', 'C', 'CLOSE'), 'READY')
  then Response = AskUser('Halt detected.  Do you want to abort?',,
      'NO YES', 1, 0)
  else do
    Response = 'NO'
    say 'Could not close stdin.  Unconditional abort.'
  end
if Response = 'NO'
  then call on halt
  else do
**/
    say 'Execution halted by user at line' Where'.'
    exit 255
/**
  end
**/
return

ITLSyntax:
Syntax:
signal off error; signal off failure; signal off halt
signal off novalue; signal off notready; signal off syntax
if arg(1) = d2c(0)
  then Where = arg(2)
  else Where = SigL
/**
call BugInit
**/
select
  when Syntax.Ref = 'NOCOUENV'
    then Msg999 = '>> COUENV.DLL not found.'
  otherwise
    Msg999 = '>> Syntax error' rc '('errortext(rc)') raised in line' Where
end
signal DebugExit

Novalue:
Where = SigL
signal off error; signal off failure; signal off halt
signal off novalue; signal off notready; signal off syntax
Msg999 = '>> Novalue error' condition('D') 'raised in line' Where
signal DebugExit

DebugExit:
if Imp.!ItlActive = 1
  then do
    Imp.0ErrorMode = 'CONTINUE'
    call ItlErr Msg999
  end
  else say Msg999
Line = sourceline(Where)
say 'Line reads: "'Line'"'
if wordpos('EXPR', translate(Line)) > 0
  then say 'Expr =' Expr
say
say 'Please notify the developers!  Press <Enter> to exit.'
if translate(linein('STDIN:')) = '/D'
  then do
    trace ?i
    nop
  end
exit 255

/*
 * Change History:
 * (Previous history in \COREUTIL\IMPIT.HST)
 * 30 Sep 91 - 2.20 - Remove CMD file tokenization
 *                  - bug fix - multiple ITL files mangled string lookup table.
 *                  - bug fix - standalone & in boolean seen as function start.
 * 15 Oct 91 - 2.21 - bug: ITL CMD not inserting unique lines.
 *                  - SAY not being added to log file.
 *                  - bug: DELFILE syntax error
 *                  - change default setting for 0NullEnv to 1.
 *                  - Force INSLINE value to be inside file range.
 *                  - SOURCE.DIR not correct path to ITL file.
 * 16 Oct 91 - 2.22 - Add &INIVAL() function.
 *                  - Add support for wild cards to REPLACEFILE.
 *                  - bug: force INSLINE value to be at least 1.
 *                  - bug: adding line at EOF added it at line EOF-1.
 *                  - changed EVAL to handle calls which don't return a value.
 *                  - Give better error message for no closing parenthesis.
 *                  - Pause before exiting on ITL errors.
 * 13 Nov 91 - 2.23 - Add OPTIONS EXITPAUSE.
 *  2 Jan 92        - Fix COMPUTERNAME for OS/2 2.0.
 * 27 Jan 92 - 2.24 - Add {BOOT.DRIVE} replace string.
 *  3 Feb 92 - 2.25 - Correct BOOT.DRIVE for down-level systems.
 *  3 Mar 92 - 2.26 - bug: FINDIT could die if lines were deleted in FindNext loop.
 *  6 Mar 92 - 2.27 - bug: REPFILE would not create files in root directory.
 * 10 Mar 92 - 2.28 - Add /NOPAUSE option to force no pause on exit.
 *                  - Add error checking in ADDINI.
 * 19 Mar 92 - 2.29 - bug: CHANGEPATH w/ target could cause syntax error.
 *                  - bug: WRITEFILE n kept n+1 backup copies.
 *                  - Make informed guess if 2.0 boot drive can't be determined.
 * 26 Mar 92 - 2.30 - Add {OS2VER} Replace String.
 *  3 Apr 92        - ADDINI was not uppercasing file name before checking.
 *  6 Apr 92 - 2.31 - Add DELP/DELPROGRAM to delete program entry.
 *                  - Add FORCE option to CP to delete and readd entry.
 * 22 Apr 92 - 2.32 - bug: DelPath died if dir entry was first in path.
 *                  - Mark current line in ECHOFILE display.
 *                  - bug: Targets on INSUNIQUE were getting ignored.
 * 25 Apr 92        - Strip trailing backslash, if needed, from CP insertions.
 *  8 May 92        - Add RXCADD initialization, if available.
 * 18 May 92 - 2.33 - bug: REMLINE would add REM even if it already existed.
 *                  - EOF before ENDIF did not raise an error condition.
 * 20 May 92        - Remove all hardcoded C: occurances.
 * 21 May 92   2.34 - Add more RXCADD support.
 *                  - Add INIGET and INISET IMP functions.
 *                  - Add ADDLOCAL and DELLOCAL ITL functions.
 *                  - Add DIR= option to ITL DELFILE function.
 *                  - Add REMOVE option to ITL ENVVAR function.
 *                  - Add NOCONF parameter to ASK.
 * 23 Jun 92        - Add workaround for NOVALUE error in REXX20 2.01.
 *  7 Jul 92        - Reworked InsUnique prefix processing to handle RUN=
 *                    and CALL= properly.
 * 14 Jul 92        - Make comments generated by our code look nicer.
 * 15 Jul 92        - bug: 14 Jul mod broke InsUnique.
 *                  - Allow ".." delimitters to arguments to enclose leading/
 *                    trailing spaces.
 *                  - Translate nulls to spaces in ITLSAY.
 * 28 Jul 92        - bug: {SOURCE.DIR} repstr not always set properly.
 *                  - bug: REPFILE (ITL) did not report all errors returned by
 *                    REPLACEFILE (IMP).
 *  5 Jul 92        - Add DPATH searching for ITL file.
 *                  - bug: Incorrect interpreter error when ADDP nested in IF stmt.
 * 11 Aug 92        - Display IMP version at startup.
 * 13 Aug 92        - Added LOWER (5th) parameter to ASK.
 * 26 Aug 92 - 2.35 - bug: INSPATH "AFTER target" placed entry incorrectly if target
 *                    did not exist.
 *                  - Add multiple targets to INSPATH.
 *                  - Add REPLACEONLY and NEWONLY options to IMP InsUnique and ITL
 *                    COMMAND.
 * 17 Sep 92        - Ignore double quotes in ITL MD directory specification.
 *  1 Oct 92        - READFILE returned too early if file empty.
 *  5 Oct 92 - 2.36 - AddObject added for OS/2 2.0 systems.
 *                  - AddProgram calls converted to ADDOBJ calls on 2.0 systems.
 *                  - bug: Recursive call to CP would not find traget line.
 * 19 Oct 92 - 2.37 - Allows ITL commands to be run from the REXX queue.
 *                  - Adds (undocumented) DELETE option to REMALL.
 * 29 Oct 92        - Add SYNCH nop for later implementation.
 * 10 Dec 92 - 2.38 - Remove RXCADD knowlegde.  Direct ITL calls not supported from
 *                    COREADD.
 * 18 Dec 92 - 2.39 - bug: WF before RF would cause novalue error.
 *                  - bug: CMD at TOP would break REXX execs
 *                  - TOP now goes to 1st non-comment line.  Use 1 for line 1.
 *                  - bug: ImpError novalue error under some conditions.
 *  4 Jan 93        - bug: NOVALUE error when ITL embedded in a CMD file.
 * 18 Jan 93        - bug: WF would fail if file had attributes of R, S, or H.
 *                  - WF now preserves attributes of file.
 *                  - WF preserves EAs of original object.
 *                  - bug: COREDATA used wrong default for CORE.INI location.
 *  1 Feb 93 - 2.40 - Extend AddLocal to take one filename.
 *  5 Mar 93        - bug: FORCE on CP had to be in exact case.
 *                  - bug: REMALL could set mod flag when no mod occurred.
 *                  - bug: InsString always inserted at end.
 *  7 Mar 93 - 2.41 - Add AddLocalFiles and DelLocalFiles routines.
 * 15 Mar 93        - Add PATH & DPATH support to InsPath, DelPath for BATCH types.
 * 18 Mar 93        - REMALL was returning wrong return code.
 * 19 Mar 93        - Add NAME=xxx backup type.
 *  1 Apr 93        - ImpError now writes to ITL log if ITL is active.
 *                  - Readd undocumented DELETE option to REMALL.
 * 20 Apr 93        - Allow trailing semicolon on CP dir spec.
 * 27 Apr 93 - 2.42 - Add COREINST private routines.
 *                  - Add &COUINFO function.
 *                  - RF and READFILE were incorrectly handling empty files.
 * 10 May 93        - bug: empty paths not handled correctly by InsPath.
 *                  - bug: DelPath mishandled missing semicolon.
 * 21 May 93 - 2.43 - bug: InsUnique was not handling similar prefixes.
 *  1 Jun 93        - use RXCOUENV to obtain CORE information.
 *  4 Jun 93 - 2.44 - Update CopyFile to support RXCOUCOPY.
 * 28 Jun 93        - bug: RemAll/RemLine would rem REMs.
 *  7 Jul 93 - 2.45 - disable saving of EAs under OS/2 2.x.
 *  5 Aug 93        - bug: NUMCHECK died if param missing from file.
 * 17 Aug 93        - bug: Lowercase call to CP DELETE would fail.
 * 18 Mar 94        - bug: Changing SET HELP would modify HELPINDEX if it came
 *                    first in the file.
 * 31 May 94 - 2.46 - bug: PATH xxx (without equals sign) not handled properly
 *                    in AUTOEXEC.BAT file.
 */
