OS/2 Shareware BBS: 10 Tools/10-Tools.zip/ppwi2284.zip/ppwizard.cmd

OS/2 REXX Batch file | 2002-10-10 | 416KB | 16,393 lines

/**+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+
* Generator   : PPWIZARD version 02.268
*             : FREE tool for Windows, OS/2, DOS and UNIX by Dennis Bareis ([e-mail])
*             : http://www.labyrinth.net.au/~dbareis/ppwizard.htm
* Time        : Friday, 11 Oct 2002 11:06:34am
* Input File  : C:\DBAREIS\Projects\MultiOs\PPWIZARD\ppwizard.x
* Output File : C:\DBAREIS\Projects\MultiOs\PPWIZARD\out\ppwizard.rex
*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*/

if arg(1)="!CheckSyntax!" then exit(21924)

PgmVersion="02.284"
SupportedReginaVersions='2.0, 2.2, 3.0, 3.0.1 or 3.0BETA2'
RecommendedReginaVersions='3.0.1'
TrapHandler=''
RedirMethod=''
call ConsoleWriteAllowed 'Y'
call InitScreenHandling2Off
call InitCommandLineOptions arg(1)
call InitConsoleOutputVarsPass1
PpwDoing='Initializing'
Dummy=time('Reset')
b2rNewSingleQuote="' || " || '"' || "'" || '" || ' || "'"
b2rAllHexCodes=''
b2rAllAsciiCodes=''
do b2rCharCode=0 to 31
b2rAllHexCodes=b2rAllHexCodes||d2c(b2rCharCode)
end
do b2rCharCode=32 to 126
b2rAllAsciiCodes=b2rAllAsciiCodes||d2c(b2rCharCode)
end
do b2rCharCode=127 to 255
b2rAllHexCodes=b2rAllHexCodes||d2c(b2rCharCode)
end
signal EndBIN2REXPXh

_QuoteAscii:
b2rAscii2Quote=arg(1)
if pos("'",b2rAscii2Quote)=0 then
return("'" || b2rAscii2Quote || "'")
else
do
if pos('"',b2rAscii2Quote)=0 then
return('"' || b2rAscii2Quote || '"')
else
do
return("'" || ReplaceString(b2rAscii2Quote, "'", b2rNewSingleQuote) || "'")
end
end

_FormatHex:
b2rHexString=arg(1)
b2rLengthHex=length(b2rHexString)
b2rFormattedHex="'"
if b2rLengthHex>7 then
do
b2rLeft1=left(b2rHexString,1)
b2rLeft1Pos=verify(b2rHexString,b2rLeft1)
if b2rLeft1Pos=0 then
return( "copies('" || c2x(b2rLeft1) || "'x, " || b2rLengthHex || ")" )
else
do
if b2rLeft1Pos>7 then
do
b2rFormattedHex="copies('" || c2x(b2rLeft1) || "'x, " || b2rLeft1Pos-1 || ") || '"
b2rHexString=substr(b2rHexString,b2rLeft1Pos)
b2rLengthHex=b2rLengthHex-(b2rLeft1Pos-1)
end
end
end
do b2rCharPosn=1 to b2rLengthHex
if(b2rCharPosn//8)=1 then
do
if b2rCharPosn<>1 then
b2rFormattedHex=b2rFormattedHex|| ' '
end
b2rFormattedHex=b2rFormattedHex||c2x(substr(b2rHexString,b2rCharPosn,1))
end
b2rFormattedHex=b2rFormattedHex|| "'x"
return(b2rFormattedHex)

_QuoteAsciiBreakIfRequired:
qabAscii=arg(1)
qabLength=length(qabAscii)
qabReturn=''
do while qabLength>256
qabLeft=left(qabAscii,256)
qabAscii=substr(qabAscii,256+1)
qabLength=qabLength-256
if qabReturn='' then
qabReturn=_QuoteAscii(qabLeft)
else
qabReturn=qabReturn|| " || " ||_QuoteAscii(qabLeft)
end
if qabLength=0 then
return(qabReturn)
else
do
if qabReturn='' then
return(_QuoteAscii(qabAscii))
else
return(qabReturn|| " || " ||_QuoteAscii(qabAscii))
end

_FormatHexBreakIfRequired:
fhbHex=arg(1)
fhbLength=length(fhbHex)
fhbReturn=''
do while fhbLength>80
fhbLeft=left(fhbHex,80)
fhbHex=substr(fhbHex,80+1)
fhbLength=fhbLength-80
if fhbReturn='' then
fhbReturn=_FormatHex(fhbLeft)
else
fhbReturn=fhbReturn|| " || " ||_FormatHex(fhbLeft)
end
if fhbLength=0 then
return(fhbReturn)
else
do
if fhbReturn='' then
return(_FormatHex(fhbHex))
else
return(fhbReturn|| " || " ||_FormatHex(fhbHex))
end

BIN2REXP:
call BIN2REXP_START
b2rValue=arg(1)
b2rValueLength=length(b2rValue)
if b2rValueLength=0 then
call BIN2REXP_ONEBIT '""'
else
do
do while b2rValue\==''
b2rEndAsciiPos=verify(b2rValue,b2rAllAsciiCodes)
if b2rEndAsciiPos=0 then
do
call BIN2REXP_ONEBIT _QuoteAsciiBreakIfRequired(b2rValue)
b2rValue=''
end
else
do
if b2rEndAsciiPos<>1 then
do
call BIN2REXP_ONEBIT _QuoteAsciiBreakIfRequired(left(b2rValue,b2rEndAsciiPos-1))
b2rValue=substr(b2rValue,b2rEndAsciiPos)
end
else
do
b2rEndBinaryPos=verify(b2rValue,b2rAllHexCodes)
if b2rEndBinaryPos=0 then
do
call BIN2REXP_ONEBIT _FormatHexBreakIfRequired(b2rValue)
b2rValue=''
end
else
do
call BIN2REXP_ONEBIT _FormatHexBreakIfRequired(left(b2rValue,b2rEndBinaryPos-1))
b2rValue=substr(b2rValue,b2rEndBinaryPos)
end
end
end
end
end
call BIN2REXP_END
return

EndBIN2REXPXh:
signal EndDUMPVARXh

DumpVarsInExpression:
dv_RexxExp=arg(1)
dv_Stem=translate(arg(2))
dv_VarHeading=arg(3)
dv_LineRoutine=arg(4)
if dv_Stem<> '' then
do
dv_AutoDump='N'
dv_StemDot=dv_Stem|| '.'
if symbol(dv_StemDot|| '0') = 'VAR' then
dv_VarCount=value(dv_StemDot|| '0')
else
do
call _DumpVarsLineOutput 'DumpVar: Could not find "' || dv_StemDot || '0' || '"'
return(0)
end
end
else
do
dv_AutoDump='Y'
dv_Stem='DV_VARLIST'
dv_StemDot=dv_Stem|| '.'
dv_VarCount=0
end
if dv_VarCount=0 then
dv_MaxVarLng=0
do while dv_RexxExp<> ''
parse value strip(dv_RexxExp, 'L')with dv_1stChar+1 dv_RexxExp
select
when datatype(dv_1stChar, 'S')then
do
dv_OneVar=dv_1stChar
do while dv_RexxExp<> ''
parse var dv_RexxExp dv_1stChar+1 dv_RexxExp
if datatype(dv_1stChar, 'S')then
dv_OneVar=dv_OneVar||dv_1stChar
else
do
dv_RexxExp=dv_1stChar||dv_RexxExp
leave
end
end
call _RememberDumpedVar dv_OneVar
if pos('.',dv_OneVar)<>0 then
do
do while dv_OneVar<> ''
parse var dv_OneVar dv_ThisBit '.' dv_OneVar
call _RememberDumpedVar dv_ThisBit
end
end
end
when dv_1stChar='"' | dv_1stChar = "'" then
do
dv_EndQuotePos=pos(dv_1stChar,dv_RexxExp)
if dv_EndQuotePos=0 then
dv_RexxExp=''
else
dv_RexxExp=substr(dv_RexxExp,dv_EndQuotePos+1)
end
otherwise
nop
end
end
call value dv_StemDot|| '0',dv_VarCount
if dv_AutoDump='Y' then
call DumpVarsInExpressionNow dv_Stem,dv_VarHeading,dv_LineRoutine
return(dv_VarCount)

DumpVarsInExpressionNow:
dv_StemDot=arg(1)|| '.'
dv_VarHeading=arg(2)
dv_LineRoutine=arg(3)
if symbol(dv_StemDot|| '0') = 'VAR' then
dv_VarCount=value(dv_StemDot|| '0')
else
do
call _DumpVarsLineOutput 'DumpVar: could not find "' || dv_StemDot || '0' || '"'
return(0)
end
if dv_VarCount<>0&dv_VarHeading<> '' then
do
call _DumpVarsLineOutput ''
call _DumpVarsLineOutput dv_VarHeading
call _DumpVarsLineOutput copies('~',length(dv_VarHeading))
end
dv_ShowVarLng=dv_MaxVarLng
if dv_MaxVarLng>30 then
dv_ShowVarLng=30
do dv_Index=1 to dv_VarCount
dv_OneVar=value(dv_StemDot||dv_Index)
if length(dv_OneVar)>=dv_ShowVarLng then
ShowVar=dv_OneVar
else
ShowVar=right(dv_OneVar,dv_ShowVarLng)
dv_OneVarValue=value(translate(dv_OneVar))
if datatype(dv_OneVarValue, 'N')=0 then
do
call BIN2REXP dv_OneVarValue
dv_OneVarValue=dv_Value
end
call _DumpVarsLineOutput ShowVar|| ' = ' ||dv_OneVarValue
end
return

_RememberDumpedVar:
dv_ThisVar=arg(1)
if symbol(dv_ThisVar)='VAR' then
do
dv_AlreadyHave='N'
dv_ThisVarUpper=translate(dv_ThisVar)
do dv_Index=1 to dv_VarCount
if dv_ThisVarUpper=translate(value(dv_StemDot||dv_Index))then
do
dv_AlreadyHave='Y'
leave
end
end
if dv_AlreadyHave='N' then
do
dv_VarCount=dv_VarCount+1
call value dv_StemDot||dv_VarCount,dv_ThisVar
if length(dv_ThisVar)>dv_MaxVarLng then
dv_MaxVarLng=length(dv_ThisVar)
end
end
return

_DumpVarsLineOutput:
if dv_LineRoutine='' then
call say arg(1)
else
interpret 'call ' || dv_LineRoutine || ' arg(1)'
return

BIN2REXP_START:
dv_Value=''
return

BIN2REXP_ONEBIT:
if dv_Value<> '' then
dv_Value=dv_Value|| ' || '
dv_Value=dv_Value||arg(1)
return

BIN2REXP_END:
return

EndDUMPVARXh:
HaveCapturedTrapDetails='N'
MacroBeingExpanded=''
LastLineAfterMacroRep=''
LastFileLine=''
LastLine=''
ErrorHookCount=0
call RexxHookInit
signal on NOVALUE name SimpleRexxTrapUninitializedVariable
signal on SYNTAX name SimpleRexxTrapSyntaxError
TrapHandler='SIMPLE'
MyBaseHomeDir="http://www.labyrinth.net.au/~dbareis/"
PgmHomePage=MyBaseHomeDir|| "ppwizard.htm"
PgmAuthorHomePage=MyBaseHomeDir|| "index.htm"
PgmAuthor="Dennis Bareis"
PgmAuthorEmail="[e-mail]"
ExpressionKilledUs=''
SyntaxOkRc=21924
SyntaxOkText='!CheckSyntax!'
CopyrightDisplayed='N'
CurrentOutFile=''
CurrentOutLine=0
OutSyntaxMsg=''
OutSyntaxCmd=''
OutSyntaxRc=''
OutSyntaxCode=''
OutSyntaxErrLineMask=''
IncludeLevel=0
Warnings=0
LineSourceBeingProcessed='?'
OnExitSleepForOk=0
OnExitSleepForError=2
SleepSwitch='N'
if translate(strip(arg(1)))='DEBUG' then
call DisplayCopyright
/*
*REXSYSTM.XH Version 02.249 By Dennis Bareis
*http://www.labyrinth.net.au/~dbareis/index.htm([e-mail])
*/
trace off
RexSystmRexxPgmName='?'
if '1' == 'F1'x then
RexIsAscii='N'
else
RexIsAscii='Y'
parse version RexVersionInfo
if pos('REGINA',translate(RexVersionInfo))<>0 then
do
RexWhich='REGINA'
parse value translate(RexVersionInfo)with . 'REGINA_' RexVerRegina ' '
RexVerRegina=translate(RexVerRegina, '.', '_')
end
else
do
RexVerRegina=''
if pos('REXX370',translate(RexVersionInfo))<>0 then
do
RexWhich='REXX370'
end
else
do
RexWhich='STANDARD_OS/2'
end
end
parse source RexSystemOpSys .
RexSystemOpSysREAL=RexSystemOpSys
if RexWhich='REGINA' then
do
if RexSystemOpSys="WIN32" then
parse value uname()with RexSystemOpSysREAL .
if RexSystemOpSys="UNIX" then
parse value uname()with RexSystemOpSysREAL .
end
if RexSystemOpSys="BEOS" then
RexSystemOpSys="UNIX"
if RexSystemOpSys="TSO" then
do
call syscalls 'ON'
RexSystemOpSys="UNIX"
end
RexSystmRexxPgmName=RexGetFullSourceName()
if RexIsAscii='N' then
do
RexEOL='15'x
end
else
do
if RexSystemOpSys="UNIX" then
RexEOL='0A'x
else
RexEOL='0D0A'x
end
if arg(2)<> '' then
call RexSystemFailure 'ARG(2) contains unexpected data of ' || arg(2) || '.'
if translate(strip(arg(1)))='DEBUG' then
do
call RexDumpSystemInfo
exit(0)
end
if RexWhich='STANDARD_OS/2' then
do
call RxFuncAdd 'SysSleep',        'RexxUtil', 'SysSleep'
call RxFuncAdd 'SysFileDelete',   'RexxUtil', 'SysFileDelete'
call RxFuncAdd 'SysSearchPath',   'RexxUtil', 'SysSearchPath'
call RxFuncAdd 'SysFileTree',     'RexxUtil', 'SysFileTree'
call RxFuncAdd 'SysTempFileName', 'RexxUtil', 'SysTempFileName'
call SetLocal
RexEnvVarPool='OS2ENVIRONMENT'
RexStdoutStream='STDOUT'
RexStderrStream='STDERR'
RexTmpFileCntr=random(90000)
end
else
do
OPTIONS 'NOEXT_COMMANDS_AS_FUNCS'
numeric digits 11
RexEnvVarPool='SYSTEM'
RexStdoutStream='<stdout>'
RexStderrStream='<stderr>'
end
if RexSystemOpSys<> "UNIX" then
do
RexDirChar='\'
RexOptionChar='/'
end
else
do
RexDirChar='/'
RexOptionChar='-'
end
signal REXSYSTM_1

RexDumpSystemInfo:
say 'Program Name  : ' ||RexSystmRexxPgmName
say 'Op System     : ' ||RexSystemOpSys
say 'Rexx Ver      : ' ||RexVersionInfo
say 'Which System  : ' ||RexWhich
if RexWhich='REGINA' then
say 'regina uname(): ' ||uname()
return

RexNeedReginaWorkAround:
if RexWhich='STANDARD_OS/2' then
return('N')
else
return('Y')

RexGetFullSourceName:
parse source . . TmpRexxSrc
if RexWhich='REGINA' then
TmpRexxSrc=_FileQueryExists(strip(TmpRexxSrc))
if RexSystemOpSysREAL="TSO" then
do
TmpRexxSrc=word(TmpRexxSrc,1)
TmpRexxSrc=_FileQueryExists(TmpRexxSrc)
end
if TmpRexxSrc='' then
call RexSystemFailure 'Could not determine the name of the rexx program!'
return(TmpRexxSrc)

RexGetNameOfTmpDir:call TRACE "OFF"
TmpDir=strip(GetEnv('TMP'))
if TmpDir='' then
TmpDir=strip(GetEnv('TEMP'))
if TmpDir='' then
do
if RexSystemOpSys="UNIX" then
TmpDir='/tmp'
end
if right(TmpDir,1)==RexDirChar then
TmpDir=left(TmpDir,length(TmpDir)-1)
if RexWhich='REXX370' then
do
if TmpDir="SYSTEM" then
TmpDir="TMP"
end
return(TmpDir)

RedirectStdOutAndErr2:
if RedirMethod<> '' then
do
select
when RedirMethod="@bash" then
return(' > "' || arg(1) || '" 2>&1')
when RedirMethod="@csh" then
return(' >& "' || arg(1) || '"')
otherwise
do
r12Meth=RedirMethod
r12Pos=pos('{?}',r12Meth)
do while r12Pos<>0
r12Meth=left(r12Meth,r12Pos-1)||arg(1)||substr(r12Meth,r12Pos+3)
r12Pos=pos('{?}',r12Meth)
end
end
end
return(' ' ||r12Meth)
end
if RexSystemOpSys="DOS" | RexSystemOpSysREAL = "WIN95" | RexSystemOpSysREAL = "WIN98" | RexSystemOpSysREAL = "WINME" then
do
return(' >' ||arg(1))
end
else
do
return(' > "' || arg(1) || '" 2>&1')
end

NameOfNulDevice:
if RexSystemOpSys="UNIX" then
return('/dev/null')
else
return('nul')

AllCmdOutput2Nul:
return(RedirectStdOutAndErr2(NameOfNulDevice()))

AddressCmd:call TRACE "OFF"
SysCmd2Exec=arg(1)
if RexWhich='STANDARD_OS/2' then
SysCmd2Exec='@' ||SysCmd2Exec
call DebugAddressCmdBefore SysCmd2Exec
SysCmd2Exec
SysCmdRc=Rc
FileIndex=2
SysCmdFile=arg(FileIndex)
do while SysCmdFile<> ''
call DebugAddressCmdOutput SysCmdFile, 'H1'
call DebugAddressCmdOutput copies('~', length(SysCmdFile)), 'H2'
if _FileQueryExists(SysCmdFile)='' then
call DebugAddressCmdOutput '*File does not exist*',     '!'
else
do
SysCmdLine=0
call _FileClose SysCmdFile
do while lines(SysCmdFile)<>0
SysCmdLine=SysCmdLine+1
call DebugAddressCmdOutput linein(SysCmdFile),SysCmdLine
end
call _FileClose SysCmdFile
end
FileIndex=FileIndex+1
SysCmdFile=arg(FileIndex)
end
call DebugAddressCmdAfter SysCmdRc
Rc=SysCmdRc
return(SysCmdRc)

_filespec:call TRACE "OFF"
fsCmd=translate(arg(1))
select
when fsCmd='D' | fsCmd = 'DRIVE' then
do
if RexSystemOpSys="UNIX" then
return('')
fsPos=pos(':',arg(2))
if fsPos=0 then
return('')
else
return(left(arg(2),fsPos))
end
when fsCmd='P' | fsCmd = 'PATH' then
do
fsStartWith=substr(arg(2),length(_filespec('D',arg(2)))+1)
fsPos=lastpos(RexDirChar,fsStartWith)
if fsPos=0 then
return('')
else
return(left(fsStartWith,fsPos))
end
when fsCmd='N' | fsCmd = 'NAME' then
do
return(substr(arg(2),length(_filespec('L',arg(2)))+1))
end
when fsCmd='L' | fsCmd = 'LOCATION' then
do
return(_filespec('D', arg(2)) || _filespec('P',arg(2)))
end
when fsCmd='S' | fsCmd = 'SLASHLESS' then
do
fsPos=_filespec('L',arg(2))
if right(fsPos,1)=RexDirChar then
fsPos=left(fsPos,length(fsPos)-1)
return(fsPos)
end
when fsCmd='E' | fsCmd = 'EXTN' then
do
fsDotPos=lastpos('.',arg(2))
if fsDotPos=0 then
return('')
else
return(substr(arg(2),fsDotPos+1))
end
when fsCmd='W' | fsCmd = 'WITHOUTEXTN' then
do
fsDotPos=lastpos('.',arg(2))
if fsDotPos=0 then
return(arg(2))
else
return(left(arg(2),fsDotPos-1))
end
when fsCmd='B' | fsCmd = 'BASENAME' then
do
return(_filespec('W', _filespec('N',arg(2))))
end
otherwise
call RexSystemFailure 'Unknown _filespec() command of "' || arg(1) || '"'
end
return

_SysSleep:call TRACE "OFF"
if RexWhich='STANDARD_OS/2' then
do
call SysSleep arg(1)
return
end
call sleep arg(1)
return

_SysFileTree:call TRACE "OFF"
a!Mask=arg(1)
a!Stem=arg(2)
if pos('D',arg(3))<>0 then
a!Type='D'
else
a!Type='F'
if RexWhich='STANDARD_OS/2' then
do
a!P3=a!Type|| 'O'
if pos('S',arg(3))<>0 then
a!P3=a!P3|| 'S'
return(SysFileTree(a!Mask,a!Stem,a!P3))
end
a!TmpFile=RexGetTmpFileName()
if RexSystemOpSys<> "UNIX" then
do
a!Cmd='dir /B '
if pos('S',arg(3))<>0 then
a!Cmd=a!Cmd|| "/S "
if a!Type='F' then
a!Cmd=a!Cmd|| "/A-D "
else
a!Cmd=a!Cmd|| "/AD "
if RexSystemOpSys="DOS" then
a!CmdMask=a!Mask
else
a!CmdMask='"' || a!Mask || '"'
a!Cmd=a!Cmd||a!CmdMask||RedirectStdOutAndErr2(a!TmpFile)
end
else
do
a!Cmd='find ' || _filespec('L', a!Mask) || ' '
if RexSystemOpSysREAL<> "FREEBSD" & RexSystemOpSysREAL <> "Darwin" & RexSystemOpSysREAL <> "TSO" then
a!Cmd=a!Cmd|| '-noleaf '
if pos('S',arg(3))=0 then
do
if RexSystemOpSysREAL<> "FREEBSD" & RexSystemOpSysREAL <> "Darwin" & RexSystemOpSysREAL <> "TSO" then
a!Cmd=a!Cmd|| '-maxdepth 1 '
else
a!Cmd=a!Cmd|| '-prune '
end
if a!Type='F' then
a!Cmd=a!Cmd|| "-type f "
else
a!Cmd=a!Cmd|| "-type d "
stfSName=_filespec('N',a!Mask)
if stfSName<> '' then
a!Cmd=a!Cmd|| '-name "' || stfSName || '"'
a!Cmd=a!Cmd||RedirectStdOutAndErr2(a!TmpFile)
end
Rc=AddressCmd(a!Cmd,a!TmpFile)
LastSlash=lastpos(RexDirChar,a!Mask)
call _FileClose a!TmpFile
a!FileCnt=0
do while lines(a!TmpFile)<>0
a!AFile=linein(a!TmpFile)
if a!AFile='' | a!AFile = '.' | a!AFile = '..' then
iterate
if RexSystemOpSys="UNIX" & a!Type = 'D' then
do
if a!AFile=_filespec('L',a!Mask)then
iterate
end
if LastSlash<>0 then
do
if pos(RexDirChar,a!AFile)==0 then
a!AFile=left(a!Mask,LastSlash)||a!AFile
end
if a!Type='F' then
do
a!AFile=_FileQueryExists(a!AFile)
if a!AFile='' then
iterate
end
else
do
if RexWhich='REGINA' then
do
if DirQueryExists(a!AFile)='' then
iterate
end
else
do
if pos(' ',a!AFile)<>0 then
iterate
end
end
a!FileCnt=a!FileCnt+1
call _valueS a!Stem|| '.' ||a!FileCnt,strip(a!AFile)
end
call _FileClose a!TmpFile
DeleteRc=_SysFileDelete(a!TmpFile)
call _valueS a!Stem|| '.0',a!FileCnt
return(0)

_SysFileDelete:call TRACE "OFF"
if RexWhich='STANDARD_OS/2' then
return(SysFileDelete(arg(1)))
b!F=arg(1)
if RexSystemOpSys<> "DOS" then
b!F='"' || b!F || '"'
if RexSystemOpSys="DOS" | RexSystemOpSysREAL = "WIN95" | RexSystemOpSysREAL = "WIN98" | RexSystemOpSysREAL = "WINME" then
return(AddressCmd('if exist ' || b!F || ' del ' ||b!F||AllCmdOutput2Nul()))
else
do
if RexSystemOpSys="UNIX" then
return(AddressCmd('rm -f ' ||b!F||AllCmdOutput2Nul()))
else
return(AddressCmd('del ' ||b!F||AllCmdOutput2Nul()))
end

RexGetTmpFileName:call TRACE "OFF"
if arg(1)<> '' then
TmpFileM=arg(1)
else
do
if RexSystemOpSys<> "UNIX" then
TmpFileM='RSTM????.TMP'
else
do
TmpFileM=GetEnv('USER')
if TmpFileM='' then
TmpFileM=GetEnv('user')
if TmpFileM='' then
TmpFileM='?????.rstm'
else
TmpFileM=TmpFileM|| '_?????.rstm'
end
end
TmpFileM=RexGetNameOfTmpDir()||RexDirChar||TmpFileM
if RexWhich='STANDARD_OS/2' then
do
TmpFileF=SysTempFileName(TmpFileM)
if TmpFileF='' then
do
RexTmpFileCntr=RexTmpFileCntr+1
TmpFileF='C_' || right(RexTmpFileCntr, 6, '0') || '.TMP'
end
return(TmpFileF)
end
TmpRandom=right(time('S'),3)||random(99999)
TmpRandomAdd=0
do until _FileQueryExists(TmpFileA)=''
TmpRandomS=reverse(d2x(TmpRandom+TmpRandomAdd))
TmpRandomAdd=TmpRandomAdd+1
TmpFileA=TmpFileM
TmpWhich=1
QmPos=pos('?',TmpFileA)
do while QmPos<>0
TmpReplace=substr(TmpRandomS,TmpWhich,1)
TmpWhich=TmpWhich+1
if TmpReplace='' then
TmpWhich=1
else
do
TmpFileA=overlay(TmpReplace,TmpFileA,QmPos)
QmPos=pos('?',TmpFileA)
end
end
end
return(TmpFileA)

GetEnv:call TRACE "OFF"
if RexWhich<> 'REXX370' then
rsGetEnv=value(arg(1),,RexEnvVarPool)
else
do
rsGetEnv=''
end
if rsGetEnv=='' & arg(2) = 'Y' then
call RexSystemFailure 'Could not find the environment variable "' || arg(1) || '"'
call DebugGetEnv arg(1),rsGetEnv
return(rsGetEnv)

SetEnv:call TRACE "OFF"
if RexWhich<> 'REXX370' then
return(value(arg(1),arg(2),RexEnvVarPool))
else
do
return('')
end

_valueS:call TRACE "OFF"
if RexWhich='STANDARD_OS/2' then
return(value(arg(1),arg(2)))
return(value(translate(arg(1)),arg(2)))

_valueG:call TRACE "OFF"
if RexWhich='STANDARD_OS/2' then
return(value(arg(1)))
return(value(arg(1)))
/*
 * DB$STUBS - Keep indent (not so easy for comments)
 *            for this bit until finished!
 */

DirGetCurrent:
   return( directory() )

DirQueryExists:
   if  arg(1) = '' then
       return('')
   select
       when RexWhich = 'REGINA' then
       do
           return( stream(arg(1) || RexDirChar || '.', 'c', 'query exists') )
       end
       when RexWhich = 'STANDARD_OS/2' then
       do
           c!CDir = directory()
           c!NewDir = directory(arg(1))
           call directory c!CDir
           return(c!NewDir)
       end
       when RexWhich = 'REXX370' then
       do
           /* DB$390 - return passed name (BAD! - ppwizard might fail in parts)
            */
           return(arg(1))
       end
       otherwise
       do
           return(arg(1))
       end
   end

_FileQueryExists:
   if  arg(1) = '' then
       return('')
   if  RexWhich <> 'REXX370' then
       return( stream(arg(1), 'c', 'query exists') )
   else
   do
       /* DB$390 - return passed name (BAD! - ppwizard might fail in parts)
       */
       return(arg(1))
   end

_FileQueryDateTime:
   if  RexWhich <> 'REXX370' then
       return( stream(arg(1), 'c', 'query datetime') )
   else
   do
       /* DB$390 - Return valid but fixed value
       */
       return('01-01-01 12:00:00')
   end

FileQuerySize:
   if  RexWhich <> 'REXX370' then
       return( stream(arg(1), 'c', 'query size') )
   else
   do
       /* DB$390 - Return valid but fixed value
       */
       return('219')
   end

FileOpenReadOnly:
   if  RexWhich <> 'REXX370' then
       return( stream(arg(1), 'c', 'open read') )
   else
   do
       /* DB$390 - For now do nothing (so file opens read/write - so what)
       */
       return('')
   end

FileLineIn:
   parse arg d!F, d!Ln
   if  d!Ln = '' then
       return( LineIn(d!F) )
   else
   do
       if  RexWhich = 'REGINA' | d!LN = 1 then
           return( LineIn(d!F, d!Ln) )
       else
       do
           d!Cont = linein(d!F, 1);
           do d!l = 2 to d!LN
              d!Cont = linein(d!F);
           end
           return(d!Cont)
       end
   end

_FileClose:
   if  RexWhich <> 'REXX370' then
       return( stream(arg(1), 'c', 'close') )
   else
   do
       /* DB$390 - Worth a try
       */
       call lineout arg(1)
       return('')
   end

FileState:
   if  RexWhich <> 'REXX370' then
       return( stream(arg(1), 'State') )
   else
   do
       /* DB$390 - Stream Description
       */
       return('')
   end

FileDescription:
   if  RexWhich <> 'REXX370' then
       return( stream(arg(1), 'Description') )
   else
   do
       /* DB$390 - Stream Description
       */
       return('')
   end
/*
   REXSYSTM.XH - a few stream there (need to move stubs there)
   DirMake
   FileCharin    ?
   FileCharout   ?
   FileLineOut   ?
*/

REXSYSTM_1:
PpWizardPgmName=RexSystmRexxPgmName
PpWizardOpSysREAL=RexSystemOpSysREAL
PpWizardOpSys=RexSystemOpSys
WizName=translate(_filespec('name',PpWizardPgmName))
call InitScreenHandling
TryQuoteListSd="'" || '"'
TryQuoteListDs='"' || "'"
TryQuoteListAny=TryQuoteListDs|| '^~!@#$%&*-+=?/\|`:;._'
NullChar='00'x
TabChar='09'x
CrLf=RexEOL
if RexIsAscii='N' then
do
MarksNewLine='15'x
end
else
do
MarksNewLine='0A'x
TryQuoteListAny=TryQuoteListAny||xrange('DB'x, 'FE'x) || xrange('80'x, 'DA'x)
end
call InitConsoleOutputVarsPass2
if RexSystemOpSys<> "UNIX" then
call SetDebugChars '96,96,25',  'Y'
else
call SetDebugChars '34,-1,165', 'Y'
numeric digits 14
trace off
if RexSystemOpSys="UNIX" then
NewLineChars=MarksNewLine
else
NewLineChars=CrLf
MarksNewLineInHashDefine='<{nl}>'
MarksNewLineInHashDefine2=MarksNewLineInHashDefine||MarksNewLineInHashDefine
Ignore=0
LowerCase="abcdefghijklmnopqrstuvwxyz"
UpperCase="ABCDEFGHIJKLMNOPQRSTUVWXYZ"
DecimalDigits="0123456789"
CharsLUN=LowerCase||UpperCase||DecimalDigits
DebugOnStuffOutputted='N'
WantedWarningRc=1
NotEqualInC='!' || '='
EofChar=d2c(26)
RexxCmtStart='/' || '*'
RexxCmtEnd='*' || '/'
TagSvNewLine='<' || '?NewLine>' ||MarksNewLine
signal Screen_2

InitScreenHandling2Off:
e!G_CtextAvail=''
e!BeepsAllow='N'
e!ColorAllow='N'
e!How2ChangeColors='A'
return

CfgColor:
parse arg e!Var,e!DefC,e!DefA
if e!How2ChangeColors='C' then
e!D=e!DefC
else
e!D=e!DefA
e!Val=CfgEnv('PPWIZARD_COLOR_' ||e!Var,e!D)
e!Val=ReplaceCurlyHexCodes(e!Val)
call value 'e!COL_' ||e!Var,e!Val
return

InitScreenHandling:
if RexSystemOpSys="WIN32" then
do
e!Comspec=GetEnv("COMSPEC", "Y")
if pos('.COM',e!Comspec)<>0 then
do
e!How2ChangeColors='A'
call DBG 'This windows version does not support use of CTEXT.EXE'
call DBG 'It can use ANSI.SYS if this is installed in "config.sys".'
end
else
do
e!G_CtextAvail=FileQueryExists(_filespec('L', PpWizardPgmName) || 'ctext.exe')
if e!G_CtextAvail='' then
do
e!How2ChangeColors=''
e!Cmt='not'
end
else
do
e!How2ChangeColors='C'
e!Cmt='found'
end
call DBG 'This windows version supports use of CTEXT.EXE (CTEXT.EXE ' || e!Cmt || ' in the PPWIZARD directory)'
end
end
call CfgColor 'RESET',      '{white}',    '{x1B}[0m'
call CfgColor 'DEFAULT',    '{brown}',    '{x1B}[0;33m'
call CfgColor 'Error',      '{bred}',     '{x1B}[0;1;31m'
call CfgColor 'Warning',    '{yellow}',   '{x1B}[0;1;33m'
call CfgColor 'Info',       '{bwhite}',   '{x1B}[0;1m'
call CfgColor 'HighLight',  '{bmagenta}', '{x1B}[0;1;35m'
call CfgColor 'Title',      '{green}',    '{x1B}[0;32m'
call CfgColor 'PromptText', '{bwhite}',   '{x1B}[0;1m'
call CfgColor 'RexxTrace',  '{bmagenta}', '{x1B}[0;1;35m'
call CfgColor 'RexxOther',  '{cyan}'      '{x1B}[0;36m'
call CfgColor 'Summary',    '{white}'     '{x1B}[0m'
e!HowToBeep=d2c(7)
e!BeepsAllow='Y'
e!ColorAllow='N'
if RexSystemOpSys="OS/2" then
e!ColorAllow='Y'
else
do
if e!How2ChangeColors='C' then
e!ColorAllow='Y'
end
return

GetColorCode:
e!Cc='e!COL_' ||arg(1)
if symbol(e!Cc)<> 'VAR' then
CryAndDie('Invalid color category of "' || arg(1) || '" specified!')
return(e!CC)

Beeps:call TRACE "OFF"
if e!BeepsAllow='Y' then
do
e!C=arg(1)
if e!C='' then
e!C=1
do e!i=1 to e!C
call charout,e!HowToBeep
end
end
return("")

ColorCfg:call TRACE "OFF"
parse arg e!Var,e!Val
call DBG 'ColorCfg(' || e!Var || ') = ' ||e!Val
e!Val=ReplaceCurlyHexCodes(e!Val)
e!S=GetColorCode(e!Var)
e!P=value(e!S)
call value e!S,e!Val
return(e!P)

ColorSet:call TRACE "OFF"
if e!ColorAllow='Y' then
do
e!C=arg(1)
if e!C='' then
e!C='DEFAULT'
e!S=GetColorCode(e!C)
if e!How2ChangeColors='C' then
do
e!Cmd='"' || e!G_CtextAvail || '" ' || value(e!S) || ' ' ||AllCmdOutput2Nul()
e!Comspec|| ' /c ' ||e!Cmd
end
else
do
if e!How2ChangeColors='A' then
call charout,value(e!S)
end
end
return

ColorAllow:call TRACE "OFF"
e!Rc=e!ColorAllow
e!ColorAllow=translate(arg(1))
if e!How2ChangeColors='' then
do
if e!ColorAllow='Y' then
do
e!ColorAllow='N'
call DBG 'User tried to turn on color changing but it is not possible to change colors...'
end
end
return(e!Rc)

BeepsAllow:call TRACE "OFF"
e!Rc=e!BeepsAllow
e!BeepsAllow=translate(arg(1))
return(e!Rc)

Screen_2:
signal Progress_3

RepCommonProgCodes:
parse arg f!T,f!F
f!CDU=UFile(DirGetCurrent())||RexDirChar
f!CDUL=length(f!CDU)
if pos('{.}',f!T)<>0 then
f!T=ReplaceString(f!T, '{.}',FileNameRelative(f!F))
f!T=ReplaceString(f!T, '{S}',  _filespec('N',f!F))
f!T=ReplaceString(f!T, '{L}',f!F)
f!T=ReplaceString(f!T, '{PM}',ProcessingMode)
return(f!T)

Making:call TRACE "OFF"
parse arg g!FN,MsgMode
if g!FN='' then
g!FN=CurrentOutFile
g!FFN=FileQueryExists(g!FN)
if g!FFN<> '' then
g!FN=g!FFN
call DBG 'Making(' || g!FN || ')'
call DBGIND 1
g!I=copies("  ", IncludeLevel+1) || ' '
g!T=OptionMsgMaking
g!Rexx=CfgMacro('HOOK_MSG_MAKING', '')
g!Rexx=PerformReplacementsInCmdsParameters(g!Rexx)
if g!Rexx<> '' then
do
MsgFile=g!FN
MsgInd=g!I
MsgText=g!T
call ExecRexxCmd g!Rexx
call DBGIND-1
return
end
call DBG 'Spec: ' ||g!T
if g!T='' then
do
call DBGIND-1
return
end
if pos('{R?}',g!T)<>0 then
do
if MsgMode<> 'R' then
g!T=ReplaceString(g!T, '{R?}', '')
else
do
call DBGIND-1
return
end
end
g!T=RepCommonProgCodes(g!T,g!FN)
call Line1 g!I||g!T
call DBGIND-1
return

Reading:call TRACE "OFF"
if arg(1)='' then
h!Ex=0
else
h!Ex=1
call ReadingI arg(1),,h!Ex
return

ReadingI:
parse arg i!FFN,i!Frag,i!Ex
call DBG 'Reading(' || i!FFN || ')'
call DBGIND 1
if i!FFN='' then
i!FFN=IncludeFileName
if i!Frag='N' then
do
MsgFragSp=''
MsgFragS=''
MsgFragE=''
end
else
do
MsgFragSp=IncludeFragmentSpec
MsgFragS=IncludeFragmentS
MsgFragE=IncludeFragmentE
end
i!I=ReadingIndent(i!Ex)
i!T=OptionMsgReading
i!Rexx=CfgMacro('HOOK_MSG_READING', '')
i!Rexx=PerformReplacementsInCmdsParameters(i!Rexx)
if i!Rexx<> '' then
do
MsgFile=i!FFN
MsgInd=i!I
MsgText=i!T
call ExecRexxCmd i!Rexx
call DBGIND-1
return
end
call DBG 'Spec: ' ||i!T
if i!T='' then
do
call DBGIND-1
return
end
i!P=pos('{F?}',i!T)
if i!P<>0 then
do
if MsgFragSp='' then
i!T=left(i!T,i!P-1)
else
i!T=ReplaceString(i!T, '{F?}', '')
end
i!T=RepCommonProgCodes(i!T,i!FFN)
i!T=ReplaceString(i!T, '{F}',MsgFragSp)
i!T=ReplaceString(i!T, '{FS}',MsgFragS)
i!T=ReplaceString(i!T, '{FE}',MsgFragE)
call Line1 i!I||i!T
call DBGIND-1
return

ReadingIndent:
j!Ex=arg(1)
if j!Ex='' then j!Ex=0
return(copies("  ", IncludeLevel+j!Ex) || ' ')

UFile:
if RexSystemOpSys="UNIX" then
return(arg(1))
else
return(translate(arg(1)))

Progress_3:
LastSystemCmd="none"
LastSystemCmdFull="none"
LastSystemRc=999
signal System_4

ProcessSystem:
Rest=PerformReplacementsInCmdsParameters(arg(1))
Log2File=GetQuotedText(Rest, "Rest")
LastSystemCmd=GetQuotedRest(Rest)
select
when RexSystemOpSys="OS/2" then
CmdProc='CMD.EXE /c '
otherwise
CmdProc=''
end
LastSystemCmdFull=CmdProc||LastSystemCmd
DeleteFileAfter='N'
select
when translate(Log2File)='ASIS' then
Log2File=''
when Log2File='-' then
Log2File=NameOfNulDevice()
when Log2File='?' then
do
Log2File=RexGetTmpFileName()
DeleteFileAfter='Y'
end
otherwise
nop
end
if Log2File<> '' then
LastSystemCmdFull=LastSystemCmdFull||RedirectStdOutAndErr2(Log2File)
LastSystemRc=AddressCmd(LastSystemCmdFull,Log2File)
if DeleteFileAfter='Y' then
call _SysFileDelete(Log2File)
return(0)

System_4:
signal stack_5

StackInitForBuild:
STK_CNT=0
return

_StkErrLine:
if StackErrorText='' then
StackErrorText=arg(1)
else
StackErrorText=StackErrorText||MarksNewLine||arg(1)
return

StackValidation:
call DBG "Validating the " || STK_CNT || " stack(s)"
call DBGIND+1
StackErrorText=''
k!Invalid=0
do k!S=1 to STK_CNT
k!ID=STK.k!S
k!Desc=value(k!ID|| '_DESC')
call DBG 'Validating: ' ||k!Desc
k!Lvl=value(k!ID|| '.0')
call DBGIND+1
if k!Lvl=0 then
call DBG 'OK'
else
do
k!Invalid=k!Invalid+1
call DBG 'There are ' || k!Lvl || ' items still on the stack!'
k!T='STACK "' || k!Desc || '" has ' || k!Lvl || ' errors'
call _StkErrLine ''
call _StkErrLine k!T
call _StkErrLine copies('~',length(k!T))
do k!Inv=1 to k!Lvl
call _StkErrLine 'Push # : ' ||k!Inv
call _StkErrLine 'Where  : ' || value(k!ID || '_LOCN.' ||k!Inv)
call _StkErrLine 'Doing  : ' || value(k!ID || '_DOING.' ||k!Inv)
call _StkErrLine ''
end
end
call DBGIND-1
end
if k!Invalid<>0 then
CryAndDie(StackErrorText||MarksNewLine|| 'There are ' || k!Invalid || ' stacks with incorrect nesting (details above).')
call DBGIND-1
return

StackPush:call TRACE "OFF"
parse arg l!Desc,l!What,l!Doing
l!ID='STK_' ||c2x(l!Desc)
if symbol(l!ID|| '.0') = 'VAR' then
l!L=value(l!ID|| '.0')+1
else
do
l!L=1
STK_CNT=STK_CNT+1
STK.STK_CNT=l!ID
call value l!ID|| '_DESC',l!Desc
end
call value l!ID|| '.0',l!L
call value l!ID|| '.' ||l!L,l!What
call value l!ID|| '_LOCN.' ||l!L,GetInputFileNameAndLine()
if l!Doing='' then
l!Doing=GetFileLineBeingProcessed()
call value l!ID|| '_DOING.' ||l!L,l!Doing
return

StackPop:call TRACE "OFF"
m!ID='STK_' ||c2x(arg(1))
if symbol(m!ID|| '.0') <> 'VAR' then
CryAndDie('Can''t pop the non-existant stack "' || arg(1) || '"')
m!L=value(m!ID|| '.0')
if m!L<=0 then
CryAndDie('Nothing on the stack "' || arg(1) || '"')
call value m!ID|| '.0',m!L-1
return(value(m!ID|| '.' ||m!L))

ProcessPush:
n!R=PerformReplacementsInCmdsParameters(arg(1))
n!Typ=translate(GetQuotedText(n!R, "n!R"))
do until n!R=''
n!I=GetQuotedText(n!R, "n!R")
select
when n!Typ='MACRO' then
do
call StackPush '#Push MACRO',MacroGet(n!I)
end
when n!Typ='REXXVAR' then
do
call StackPush '#Push REXXVAR',_valueG(n!I)
end
otherwise
CryAndDie('Unsupported #PUSH type of ' ||n!Typ)
end
end
return(0)

ProcessPop:
o!R=PerformReplacementsInCmdsParameters(arg(1))
o!Typ=translate(GetQuotedText(o!R, "o!R"))
o!C=0
do until o!R=''
o!C=o!C+1
o!S.o!C=GetQuotedText(o!R, "o!R")
end
do o!I=o!C to 1 by-1
select
when o!Typ='MACRO' then
do
call MacroSet o!S.o!I,StackPop('#Push MACRO'), 'Y'
end
when o!Typ='REXXVAR' then
do
call _valueS o!S.o!I,StackPop('#Push REXXVAR')
end
otherwise
CryAndDie('Unsupported #POP type of ' ||o!Typ)
end
end
return(0)

stack_5:
call InitTransformationCode
signal Transfrm_6

InitTransformationCode:
TransformCodeLvl=0
return

ProcessTransform:
p!Do=arg(1)
if p!Do<> '' then
do
p!Do=PerformReplacementsInCmdsParameters(p!Do)
p!Do=GetQuotedText(p!Do)
end
if p!Do<> '' then
do
TransformCodeLvl=TransformCodeLvl+1
if OptionDebugOn='Y' then
call DBG 'Start of transformation block #' || TransformCodeLvl || ' - "' || p!Do || '"'
p!C=MacroGet(p!Do)
p!C=PerformReplacementsInCmdsParameters(p!C)
call StackPush "#transform Nesting",,"PPWIZARD's #transform command"
TransformCode.TransformCodeLvl=p!C
end
else
do
if OptionDebugOn='Y' then
call DBG "End of transformation block #" ||TransformCodeLvl
call StackPop "#transform Nesting"
TransformCodeLvl=TransformCodeLvl-1
end
return(0)

Transfrm_6:
signal NextId_7

InitNextId:
NextIdUnique=0
NextIdReplOn='N'
NextIdMarker='@' || '@'
NextIdMask='*_'
NextIdNewCounter=NextIdUnique
NextIdChars1st=LowerCase
NextIdCharsRst=LowerCase|| '!?_' ||DecimalDigits
NextIdNew=_GetNextIdPrefix()
NextIdUsed='N'
NextIdLocked=''
NextIdLockedAt=''
return

ProcessNextId:
q!P=arg(1)
if q!P='' then
call _NextIdInc
else
do
q!P=PerformReplacementsInCmdsParameters(q!P)
q!Cmd=GetQuotedText(q!P, 'q!P')
q!CmdU=translate(q!Cmd)
select
when q!CmdU='OFF' then
NextIdReplOn='N'
when q!CmdU='ON' then
NextIdReplOn='Y'
when q!CmdU='CHARS' then
do
call _DieIfLocked q!Cmd
NextIdChars1st=GetQuotedText(q!P, 'q!P')
NextIdCharsRst=GetQuotedRest(q!P)
NextIdNew=_GetNextIdPrefix()
end
when q!CmdU='LOCK' then
do
call _DieIfLocked q!Cmd
if q!P='' then
q!P='"?"'
NextIdLocked=GetQuotedRest(q!P)
NextIdLockedAt=CurrentSourceLocation()
if NextIdLocked='' then
CryAndDie('You must specify a KEY to lock Next ID incrementing.')
end
when q!CmdU='UNLOCK' then
do
if NextIdLocked='' then
CryAndDie('Not locked!')
if q!P='' then
q!P='"?"'
q!Key=GetQuotedRest(q!P)
if q!Key<>NextIdLocked then
CryAndDie('Incorrect key used, required "' || NextIdLocked || '"', 'Locking was done at ' ||NextIdLockedAt)
NextIdLocked=''
end
when q!CmdU='REPLACE' then
do
call _DieIfLocked q!Cmd
NextIdMarker=GetQuotedRest(q!P)
if NextIdMarker='' then
NextIdMarker='@' || '@'
end
when q!CmdU='MASK' then
do
call _DieIfLocked q!Cmd
NextIdMask=GetQuotedRest(q!P)
if NextIdMask='' then
NextIdMask='*_'
NextIdNew=_GetNextIdPrefix()
end
when q!CmdU='PUSH' then
do
q!Info=NextIdReplOn|| '00'x || NextIdMarker || '00'x || NextIdMask || '00'x || NextIdNew || '00'x || NextIdNewCounter || '00'x || NextIdUsed || '00'x || NextIdLocked || '00'x || NextIdLockedAt || '00'x || NextIdChars1st || '00'x||NextIdCharsRst
call StackPush "#NextId PUSH",q!Info
NextIdLocked=''
NextIdUsed='Y'
call _NextIdInc
NextIdReplOn='N'
end
when q!CmdU='POP' then
do
q!Info=StackPop("#NextId PUSH")
parse var q!Info NextIdReplOn '00'x NextIdMarker '00'x NextIdMask '00'x NextIdNew '00'x NextIdNewCounter '00'x NextIdUsed '00'x NextIdLocked '00'x NextIdLockedAt '00'x NextIdChars1st '00'x NextIdCharsRst
end
otherwise
CryAndDie('Unknown #NextID command of "' || q!Cmd || '"')
end
end
if OptionDebugOn='Y' then
do
if NextIdReplOn='N' then
q!T='off'
else
q!T='on'
q!I=NextIdLocked
if q!I='' then
q!I='unlocked'
else
q!I='locked (KEY = "' || NextIdLocked || '", locked at ' || NextIdLockedAt || ')'
call DBG '#NextID processing is turned ' ||q!T
call DBG '#NextID incrementing is ' ||q!I
call DBG 'If ON, any "' || NextIdMarker || '" strings will be replaced with "' || NextIdNew || '"'
end
return(0)

_NextIdInc:
call _DieIfLocked 'increment'
NextIdReplOn='Y'
if NextIdUsed='Y' then
do
NextIdUnique=NextIdUnique+1
NextIdNewCounter=NextIdUnique
NextIdNew=_GetNextIdPrefix()
end
return

_DieIfLocked:
if NextIdLocked<> '' then
CryAndDie('Operation (' || arg(1) || ') not allowed as #NextId ID is locked, KEY = "' || NextIdLocked || '"', 'Locking was done at ' ||NextIdLockedAt)
return

_GetNextIdPrefix:
r!Dec=NextIdNewCounter
r!LenLeading=length(NextIdChars1st)
r!LenTrailing=length(NextIdCharsRst)
r!1=''
r!P=''
do until r!Dec=0
if r!1=='' then
do
r!1=substr(NextIdChars1st,(r!Dec//r!LenLeading)+1,1)
r!Dec=r!Dec%r!LenLeading
end
else
do
r!P=substr(NextIdCharsRst,(r!Dec//r!LenTrailing)+1,1)||r!P
r!Dec=r!Dec%r!LenTrailing
end
end
r!P=ReplaceString(NextIdMask, '*',r!1||r!P)
NextIdUsed='N'
return(r!P)

NextId_7:
call InitINTERCEPTCode
signal Intercpt_8

InitINTERCEPTCode:
InterceptCode=''
InterceptStartLoc=''
InterceptOffMarker=''
return

ProcessIntercept:
RexxCode=arg(1)
if RexxCode<> '' then
do
RexxCode=PerformReplacementsInCmdsParameters(RexxCode)
RexxCode=GetQuotedText(RexxCode)
end
if RexxCode<> '' then
do
if OptionDebugOn='Y' then
call DBG 'Start of INTERCPT block "' || RexxCode || '"'
if InterceptCode<> '' then
CryAndDie("Already in tranformation block started at " ||InterceptStartLoc)
InterceptStartLoc=CurrentSourceLocation()
InterceptOffMarker=arg(2)
InterceptCode=MacroGet(RexxCode)
InterceptCode=PerformReplacementsInCmdsParameters(InterceptCode)
end
else
do
if OptionDebugOn='Y' then
call DBG "End of INTERCPT block"
if InterceptCode='' then
CryAndDie('We were not in a INTERCPT block!')
InterceptCode=''
end
return(0)

Intercpt_8:
OutputHoldLvl=0
call InitOutputHold
signal OutpHold_9

InitOutputHold:
HoldingOutput='N'
HeldOutput=''
OutpHoldStartLoc=''
return

OutputHoldPushAndClear:
OutputHoldLvl=OutputHoldLvl+1
OutHold_.OutputHoldLvl.!HoldingOutput=HoldingOutput
OutHold_.OutputHoldLvl.!HeldOutput=HeldOutput
OutHold_.OutputHoldLvl.!OutpHoldStartLoc=OutpHoldStartLoc
call InitOutputHold
return

OutputHoldPop:
HoldingOutput=OutHold_.OutputHoldLvl.!HoldingOutput
HeldOutput=OutHold_.OutputHoldLvl.!HeldOutput
OutpHoldStartLoc=OutHold_.OutputHoldLvl.!OutpHoldStartLoc
OutputHoldLvl=OutputHoldLvl-1
return

DieIfHoldingOutput:
if HoldingOutput='Y' then
CryAndDie('Missing #OutputHold (end)', 'Block started at ' ||OutpHoldStartLoc)
return

ProcessHashOutputHold:
OrexxRexx=arg(1)
if OrexxRexx='' then
do
if OptionDebugOn='Y' then
call DBG 'Start of hold output block'
if HoldingOutput='Y' then
CryAndDie("Already in hold output block started at " ||OutpHoldStartLoc)
call FlushQueuedOutput
HoldingOutput='Y'
OutpHoldStartLoc=CurrentSourceLocation()
end
else
do
if OptionDebugOn='Y' then
call DBG "End of hold output block - Held " || length(HeldOutput) || ' byte(s)'
if HoldingOutput='N' then
CryAndDie('We were not in a hold output block!')
call FlushQueuedOutput
OrexxRexx=PerformReplacementsInCmdsParameters(OrexxRexx)
OrexxRexx=GetQuotedText(OrexxRexx)
if translate(OrexxRexx)='DROP' then
HeldOutput=''
else
do
OutputModCode=MacroGet(OrexxRexx)
OutputModCode=PerformReplacementsInCmdsParameters(OutputModCode)
call ExecRexxCmd OutputModCode
end
if HeldOutput\=='' then
do
if OptionDebugOn='Y' then
call DBG 'Writing ' || length(HeldOutput) || ' byte(s) to output'
call FileCharOut HeldOutput
end
call InitOutputHold
end
return(0)

OutpHold_9:
signal RexxHook_10

RexxHookSetBuildingParms:
parse arg HookBuildParmInput,HookBuildParmOutput,HookBuildParmTemplate
return

RexxHookInit:
RexxHookBefore=''
RexxHookAfter=''
RexxHookWarning=''
RexxHookError=''
RexxHookGetFileList=''
call RexxHookSetBuildingParms
return

RexxHookSet:
parse arg ThisCmd,s!Spec
parse var s!Spec s!W';'s!Rx
s!W=translate(s!W)
do until s!W=''
parse var s!W s!W1','s!W
rhDone='N'
if s!W1='' | abbrev("BEFORE",s!W1)then
do
rhDone='Y'
RexxHookBefore=s!Rx
end
if s!W1='' | abbrev("AFTER",s!W1)then
do
rhDone='Y'
RexxHookAfter=s!Rx
end
if s!W1='' | abbrev("WARNING",s!W1)then
do
rhDone='Y'
RexxHookWarning=s!Rx
end
if s!W1='' | abbrev("ERROR",s!W1)then
do
rhDone='Y'
RexxHookError=s!Rx
end
if s!W1='' | abbrev("GETFILELIST",s!W1)then
do
rhDone='Y'
RexxHookGetFileList=s!Rx
end
if rhDone='N' then
CryAndDie('The hook type of "' || s!W1 || '" is unknown')
end
return

CallHook:
parse arg CallHook,CallHookOkParmsOk,Parm1,Parm2,Parm3,Parm4
BuildDetailParms=', HookBuildParmInput, HookBuildParmOutput, HookBuildParmTemplate'
HookSpecificParms=', Parm1, Parm2, Parm3, Parm4'
select
when CallHook="WARNING" then
HookRexxCmd=RexxHookWarning
when CallHook="BEFORE" then
HookRexxCmd=RexxHookBefore
when CallHook="AFTER" then
HookRexxCmd=RexxHookAfter
when CallHook="ERROR" then
do
ErrorHookCount=ErrorHookCount+1
if ErrorHookCount>1 then
return
HookRexxCmd=RexxHookError
end
when CallHook="GETFILELIST" then
do
HookRexxCmd=RexxHookGetFileList
BuildDetailParms=''
end
end
SrcLineLoc=CurrentSourceLocation('')
if OptionDebugOn='Y' then
do
call DBG 'Calling hook: ' || CallHook || ' - ' ||HookRexxCmd
call DBGIND 1
end
HookCmd='HookRc =  "' || HookRexxCmd || '"("00.050", SrcLineLoc, "' || CallHook || '"' || BuildDetailParms || HookSpecificParms || ')'
HookRc='?'
signal ON SYNTAX NAME SyntaxErrorInHook
Interpret HookCmd
if OptionDebugOn='Y' then
call DBG 'Rc = ' ||HookRc
if abbrev(HookRc, 'OK:')=0 then
do
call DumpVarsInExpression HookCmd,, 'HOOK VARIABLES', 'Line1'
CryAndDie('Hook Command Failed: ' || HookCmd, "Hook's Return Code : " ||HookRc)
end
OkParms=substr(HookRc,4)
if OkParms<> '' & CallHookOkParmsOk <> 'Y' then
CryAndDie('OK parameters not allowed on "' || CallHook || '" hooks.')
if OptionDebugOn='Y' then
call DBGIND-1
return(OkParms)

SyntaxErrorInHook:
CryAndDie('Hook Cmd Failed: ' ||HookCmd)

RexxHook_10:
WarningSpecs=''
signal Warning_11

OutputWarningToScreen:
t!Code=strip( 'WARNING ' ||strip(arg(1)))
t!Txt=arg(2)
if IncludeLevel=0 then
LineText=''
else
LineText='(@' || AddCommasToDecimalNumber(IncludeLineNumber) || ')'
t!CodeTxt=t!Code|| ': ' ||t!Txt
t!Msg=LineText||t!CodeTxt
t!LookIn=translate(t!Msg)
t!Lst=WarningSpecs
do while t!Lst<> ''
parse var t!Lst t!Spec (PathDelimiterChar) t!Lst
t!Spec1=left(t!Spec,1)
t!SpecR=substr(t!Spec,2)
if t!Spec1<> '-' & t!Spec1 <> '+' & t!Spec1 <> '!' then
do
t!Spec1='-'
t!SpecR=t!Spec
t!Spec=t!Spec1||t!SpecR
end
if t!SpecR='' then
iterate
if t!SpecR='*' |pos(translate(t!SpecR),t!LookIn)<>0 then
do
if OptionDebugOn='Y' then
call DBG 'Warning matched the spec => ' ||t!Spec
select
when t!Spec1='!' then
do
if OptionDebugOn='Y' then
call DBG 'Normal Warning => ' ||t!Msg
leave
end
when t!Spec1='+' then
do
CryAndDie(t!CodeTxt,, 'This warning was promoted to a fatal error by "' || t!Spec || '"')
end
when t!Spec1='-' then
do
if OptionDebugOn='Y' then
call DBG 'Ignoring Warning => ' ||t!Msg
return
end
end
end
end
if RexxHookWarning<> '' then
do
t!Rc=translate(CallHook("WARNING", 'Y',t!Txt))
if t!Rc='IGNORE+' then
Warnings=Warnings+1
if t!Rc='IGNORE' | t!Rc = 'IGNORE+' then
do
if OptionDebugOn='Y' then
call DBG "HOOK said to drop warning: " ||t!Txt
return
end
if t!Rc<> '' then
CryAndDie('Unknown warning hook return code of: ' ||t!Rc)
end
call ColorSet 'WARNING'
call Line1 ReadingIndent()|| '  ' ||t!Msg
call ColorSet
Warnings=Warnings+1
return

WarnAboutDepreciatedFeature:
call OutputWarningToScreen 'DEP0', 'Replace OBSOLETE Feature ASAP -> ' ||arg(1)
return

ProcessHashWarning:
u!R=PerformReplacementsInCmdsParameters(arg(1))
u!Code=GetQuotedText(u!R, "u!R")
u!Txt=GetQuotedRest(u!R)
call OutputWarningToScreen u!Code,u!Txt
return(0)

WARNINGS_DEBUG:
if OptionDebugOn='Y' then
call OptionDebugShow 'WARNINGS', 'Ignoring any warnings containing "' || WarningSpecs || '"'
return

WARNINGS_SET:
Tags=arg(1)
if ProcessedCmdLine='N' then
do
call OptionDebugShow 'WARNINGS', 'Setting default ignore warnings to "' || Tags || '"'
Default4_WarningSpecs=Tags
return(0)
end
if Tags=='' then
Tags=Default4_WarningSpecs
if translate(Tags)=='NULL' then
Tags=''
WarningSpecs=Tags
call WARNINGS_DEBUG
return

WARNINGS_GET:
call WARNINGS_DEBUG
return(WarningSpecs)

Warning_11:
signal Tabs_12

TABS_DEBUG:
if OptionDebugOn='Y' then
call OptionDebugShow 'TABS', 'TABS is set to "' || OptionTabsString || '" (' || TabsMode || ')'
return

TABS_SET:
OptionTabsString=translate(arg(1))
if ProcessedCmdLine='N' then
do
call OptionDebugShow 'TABS', 'Setting default TABS to "' || OptionTabsString || '"'
DefaultTabsString=OptionTabsString
return(0)
end
if OptionTabsString=='' then
OptionTabsString=DefaultTabsString
WidthOfTab=0
OptionTabs=left(OptionTabsString,1)
select
when datatype(OptionTabsString, 'W')then
do
OptionTabs='E'
WidthOfTab=OptionTabsString
TabsMode='expanding tabs, fixed tab stop every ' || WidthOfTab || ' characters'
end
when OptionTabsString='WARNINGS' then
TabsMode='display warnings'
when OptionTabsString='IGNORE' then
TabsMode='ignore tabs, leave in place'
when OptionTabsString='TOSPACES' then
TabsMode='converting each tab to one space'
otherwise
CryAndDie('Invalid TABS option of "' || OptionTabsString || '"')
end
call TABS_DEBUG
return

TABS_GET:
call TABS_DEBUG
return(OptionTabsString)

Tabs_12:
SrTypePre=d2c(254)||d2c(174)
SrTypeSuf=d2c(175)
call SrInit
signal SR_TYPE_13

SrInit:
SrCaseIns=SrTypePre|| 'CI' ||SrTypeSuf
SrCaseIns_P=length(SrCaseIns)+1
SrFixed=SrTypePre|| 'FiX' ||SrTypeSuf
SrFixed_P=length(SrFixed)+1
return

CompareReplaceFixed:call TRACE "OFF"

CompareReplaceFixed2:
sr_FromOrig=arg(1)
sr_SSpec=arg(2)
sr_CaseInSens='N'
sr_From=sr_FromOrig
sr_From_L=length(sr_From)
if arg(3, 'E')=1 then
sr_NoMatch=sr_From
else
sr_NoMatch=0
do while sr_SSpec<> ''
parse var sr_SSpec sr_CmdChar +1 sr_SSpec
select
when sr_CmdChar='@' then
do
parse var sr_SSpec sr_Operator ',' sr_Posn '=' +1 sr_Delim +1 sr_CompWith (sr_Delim) sr_SSpec
sr_Length=length(sr_CompWith)
if datatype(sr_Posn, 'W')=0 then
CryAndDie("CompareReplaceFixed()", "The position must be a whole number, '" || sr_Posn || "' is invalid")
if sr_Posn<0 then
do
sr_Posn=sr_From_L+sr_Posn+1
if sr_Posn<1 then
return(sr_NoMatch)
end
if sr_CaseInSens='N' then
sr_bit=substr(sr_From,sr_Posn,sr_Length)
else
sr_bit=translate(substr(sr_From,sr_Posn,sr_Length))
select
when sr_Operator='=' then
srCompRc=sr_bit=sr_CompWith
when sr_Operator='<>' then
srCompRc=sr_bit<>sr_CompWith
when sr_Operator='==' then
srCompRc=sr_bit==sr_CompWith
when sr_Operator='\==' then
srCompRc=sr_bit\==sr_CompWith
when sr_Operator='<' then
srCompRc=sr_bit<sr_CompWith
when sr_Operator='>' then
srCompRc=sr_bit>sr_CompWith
when sr_Operator='<=' then
srCompRc=sr_bit<=sr_CompWith
when sr_Operator='>=' then
srCompRc=sr_bit>=sr_CompWith
otherwise
CryAndDie("CompareReplaceFixed()", "Unsupported operator of '" || sr_Operator || "' used", '', 'ONLY "=, <>, ==, \==, <, >, <=, >=" are supported!')
end
if srCompRc=0 then
return(sr_NoMatch)
end
when sr_CmdChar='!' then
do
parse var sr_SSpec sr_CmdChar2 +1 sr_SSpec
select
when sr_CmdChar2='B' | sr_CmdChar2 = 'L' | sr_CmdChar2 = 'T' then
do
sr_From=strip(sr_From,sr_CmdChar2)
sr_From_L=length(sr_From)
end
when sr_CmdChar2='I' then
do
sr_From=space(sr_From)
sr_From_L=length(sr_From)
end
when sr_CmdChar2='S' then
sr_CaseInSens='N'
when sr_CmdChar2='i' then
sr_CaseInSens='Y'
otherwise
CryAndDie("CompareReplaceFixed()", 'Invalid "!" command of "' || sr_CmdChar2 || '"')
end
end
when sr_CmdChar='?' then
do
parse var sr_SSpec sr_Operator +1 sr_Delim +1 sr_LookFor (sr_Delim) sr_SSpec
if sr_CaseInSens='N' then
sr_Pos=pos(sr_LookFor,sr_From)
else
sr_Pos=pos(sr_LookFor,translate(sr_From))
if sr_Operator='=' then
do
if sr_Pos=0 then
return(sr_NoMatch)
end
else
do
if sr_Pos<>0 then
return(sr_NoMatch)
end
end
otherwise
CryAndDie("CompareReplaceFixed()", 'Invalid compare command of "' || sr_CmdChar || '"')
end
end
if arg(3, 'O')=1 then
return(1)
sr_RSpec=arg(3)
ReplaceCount=ReplaceCount+1
sr_From=sr_FromOrig
sr_From_L=length(sr_From)
sr_output=''
do forever
parse var sr_RSpec sr_Before '@' sr_RSpec
sr_Output = sr_Output || sr_Before
if sr_RSpec=='' then
return(sr_Output)
parse var sr_RSpec sr_CmdChar +1 sr_RSpec
select
when sr_CmdChar='$' then
do
parse var sr_RSpec sr_Posn ',' sr_Length ';' sr_RSpec
if sr_Posn<0 then
do
sr_Posn=sr_From_L+sr_Posn+1
if sr_Posn<1 then
return(sr_From)
end
if sr_Length='*' then
sr_Output=sr_Output||substr(sr_From,sr_Posn)
else
sr_Output=sr_Output||substr(sr_From,sr_Posn,sr_Length)
end
when sr_CmdChar='=' then
do
parse var sr_RSpec sr_Delim +1 sr_Exec (sr_Delim) sr_RSpec
CompareString=sr_From
call ExecRexxCmd('sr_Output = sr_Output || ' ||sr_Exec)
end
when sr_CmdChar='@' then
sr_Output=sr_Output|| '@'
otherwise
CryAndDie("CompareReplaceFixed()", 'Invalid replace command of "' || sr_CmdChar || '"')
end
end

SR_TYPE_13:
SpellDelChars=d2c(9)|| ',.=:;<>&-%()!/~' || '?#${}[]"'
SpellDictFileCount=0
SpellDelChangeCount=0
SpellingPrompts='N'
SpellShowEachError='N'
SpellingAddFile=''
SpellWordCount=0
SpellMistakeCount=0
SpellingAddCount=0
BadlySpellWordCount=0
CheckSpelling='N';
signal SPELLING_14

PrepareSpellingForThisBuild:
if OptionCompleteAddToToDepFile='Y' then
do
do DictIndex=1 to SpellDictFileCount
call AddInputFileToDependancyList SpellDictFile.DictIndex,SpellDictTime.DictIndex
end
end
Drop ?BADWORDEB.
return

LoadSpellingDictionary:
DictFileS=arg(1)
call DBG_SPELLING 'User wants the dictionary "' || DictFileS || '"'
DictFile=FindFile(DictFileS, 'dictionary')
call DBG_SPELLING 'Loading "' || DictFile || '"'
SpellDictFileCount=SpellDictFileCount+1
SpellDictFile.SpellDictFileCount=DictFile
SpellDictTime.SpellDictFileCount=GetFileDateTimeButDontWarnOnError(DictFile)
call FileClose DictFile, 'N'
do while lines(DictFile)<>0
ThisWord=translate(strip(linein(DictFile)))
if ThisWord='' then
iterate
if left(ThisWord,1)=';' then
iterate
if left(ThisWord,1)<> '$' then
do
SpellWordCount=SpellWordCount+1
call _valueS '?SPELLDICT.?' || c2x(ThisWord), ''
end
else
do
parse var ThisWord DictCmd Rest
select
when DictCmd='$MISTAKE' then
do
parse var Rest SpeltWrong SpeltCorrectly .
SpellMistakeCount=SpellMistakeCount+1
call _valueS '?SPELLERR.?' ||c2x(SpeltWrong),SpeltCorrectly
end
when DictCmd='$DELIMITERS' then
do
call DBG_SPELLING 'Dictionary is changing spelling delimiters'
SpellDelChangeCount=SpellDelChangeCount+1
if SpellDelChangeCount>1 then
call OutputWarningToScreen 'SPL9', 'Spell check delimiters already modified!'
call ExecRexxCmd "SpellDelChars = " ||strip(Rest)
end
otherwise
do
SpellWordCount=SpellWordCount+1
call _valueS '?SPELLDICT.?' || c2x(ThisWord), ''
end
end
end
end
call FileClose DictFile
call DBG_SPELLING 'Now have ' || AddCommasToDecimalNumber(SpellWordCount) || ' word(s) in dictionary and ' || AddCommasToDecimalNumber(SpellMistakeCount) || ' common mistakes noted!'
CheckSpelling='Y';
return

SpellCheckOneLine:
SpellLine=space(arg(1))
if 1=1 then
do
RightBit=SpellLine
SpellLine=''
StartPos=pos('<',RightBit)
do while StartPos<>0
EndPos=pos('>',RightBit,StartPos+1)
if EndPos=0 then
EndPos=StartPos
SpellLine=SpellLine||left(RightBit,StartPos-1)|| ' '
RightBit=substr(RightBit,EndPos+1)
StartPos=pos('<',RightBit)
end
SpellLine=SpellLine||RightBit
if SpellLine='' then
return
end
SpellLine=translate(translate(SpellLine), '', SpellDelChars, ' ')
do WordIndex=1 to words(SpellLine)
ThisWord=Word(SpellLine,WordIndex)
if left(ThisWord,1)="'" then
ThisWord=substr(ThisWord,2)
if right(ThisWord,1)="'" then
ThisWord=left(ThisWord,length(ThisWord)-1)
if length(ThisWord)>100 then
do
if OptionDebugOn='Y' then
call DBG_SPELLING 'Word too big to safely handle "' || ThisWord || '"'
iterate
end
ThisWordC2X=c2x(ThisWord)
if SpellMistakeCount<>0 then
do
MistakeId='?SPELLERR.?' ||ThisWordC2X
if symbol(MistakeId)='VAR' then
do
if SpellShowEachError='Y' then
ShowThisError='Y'
else
do
DuplicatedId='?BADWORDEB.?' ||ThisWordC2X
if symbol(DuplicatedId)='VAR' then
ShowThisError='N'
else
do
ShowThisError='Y'
call _valueS DuplicatedId, ''
end
end
if ShowThisError='Y' then
do
CorrectWord=_valueG(MistakeId)
if CorrectWord='' then
call OutputWarningToScreen 'SPL0', 'Common Mistake: ' ||ThisWord
else
call OutputWarningToScreen 'SPL0', 'Common Mistake: ' || ThisWord || ' (use "' || CorrectWord || '" instead)'
end
iterate
end
end
if SpellWordCount=0&SpellingPrompts='N' then
iterate
ValidId='?SPELLDICT.?' ||ThisWordC2X
if symbol(ValidId)<> 'VAR' then
do
if datatype(ThisWord)<> 'NUM' then
do
WordWarningId=''
WordWarningMsg=''
if SpellingPrompts<> 'N' then
do
DuplicatedId='?BADWORDPI.?' ||ThisWordC2X
if symbol(DuplicatedId)='VAR' then
do
BadIndex=_valueG(DuplicatedId)
if BadIndex<> '' then
do
WordWarningId='SPL1'
WordWarningMsg='Added "' || ThisWord || '" to "' || SpellingAddFile || '"'
SpellingAddOccurs.BadIndex=SpellingAddOccurs.BadIndex+1
end
end
else
do
DuplicatedIdValue=''
if SpellingAddFile<> '' & SpellingPrompts <> 'N' then
do
if SpellingPrompts='OK' then
UserResp='Y'
else
do
do until UserResp='Y' | UserResp = 'N' | UserResp = 'Q' | UserResp = 'A'
call ColorSet 'PromptText'
call charout,ThisWord|| ' <- OK (Yes/yes All/No/Quit asking)?'
call ColorSet
UserResp=translate(left(linein(),1))
end
end
if UserResp='A' then
do
SpellingPrompts='OK'
UserResp='Y'
end
if UserResp='Y' then
do
SpellingAddCount=SpellingAddCount+1
DuplicatedIdValue=SpellingAddCount
SpellingAddWord.SpellingAddCount=ThisWord
SpellingAddOccurs.SpellingAddCount=1
if SpellingPrompts='OK' then
do
WordWarningId='SPL1'
WordWarningMsg='Added "' || ThisWord || '" to "' || SpellingAddFile || '"'
end
end
else
do
if UserResp='Q' then
SpellingPrompts='N'
end
end
BadlySpellWordCount=BadlySpellWordCount+1
call _valueS DuplicatedId,DuplicatedIdValue
end
end
if SpellShowEachError='Y' then
ShowThisError='Y'
else
do
DuplicatedId='?BADWORDEB.?' ||ThisWordC2X
if symbol(DuplicatedId)='VAR' then
ShowThisError='N'
else
do
ShowThisError='Y'
call _valueS DuplicatedId, ''
end
end
if ShowThisError='Y' then
do
if WordWarningId='' then
do
WordWarningId='SPL1'
WordWarningMsg='Spelling? : ' ||ThisWord
end
call OutputWarningToScreen WordWarningId,WordWarningMsg
end
end
end
end
return

OutputAnySpellingAdditions:
if SpellingAddCount=0 then
return
call DBG_SPELLING 'Adding spelling words to file "' || SpellingAddFile || '"'
call DBGIND 1
if MacroExists("PPWIZARD_DONT_SORT_ADD_WORDS") = 'N' then
do
call DBG_SPELLING 'Sorting ' || SpellingAddCount || ' "bad" word(s) by number of occurences!'
SpellingAddWord.0=SpellingAddCount
SpellingAddOccurs.0=SpellingAddCount
SrtM=1
SrtCount=SpellingAddOccurs.0
do while(9*SrtM+4)<SrtCount
SrtM=SrtM*3+1
end
do while SrtM>0
SrtK=SrtCount-SrtM
do SrtJ=1 to SrtK
SrtIndex1=SrtJ
do while SrtIndex1>0
SrtIndex2=SrtIndex1+SrtM
SrtGreater=SpellingAddOccurs.SrtIndex1>SpellingAddOccurs.SrtIndex2
if SrtGreater then
do
SrtTemp=SpellingAddOccurs.SrtIndex1;SpellingAddOccurs.SrtIndex1=SpellingAddOccurs.SrtIndex2;SpellingAddOccurs.SrtIndex2=SrtTemp;SrtTemp=SpellingAddWord.SrtIndex1;SpellingAddWord.SrtIndex1=SpellingAddWord.SrtIndex2;SpellingAddWord.SrtIndex2=SrtTemp
end
else
leave
SrtIndex1=SrtIndex1-SrtM
end
end
SrtM=SrtM%3
end
call ArrayReverse "SpellingAddWord"
call ArrayReverse "SpellingAddOccurs"
end
call FileClose SpellingAddFile, 'N'
if FileQueryExists(SpellingAddFile)<> "" then
do
call DBG_SPELLING 'Deleting existing "' || SpellingAddFile || '"'
call MustDeleteFile SpellingAddFile
end
call DBG_SPELLING 'Writing words to file'
call DBGIND 1
do WordIndex=1 to SpellingAddCount
call lineout SpellingAddFile,SpellingAddWord.WordIndex
if OptionDebugOn='Y' then
call DBG_SPELLING 'The word "' || SpellingAddWord.WordIndex || '" occured ' || SpellingAddOccurs.WordIndex || ' time(s).'
end
call DBGIND-1
call FileClose SpellingAddFile
call OutputInformationToScreen AddCommasToDecimalNumber(SpellingAddCount)|| ' word(s) added to "' || SpellingAddFile || '"'
call DBGIND-1
return

SPELLING_14:
OptionDebugOn='N'
OptionMaxCol=500
OptionDebugTime='*'
call DBGINDInit
signal Debug_15

DebugInc:call TRACE "OFF"
call DBGIND 1
return

DebugDec:call TRACE "OFF"
call DBGIND-1
return

DebugOn:call TRACE "OFF"
call _DebugOnOff 'Y'
return

DebugOff:call TRACE "OFF"
call _DebugOnOff 'N'
return

_DebugOnOff:
if DebugSwitchUsed='Y' then
call DBG 'Command ignored as "/debug" used'
else
do
OptionDebugOn=arg(1)
call DebugStateChanged
end
return

DebugIndent:call TRACE "OFF"

DBGIND:
DebugIndent=DebugIndent+(arg(1)*2)
if DebugIndent<0 then
DebugIndent=0
return

Debug:call TRACE "OFF"

DBG:
if OptionDebugOn='N' then
return

DBG2:
if arg(1)='' then
call _DBG1 ''
else
call _DBG1 _DebugPrefix()|| '         >' ||translate(arg(1),DebugNewline,MarksNewLine)
return

_DebugPrefix:
if OptionDebugTime='' then
v!T=''
else
do
if OptionDebugTime="*" then
v!T=trunc(time('E'),3)
else
v!T=time(OptionDebugTime)
v!T='[' || v!T || ']'
end
return(v!T||copies("  ",IncludeLevel+DebugIndent))

YorN2OnorOff:
if arg(1)='Y' then
return('ON')
else
return('OFF')

DebugShowCurrentLineWithLineNumber:
if OptionDebugOn='Y' then
do
FmtLineNum=IncludeLineNumber
if length(FmtLineNum)<4 then
FmtLineNum=right(FmtLineNum,4, '0')
if arg(2)<> '' then
FmtLineNum=left(arg(2),length(FmtLineNum))
if IncludeMemHandle='' then
FmtLineNum='{' || DebugCurrentFileNumber || '}' ||FmtLineNum
else
FmtLineNum='[' || DebugCurrentFileNumber || ']' ||FmtLineNum
select
when AsIsModeOn='Y' & AutoTagOn = 'Y' then
DebugSym='> '
when AsIsModeOn='Y' then
DebugSym='} '
when AutoTagOn='Y' then
DebugSym=') '
otherwise
DebugSym=': '
end
if arg(1)=='' then
call _DBG1 _DebugPrefix()||FmtLineNum||DebugSym
else
call _DBG1 _DebugPrefix()||FmtLineNum||DebugSym||DebugRightArrow||translate(arg(1),DebugNewline,MarksNewLine)||DebugLeftArrow
end
return

DebugShowLineDropped:
if OptionDebugOn='Y' then
do
call _DBG1 _DebugPrefix()||left(arg(1),length(FmtLineNum), ' ') || '-'
end
return

DebugGetEnv:
if OptionDebugOn='Y' then
call DBG 'GetEnv(): "' || arg(1) || '" = ' ||DebugRightArrow||arg(2)||DebugLeftArrow
return

DebugWarning:
if OptionDebugOn='N' then
return
DbgWarning='!!! ' || arg(1) || ' !!!'
DbgLine=copies('!',length(DbgWarning))
call DBG2 ''
call DBG2 left('!!!![ DEBUG WARNING ]', length(DbgWarning), '!')
call DBG2 DbgWarning
call DBG2 left('', length(DbgWarning), '!')
call DBG2 ''
return

DebugOutputVariableInfo:
if OptionDebugOn='Y' then
call DBG2 '? ' ||translate(arg(1),DebugNewline,MarksNewLine)
return

DBGINDInit:
DebugIndent=0
return

DebugGetOpSysText:
if PpWizardOpSys=PpWizardOpSysREAL then
return(PpWizardOpSys)
else
return(PpWizardOpSys|| ' ("' || PpWizardOpSysREAL || '")')

DebugStateChanged:
if OptionDebugOn='Y' then
do
call DisplayCopyright
if DebugOnStuffOutputted='N' then
do
call _DBG1 ''
call _DBG1 ''
call _DBG1 'BRIEF INTRO TO DEBUG OUTPUT'
call _DBG1 '~~~~~~~~~~~~~~~~~~~~~~~~~~~'
call _DBG1 'Indenting of debug text represents logic "nesting", the format'
call _DBG1 'of a line read from file is explained below:'
call _DBG1 ''
call _DBG1 '[0.050]  {1}0006: #define Fred Value'
call _DBG1 '-------  ~~~----  ------------------'
call _DBG1 '   ^      ^  ^            ^'
call _DBG1 '   |      |  |            + The line(s)'
call _DBG1 '   |      |  |'
call _DBG1 '   |      |  +-- <<#{   = Line came from memory buffer only used for "<<ML" lines'
call _DBG1 '   |      |  +-- <<ML   = Line came from #{ defined within a macro'
call _DBG1 '   |      |  +-- <<<<   = Line came from memory buffer (macro, line continuation etc - Imbedded newlines IGNORED)'
call _DBG1 '   |      |  +-- >>>>   = Writing buffered line to output'
call _DBG1 '   |      |  +-- <<FL   = Line came from #{ defined in a file'
call _DBG1 '   |      |  +-- Number = Number of line just read from file'
call _DBG1 '   |      |'
call _DBG1 '   |      +-- The number is a unique number to represent a file inclusion'
call _DBG1 '   |          {file#} means file is being read from disk'
call _DBG1 '   |          [file#] means file is being read from cached memory'
call _DBG1 '   |          Indenting represents #include level'
call _DBG1 '   |'
call _DBG1 '   +- Time in your preferred format (defaults to elapsed - See /DebugTime)'
call _DBG1 ''
call _DBG1 'Note that the #OPTION "DebugLevel" command can be used to reduce the'
call _DBG1 'information generated!'
call _DBG1 ''
call _DBG1 'Never use the rexx say command to display output! Use the PPWIZARD'
call _DBG1 '"say()" function instead to ensure that the output is included in any'
call _DBG1 'PPWIZARD output.'
call _DBG1 'There are MANY rexx debugging options, including tracing, interactive debugging'
call _DBG1 'and break points. The #DefineRexx command will so cause rexx code variables to be dumped.'
call _DBG1 ''
call _DBG1 ''
call _DBG1 ''
SourceTime=_FileQueryDateTime(PpWizardPgmName)
call DBG 'Debug Header'
call DBG '~~~~~~~~~~~~'
call DBGIND 1
call DBG 'Started@: "' || PpwCompTime        || '"'
call DBG 'Program : "' || PpWizardPgmName    || '" (' || SourceTime || ')'
call DBG 'OptionE : "' || OptionsEnvironment || '"'
call DBG 'OptionC : "' || OptionsCmdLine     || '"'
call DBG 'Src Type: "' || ProcessingMode     || '"'
call DBG 'OpSystem: "' ||DebugGetOpSysText()
call DBG 'Rexx Ver: "' || RexVersionInfo     || '"'
call DBG 'Mode    : "' || RexWhich           || '"'
if RexWhich='REGINA' then
call DBG 'uname() : "' || uname()        || '"'
if OptionFilterIn<> '' then
call DBG 'Filter I: ' || FunctionFilterIn || '(' || InputInterfaceVer || ')'
if OptionFilterOut<> '' then
call DBG 'Filter O: "' || OptionFilterOut   || '" (interface version ' || OutputInterfaceVer || ')'
DebugOnStuffOutputted='Y'
call DBGIND-1
end
end
call SetEnv "PPWIZARD_DEBUG",OptionDebugOn
return

ProcessHashDebug:
if DebugSwitchUsed='Y' then
call DBG 'Command ignored as "/debug" used'
else
do
ReturnRc=SetOnorOffVariable(arg(1), 'OptionDebugOn')
call DebugStateChanged
end
return(0)

DebugShowAsMuchEnvironmentDetailAsPossible:
if OptionDebugOn='N' then
return
call DBG 'Dumping Environmental Info'
TmpSetFile=RexGetTmpFileName()
RedirBit=RedirectStdOutAndErr2(TmpSetFile)
call _EnvAddCmd 'set'
if RexSystemOpSys<> "UNIX" then
do
select
when RexSystemOpSys="OS/2"  then VerCmd = 'VER /R'
otherwise VerCmd='VER'
end
call _EnvAddCmd VerCmd
end
if RexSystemOpSys<> "UNIX" then
call _SysFileDelete TmpSetFile
return

_EnvAddCmd:
call AddressCmd arg(1)||RedirBit,TmpSetFile
if RexSystemOpSys="UNIX" then
call _SysFileDelete TmpSetFile
return

_DBG1:
w!Line=arg(1)
if OptionMaxCol=0 then
call Line1 w!Line
else
do
if length(w!Line)<=OptionMaxCol then
call Line1 w!Line
else
call Line1 left(w!Line,OptionMaxCol)|| ' <-[' || OptionMaxCol || ']'
end
return

_SetDebugChar:
x!Var=arg(1)
x!CurValVar=arg(2)
parse value strip(value(x!Var)) with x!Val ',' x!Rest
call value x!Var,x!Rest
if x!Val=-1 then
x!NewVal=''
else
do
x!Val=strip(x!Val)
if x!Val='' then
x!NewVal=value(x!CurValVar)
else
do
if datatype(x!Val, 'W')then
x!NewVal=d2c(x!Val)
else
x!NewVal=x!Val
end
end
return(x!NewVal)

SetDebugChars:
y!Chars=arg(1)
y!MakDef=arg(2)
if y!Chars='' then
do
DebugLeftArrow=_DebugLeftArrow
DebugRightArrow=_DebugRightArrow
DebugNewline=_DebugNewline
end
else
do
DebugRightArrow=_SetDebugChar('y!Chars', 'DebugRightArrow')
DebugLeftArrow=_SetDebugChar('y!Chars', 'DebugLeftArrow' )
DebugNewline=_SetDebugChar('y!Chars', 'DebugNewline' )
end
if y!MakDef='Y' then
do
_DebugLeftArrow=DebugLeftArrow
_DebugRightArrow=DebugRightArrow
_DebugNewline=DebugNewline
end
call DBG 'New debug characters are "LEFT=' || DebugRightArrow || ', RIGHT=' || DebugLeftArrow || ', NL=' || DebugNewline || '"'
return

Debug_15:
DebugLevelCnt=0
SeeLevelAll=_SaveDebugLevel("ALL",           "FFFFFF")
SeeNone=_SaveDebugLevel("NONE",          "000000")
DummyUser1=_SaveDebugLevel("USER1",         "000001")
DummyUser2=_SaveDebugLevel("USER2",         "000002")
SeeLevelConditional=_SaveDebugLevel("CONDITIONAL",   "000004")
SeeFoundVar=_SaveDebugLevel("FOUNDVAR",      "000008")
SeeFoundVarParms=_SaveDebugLevel("FOUNDVARPARMS", "000010")
SeeFoundStdVar=_SaveDebugLevel("FOUNDSTDVAR",   "000020")
SeeAfterReplace=_SaveDebugLevel("AFTERREPLACE",  "000040")
SeeOptions=_SaveDebugLevel("OPTIONS",       "000080")
SeeOpSys=_SaveDebugLevel("OPSYS",         "000100")
SeeDefining=_SaveDebugLevel("DEFINING",      "000200")
SeeDefaultOrMacroValue=_SaveDebugLevel("MACROVALORDEF", "000400")
SeeAsIs=_SaveDebugLevel("ASIS",          "000800")
SeeAutoTag=_SaveDebugLevel("AUTOTAG",       "001000")
SeeRexxVar=_SaveDebugLevel("REXXVAR",       "002000")
SeeRexxTrace=_SaveDebugLevel("REXXTRACE",     "004000")
SeeInterpret=_SaveDebugLevel("INTERPRET",     "008000")
SeeEvaluate=_SaveDebugLevel("EVALUATE",      "010000")
SeeImport=_SaveDebugLevel("IMPORT",        "020000")
SeeSpelling=_SaveDebugLevel("SPELLING",      "040000")
SeeQuoting=_SaveDebugLevel("QUOTING",       "080000")
SeeImport=bitand(SeeImport,SeeDefaultOrMacroValue)
UserBitsOn=bitor(DummyUser1,DummyUser2)
DebugLevel=bitxor(SeeLevelAll,UserBitsOn)
DebugLevel=bitxor(DebugLevel,SeeQuoting)
SeeLevelDEFAULT=_SaveDebugLevel("DEFAULT",c2x(DebugLevel))
signal DebugOpt_16

IsDebugOn:call TRACE "OFF"
ido1=arg(1)
if ido1='' then
return(OptionDebugOn)
else
do
if OptionDebugOn='N' then
return(0)
else
do
idoUBits=bitand(DebugLevel,UserBitsOn)
idoUBits=bitand(idoUBits,x2c(right(ido1,6, '0')))
return(c2d(idoUBits))
end
end

DebugAddressCmdBefore:
if OptionDebugOn='Y' then
do
if bitand(DebugLevel,SeeOpSys)==SeeOpSys then
do
call DBGIND 1
call DBG 'Executing: ' ||arg(1)
call DBGIND-1
end
end
return

DebugAddressCmdOutput:
if OptionDebugOn='Y' then
do
if bitand(DebugLevel,SeeOpSys)==SeeOpSys then
do
call DBGIND 2
DbgLineNumber=arg(2)
if datatype(DbgLineNumber, 'W')=0 then
call DBG '> ' ||arg(1)
else
do
if DbgLineNumber<999 then
DbgLineNumber=right(DbgLineNumber,3, '0')
call DBG '> ' || DbgLineNumber || ': ' ||arg(1)
end
call DBGIND-2
end
end
return

DebugAddressCmdAfter:
if OptionDebugOn='Y' then
do
if bitand(DebugLevel,SeeOpSys)==SeeOpSys then
do
call DBGIND 2
call DBG '  Rc = ' ||arg(1)
call DBGIND-2
end
end
return

DebugOutputAfterReplacement:
if OptionDebugOn='N' then
return
if bitand(DebugLevel,SeeAfterReplace)==SeeAfterReplace then
call DBG2 arg(2)||DebugRightArrow||translate(arg(1),DebugNewline,MarksNewLine)||DebugLeftArrow
return

DBG_DEFINING:
if bitand(DebugLevel,SeeDefining)==SeeDefining then
call DBG arg(1)
return

DBG_ASIS:
if bitand(DebugLevel,SeeAsIs)==SeeAsIs then
call DBG arg(1)
return

DBG_REXXVAR:
if bitand(DebugLevel,SeeRexxVar)==SeeRexxVar then
call DBG arg(1)
return

DBG_INTERPRET:
if bitand(DebugLevel,SeeInterpret)==SeeInterpret then
call DBG arg(1)
return

DBG_EVALUATE:
if bitand(DebugLevel,SeeEvaluate)==SeeEvaluate then
call DBG arg(1)
return

DBG_SPELLING:
if bitand(DebugLevel,SeeSpelling)==SeeSpelling then
call DBG arg(1)
return

DBG_QUOTING:
if bitand(DebugLevel,SeeQuoting)==SeeQuoting then
call DBG arg(1)
return

DBG_IMPORT:
if bitand(DebugLevel,SeeImport)==SeeImport then
call DBG arg(1)
return

DBG_AUTOTAG:
if bitand(DebugLevel,SeeAutoTag)==SeeAutoTag then
call DBG arg(1)
return

DBG_MACROVALORDEF:
if bitand(DebugLevel,SeeDefaultOrMacroValue)==SeeDefaultOrMacroValue then
call DBG arg(1)
return

DBG_OPTIONS:
if bitand(DebugLevel,SeeOptions)==SeeOptions then
call DBG arg(1)
return

DBG_CONDITIONAL:
if bitand(DebugLevel,SeeLevelConditional)==SeeLevelConditional then
call DBG arg(1)
return

DebugOutputVariableInfo_FOUNDSTDVAR:
if bitand(DebugLevel,SeeFoundStdVar)==SeeFoundStdVar then
call DebugOutputVariableInfo arg(1)
return

DebugOutputVariableInfo_FOUNDVAR:
if bitand(DebugLevel,SeeFoundVar)==SeeFoundVar then
call DebugOutputVariableInfo arg(1)
return

DebugOutputVariableInfo_FOUNDVARPARMS:
if bitand(DebugLevel,SeeFoundVarParms)==SeeFoundVarParms then
call DebugOutputVariableInfo arg(1)
return

DebugOutputVariableInfo_FOUNDSTDVAR:
if bitand(DebugLevel,SeeFoundVar)==SeeFoundVar then
call DebugOutputVariableInfo arg(1)
return

_SaveDebugLevel:
DebugLevelCnt=DebugLevelCnt+1
DebugLevelNme.DebugLevelCnt=translate(arg(1))
DebugLevelVal.DebugLevelCnt=arg(2)
return(x2c(arg(2)))

GetDebugLevel:
WantedName=translate(arg(1))
do DbgIndex=1 to DebugLevelCnt
if WantedName=DebugLevelNme.DbgIndex then
return(DebugLevelVal.DbgIndex)
end
return('')

_WorkOutDebugLevelText:
DbgLvlTxt="ALL"
do DbgIndex=1 to DebugLevelCnt
if bitand(DebugLevel,x2c(DebugLevelVal.DbgIndex))=SeeNone then
DbgLvlTxt=DbgLvlTxt|| ',-' ||DebugLevelNme.DbgIndex
end
return(DbgLvlTxt)

DEBUGLEVEL_DEBUG:
if OptionDebugOn='Y' then
call OptionDebugShow 'DEBUGLEVEL', 'Debug level (when on) is ' ||_WorkOutDebugLevelText()
return

DEBUGLEVEL_GET:
call DEBUGLEVEL_DEBUG
return(_WorkOutDebugLevelText())

DEBUGLEVEL_SET:
DebugCmdsIn=arg(1)
DebugCmds=DebugCmdsIn
do while DebugCmds<> ''
parse var DebugCmds OneDebugOpt','DebugCmds
OptionAction=left(OneDebugOpt,1)
if OptionAction='+' then
OneDebugOpt=substr(OneDebugOpt,2)
else
do
if OptionAction='-' then
OneDebugOpt=substr(OneDebugOpt,2)
else
OptionAction='='
end
OptionBinary=x2c(GetDebugLevel(OneDebugOpt))
if OptionBinary='' then
CryAndDie('Invalid debug option of "' || OneDebugOpt || '"')
if OptionAction='=' then
DebugLevel=OptionBinary
else
do
if OptionAction='+' then
DebugLevel=bitor(DebugLevel,OptionBinary)
else
DebugLevel=bitxor(DebugLevel,OptionBinary)
end
end
if ProcessedCmdLine='N' then
do
call OptionDebugShow 'DEBUGLEVEL', 'Setting default value of debug level to "' || _WorkOutDebugLevelText() || '"'
Default4_DebugLevel=DebugLevel
return(0)
end
if DebugCmdsIn='' then
DebugLevel=Default4_DebugLevel
call DEBUGLEVEL_DEBUG
return

DebugOpt_16:
OptionCgiModeOn='N'
CgiOutputFile=''
CgiFatalError='N'
signal CGI_17

InitConsoleOutputVarsPass1:
ConsoleFile=''
OutputToConsoleLog='N'
OutputToErrorLog='N'
ConsoleErrorFile='PPWIZARD.ERR'
TruncateDefaultErrorFile='Y'
return

InitConsoleOutputVarsPass2:
call UserIsSpecifyingConsoleFileName GetEnv("PPWIZARD_CONSOLEFILE")
call UserIsSpecifyingErrorFileName GetEnv("PPWIZARD_ERRORFILE")
if ConsoleErrorFile='' then
ConsoleErrorFile='PPWIZARD.ERR'
return

ConsoleWriteAllowed:
_ConsoleWriteAllowed=translate(arg(1))
return

UserIsSpecifyingErrorFileName:
ConsoleErrorFile=arg(1)
if ConsoleErrorFile<> '' then
do
if left(ConsoleErrorFile,1)='+' then
do
ConsoleErrorFile=substr(ConsoleErrorFile,2)
TruncateDefaultErrorFile='N'
end
else
do
TruncateDefaultErrorFile='Y'
end
end
return

UserIsSpecifyingConsoleFileName:
z!ConFile=arg(1)
z!CopyFrom=''
if OutputToConsoleLog='Y' then
do
if left(z!ConFile,1)='+' then
z!New=substr(z!ConFile,2)
else
z!New=z!ConFile
if translate(ConsoleFile)<>translate(z!New)then
z!CopyFrom=ConsoleFile
else
z!ConFile='+' ||z!New
end
if ConsoleFile<> '' then
do
call _FileClose ConsoleFile
ConsoleFile=''
end
if z!ConFile<> '' then
do
if left(z!ConFile,1)='+' then
do
z!ConFile=substr(z!ConFile,2)
end
else
do
call MustDeleteFile z!ConFile
end
end
if z!ConFile='' then
OutputToConsoleLog='N'
else
do
call MakeDirectoryTree _filespec('Location',z!ConFile)
OutputToConsoleLog='y'
ConsoleFile=z!ConFile
if z!CopyFrom<> '' then
do
do while lines(z!CopyFrom)<>0
call _Lne2CFle linein(z!CopyFrom)
end
call lineout z!CopyFrom, ''
call lineout z!CopyFrom, 'See "' || ConsoleFile || '" for more console output...'
call _FileClose z!CopyFrom
call _Lne2CFle ''
call _Lne2CFle ''
call _Lne2CFle copies('*+',38)
call _Lne2CFle strip(PadString('above copied from "' || z!CopyFrom || '"', 78, 'C'), 'T')
call _Lne2CFle strip(PadString(TheTime,78, 'C'), 'T')
call _Lne2CFle copies('*+',38)
call _Lne2CFle ''
OutputToConsoleLog='Y'
end
end
return

AllFollowingOutputGoesToErrorFile:
call ConsoleWriteAllowed 'Y'
if ConsoleErrorFile='' then
return
if TruncateDefaultErrorFile='Y' then
do
TruncateDefaultErrorFile='N'
call MustDeleteFile ConsoleErrorFile
end
call MakeDirectoryTree _filespec('Location',ConsoleErrorFile)
TheTime=NiceDateTime()
if symbol('InputFileFull') <> 'VAR' then
TheFile=''
else
TheFile=InputFileFull
OutputToErrorLog='Y'
call Say2ErrorFile ''
call Say2ErrorFile ''
call Say2ErrorFile copies('*+',38)
call Say2ErrorFile strip(PadString(TheFile,78, 'C'), 'T')
call Say2ErrorFile strip(PadString(TheTime,78, 'C'), 'T')
call Say2ErrorFile copies('*+',38)
call Say2ErrorFile ''
return

Say2ErrorFile:
if OutputToErrorLog='Y' then
do
ab!L=arg(1)
do until ab!L==''
parse var ab!L ab!Nxt (MarksNewLine) ab!L
call lineout ConsoleErrorFile,ab!Nxt
end
end
return

Char1ToErrorFile:
if OutputToErrorLog='Y' then
call charout ConsoleErrorFile,arg(1)
return

AddConsoleHdr:
OutputToConsoleLog='N'
TheTime=NiceDateTime()
OutputToConsoleLog='Y'
call _Lne2CFle ''
call _Lne2CFle ''
call _Lne2CFle copies('*+',38)
call _Lne2CFle strip(PadString(TheTime,78, 'C'), 'T')
call _Lne2CFle copies('*+',38)
call _Lne2CFle ''
return

_Lne2CFle:
if OutputToConsoleLog<> 'N' then
do
bb!L=arg(1)
do until bb!L==''
parse var bb!L bb!Nxt (MarksNewLine) bb!L
call lineout ConsoleFile,bb!Nxt
end
end
return

_Chr2CFle:
if OutputToConsoleLog<> 'N' then
call charout ConsoleFile,arg(1)
return

Say:call TRACE "OFF"

Line1:
parse arg cb!Short,cb!Long
if cb!Long='' then
cb!Long=cb!Short
if OptionCgiModeOn='N' then
do
if _ConsoleWriteAllowed='Y' then
say cb!Short
if OutputToErrorLog='Y' then
call Say2ErrorFile cb!Long
if OutputToConsoleLog<> 'N' then
do
if OutputToConsoleLog='y' then
call AddConsoleHdr
call _Lne2CFle cb!Long
end
end
else
do
if CgiOutputFile<> '' then
call lineout CgiOutputFile,cb!Short
if CgiFatalError='Y' then
say _MustSeeAsIsInHtmlViewer(cb!Short)
end
return

Chars:call TRACE "OFF"

Char1:
TheChar1=arg(1)
if OptionCgiModeOn='N' then
do
call charout,TheChar1
if OutputToErrorLog='Y' then
call Char1ToErrorFile TheChar1
if OutputToConsoleLog<> 'N' then
do
if OutputToConsoleLog='y' then
call AddConsoleHdr
call _Chr2CFle TheChar1
end
end
else
do
if CgiOutputFile<> '' then
call charout CgiOutputFile,TheChar1
if CgiFatalError='Y' then
call charout,_MustSeeAsIsInHtmlViewer(TheChar1)
end
return

DieIfCgiModeOn:
if OptionCgiModeOn='Y' then
call CryAndDie "This feature is not allowed in CGI mode"
return

TurnCgiModeOn:
OptionCgiModeOn='Y'
CgiOutputFile=ThisCmdOptions
if pos('?',CgiOutputFile)<>0 then
do
PartSecond=time('Long')
parse var PartSecond .'.'PartSecond
RandomBit=right(time('Seconds'), 5, '0')
RandomBit=RandomBit||left(strip(PartSecond),3)
RandomBit=RandomBit|| '.' || right( date('Days'), 3, '0')
CgiOutputFile=ReplaceString(CgiOutputFile, '?',RandomBit)
end
if CgiOutputFile<> '' then
do
if FileQueryExists(CgiOutputFile)<> '' then
do
call _FileClose CgiOutputFile
DeleteRc=_SysFileDelete(CgiOutputFile)
if DeleteRc<>0 then
call DBG 'Could not delete "' || CgiOutputFile || '" (Rc = ' || DeleteRc || ')'
end
end
call ColorAllow 'N'
call BeepsAllow 'N'
return

CloseCgiFileIfOpen:
if OutputToConsoleLog<> 'N' then
do
call _FileClose ConsoleFile
OutputToConsoleLog='N'
end
if OutputToErrorLog='Y' then
do
call _FileClose ConsoleErrorFile
OutputToErrorLog='N'
end
if CgiOutputFile<> '' then
call _FileClose CgiOutputFile
return

CgiStartFatalError:
if OptionCgiModeOn='N' then
return
CgiDoVar='CGI_FATAL_MY_MESSAGE_ONLY'
if MacroExists(CgiDoVar)='Y' then
do
CgiErrorCodes=CfgMacro(CgiDoVar, '')
if CgiErrorCodes='' then
call DBG 'We do not want any error indication in user output'
else
call DBG 'Displaying user message only (no error details)'
say CgiErrorCodes
return
end
call DBG 'Will show user error output as "' || CgiDoVar || '" was not defined'
CgiErrDefault='<P><HR><FONT SIZE=+1 COLOR=RED><CENTER><H1>FATAL ERROR</H1></CENTER><P><PRE>'
CgiErrorCodes=CfgMacro("CGI_FATAL_HEADER",CgiErrDefault)
say CgiErrorCodes
CgiErrDefault='</PRE><HR></FONT>'
CgiErrorCodes=CfgMacro("CGI_FATAL_TRAILER",CgiErrDefault)
CgiFatalError='Y'
return

CgiEndFatalError:
if OptionCgiModeOn='N' then
return
if CgiFatalError='N' then
return
say CgiErrorCodes
CgiFatalError='N'
return

_MustSeeAsIsInHtmlViewer:
BrowserOk=ReplaceString(arg(1), "<",          "<")
BrowserOk=ReplaceString(BrowserOk, ">",          ">")
return(BrowserOk)

CGI_17:
ReplaceCount=0
CiSelfRef="{*}"
signal EndREPLSTR

ReplaceString:call TRACE "OFF"
parse arg rs?TheString,rs?ChangeFrom
rs?FoundPosn=pos(rs?ChangeFrom,rs?TheString)
if rs?FoundPosn=0 then
return(rs?TheString)
rs?ChangeTo=arg(3)
rs?ChangeFromLength=length(rs?ChangeFrom)
rs?LeftPart=''
do until rs?FoundPosn=0
rs?LeftPart=rs?LeftPart||left(rs?TheString,rs?FoundPosn-1)||rs?ChangeTo
rs?TheString=substr(rs?TheString,rs?FoundPosn+rs?ChangeFromLength)
ReplaceCount=ReplaceCount+1
rs?FoundPosn=pos(rs?ChangeFrom,rs?TheString)
end
return(rs?LeftPart||rs?TheString)

ReplaceStringCi:call TRACE "OFF"
rsi?TheString=arg(1)
rsi?TheStringU=translate(rsi?TheString)
rsi?ChangeFrom=translate(arg(2))
rsi?FoundPosn=pos(rsi?ChangeFrom,rsi?TheStringU)
if rsi?FoundPosn=0 then
return(rsi?TheString)
rsi?ChangeTo=arg(3)
if pos(CiSelfRef,rsi?ChangeTo)=0 then
rsi?Ref='N'
else
rsi?Ref='Y'
rsi?ChangeFromLength=length(rsi?ChangeFrom)
rsi?LeftPart=''
do until rsi?FoundPosn=0
if rsi?Ref='N' then
rsi?SubWith=rsi?ChangeTo
else
do
rsi?SaveCount=ReplaceCount
rsi?SubWith=ReplaceString(rsi?ChangeTo,CiSelfRef,substr(rsi?TheString,rsi?FoundPosn,rsi?ChangeFromLength))
ReplaceCount=rsi?SaveCount
end
rsi?LeftPart=rsi?LeftPart||left(rsi?TheString,rsi?FoundPosn-1)||rsi?SubWith
rsi?TheString=substr(rsi?TheString,rsi?FoundPosn+rsi?ChangeFromLength)
rsi?TheStringU=substr(rsi?TheStringU,rsi?FoundPosn+rsi?ChangeFromLength)
ReplaceCount=ReplaceCount+1
rsi?FoundPosn=pos(rsi?ChangeFrom,rsi?TheStringU)
end
return(rsi?LeftPart||rsi?TheString)

EndREPLSTR:
ReplaceCount=0
signal EndBULK_C2S

BulkChar2String:call TRACE "OFF"
parse arg brRightBit,brArray
brModifyThese=value(brArray)
brPos=verify(brRightBit,brModifyThese, 'M')
if brPos=0 then
return(brRightBit)
brLeftBit=''
brArray=brArray|| '.'
do until brPos=0
brLeftBit=brLeftBit||left(brRightBit,brPos-1)||value(brArray||pos(substr(brRightBit,brPos,1),brModifyThese))
brRightBit=substr(brRightBit,brPos+1)
ReplaceCount=ReplaceCount+1
brPos=verify(brRightBit,brModifyThese, 'M')
end
return(brLeftBit||brRightBit)

BulkChangePrepare:call TRACE "OFF"
parse arg brArray,brChar,brString
if brChar=='' then
call value brArray, ''
else
do
brValue=value(brArray)||BrChar
call value brArray,brValue
call value brArray|| '.' ||length(brValue),brString
end
return

EndBULK_C2S:
_CCnt=0
call _32 '00000000'x
call _32 '77073096'x
call _32 'EE0E612C'x
call _32 '990951BA'x
call _32 '076DC419'x
call _32 '706AF48F'x
call _32 'E963A535'x
call _32 '9E6495A3'x
call _32 '0EDB8832'x
call _32 '79DCB8A4'x
call _32 'E0D5E91E'x
call _32 '97D2D988'x
call _32 '09B64C2B'x
call _32 '7EB17CBD'x
call _32 'E7B82D07'x
call _32 '90BF1D91'x
call _32 '1DB71064'x
call _32 '6AB020F2'x
call _32 'F3B97148'x
call _32 '84BE41DE'x
call _32 '1ADAD47D'x
call _32 '6DDDE4EB'x
call _32 'F4D4B551'x
call _32 '83D385C7'x
call _32 '136C9856'x
call _32 '646BA8C0'x
call _32 'FD62F97A'x
call _32 '8A65C9EC'x
call _32 '14015C4F'x
call _32 '63066CD9'x
call _32 'FA0F3D63'x
call _32 '8D080DF5'x
call _32 '3B6E20C8'x
call _32 '4C69105E'x
call _32 'D56041E4'x
call _32 'A2677172'x
call _32 '3C03E4D1'x
call _32 '4B04D447'x
call _32 'D20D85FD'x
call _32 'A50AB56B'x
call _32 '35B5A8FA'x
call _32 '42B2986C'x
call _32 'DBBBC9D6'x
call _32 'ACBCF940'x
call _32 '32D86CE3'x
call _32 '45DF5C75'x
call _32 'DCD60DCF'x
call _32 'ABD13D59'x
call _32 '26D930AC'x
call _32 '51DE003A'x
call _32 'C8D75180'x
call _32 'BFD06116'x
call _32 '21B4F4B5'x
call _32 '56B3C423'x
call _32 'CFBA9599'x
call _32 'B8BDA50F'x
call _32 '2802B89E'x
call _32 '5F058808'x
call _32 'C60CD9B2'x
call _32 'B10BE924'x
call _32 '2F6F7C87'x
call _32 '58684C11'x
call _32 'C1611DAB'x
call _32 'B6662D3D'x
call _32 '76DC4190'x
call _32 '01DB7106'x
call _32 '98D220BC'x
call _32 'EFD5102A'x
call _32 '71B18589'x
call _32 '06B6B51F'x
call _32 '9FBFE4A5'x
call _32 'E8B8D433'x
call _32 '7807C9A2'x
call _32 '0F00F934'x
call _32 '9609A88E'x
call _32 'E10E9818'x
call _32 '7F6A0DBB'x
call _32 '086D3D2D'x
call _32 '91646C97'x
call _32 'E6635C01'x
call _32 '6B6B51F4'x
call _32 '1C6C6162'x
call _32 '856530D8'x
call _32 'F262004E'x
call _32 '6C0695ED'x
call _32 '1B01A57B'x
call _32 '8208F4C1'x
call _32 'F50FC457'x
call _32 '65B0D9C6'x
call _32 '12B7E950'x
call _32 '8BBEB8EA'x
call _32 'FCB9887C'x
call _32 '62DD1DDF'x
call _32 '15DA2D49'x
call _32 '8CD37CF3'x
call _32 'FBD44C65'x
call _32 '4DB26158'x
call _32 '3AB551CE'x
call _32 'A3BC0074'x
call _32 'D4BB30E2'x
call _32 '4ADFA541'x
call _32 '3DD895D7'x
call _32 'A4D1C46D'x
call _32 'D3D6F4FB'x
call _32 '4369E96A'x
call _32 '346ED9FC'x
call _32 'AD678846'x
call _32 'DA60B8D0'x
call _32 '44042D73'x
call _32 '33031DE5'x
call _32 'AA0A4C5F'x
call _32 'DD0D7CC9'x
call _32 '5005713C'x
call _32 '270241AA'x
call _32 'BE0B1010'x
call _32 'C90C2086'x
call _32 '5768B525'x
call _32 '206F85B3'x
call _32 'B966D409'x
call _32 'CE61E49F'x
call _32 '5EDEF90E'x
call _32 '29D9C998'x
call _32 'B0D09822'x
call _32 'C7D7A8B4'x
call _32 '59B33D17'x
call _32 '2EB40D81'x
call _32 'B7BD5C3B'x
call _32 'C0BA6CAD'x
call _32 'EDB88320'x
call _32 '9ABFB3B6'x
call _32 '03B6E20C'x
call _32 '74B1D29A'x
call _32 'EAD54739'x
call _32 '9DD277AF'x
call _32 '04DB2615'x
call _32 '73DC1683'x
call _32 'E3630B12'x
call _32 '94643B84'x
call _32 '0D6D6A3E'x
call _32 '7A6A5AA8'x
call _32 'E40ECF0B'x
call _32 '9309FF9D'x
call _32 '0A00AE27'x
call _32 '7D079EB1'x
call _32 'F00F9344'x
call _32 '8708A3D2'x
call _32 '1E01F268'x
call _32 '6906C2FE'x
call _32 'F762575D'x
call _32 '806567CB'x
call _32 '196C3671'x
call _32 '6E6B06E7'x
call _32 'FED41B76'x
call _32 '89D32BE0'x
call _32 '10DA7A5A'x
call _32 '67DD4ACC'x
call _32 'F9B9DF6F'x
call _32 '8EBEEFF9'x
call _32 '17B7BE43'x
call _32 '60B08ED5'x
call _32 'D6D6A3E8'x
call _32 'A1D1937E'x
call _32 '38D8C2C4'x
call _32 '4FDFF252'x
call _32 'D1BB67F1'x
call _32 'A6BC5767'x
call _32 '3FB506DD'x
call _32 '48B2364B'x
call _32 'D80D2BDA'x
call _32 'AF0A1B4C'x
call _32 '36034AF6'x
call _32 '41047A60'x
call _32 'DF60EFC3'x
call _32 'A867DF55'x
call _32 '316E8EEF'x
call _32 '4669BE79'x
call _32 'CB61B38C'x
call _32 'BC66831A'x
call _32 '256FD2A0'x
call _32 '5268E236'x
call _32 'CC0C7795'x
call _32 'BB0B4703'x
call _32 '220216B9'x
call _32 '5505262F'x
call _32 'C5BA3BBE'x
call _32 'B2BD0B28'x
call _32 '2BB45A92'x
call _32 '5CB36A04'x
call _32 'C2D7FFA7'x
call _32 'B5D0CF31'x
call _32 '2CD99E8B'x
call _32 '5BDEAE1D'x
call _32 '9B64C2B0'x
call _32 'EC63F226'x
call _32 '756AA39C'x
call _32 '026D930A'x
call _32 '9C0906A9'x
call _32 'EB0E363F'x
call _32 '72076785'x
call _32 '05005713'x
call _32 '95BF4A82'x
call _32 'E2B87A14'x
call _32 '7BB12BAE'x
call _32 '0CB61B38'x
call _32 '92D28E9B'x
call _32 'E5D5BE0D'x
call _32 '7CDCEFB7'x
call _32 '0BDBDF21'x
call _32 '86D3D2D4'x
call _32 'F1D4E242'x
call _32 '68DDB3F8'x
call _32 '1FDA836E'x
call _32 '81BE16CD'x
call _32 'F6B9265B'x
call _32 '6FB077E1'x
call _32 '18B74777'x
call _32 '88085AE6'x
call _32 'FF0F6A70'x
call _32 '66063BCA'x
call _32 '11010B5C'x
call _32 '8F659EFF'x
call _32 'F862AE69'x
call _32 '616BFFD3'x
call _32 '166CCF45'x
call _32 'A00AE278'x
call _32 'D70DD2EE'x
call _32 '4E048354'x
call _32 '3903B3C2'x
call _32 'A7672661'x
call _32 'D06016F7'x
call _32 '4969474D'x
call _32 '3E6E77DB'x
call _32 'AED16A4A'x
call _32 'D9D65ADC'x
call _32 '40DF0B66'x
call _32 '37D83BF0'x
call _32 'A9BCAE53'x
call _32 'DEBB9EC5'x
call _32 '47B2CF7F'x
call _32 '30B5FFE9'x
call _32 'BDBDF21C'x
call _32 'CABAC28A'x
call _32 '53B39330'x
call _32 '24B4A3A6'x
call _32 'BAD03605'x
call _32 'CDD70693'x
call _32 '54DE5729'x
call _32 '23D967BF'x
call _32 'B3667A2E'x
call _32 'C4614AB8'x
call _32 '5D681B02'x
call _32 '2A6F2B94'x
call _32 'B40BBE37'x
call _32 'C30C8EA1'x
call _32 '5A05DF1B'x
call _32 '2D02EF8D'x
signal CRC32REX_18

_32:
db!c=d2c(_CCnt)
_C.db!c=arg(1)
_CCnt=_CCnt+1
return

Crc32PrePostConditioning:call TRACE "OFF"
if arg(1)='' then
return('FFFFFFFF'x)
else
return(bitxor(arg(1), 'FFFFFFFF'x))

UpdateCrc32:call TRACE "OFF"
parse arg eb!Crc,eb!Buffer
do while eb!Buffer\==''
parse var eb!Buffer eb!PerfBuffer 2001 eb!Buffer
do eb!ThisByte=1 to length(eb!PerfBuffer)
parse var eb!Crc eb!L3 4 eb!R1
eb!ArrayEl=bitxor(eb!R1,substr(eb!PerfBuffer,eb!ThisByte,1))
eb!Crc=Bitxor('00'x||eb!L3,_C.eb!ArrayEl)
end
end
return(eb!Crc)

Crc32InDisplayableForm:call TRACE "OFF"
return(c2x(arg(1)))

CRC32REX_18:
signal EndBASEDATEXh

BaseDate:procedure;call TRACE "OFF"
TheDate=translate(arg(1), ' ', '/-')
if TheDate='' then
TheDate=date('Sorted')
parse var TheDate Year MM DD
if length(Year)>=8 then
do
DD=substr(Year,7,2)
MM=substr(Year,5,2)
Year=left(Year,4)
end
DaysInMonth='31  28  31  30  31  30  31  31  30  31  30  31'
if datatype(Year, 'WholeNumber')<>1 then
return(-10)
if datatype(MM, 'WholeNumber')<>1 then
return(-20)
if datatype(DD, 'WholeNumber')<>1 then
return(-30)
if MM<0|MM>12 then
return(-21)
DaysThisMonth=word(DaysInMonth,MM)
if MM=2 then
DaysThisMonth=DaysThisMonth+1
if DD<0|DD>DaysThisMonth then
return(-31)
if length(strip(Year))=2 then
do
if Year>=80 then
Year='19' ||Year
else
Year='20' ||Year
end
y=Year;m=MM;d=DD
z=y+(m-14)%12
f=word('306 337 0 31 61 92 122 153 184 214 245 275',m)
b=d+f+365*z+z%4-z%100+z%400-307
return(b)

_Bd2Date:procedure;call TRACE "OFF"
parse arg rd,Format,Delimiter
z=rd+307
h=100*z-25
a=h%3652425
b=a-a%4
year=(100*b+h)%36525
c=b+z-365*year-year%4
month=(5*c+456)%153
day=c-word('0 31 61 92 122 153 184 214 245 275 306 337',month-2)
if month>12 then
do
year=year+1
month=month-12
end
yyyy=right(year,4, '0')
mm=right(month,2, '0')
dd=right(day,2, '0')
return(yyyy||Delimiter||mm||Delimiter||dd)

EndBASEDATEXh:
signal PREFIX_19

HASHPREFIX_DEBUG:
if OptionDebugOn='Y' then
call OptionDebugShow 'HASHPREFIX', 'Hash prefix is now "' || HashPrefix || '" (' || HashPrefix || 'define etc)'
return

HASHPREFIX_GET:
call HASHPREFIX_DEBUG
return(HashPrefix)

HASHPREFIX_SET:
HashPrefix=arg(1)
if ProcessedCmdLine='N' then
do
call OptionDebugShow 'HASHPREFIX', 'Setting default value of hash Prefix to "' || HashPrefix || '"'
Default4_HashPrefix=HashPrefix
return(0)
end
if HashPrefix=='' then
HashPrefix=Default4_HashPrefix
AfterPrefix=translate(HashPrefix, '',LowerCase)
if AfterPrefix<>HashPrefix then
CryAndDie('A hash prefix should not include lower case characters!')
HashPrefixLng=length(HashPrefix)
call HASHPREFIX_DEBUG
CmdHashAsIs=HashPrefix|| 'ASIS'
CmdHashAutoTag=HashPrefix|| 'AUTOTAG'
CmdHashAutoTagClear=HashPrefix|| 'AUTOTAGCLEAR'
CmdHashAutoTagState=HashPrefix|| 'AUTOTAGSTATE'
CmdHashLoopBreak=HashPrefix|| 'BREAK'
CmdHashLoopContinue=HashPrefix|| 'CONTINUE'
CmdHashDebug=HashPrefix|| 'DEBUG'
CmdHashDefine=HashPrefix|| 'DEFINE'
CmdHashDefinePlus=HashPrefix|| 'DEFINE+'
CmdHashDefineIfReq=HashPrefix|| 'DEFINE?'
CmdHashDefineRexx=HashPrefix|| 'DEFINEREXX'
CmdHashDefineRexxPlus=HashPrefix|| 'DEFINEREXX+'
CmdHashDependsOn=HashPrefix|| 'DEPENDSON'
CmdHashElseifL=HashPrefix|| 'ELSEIF'
CmdHashEndifL=HashPrefix|| 'ENDIF'
CmdHashEof=HashPrefix|| 'EOF'
CmdHashErrorL=HashPrefix|| 'ERROR'
CmdHashEvaluateL=HashPrefix|| 'EVALUATE'
CmdHashEvaluatePlusL=HashPrefix|| 'EVALUATE+'
CmdHashIf=HashPrefix|| 'IF'
CmdHashIfdef=HashPrefix|| 'IFDEF'
CmdHashIfndef=HashPrefix|| 'IFNDEF'
CmdHashImport=HashPrefix|| 'IMPORT'
CmdHashInclude=HashPrefix|| 'INCLUDE'
CmdHashInfo=HashPrefix|| 'INFO'
CmdHashIntercept=HashPrefix|| 'INTERCEPT'
CmdHashMacroSpace=HashPrefix|| 'MACROSPACE'
CmdHashNextId=HashPrefix|| 'NEXTID'
CmdHashOnExit=HashPrefix|| 'ONEXIT'
CmdHashOption=HashPrefix|| 'OPTION'
CmdHashOutput=HashPrefix|| 'OUTPUT'
CmdHashOutputHold=HashPrefix|| 'OUTPUTHOLD'
CmdHashPush=HashPrefix|| 'PUSH'
CmdHashPop=HashPrefix|| 'POP'
CmdHashRequire=HashPrefix|| 'REQUIRE'
CmdHashSystem=HashPrefix|| 'SYSTEM'
CmdHashTransform=HashPrefix|| 'TRANSFORM'
CmdHashRexxVar=HashPrefix|| 'REXXVAR'
CmdHashUndefL=HashPrefix|| 'UNDEF'
CmdHashWarningL=HashPrefix|| 'WARNING'
CmdHashLoopS=HashPrefix|| '{'
CmdHashLoopE=HashPrefix|| '}'
CmdHash1Line=HashPrefix|| '('
CmdHash1LineEnd=HashPrefix|| ')'
CmdHashOneLine=HashPrefix|| 'ONELINE'
CmdHashEvaluateS=HashPrefix|| 'E'
CmdHashEvaluatePlusS=HashPrefix|| 'E+'
CmdHashUndefS=HashPrefix|| 'U'
CmdHashElseifS=HashPrefix|| 'ELSE'
CmdHashEndifS=HashPrefix|| 'END'
CmdHashErrorS=HashPrefix|| '!'
CmdHashWarningS=HashPrefix|| 'W'
return

PREFIX_19:
signal LineCmt_20

LINECOMMENT_DEBUG:
if OptionDebugOn='Y' then
do
if LineComment<>NullChar then
call OptionDebugShow 'LINECOMMENT', 'Lines starting with "' || LineComment || '" are comments ("' || InLineComment || '" for inline comments)'
else
call OptionDebugShow 'LINECOMMENT', 'Comment removal has been turned off'
end
return

LINECOMMENT_GET:
call LINECOMMENT_DEBUG
return(LineCommentSet2)

LINECOMMENT_SET:
LineComment=arg(1)
LineCommentSet2=LineComment
if ProcessedCmdLine='N' then
do
call OptionDebugShow 'LINECOMMENT', 'Setting default value of line comment to "' || LineComment || '"'
Default4_LineComment=LineComment
return(0)
end
if LineComment=='' then
LineComment=Default4_LineComment
if translate(LineComment)='NULL' then
LineComment=NullChar
else
do
if length(LineComment)<>1 then
CryAndDie('A comment char should be one character long')
end
InLineComment=LineComment||LineComment
call LINECOMMENT_DEBUG
return

LineCmt_20:
signal WhiteSpc_21

_WsFmt:
dbgExtra=''
do CharIndex=1 to length(ExtraWhiteSpace)
if CharIndex<>1 then
dbgExtra=dbgExtra|| ', '
dbgExtra=dbgExtra||c2x(substr(ExtraWhiteSpace,CharIndex,1))
end
return(dbgExtra)

WHITESPACE_DEBUG:
if OptionDebugOn='Y' then
do
if ExtraWhiteSpace=='' then
call OptionDebugShow 'WHITESPACE', 'No extra whitespace characters defined'
else
call OptionDebugShow 'WHITESPACE', 'Extra whitespace characters are hexadecimal ' ||_WsFmt()
end
return

WHITESPACE_GET:
call WHITESPACE_DEBUG
return(ExtraWhiteSpace)

WHITESPACE_SET:
ExtraWhiteSpace=arg(1)
if ProcessedCmdLine='N' then
do
Default4_ExtraWhiteSpace=ExtraWhiteSpace
if ExtraWhiteSpace=='' then
call OptionDebugShow 'WHITESPACE', 'Setting default to no extra whitespace'
else
call OptionDebugShow 'WHITESPACE', 'Setting default to extra whitespace characters are hexadecimal ' ||_WsFmt()
return(0)
end
if ExtraWhiteSpace=='NULL' then
ExtraWhiteSpace=Default4_ExtraWhiteSpace
call WHITESPACE_DEBUG
return

WhiteSpc_21:
signal LineCont_22

LINECONTINUATION_DEBUG:
if OptionDebugOn='Y' then
do
if LineContChar=NullChar then
call OptionDebugShow 'LINECONTINUATION', 'Line continuation handling has been turned off'
else
do
call OptionDebugShow 'LINECONTINUATION', 'The line continuation marker is now "' || LineContChar || '"'
if symbol('CodexNewLine') = 'VAR' then
DbgText='"' || CodexNewLine || '"'
else
DbgText="'X' code for newline"
call DBGIND 1
call DBG '"' || LineContAddNewLine   || '" = Join with    ' ||DbgText
call DBG '"' || LineContWithoutSpace || '" = Join without space'
call DBG '"' || LineContWithSpace    || '" = Join with    space'
call DBG '"' || LineContDefault      || '" = Join with    space'
call DBGIND-1
end
end
return

LINECONTINUATION_GET:
call LINECONTINUATION_DEBUG
return(LineContCharList)

LINECONTINUATION_SET:
LineContParm=arg(1)
LineContParmSet2=LineContParm
if ProcessedCmdLine='N' then
do
call OptionDebugShow 'LINECONTINUATION', 'Setting default value of line continuation chars to "' || LineContParm || '"'
Default4_LineContParm=LineContParm
LineContCharList=LineContParm
return(0)
end
if LineContParm=='' then
LineContParm=Default4_LineContParm
if translate(LineContParm)='NULL' then
LineContParm=NullChar
else
do
if length(LineContParm)<>1&length(LineContParm)<>5 then
CryAndDie('Invalid line continuation spec of "' || LineContParm || '"')
end
LineContCharList=overlay(LineContParm,LineContCharList)
LineContChar=substr(LineContCharList,1,1)
LineContAddNewLine=substr(LineContCharList,2,1)||LineContChar
LineContAddNewLineObs=d2c(25)||LineContChar
LineContWithoutSpace=substr(LineContCharList,3,1)||LineContChar
LineContWithSpace=substr(LineContCharList,4,1)||LineContChar
LineContDefault=substr(LineContCharList,5,1)||LineContChar
call LINECONTINUATION_DEBUG
return

LineCont_22:
AsIsCount=0
AsIsUsing=''
signal AsIs_23

AsIsPrepare:call TRACE "OFF"
AsIsParms=space(arg(1))
AsIsUsing=AsIsParms
AsIsCount=0
AsIsIndex=0
AsIsCollecting=''
call DBG_ASIS 'AsIsPrepare(): Cleared memory. Processing "' || AsIsUsing || '"'
call DBGIND 1
aiOptCnt=0
do while AsIsParms<> ''
call _SetUpAsIsTagging translate(GetQuotedText(AsIsParms, "AsIsParms"))
end
if AsIsCount<>0 then
do
if aiOptCnt=0 then
aiMsg='none'
else
do
if aiOptCnt=AsIsCount then
aiMsg='all'
else
aiMsg=aiOptCnt
end
call DBG_ASIS 'Have ' || AsIsCount || ' "as is" tags (' || aiMsg || ' optimised)'
end
call DBGIND-1
return(AsIsCount)

ExpandAsIsTags:
if AsIsModeOn='N' then
return(arg(1))

AsIs:call TRACE "OFF"
if AsIsCount=0 then
return(arg(1))
EaiString=arg(1)
AsIsCnt=ReplaceCount
do Tag=1 to AsIsIndex
if AsIsBef.Tag=='' then
EaiString=BulkChar2String(EaiString,AsIsAft.Tag)
else
do
if left(AsIsBef.Tag,2)<>SrTypePre then
EaiString=ReplaceString(EaiString,AsIsBef.Tag,AsIsAft.Tag)
else
do
select
when abbrev(AsIsBef.Tag,SrCaseIns)then
EaiString=ReplaceStringCI(EaiString,substr(AsIsBef.Tag,SrCaseIns_P),AsIsAft.Tag)
when abbrev(AsIsBef.Tag,SrFixed)then
EaiString=CompareReplaceFixed2(EaiString,substr(AsIsBef.Tag,SrFixed_P),AsIsAft.Tag)
otherwise
EaiString=ReplaceString(EaiString,AsIsBef.Tag,AsIsAft.Tag)
end
end
end
end
if OptionDebugOn='Y' then
do
if AsIsCnt<>ReplaceCount then
call DebugOutputAfterReplacement EaiString, 'ASIS'
end
return(EaiString)

ProcessAsIs:
HashCmdParms=PerformReplacementsInCmdsParameters(arg(1))
AsIsCmd=translate(GetQuotedText(HashCmdParms, "AsIsParms"))
if AsIsCmd='SETUP' then
do
AsIsPrepCache='?'
call SetupNamedAsIsStorage GetQuotedText(AsIsParms)
return(0)
end
call SetOnorOffVariable AsIsCmd, 'AsIsModeOn'
if AsIsModeOn='N' then
do
AsIsCount=0
if AsIsParms<> '' then
CryAndDie('Did not expect more than the "OFF" parameter')
call OptionsPop
end
else
do
call OptionsPush
call OptionOnOrOff_SET "KEEPINDENT",      "KeepIndent",      "ON"
call OptionOnOrOff_SET "LEAVEBLANKLINES", "LeaveBlankLines", "ON"
call LINECOMMENT_SET "NULL"
call LINECONTINUATION_SET "NULL"
call AsIsPrepare AsIsParms
end
if OptionDebugOn='Y' then
do
if AsIsCount=0 then
call DBG_ASIS 'AsIs mode is ' || YorN2OnorOff(AsIsModeOn) || '.  No tags prepared.'
else
call DBG_ASIS 'AsIs mode is ' || YorN2OnorOff(AsIsModeOn) || '.  Have ' || AsIsCount || ' tags from "' || AsIsUsing || '"'
end
return(0)

SetupNamedAsIsStorage:
AsIsNameU=translate(arg(1))
AsIsName='AI_' ||c2x(AsIsNameU)
AsIsAltCnt=arg(2)
AsIsCounter=0
if AsIsAltCnt='' then
do
TagFrom=AutoTagFirst
TagTo=AutoTagLast
end
else
do
TagFrom=1
TagTo=AsIsAltCnt
end
do Tag=TagFrom to TagTo
AsIsCounter=AsIsCounter+1
if AsIsAltCnt='' then
do
AsIsBef.AsIsCounter.AsIsName=AutoTagOnB.Tag
AsIsAft.AsIsCounter.AsIsName=AutoTagOnA.Tag
end
else
do
AsIsBef.AsIsCounter.AsIsName=ImportB.Tag
AsIsAft.AsIsCounter.AsIsName=ImportA.Tag
end
end
call _valueS AsIsName,AsIsCounter
if AsIsAltCnt='' then
call ClearAutoTags 'N'
call DBG_ASIS 'Captured ' || AsIsCounter || ' tags as "' || AsIsNameU || '"'
return

_SetUpAsIsTagging:
AsIsNameU=translate(arg(1))
AsIsName='AI_' ||c2x(AsIsNameU)
call DBG_ASIS 'Getting tags from storage named "' || AsIsNameU || '"'
call DBGIND 1
if symbol(AsIsName)<> 'VAR' then
CryAndDie('#AsIs "SETUP" has not been run for "' || AsIsNameU || '"')
AsIsCopyCount=_valueG(AsIsName)
do Index=1 to AsIsCopyCount
ThisBefore=AsIsBef.Index.AsIsName
ThisAfter=AsIsAft.Index.AsIsName
AsIsCount=AsIsCount+1
call DBG_ASIS 'AsIs #' || AsIsCount || ': From=' || DebugRightArrow || ThisBefore || DebugLeftArrow || ',  To=' ||DebugRightArrow||ThisAfter||DebugLeftArrow
if length(ThisBefore)<>1 then
do
AsIsCollecting=''
AsIsIndex=AsIsIndex+1
AsIsBef.AsIsIndex=ThisBefore
AsIsAft.AsIsIndex=ThisAfter
end
else
do
if AsIsCollecting=='' then
do
AsIsCollecting='OptAsIs' ||AsIsIndex
call _valueS AsIsCollecting, ''
AsIsIndex=AsIsIndex+1
AsIsBef.AsIsIndex=''
AsIsAft.AsIsIndex=AsIsCollecting
end
aiOptCnt=aiOptCnt+1
aiOptList=_valueG(AsIsCollecting)||ThisBefore
aiIndex=length(aiOptList)
call _valueS AsIsCollecting,aiOptList
call _valueS AsIsCollecting|| '.' ||aiIndex,ThisAfter
end
end
call DBG_ASIS 'Copied ' || AsIsCopyCount || ' tags'
call DBGIND-1
return

AsIs_23:
AtChangeType=''
AtChangeTypeDesc="CASESENSITIVE"
signal AutoTag_24

ShowAutoTagStateWhenDebugOn:
if OptionDebugOn='Y' then
do
if AutoTagName='' then
DbgText1=''
else
DbgText1=' (named "' || AutoTagName || '")'
call DBG_AUTOTAG 'AutoTagging is ' || YorN2OnorOff(AutoTagOn) || '.  Have ' || ((AutoTagLast - AutoTagFirst) + 1) || ' tags available in state #' ||AutoTagStateCnt||DbgText1
if arg(1)='Y' then
do
call DBGIND 1
do Tag=AutoTagFirst to AutoTagLast
call DBG_AUTOTAG 'AutoTag #' || Tag || ': From=' || DebugRightArrow || AutoTagOnB.Tag || DebugLeftArrow || ',  To=' ||DebugRightArrow||AutoTagOnA.Tag||DebugLeftArrow
end
call DBGIND-1
end
end
return

CompletelyInitializeAutoTagState:
AutoTagOn='N'
call ClearAutoTags 'Y'
return

ClearAutoTags:
if arg(1)='N' then
do
if AutoTagStateCnt=0 then
AutoTagLast=0
else
AutoTagLast=AutoTagState.AutoTagStateCnt.Last
end
else
do
AutoTagLast=0
AutoTagStateCnt=0
AutoTagFirst=1
AutoTagName=''
end
if OptionDebugOn='Y' then
do
if AutoTagStateCnt=0 then
call DBG_AUTOTAG 'Cleared ALL autotags (no state information saved - State #0).'
else
call ShowAutoTagStateWhenDebugOn
end
return

AutoTagAdd:call TRACE "OFF"
parse arg fb!B,fb!A,fb!T,fb!S
if fb!T=='' then
fb!T=Default4_ATCHANGETYPEDESC
if OptionDebugOn='Y' then
call DBG_AUTOTAG 'AutoTagAdd(): Assigning ' || DebugRightArrow || fb!B || DebugLeftArrow || ' = ' || DebugRightArrow || fb!A || DebugLeftArrow || ' (TYPE=' || fb!T || ')'
call _AddAutoTag GetCtCode(fb!T)||fb!B,fb!A,fb!S
return

AutoTag:call TRACE "OFF"
EatString=arg(1)
if AutoTagFirst>AutoTagLast then
return(EatString)
AtCnt=ReplaceCount
do Tag=AutoTagFirst to AutoTagLast
if left(AutoTagOnB.Tag,2)<>SrTypePre then
EatString=ReplaceString(EatString,AutoTagOnB.Tag,AutoTagOnA.Tag)
else
do
select
when abbrev(AutoTagOnB.Tag,SrCaseIns)then
EatString=ReplaceStringCI(EatString,substr(AutoTagOnB.Tag,SrCaseIns_P),AutoTagOnA.Tag)
when abbrev(AutoTagOnB.Tag,SrFixed)then
EatString=CompareReplaceFixed2(EatString,substr(AutoTagOnB.Tag,SrFixed_P),AutoTagOnA.Tag)
otherwise
EatString=ReplaceString(EatString,AutoTagOnB.Tag,AutoTagOnA.Tag)
end
end
end
if OptionDebugOn='Y' then
do
if AtCnt<>ReplaceCount then
call DebugOutputAfterReplacement EatString, 'ATAG'
end
return(EatString)

ProcessAutoTagClear:
if arg(1)='' then
AtClearAll='N'
else
do
AtParm=GetQuotedText(arg(1))
if translate(AtParm)<> 'ALL' then
CryAndDie('Invalid parameter of "' || AtParm || '" specified!')
AtClearAll='Y'
end
call ClearAutoTags AtClearAll
return(0)

_GetStateIndexForNameOrDie:
gsiName=arg(1)
do NameIndex=1 to AutoTagStateCnt
if gsiName=AutoTagState.NameIndex.Name then
return(NameIndex)
end
CryAndDie('There is no state known as "' || gsiName(1) || '"')

MatchesAutoTagStateIncDebugText:
MatchIndex=arg(1)
if MatchIndex<=0 then
return('')
else
return(' (matches "#AutoTagState +" at ' || AutoTagState.MatchIndex.AtLine || ')')

ProcessAutoTagState:
Rest=strip(arg(1))
Ats1stParm=left(Rest,1)
if Ats1stParm='+' | Ats1stParm = '-' then
Rest=substr(Rest,2)
else
Ats1stParm=GetQuotedText(arg(1), "Rest")
select
when Ats1stParm='+' then
do
AutoTagStateCnt=AutoTagStateCnt+1
AutoTagState.AutoTagStateCnt.First=AutoTagFirst
AutoTagState.AutoTagStateCnt.Last=AutoTagLast
AutoTagState.AutoTagStateCnt.Name=AutoTagName
AutoTagState.AutoTagStateCnt.AtOnOff=AutoTagOn
AutoTagState.AutoTagStateCnt.AtLine=CurrentSourceLocation()
BeforeFirst=AutoTagFirst
BeforeLast=AutoTagLast
AutoTagFirst=AutoTagLast+1
AutoTagName=''
do while Rest<> ''
StateAlias=translate(GetQuotedText(Rest, "Rest"))
if StateAlias="REMEMBER" then
do
CopyFrom=BeforeFirst
Copyto=BeforeLast
end
else
do
NameIndex=_GetStateIndexForNameOrDie(StateAlias)
CopyFrom=AutoTagState.NameIndex.First
Copyto=AutoTagState.NameIndex.Last
end
do AddTagIndex=CopyFrom to CopyTo
call _AddAutoTag AutoTagOnB.AddTagIndex,AutoTagOnA.AddTagIndex
end
end
if OptionDebugOn='Y' then
call DBG_AUTOTAG 'Remembering current #AutoTag state, now in state #' ||AutoTagStateCnt
end
when Ats1stParm='-' then
do
if AutoTagStateCnt<=0 then
CryAndDie('No #autotag states memorised!')
if OptionDebugOn='Y' then
call DBG_AUTOTAG 'This restore matches the setup at ' ||AutoTagState.AutoTagStateCnt.AtLine
BeforeFirst=AutoTagFirst
BeforeLast=AutoTagLast
AutoTagFirst=AutoTagState.AutoTagStateCnt.First
AutoTagLast=AutoTagState.AutoTagStateCnt.Last
AutoTagOn=AutoTagState.AutoTagStateCnt.AtOnOff
AutoTagName=AutoTagState.AutoTagStateCnt.Name
AutoTagStateCnt=AutoTagStateCnt-1
if Rest='' then
Remember='N'
else
do
Rest=translate(GetQuotedText(Rest, "Rest"))
if Rest="REMEMBER" then
Remember='Y'
else
CryAndDie('Invalid parameter of "' || Rest || '" specified (expected "REMEMBER")')
end
if Rest='' then
DbgWord='dropping'
else
do
Rest=translate(GetQuotedText(Rest))
if Rest<> "REMEMBER" then
CryAndDie('Invalid parameter of "' || Rest || '" specified (expected "REMEMBER")')
DbgWord='remembering'
AutoTagLast=AutoTagFirst-1
do AddTagIndex=BeforeFirst to BeforeLast
call _AddAutoTag AutoTagOnB.AddTagIndex,AutoTagOnA.AddTagIndex
end
end
if OptionDebugOn='Y' then
call DBG_AUTOTAG 'Restoring #AutoTag state #' || AutoTagStateCnt || ', we are ' || DbgWord || ' any new tags you may have defined'
end
otherwise
AutoTagName=translate(Ats1stParm)
if Rest<> '' then
call DieIfExtraUnexpectedParms Rest
if OptionDebugOn='Y' then
call DBG_AUTOTAG 'This state is now named "' || AutoTagName || '"'
end
call ShowAutoTagStateWhenDebugOn AutoTagOn
return(0)

_AddAutoTag:
TheTagB=arg(1)
TheTagA=arg(2)
ThePosn=arg(3)
if ThePosn='' then
ThePosn='999999'
ThePosn=(ThePosn+AutoTagFirst)-1
if ThePosn>AutoTagLast then
do
AutoTagLast=AutoTagLast+1
SlotIndex=AutoTagLast
end
else
do
ToIndex=AutoTagLast+2
do MoveIndex=ThePosn to AutoTagLast
ToIndex=ToIndex-1
FromIndex=ToIndex-1
AutoTagOnB.ToIndex=AutoTagOnB.FromIndex
AutoTagOnA.ToIndex=AutoTagOnA.FromIndex
end
SlotIndex=ThePosn
AutoTagLast=AutoTagLast+1
end
AutoTagOnB.SlotIndex=TheTagB
AutoTagOnA.SlotIndex=TheTagA
return

_DeleteAutoTag:
TheTagB=arg(1)
do Tag=AutoTagFirst to AutoTagLast
if TheTagB=AutoTagOnB.Tag then
do
AutoTagLast=AutoTagLast-1
do ToIndex=Tag to AutoTagLast
FromIndex=ToIndex+1
AutoTagOnB.ToIndex=AutoTagOnB.FromIndex
AutoTagOnA.ToIndex=AutoTagOnA.FromIndex
end
return('Y')
end
end
if OptionDebugOn='Y' then
call DBG_AUTOTAG 'No need to delete the tag (it does not exist)'
return('N')

ProcessAutoTag:
AtBefore=GetQuotedText(arg(1), "Rest")
if AtBefore='' then
CryAndDie("You did not supply text to be replaced (can't replace empty string)!")
AtDumpList='N'
OnOrOff=IsStringOnOrOffCmd(AtBefore)
if OnOrOff<> '' & Rest = '' then
do
AutoTagOn=OnOrOff
if AutoTagOn='Y' then
AtDumpList='Y'
end
else
do
AtBefore_NoCT=AtBefore
AtBefore=AtChangeType||AtBefore
if Rest='' then
call _DeleteAutoTag AtBefore
else
do
AtAfter=ReplaceString(GetQuotedText(Rest, "Rest"),AutoTagSelf,AtBefore_NoCT)
if ReplacementsAllowed='Y' then
do
do while pos(StartsMacroReplacement,AtAfter)<>0
BeforeCount=ReplaceCount
AtAfterR=_ReplaceAllHashDefinedVariables(AtAfter)
if pos(MarksNewLine,AtAfterR)<>0 then
leave
AtAfter=AtAfterR
if OptionDebugOn='Y' then
do
if BeforeCount<>ReplaceCount then
call DebugOutputAfterReplacement AtAfter, 'VP2O'
end
end
if pos(StartsStdSymbolReplacement,AtAfter)<>0 then
do
if pos(MarksNewLine,AtAfter)=0 then
do
BeforeCount=ReplaceCount
AtAfterR=ReplaceStandardDefinitions(AtAfter)
if BeforeCount<>ReplaceCount then
do
if pos(MarksNewLine,AtAfterR)=0 then
do
AtAfter=AtAfterR
if OptionDebugOn='Y' then
call DebugOutputAfterReplacement AtAfter, 'SP2O'
end
end
end
end
end
AtSlot=''
if Rest<> '' then
do
SlotSpec=word(rest,1)
Rest=subword(rest,2)
if left(SlotSpec,1)<> '#' then
CryAndDie('Invalid slot specification of "' || SlotSpec || '" supplied, must begin with a "#"!')
AtSlot=substr(SlotSpec,2)
end
if OptionDebugOn='Y' then
call DBG_AUTOTAG 'Assigning ' || DebugRightArrow || AtBefore_NoCT || DebugLeftArrow || ' = ' || DebugRightArrow || AtAfter || DebugLeftArrow || ' (TYPE=' || AtChangeTypeDesc || ')'
call _AddAutoTag AtBefore,AtAfter,AtSlot
end
end
call ShowAutoTagStateWhenDebugOn AtDumpList
if Rest<> '' then
CryAndDie('Too many parameters!')
return(0)

ATCHANGETYPE_DEBUG:
if OptionDebugOn='Y' then
call OptionDebugShow 'ATCHANGETYPE', 'AutoTag change type is "' || AtChangeTypeDesc || '"'
return

ATCHANGETYPE_GET:
call ATCHANGETYPE_DEBUG
return(AtChangeTypeDesc)

ATCHANGETYPE_SET:
AtChangeTypeDesc=translate(arg(1))
if ProcessedCmdLine='N' then
do
call OptionDebugShow 'ATCHANGETYPE', 'Setting default change type to "' || AtChangeTypeDesc || '"'
Default4_ATCHANGETYPEDESC=AtChangeTypeDesc
return(0)
end
if AtChangeTypeDesc=='' then
AtChangeTypeDesc=Default4_ATCHANGETYPEDESC
AtChangeType=GetCtCode(AtChangeTypeDesc)
call ATCHANGETYPE_DEBUG
return

GetCtCode:
gb!D=arg(1)
gb!U=translate(gb!D)
select
when gb!U="CASESENSITIVE" then
gb!C=''
when gb!U="CASEINSENSITIVE" then
gb!C=SrCaseIns
when gb!U="FIXED" then
gb!C=SrFixed
otherwise
CryAndDie('Unknown AutoTag Change Type of "' || gb!D || '"')
end
return(gb!C)

AutoTag_24:
DefRexxSpecialSepTag='<' || '?xRexxEos>'
call InitializeDefineRexx
ValidPpwTrace='OFF ON AUTO'
signal Def_Rexx_25

MakeSafeInSQuotes:
hb!Str=arg(1)
hb!Str=ReplaceString(hb!Str, "'", "''")
hb!L1M=left(StartsMacroReplacement,1)
hb!Str=ReplaceString(hb!Str,hb!L1M, "' || '" || hb!L1M || "' || '")
hb!L1P=left(StartsMacroParm,1)
hb!Str=ReplaceString(hb!Str,hb!L1P, "' || '" || hb!L1P || "' || '")
return(hb!Str)

InitializeDefineRexx:
DefRexxVar=''
DefRexxAddType=''
DefRexxCode=''
DefRexxStartLoc=''
DefRexxPack='Y'
DefRexxTraceNext='N'
DefRexxLineCnt=0
if symbol('OptionPpwTrace') = 'VAR' then
DefRexxTrace=OptionPpwTrace
else
DefRexxTrace='OFF'
DefRexxNumTrace=0
DefRexxTraceAllowed='Y'
return

ProcessDefineRexx:
if arg(1)='' then
do
if DefRexxVar='' then
CryAndDie("Not currently defining rexx code!", 'To execute you need to specify a parameter of ""')
if DefRexxNumTrace<>0 then
do
if DefRexxVar<> '?JustExec?';then
EndCmt='@Finished@ (Executing rexx from macro "' || DefRexxVar || '")'
else
EndCmt="@Finished@"
call DefRexxAddLine "call RexxTrace '" || EndCmt || "','?'"
DefRexxNumTrace=DefRexxNumTrace+1
call DBG_DEFINING DefRexxNumTrace|| ' $trace statements inserted'
end
if DefineMacroReplace='Y' then
DefRexxCode=PerformReplacementsInCmdsParameters(DefRexxCode)
if DefRexxVar<> '?JustExec?';then
do
call AddHashDefine DefRexxVar,DefRexxCode,DefRexxAddType
end
else
do
if OptionDebugOn='Y' then
call DBG_DEFINING 'Rexx code will be immediately executed but not saved'
call ExecRexxCmd DefRexxCode, 'Y'
end
call InitializeDefineRexx
end
else
do
if DefRexxVar<> '' then
CryAndDie("Already in rexx code block started at " ||DefRexxStartLoc)
call InitializeDefineRexx
DefRexxStartLoc=CurrentSourceLocation()
DefRexxAddType=arg(2)
DefRexxVar=GetQuotedText(PerformReplacementsInCmdsParameters(arg(1)), "Rest")
if DefRexxVar='' then
do
DefRexxVar='?JustExec?';
DefRexxPack='N'
end
if Rest<> '' then
do
Rest=translate(Rest)
do until Rest=''
DefSpec=GetQuotedText(Rest, "Rest")
select
when DefSpec='NOPACK' then
DefRexxPack='N'
when DefSpec='TRACE:AUTO' then
DefRexxTrace='AUTO'
when DefSpec='TRACE:ON' | DefSpec = '$TRACE' then
DefRexxTrace='ON'
when DefSpec='TRACE:OFF' then
DefRexxTrace='OFF'
otherwise
CryAndDie('Invalid option of "' || DefSpec || '" used')
end
end
end
if OptionPpwTraceAllowed='N' then
do
if DefRexxTrace<> 'OFF' then
do
call DBG_DEFINING 'Tracing turned off with /PPWTRACE, otherwise would trace using "' || DefRexxTrace || '"!'
DefRexxTrace='OFF'
end
end
if OptionDebugOn='Y' then
do
if DefRexxPack='Y' then
call DBG_DEFINING "AllowPack option is currently " ||YorN2OnorOff(AllowPack)
if DefRexxTrace='OFF' then
call DBG_DEFINING '$Trace and $Breakpoint commands will be ignored!'
else
do
if DefRexxTrace='AUTO' then
call DBG_DEFINING '$Trace statements for each line are being automatically inserted!'
else
call DBG_DEFINING '$Trace statements for each line are NOT being automatically inserted!'
end
end
if DefRexxTrace<> 'OFF' then
do
if DefRexxVar<> '?JustExec?';then
StrCmt='@Starting@ (Executing rexx from macro "' || DefRexxVar || '")'
else
StrCmt="@Starting@ (direct: " || CurrentSourceLocation() || ")"
call DefRexxAddLine "call RexxTrace '" || StrCmt || "','?'"
DefRexxNumTrace=DefRexxNumTrace+1
end
end
return(0)

AddDefineRexxLine:
NewRexxLine=strip(arg(1))
DefRexxLineCnt=DefRexxLineCnt+1
if right(NewRexxLine,2)=RexxCmtEnd then
do
StartCmtPos=lastpos(RexxCmtStart,NewRexxLine)
if StartCmtPos<>0 then
do
if StartCmtPos=0 then
NewRexxLine=''
else
NewRexxLine=strip(left(NewRexxLine,StartCmtPos-1), 'T')
end
end
do while right(NewRexxLine,1)=';'
NewRexxLine=strip(left(NewRexxLine,length(NewRexxLine)-1), 'T')
end
if NewRexxLine='' then
return
UnpackedLine=space(NewRexxLine)
if DefRexxPack='Y' then
do
if AllowPack='Y' then
NewRexxLine=CompressRexxLine(NewRexxLine)
end
DropLine='N'
ib!W1=translate(word(NewRexxLine,1))
select
when ib!W1="$BREAKPOINT" then
do
UserTraceCmt=subword(NewRexxLine,2)
if DefRexxTrace='OFF' then
ib!I='Ignoring - '
else
do
ib!I=''
UserTraceCmt=MakeSafeInSQuotes(UserTraceCmt)
NewRexxLine="call UserBreakPoint '$BreakPoint: " || UserTraceCmt || "','?'"
call DefRexxAddLine NewRexxLine
DefRexxNumTrace=DefRexxNumTrace+1
end
call DBG_DEFINING ib!I|| '$BreakPoint: ' ||UserTraceCmt
DropLine='Y'
end
when ib!W1="$TRACE" then
do
DropLine='Y'
if DefRexxTrace='OFF' then
call DBG_DEFINING 'Ignoring - $Trace command'
else
do
Rest=translate(subword(NewRexxLine,2))
select
when Rest="ON" then
DefRexxTraceAllowed='Y'
when Rest="OFF" then
DefRexxTraceAllowed='N'
otherwise
do
UserTraceCmt=subword(NewRexxLine,2)
if UserTraceCmt='' then
DefRexxTraceNext="Y"
else
do
call DBG_DEFINING '$tracing comment: ' ||UserTraceCmt
DefRexxTraceNext="N"
UserTraceCmt=MakeSafeInSQuotes(UserTraceCmt)
NewRexxLine="call RexxTrace '" || UserTraceCmt || "','?'"
call DefRexxAddLine NewRexxLine
DefRexxNumTrace=DefRexxNumTrace+1
end
end
end
end
end
otherwise
end
if DropLine='Y' then
DropLine='N'
else
do
if DefRexxTraceNext="Y" then
TraceThis='Y'
else
do
if DefRexxTrace<> 'AUTO' then
TraceThis='N'
else
do
if pos('/' || translate(NewRexxLine) || '/', "/THEN/DO/ELSE/")=0 then
TraceThis='Y'
else
TraceThis='N'
end
end
if TraceThis='Y' then
do
DefRexxTraceNext="N"
if DefRexxTraceAllowed='Y' then
do
call DBG_DEFINING '$tracing: ' ||UnpackedLine
TraceThis=MakeSafeInSQuotes(UnpackedLine)
NewRexxLine="call RexxTrace '@" || DefRexxLineCnt || " -> " || TraceThis || "',,'Y'" ||DefRexxSpecialSepTag||NewRexxLine
DefRexxNumTrace=DefRexxNumTrace+1
end
end
call DefRexxAddLine NewRexxLine
end
return

DefRexxAddLine:
if DefRexxCode='' then
DefRexxCode=arg(1)
else
DefRexxCode=DefRexxCode||DefRexxSpecialSepTag||arg(1)
return

PPWTRACE_DEBUG:
if OptionDebugOn='Y' then
call OptionDebugShow 'PPWTRACE', 'PPWTRACE is set to "' || OptionPpwTrace || '"'
return

PPWTRACE_SET:
OptionPpwTrace=translate(arg(1))
if ProcessedCmdLine='N' then
do
call OptionDebugShow 'PPWTRACE', 'Setting default PPWTRACE to "' || OptionPpwTrace || '"'
DefaultPpwTrace=OptionPpwTrace
return(0)
end
if OptionPpwTrace=='' then
OptionPpwTrace=DefaultPpwTrace
if pos(OptionPpwTrace,ValidPpwTrace)=0 then
CryAndDie('Invalid PPWTRACE value of "' || OptionPpwTrace || '", should be one of "' || ValidPpwTrace || '"!')
call PPWTRACE_DEBUG
return

PPWTRACE_GET:
call PPWTRACE_DEBUG
return(OptionPpwTrace)

Def_Rexx_25:
OptionCount=0
LongestPpwOptionLng=0
call _OptionsAdd "ALLOWPACK"
call _OptionsAdd "ALLOWSPELL"
call _OptionsAdd "CSREPLACEMENT"
call _OptionsAdd "DEFINEMACROREPLACE"
call _OptionsAdd "KEEPINDENT"
call _OptionsAdd "LEAVEBLANKLINES"
call _OptionsAdd "REPLACE"
call _OptionsAdd "ATCHANGETYPE"
call _OptionsAdd "DEBUGLEVEL"
call _OptionsAdd "EXTRAINDENT"
call _OptionsAdd "EXPANDX"
call _OptionsAdd "HASHPREFIX"
call _OptionsAdd "LINECOMMENT"
call _OptionsAdd "LINECONTINUATION"
call _OptionsAdd "MACROPARMTAGS"
call _OptionsAdd "PARMVAL"
call _OptionsAdd "PPWTRACE"
call _OptionsAdd "REPLACEMENTTAGS"
call _OptionsAdd "TABS"
call _OptionsAdd "WARNINGS"
call _OptionsAdd "WHITESPACE"
signal OPTION_26

_OptionsAdd:
OptionCount=OptionCount+1
OptionList.OptionCount=arg(1)
ThisLng=length(arg(1))
if ThisLng>LongestPpwOptionLng then
LongestPpwOptionLng=ThisLng
return

SetUpPpwizardOptionDefaults:
if RexIsAscii='N' then
DefWhite=''
else
do
if RexSystemOpSys<> "UNIX" then
DefWhite=d2c(26)||d2c(27)
else
DefWhite=d2c(13)||d2c(26)||d2c(27)
end
ProcessedCmdLine='N'
call DBG_OPTIONS 'Setting PPWIZARD defaults (may be overriden with ' || OptChar || 'option switch)'
call DBGIND 1
call OptionOnOrOff_SET "ALLOWPACK",          "AllowPack",           "ON"
call OptionOnOrOff_SET "ALLOWSPELL",         "AllowSpell",          "ON"
call ATCHANGETYPE_SET "CASESENSITIVE"
call OptionOnOrOff_SET "CSREPLACEMENT",      "CsReplacement",       "OFF"
call DEBUGLEVEL_SET 'DEFAULT'
call OptionOnOrOff_SET "DEFINEMACROREPLACE", "DefineMacroReplace",  "OFF"
call EXPANDX_SET 'LATE'
call EXTRAINDENT_SET 'NULL'
call HASHPREFIX_SET '#'
call OptionOnOrOff_SET "KEEPINDENT",         "KeepIndent",          "OFF"
call OptionOnOrOff_SET "LEAVEBLANKLINES",    "LeaveBlankLines",     "OFF"
call LINECOMMENT_SET ';'
call LINECONTINUATION_SET '\%-+ '
call MACROPARMTAGS_SET '{}$'
call OptionOnOrOff_SET "REPLACE",            "ReplacementsAllowed", "ON"
call PARMVAL_SET "SOME"
if OptionDebugOn='Y' then
jb!D='ON'
else
jb!D='OFF'
call PPWTRACE_SET jb!D
call REPLACEMENTTAGS_SET '<>$?[]'
call TABS_SET 'Warnings'
call WARNINGS_SET ''
call WHITESPACE_SET DefWhite
call DBGIND-1
return

SetUpOptionsForThisBuild:
ProcessedCmdLine='Y'
call DBG_OPTIONS 'Initializing #options for this build of ' ||CurrentOutFile
call DBGIND 1
call OptionOnOrOff_SET "ALLOWPACK",          "AllowPack",           ""
call OptionOnOrOff_SET "ALLOWSPELL",         "AllowSpell",          ""
call ATCHANGETYPE_SET ''
call OptionOnOrOff_SET "CSREPLACEMENT",      "CsReplacement",       ""
call DEBUGLEVEL_SET ''
call OptionOnOrOff_SET "DEFINEMACROREPLACE", "DefineMacroReplace",  ""
call EXPANDX_SET ''
call EXTRAINDENT_SET ''
call HASHPREFIX_SET ''
call OptionOnOrOff_SET "KEEPINDENT",         "KeepIndent",          ""
call OptionOnOrOff_SET "LEAVEBLANKLINES",    "LeaveBlankLines",     ""
call LINECOMMENT_SET ''
call LINECONTINUATION_SET ''
call MACROPARMTAGS_SET ''
call OptionOnOrOff_SET "REPLACE",            "ReplacementsAllowed", ""
call PARMVAL_SET ''
call PPWTRACE_SET ''
call REPLACEMENTTAGS_SET ''
call TABS_SET ''
call WARNINGS_SET ''
call WHITESPACE_SET 'NULL'
call DBGIND-1
return

MatchesOptionStackPushDebugText:
MatchIndex=arg(1)
if MatchIndex<=0 then
return('')
else
return(' (matches "#option PUSH" at ' || OptPush.MatchIndex || ')')

OptionsPush:
OptionStackCnt=OptionStackCnt+1
OptPush.OptionStackCnt=CurrentSourceLocation()
PushName='OptPush' ||OptionStackCnt
if OptionDebugOn='Y' then
call DBG_OPTIONS 'Saving current options on stack as #' ||OptionStackCnt
call DBGIND 1
do OptionIndex=1 to OptionCount
call _valueS PushName|| '.' ||OptionIndex,OptionGetValue(OptionList.OptionIndex)
end
call DBGIND-1
return

OptionsPop:
if OptionStackCnt<=0 then
CryAndDie('There are no options on the stack to pop!')
if OptionDebugOn='Y' then
call DBG_OPTIONS 'Restoring current options from #' || OptionStackCnt || ' (pushed at ' || OptPush.OptionStackCnt || ')'
call DBGIND 1
PushName='OptPush' ||OptionStackCnt
do OptionIndex=1 to OptionCount
call OptionSetValue OptionList.OptionIndex,_valueG(PushName|| '.' ||OptionIndex)
end
call DBGIND-1
OptionStackCnt=OptionStackCnt-1
return

ProcessOption:
Options=arg(1)
if ProcessedCmdLine='Y' then
Options=PerformReplacementsInCmdsParameters(Options)
if Options='' then
CryAndDie('No options specified!')
do while Options<> ''
parse var Options Word1' 'RestOptions
Word1=translate(word1)
select
when Word1="PUSH" | Word1 = "+" then
do
Options=RestOptions
call OptionsPush
end
when Word1="POP" | Word1 = "-" then
do
Options=RestOptions
call OptionsPop
end
otherwise
do
if pos('=',Options)=0 then
CryAndDie('Could not find an "=" sign in "' || Options || '"')
parse var Options ThisOption'='Options
ThisOption=translate(strip(ThisOption))
ThisValue=GetQuotedText(Options, "Options")
call OptionSetValue ThisOption,ThisValue
end
end
end
return(0)

OptionDebugShow:
if OptionDebugOn='Y' then
do
jb!M=left(arg(1),LongestPpwOptionLng)|| ': ' ||arg(2)
if arg(1)='DEBUGLEVEL' then
call DBG jb!M
else
call DBG_OPTIONS jb!M
end
return

OptionOnOrOff_DEBUG:
if OptionDebugOn='Y' then
call OptionDebugShow arg(1), 'Currently set to ' ||YorN2OnorOff(_valueG(arg(2)))
return

OptionOnOrOff_SET:
parse arg OptionName,OnOffVar2Set,OnOffValue
if ProcessedCmdLine='N' then
do
call OptionDebugShow OptionName, 'Setting default to "' || OnOffValue || '"'
call _valueS "Default4_" ||OnOffVar2Set,OnOffValue
return(0)
end
if OnOffValue=='' then
OnOffValue=_valueG("Default4_" ||OnOffVar2Set)
OnOrOff=IsStringOnOrOffCmd(OnOffValue)
if OnOrOff='' then
CryAndDie('Tried to set "' || OnOffVar2Set || '" to an invalid value of "' || OnOffValue || '"')
call _valueS OnOffVar2Set,OnOrOff
call OptionOnOrOff_DEBUG OptionName,OnOffVar2Set
return(0)

OptionOnOrOff_GET:
parse arg OptionName,OnOffVar2Get
VarState=YorN2OnorOff(_valueG(OnOffVar2Get))
call OptionOnOrOff_DEBUG OptionName,OnOffVar2Get
return(VarState)

OptionSetValue:
parse arg sOption,sValue
select
when sOption="ALLOWPACK" then
call OptionOnOrOff_SET "ALLOWPACK", "AllowPack",sValue
when sOption="ALLOWSPELL" then
call OptionOnOrOff_SET "ALLOWSPELL", "AllowSpell",sValue
when sOption="ATCHANGETYPE" then
call ATCHANGETYPE_SET sValue,sOption
when sOption="CSREPLACEMENT" then
call OptionOnOrOff_SET "CSREPLACEMENT", "CsReplacement",sValue
when sOption="DEBUGLEVEL" then
call DEBUGLEVEL_SET sValue,sOption
when sOption="DEFINEMACROREPLACE" then
call OptionOnOrOff_SET "DEFINEMACROREPLACE", "DefineMacroReplace",sValue
when sOption="EXPANDX" then
call EXPANDX_SET sValue,sOption
when sOption="EXTRAINDENT" then
call EXTRAINDENT_SET sValue,sOption
when sOption="HASHPREFIX" then
call HASHPREFIX_SET sValue,sOption
when sOption="KEEPINDENT" then
call OptionOnOrOff_SET "KEEPINDENT", "KeepIndent",sValue
when sOption="LEAVEBLANKLINES" then
call OptionOnOrOff_SET "LEAVEBLANKLINES", "LeaveBlankLines",sValue
when sOption="LINECOMMENT" then
call LINECOMMENT_SET sValue,sOption
when sOption="LINECONTINUATION" then
call LINECONTINUATION_SET sValue,sOption
when sOption="MACROPARMTAGS" then
call MACROPARMTAGS_SET sValue,sOption
when sOption="PARMVAL" then
call PARMVAL_SET sValue,sOption
when sOption="PPWTRACE" then
call PPWTRACE_SET sValue,sOption
when sOption="REPLACE" then
call OptionOnOrOff_SET "REPLACE", "ReplacementsAllowed",sValue
when sOption="REPLACEMENTTAGS" then
call REPLACEMENTTAGS_SET sValue,sOption
when sOption="TABS" then
call TABS_SET sValue,sOption
when sOption="WARNINGS" then
call WARNINGS_SET sValue,sOption
when sOption="WHITESPACE" then
call WHITESPACE_SET sValue,sOption
otherwise
CryAndDie("Can't set '" || sOption || "' as this option is unknown")
end
return

OptionGetValue:
parse arg gOption
select
when gOption="ALLOWPACK" then
return(OptionOnOrOff_GET("ALLOWPACK", "AllowPack"))
when gOption="ALLOWSPELL" then
return(OptionOnOrOff_GET("ALLOWSPELL", "AllowSpell"))
when gOption="ATCHANGETYPE" then
return(ATCHANGETYPE_GET(gOption))
when gOption="CSREPLACEMENT" then
return(OptionOnOrOff_GET("CSREPLACEMENT", "CsReplacement"))
when gOption="DEBUGLEVEL" then
return(DEBUGLEVEL_GET(gOption))
when gOption="DEFINEMACROREPLACE" then
return(OptionOnOrOff_GET("DEFINEMACROREPLACE", "DefineMacroReplace"))
when gOption="EXPANDX" then
return(EXPANDX_GET(gOption))
when gOption="EXTRAINDENT" then
return(EXTRAINDENT_GET(gOption))
when gOption="HASHPREFIX" then
return(HASHPREFIX_GET(gOption))
when gOption="KEEPINDENT" then
return(OptionOnOrOff_GET("KEEPINDENT", "KeepIndent"))
when gOption="LEAVEBLANKLINES" then
return(OptionOnOrOff_GET("LEAVEBLANKLINES", "LeaveBlankLines"))
when gOption="LINECOMMENT" then
return(LINECOMMENT_GET(gOption))
when gOption="LINECONTINUATION" then
return(LINECONTINUATION_GET(gOption))
when gOption="MACROPARMTAGS" then
return(MACROPARMTAGS_GET(gOption))
when gOption="PARMVAL" then
return(PARMVAL_GET(gOption))
when gOption="PPWTRACE" then
return(PPWTRACE_GET(gOption))
when gOption="REPLACE" then
return(OptionOnOrOff_GET("REPLACE", "ReplacementsAllowed"))
when gOption="REPLACEMENTTAGS" then
return(REPLACEMENTTAGS_GET(gOption))
when gOption="TABS" then
return(TABS_GET(gOption))
when gOption="WARNINGS" then
return(WARNINGS_GET(gOption))
when gOption="WHITESPACE" then
return(WHITESPACE_GET(gOption))
otherwise
CryAndDie("Can't get '" || gOption || "' as this option is unknown")
end
return

OPTION_26:
NameOfOs2ReginaRexxInterpreter=""
signal Rexx_27

_GetNameOfMacroSpaceExe:
if Symbol('MacroSpaceExe') <> 'VAR' then
do
MacroSpaceExeBase='MacroSpc.EXE'
MacroSpaceExe=_filespec('drive', PpWizardPgmName) || _filespec('Path',PpWizardPgmName)||MacroSpaceExeBase
if FileQueryExists(MacroSpaceExe)='' then
do
MacroSpaceExe=FindFileInPath(MacroSpaceExeBase, '*PATH')
if MacroSpaceExe="" then
MacroSpaceExe=FindFileInPath(MacroSpaceExeBase, '*DPATH')
end
call DBG 'Macro Space Pgm: ' ||MacroSpaceExe
end
return(MacroSpaceExe)

_GetNameOfOs2ReginaExe:
if Symbol('Os2ReginaExe') <> 'VAR' then
do
Os2ReginaExeBase='ROS2REXX.EXE'
Os2ReginaExe=_filespec('drive', PpWizardPgmName) || _filespec('Path',PpWizardPgmName)||Os2ReginaExeBase
if FileQueryExists(Os2ReginaExe)='' then
do
Os2ReginaExe=FindFileInPath(Os2ReginaExeBase, '*PATH')
end
end
return(Os2ReginaExe)

DoMacroSpaceOperation:
parse arg MsCommand,MsFile,MsFunction,MsQuiet
CallersLine=SIGL
call DBG 'Trying to macrospace "' || MsCommand || '" "' || MsFile || '" alias (' || MsFunction || ')'
TmpFile=RexGetTmpFileName()
CheckPgm=_GetNameOfMacroSpaceExe()
if CheckPgm='' then
do
if MsQuiet="QUIET" then
return
else
CryAndDie("Can't perform macro space command as " || MacroSpaceExeBase || ' is unavailable.')
end
FailMsg='MACRO SPACE COMMAND FAILED'
call AddressCmd CheckPgm|| ' ' || MsCommand || ' ' || MsFile || ' ' || MsFunction || ' >' || TmpFile || ' 2>&1'
if MsQuiet="QUIET" then
return
else
signal CheckMacroSpaceRc

CheckRexxModuleForSyntaxErrors:
call DBG 'CheckRexxModuleForSyntaxErrors()'
if RexWhich='REGINA' then
do
call CallStubInGeneratedCodeToCheckSyntax
return
end
CallersLine=SIGL
TmpFile=RexGetTmpFileName()
CheckPgm=_GetNameOfMacroSpaceExe()
if CheckPgm='' then
do
call DBG "Can't use normal validation method on the rexx syntax - " || MacroSpaceExeBase || ' file not found!'
call CallStubInGeneratedCodeToCheckSyntax
return
end
FailMsg='INVALID SYNTAX'
call AddressCmd CheckPgm|| ' CheckSyntax ' || Output.1.File || ' >' || NameOfNulDevice() || ' 2>' ||TmpFile

CheckMacroSpaceRc:
CheckRc=Rc
if CheckRc=0 then
do
DosDelRc=_SysFileDelete(TmpFile)
call UseOs2ReginaToDoubleCheckSyntax
return
end
call Line1 ''
call ColorSet 'ERROR'
call Line1 FailMsg
call Line1 copies('~',length(FailMsg))
do while lines(TmpFile)<>0
call Line1 linein(TmpFile)
end
call ColorSet
call _FileClose TmpFile
DosDelRc=_SysFileDelete(TmpFile)
AbnormalExit(CallersLine, "Syntax Error in generated rexx code")

CallStubInGeneratedCodeToCheckSyntax:
CheckingFile=Output.1.File
call DBGIND 1
call DBG 'Calling stub in generated code'
signal ON SYNTAX NAME SyntaxErrorInGeneratedCode
CheckRc='*?*'
interpret 'CheckRc =  "' || CheckingFile || '"("' || SyntaxOkText || '")'
if CheckRc<>SyntaxOkRc then
CryAndDie('Probably Syntax Error, got unexpected RC of "' || CheckRc || '"')
call DBGIND-1
return

SyntaxErrorInGeneratedCode:
CryAndDie('Faulty syntax in generated "' || CheckingFile || '"!')

UseOs2ReginaToDoubleCheckSyntax:
if RexWhich='REGINA' then
return
if NameOfOs2ReginaRexxInterpreter='-' then
return
call DBG 'OS/2 rexx already passed code, can we double check using OS/2 regina?'
UseExe=NameOfOs2ReginaRexxInterpreter
if UseExe='' then
UseExe=_GetNameOfOs2ReginaExe()
if UseExe='' then
return
CheckingFile=Output.1.File
call DBGIND 1
call DBG 'Checking using "' || UseExe || '"'
call AddressCmd UseExe|| ' ' || CheckingFile || ' ' ||SyntaxOkText
if Rc<>SyntaxOkRc&Rc<>255 then
CryAndDie('Probably syntax error in "' || Output.1.File || '"', 'Got unexpected RC of "' || Rc || '" from ' ||UseExe)
call DBGIND-1
return

Rexx_27:
InfiniteLoopDetected='N'
InfiniteLoopWhen=0
InfiniteIncludeLoopWhen=0
RexxSkipCounter=0
ArePositionalChars='"' || "'="
MarksPhpXml='<' || '?'
signal Define_28

_RXQuote:
parse arg lb!Right,lb!Quote,lb!OpQuote
lb!Break=lb!Quote|| '||,' ||DefRexxSpecialSepTag||lb!Quote
lb!DQuote=lb!Quote||lb!Quote
lb!Left=''
do while length(lb!Right)>100
if lb!Left=='' then
lb!Left=ReplaceString(left(lb!Right,100),lb!Quote,lb!DQuote)
else
lb!Left=lb!Left||lb!Break||ReplaceString(left(lb!Right,100),lb!Quote,lb!DQuote)
lb!Right=substr(lb!Right,100+1)
end
return(lb!Left||ReplaceString(lb!Right,lb!Quote,lb!DQuote))

_RxVar:
parse arg mb!Cmd,mb!Value
parse var mb!Cmd "$$RXVAR:" mb!Var
if mb!Var='' then
CryAndDie('You must supply a variable name on a "$$RxVar" transformation')
return('@s@RxVar:' || mb!Var || ':' || mb!Value || ':@e@RxVar')

ExpandAnyRxVarHacks:
parse arg nb!Str
nb!P=pos('@s@RxVar:',nb!Str)
if nb!P=0 then
return(nb!Str)
nb!L=''
do until nb!P=0
parse var nb!Str nb!B '@s@RxVar:' nb!Var ':' nb!Value ':@e@RxVar' nb!Str
nb!C=''
nb!Add2=''
do until nb!Value==''
parse var nb!Value nb!Bit+100 nb!Value
nb!Bit=ReplaceString(nb!Bit, '"', '""')
nb!C=nb!C||nb!Var|| '=' || nb!Add2 || '"' || nb!Bit || '"' ||DefRexxSpecialSepTag
nb!Add2=nb!Var|| '||'
end
nb!L=nb!L||nb!B||nb!C
nb!P=pos('@s@RxVar:',nb!Str)
end
return(nb!L||nb!Str)

InitCondNlCount:
CondNlCount=0
return

_MacroBitNotFoundText:
if CsReplacement='N' then
return('')
else
return('Macro names & parameters are case sensitive (check case)')

InitializeHashDefinesForThisCompile:
call DBG_DEFINING 'Initializing all #defines, got ' || OptionDefineCount || ' /define definitions to load up.'
drop MACRO?.
call AddHashDefine '_PPWIZARD_', ''
if OptionDefineCount<>0 then
do
do Index=1 to OptionDefineCount
call AddHashDefine OptionDefine.Index.Var,OptionDefine.Index.Cont
end
end
call _GetUserOptionsViaDefineSwitch
return

_GetUserOptionsViaDefineSwitch:
call DBG_MACROVALORDEF 'Getting some lesser options (not worth specific commands)'
call DBGIND 1
if RexSystemOpSys="UNIX" then
PathDelimiterChar=':'
else
PathDelimiterChar=';'
PathDelimiterChar=CfgMacro("PATH_DELIMITER_CHAR",PathDelimiterChar)
if length(PathDelimiterChar)<>1 then
CryAndDie("Invalid path delimiter (expected 1 only character)")
RexxLocalVar=CfgMacro("REXX_MAKE_LOCAL_VAR", '@' || '@')
InfiniteLoopWhen=CfgMacro("INFINITE_MACRO_LOOP_WHEN",20)
InfiniteIncludeLoopWhen=CfgMacro("INFINITE_INCLUDE_LOOP_WHEN",20)
call DBGIND-1
return

PARMVAL_DEBUG:
if OptionDebugOn='Y' then
do
if OptionParmVal="S" then
ob!D="SOME"
else
ob!D=YorN2OnorOff(OptionParmVal)
call OptionDebugShow 'PARMVAL', 'Currently set to "' || ob!D || '"'
end
return

PARMVAL_SET:
pb!Value=translate(arg(1))
if ProcessedCmdLine='N' then
do
call OptionDebugShow 'PARMVAL', 'Setting default to "' || pb!Value || '"'
DefaultParmVal=pb!Value
return(0)
end
if pb!Value=='' then
pb!Value=DefaultParmVal
if pb!Value="SOME" then
OptionParmVal="S"
else
do
OptionParmVal=IsStringOnOrOffCmd(pb!Value)
if OptionParmVal='' then
CryAndDie('Invalid PARMVAL option of "' || pb!Value || '"')
end
call PARMVAL_DEBUG
return

PARMVAL_GET:
call PARMVAL_DEBUG
if OptionParmVal="S" then
qb!Value="SOME"
else
qb!Value=YorN2OnorOff(OptionParmVal)
return(qb!Value)

REPLACEMENTTAGS_DEBUG:
if OptionDebugOn='Y' then
call OptionDebugShow 'REPLACEMENTTAGS', 'Replace tags now look like "' || StartsMacroReplacement || 'MacroVar' || EndsMacroReplacement || '" and "' || StartsStdSymbolReplacement || 'StandardMacroVar' || EndsMacroReplacement || '", Indirection like "' || MacroIndLeft || 'symbol' || MacroIndRight || '"'
return

REPLACEMENTTAGS_SET:
Tags=arg(1)
if ProcessedCmdLine='N' then
do
call OptionDebugShow 'REPLACEMENTTAGS', 'Setting default value of replacement tags to "' || Tags || '"'
Default4_ReplacementTags=Tags
return(0)
end
if Tags=='' then
Tags=Default4_ReplacementTags
qb!L=length(Tags)
if qb!L<>4&qb!L<>6 then
CryAndDie('Tried to set invalid replace tags of "' || Tags || '"')
StartsMacroReplacement=substr(Tags,1,1)||substr(Tags,3,1)
StdSymbolReplacementChar=substr(Tags,4,1)
StartsStdSymbolReplacement=substr(Tags,1,1)||StdSymbolReplacementChar
EndsMacroReplacement=substr(Tags,2,1)
if qb!L=6 then
do
MacroIndLeft=substr(Tags,5,1)
MacroIndRight=substr(Tags,6,1)
end
EndsVar=' ' ||EndsMacroReplacement
StartsStdSymbolReplacement_x=StartsStdSymbolReplacement|| 'x'
CodexNewLine=StartsStdSymbolReplacement|| "NewLine" ||EndsMacroReplacement
if RexIsAscii='N' then
do
CodexHexNewLine=StartsStdSymbolReplacement_x|| "15" ||EndsMacroReplacement
CodexHexSpace=StartsStdSymbolReplacement_x|| "40" ||EndsMacroReplacement
CodexHexHash=StartsStdSymbolReplacement_x|| "7B" ||EndsMacroReplacement
CodexHexDollar=StartsStdSymbolReplacement_x|| "5B" ||EndsMacroReplacement
CodexHexQuestionMark=StartsStdSymbolReplacement_x|| "1A" ||EndsMacroReplacement
CodexHexLessThan=StartsStdSymbolReplacement_x|| "4C" ||EndsMacroReplacement
CodexSemiColon=StartsStdSymbolReplacement_x|| "5E" ||EndsMacroReplacement
end
else
do
CodexHexNewLine=StartsStdSymbolReplacement_x|| "0A" ||EndsMacroReplacement
CodexHexSpace=StartsStdSymbolReplacement_x|| "20" ||EndsMacroReplacement
CodexHexHash=StartsStdSymbolReplacement_x|| "23" ||EndsMacroReplacement
CodexHexDollar=StartsStdSymbolReplacement_x|| "24" ||EndsMacroReplacement
CodexHexQuestionMark=StartsStdSymbolReplacement_x|| "3F" ||EndsMacroReplacement
CodexHexLessThan=StartsStdSymbolReplacement_x|| "3C" ||EndsMacroReplacement
CodexSemiColon=StartsStdSymbolReplacement_x|| "3B" ||EndsMacroReplacement
end
CodexNothing=StartsStdSymbolReplacement_x|| "Nothing" ||EndsMacroReplacement
call REPLACEMENTTAGS_DEBUG
return

REPLACEMENTTAGS_GET:
call REPLACEMENTTAGS_DEBUG
return(substr(StartsMacroReplacement,1,1)||EndsMacroReplacement||substr(StartsMacroReplacement,2,1)||substr(StartsStdSymbolReplacement,2,1)||MacroIndLeft||MacroIndRight)

MACROPARMTAGS_DEBUG:
if OptionDebugOn='Y' then
call OptionDebugShow 'MACROPARMTAGS', 'Macro parameters now look like "' || StartsMacroParm || 'MacroParameter' || EndsMacroParm || '"'
return

MACROPARMTAGS_SET:
Tags=arg(1)
if ProcessedCmdLine='N' then
do
call OptionDebugShow 'MACROPARMTAGS', 'Setting default value of macro parameter tags to "' || Tags || '"'
Default4_MacroParameterTags=Tags
return(0)
end
if Tags=='' then
Tags=Default4_MacroParameterTags
if length(Tags)<>3 then
CryAndDie('Tried to set invalid macro parameter tags of "' || Tags || '"')
StartsMacroParm=substr(Tags,1,1)||substr(Tags,3,1)
EndsMacroParm=substr(Tags,2,1)
HidesMacroParm=substr(Tags,1,1)|| '_' ||substr(Tags,3,1)
AutoTagSelf=StartsMacroParm|| 'AT' ||EndsMacroParm
call MACROPARMTAGS_DEBUG
return

MACROPARMTAGS_GET:
call MACROPARMTAGS_DEBUG
return(substr(StartsMacroParm,1,1)||EndsMacroParm||substr(StartsMacroParm,2,1))

ProcessDefine:
Rest=arg(1)
if DefineMacroReplace='Y' then
Rest=PerformReplacementsInCmdsParameters(Rest)
if pos(MarksNewLineInHashDefine,Rest)<>0 then
do
Rest=ReplaceString(arg(1),MarksNewLineInHashDefine2,MarksNewLine)
Rest=ReplaceString(Rest,MarksNewLineInHashDefine,MarksNewLine)
end
parse var Rest HashDefineV HashDefineC
return(AddHashDefine(HashDefineV,strip(HashDefineC),arg(2)))

ProcessEvaluate:
Rest=PerformReplacementsInCmdsParameters(arg(1))
HashDefineAnswerName=GetQuotedText(Rest, "Rest",, "Getting macro name")
if Rest='' then
CryAndDie('Evaluate what command?')
CmdToEvaluate=GetQuotedRest(Rest)
HashDefineRc=0
if HashDefineAnswerName='' then
call ExecRexxCmd CmdToEvaluate
else
do
CmdToEvaluate='EvaluateAnswer = ' ||CmdToEvaluate
call ExecRexxCmd CmdToEvaluate
HashDefineRc=AddHashDefine(HashDefineAnswerName,EvaluateAnswer,arg(2))
end
return(HashDefineRc)

MacroExists:
if symbol('EndsVar') <> 'VAR' then
return('N')
if verify(arg(1),EndsVar, 'M') <> 0 then CryAndDie('The macro name "' || arg(1) || '" is invalid (Any of "' || EndsVar || '" are invalid)')
kb!MacName=arg(1)
kb!MacNameO=kb!MacName
kb!RbPos=pos(MacroIndRight,kb!MacName)
if kb!RbPos<>0 then
do
if OptionDebugOn='Y' then
do
call DBG_DEFINING '[indirection]: ' ||DebugRightArrow||kb!MacName||DebugLeftArrow
call DBGIND 1
end
do while kb!RbPos<>0
kb!LbPos=lastpos(MacroIndLeft,kb!MacName,kb!RbPos)
if kb!LbPos=0 then
CryAndDie('Could not find a matching "' || MacroIndLeft || '" character for "' || MacroIndRight || '"', 'The invalid macro is:', '  ' ||kb!MacName)
kb!L=left(kb!MacName,kb!LbPos-1)
kb!M=substr(kb!MacName,kb!LbPos+1,kb!RbPos-kb!LbPos-1)
kb!R=substr(kb!MacName,kb!RbPos+1)
if OptionDebugOn='Y' then
do
call DBG_DEFINING 'Looking for: ' ||kb!M
call DBGIND 1
end
kb!RepType=''
if symbol(kb!M)='VAR' then
do
kb!RepType='REXX'
kb!RepWith=value(kb!M)
end
else
do
if CsReplacement='N' then
kb!SavedAs='MACRO?.M?'||c2x(translate(kb!M))
else
kb!SavedAs='MACRO?.M?'||c2x(kb!M)
if symbol(kb!SavedAs)='VAR' then
do
kb!RepType='PPWIZARD'
kb!RepWith=value(kb!SavedAs)
end
end
if OptionDebugOn='Y' then
do
if kb!RepType='' then
call DBG_DEFINING 'No such REXX or PPWIZARD symbol!'
else
call DBG_DEFINING kb!RepType|| ' symbol contained: ' ||kb!RepWith
call DBGIND-1
end
if kb!RepType='' then
do
if kb!MacName=kb!MacNameO then
kb!Show=kb!MacName
else
kb!Show=kb!MacName|| ' <= "' ||kb!MacNameO
CryAndDie("Could not find a REXX variable or PPWIZARD macro matching:", '  ' || kb!M, 'In the macro reference:', '  ' ||kb!Show)
end
kb!MacName=kb!L||kb!RepWith||kb!R
if OptionDebugOn='Y' then
call DBG_DEFINING 'New macro reference is "' ||DebugRightArrow||kb!MacName||DebugLeftArrow
kb!RbPos=pos(MacroIndRight,kb!MacName)
end
if OptionDebugOn='Y' then
call DBGIND-1
end
if pos(MacroIndLeft,kb!MacName)<>0 then
CryAndDie('Could not find a matching "' || MacroIndRight || '" character for "' || MacroIndLeft || '"', 'The invalid macro is:', '  ' ||kb!MacName)
rb!Dummy=kb!MacName
if CsReplacement='N' then
rb!As='MACRO?.M?'||c2x(translate(kb!MacName))
else
rb!As='MACRO?.M?'||c2x(kb!MacName)
if symbol(rb!As)='VAR' then
return('Y')
else
return('N')

HandleUndefCommand:
sb!Ud=PerformReplacementsInCmdsParameters(arg(1))
if verify(sb!Ud,EndsVar, 'M') <> 0 then CryAndDie('The macro name "' || sb!Ud || '" is invalid (Any of "' || EndsVar || '" are invalid)')
kb!MacName=sb!Ud
kb!MacNameO=kb!MacName
kb!RbPos=pos(MacroIndRight,kb!MacName)
if kb!RbPos<>0 then
do
if OptionDebugOn='Y' then
do
call DBG_DEFINING '[indirection]: ' ||DebugRightArrow||kb!MacName||DebugLeftArrow
call DBGIND 1
end
do while kb!RbPos<>0
kb!LbPos=lastpos(MacroIndLeft,kb!MacName,kb!RbPos)
if kb!LbPos=0 then
CryAndDie('Could not find a matching "' || MacroIndLeft || '" character for "' || MacroIndRight || '"', 'The invalid macro is:', '  ' ||kb!MacName)
kb!L=left(kb!MacName,kb!LbPos-1)
kb!M=substr(kb!MacName,kb!LbPos+1,kb!RbPos-kb!LbPos-1)
kb!R=substr(kb!MacName,kb!RbPos+1)
if OptionDebugOn='Y' then
do
call DBG_DEFINING 'Looking for: ' ||kb!M
call DBGIND 1
end
kb!RepType=''
if symbol(kb!M)='VAR' then
do
kb!RepType='REXX'
kb!RepWith=value(kb!M)
end
else
do
if CsReplacement='N' then
kb!SavedAs='MACRO?.M?'||c2x(translate(kb!M))
else
kb!SavedAs='MACRO?.M?'||c2x(kb!M)
if symbol(kb!SavedAs)='VAR' then
do
kb!RepType='PPWIZARD'
kb!RepWith=value(kb!SavedAs)
end
end
if OptionDebugOn='Y' then
do
if kb!RepType='' then
call DBG_DEFINING 'No such REXX or PPWIZARD symbol!'
else
call DBG_DEFINING kb!RepType|| ' symbol contained: ' ||kb!RepWith
call DBGIND-1
end
if kb!RepType='' then
do
if kb!MacName=kb!MacNameO then
kb!Show=kb!MacName
else
kb!Show=kb!MacName|| ' <= "' ||kb!MacNameO
CryAndDie("Could not find a REXX variable or PPWIZARD macro matching:", '  ' || kb!M, 'In the macro reference:', '  ' ||kb!Show)
end
kb!MacName=kb!L||kb!RepWith||kb!R
if OptionDebugOn='Y' then
call DBG_DEFINING 'New macro reference is "' ||DebugRightArrow||kb!MacName||DebugLeftArrow
kb!RbPos=pos(MacroIndRight,kb!MacName)
end
if OptionDebugOn='Y' then
call DBGIND-1
end
if pos(MacroIndLeft,kb!MacName)<>0 then
CryAndDie('Could not find a matching "' || MacroIndRight || '" character for "' || MacroIndLeft || '"', 'The invalid macro is:', '  ' ||kb!MacName)
sb!Dummy=kb!MacName
if CsReplacement='N' then
SavedAs='MACRO?.M?'||c2x(translate(kb!MacName))
else
SavedAs='MACRO?.M?'||c2x(kb!MacName)
if symbol(SavedAs)='VAR' then
drop(SavedAs)
return(0)

MacroSet:call TRACE "OFF"

AddHashDefine:
parse arg HashDefineU,HashDefineC,DefineMode
if OptionDebugOn='Y' then
do
call DBG_DEFINING 'Defining "' || HashDefineU || '" <- ' ||DebugRightArrow||HashDefineC||DebugLeftArrow
call DBGIND 1
end
if verify(HashDefineU,EndsVar, 'M') <> 0 then CryAndDie('The macro name "' || HashDefineU || '" is invalid (Any of "' || EndsVar || '" are invalid)')
kb!MacName=HashDefineU
kb!MacNameO=kb!MacName
kb!RbPos=pos(MacroIndRight,kb!MacName)
if kb!RbPos<>0 then
do
if OptionDebugOn='Y' then
do
call DBG_DEFINING '[indirection]: ' ||DebugRightArrow||kb!MacName||DebugLeftArrow
call DBGIND 1
end
do while kb!RbPos<>0
kb!LbPos=lastpos(MacroIndLeft,kb!MacName,kb!RbPos)
if kb!LbPos=0 then
CryAndDie('Could not find a matching "' || MacroIndLeft || '" character for "' || MacroIndRight || '"', 'The invalid macro is:', '  ' ||kb!MacName)
kb!L=left(kb!MacName,kb!LbPos-1)
kb!M=substr(kb!MacName,kb!LbPos+1,kb!RbPos-kb!LbPos-1)
kb!R=substr(kb!MacName,kb!RbPos+1)
if OptionDebugOn='Y' then
do
call DBG_DEFINING 'Looking for: ' ||kb!M
call DBGIND 1
end
kb!RepType=''
if symbol(kb!M)='VAR' then
do
kb!RepType='REXX'
kb!RepWith=value(kb!M)
end
else
do
if CsReplacement='N' then
kb!SavedAs='MACRO?.M?'||c2x(translate(kb!M))
else
kb!SavedAs='MACRO?.M?'||c2x(kb!M)
if symbol(kb!SavedAs)='VAR' then
do
kb!RepType='PPWIZARD'
kb!RepWith=value(kb!SavedAs)
end
end
if OptionDebugOn='Y' then
do
if kb!RepType='' then
call DBG_DEFINING 'No such REXX or PPWIZARD symbol!'
else
call DBG_DEFINING kb!RepType|| ' symbol contained: ' ||kb!RepWith
call DBGIND-1
end
if kb!RepType='' then
do
if kb!MacName=kb!MacNameO then
kb!Show=kb!MacName
else
kb!Show=kb!MacName|| ' <= "' ||kb!MacNameO
CryAndDie("Could not find a REXX variable or PPWIZARD macro matching:", '  ' || kb!M, 'In the macro reference:', '  ' ||kb!Show)
end
kb!MacName=kb!L||kb!RepWith||kb!R
if OptionDebugOn='Y' then
call DBG_DEFINING 'New macro reference is "' ||DebugRightArrow||kb!MacName||DebugLeftArrow
kb!RbPos=pos(MacroIndRight,kb!MacName)
end
if OptionDebugOn='Y' then
call DBGIND-1
end
if pos(MacroIndLeft,kb!MacName)<>0 then
CryAndDie('Could not find a matching "' || MacroIndRight || '" character for "' || MacroIndLeft || '"', 'The invalid macro is:', '  ' ||kb!MacName)
sb!Dummy=kb!MacName
if CsReplacement='N' then
SavedAs='MACRO?.M?'||c2x(translate(kb!MacName))
else
SavedAs='MACRO?.M?'||c2x(kb!MacName)
if symbol(SavedAs)='VAR' then
do
select
when DefineMode='Y' then
do
if OptionDebugOn='Y' then
call DBG_DEFINING 'User said OK to redefine so no warning'
end
when DefineMode='' then
do
call OutputWarningToScreen 'R000', 'Redefine of "' || HashDefineU || '".'
end
when DefineMode='?' then
do
if OptionDebugOn='Y' then
do
call DBG_DEFINING 'Macro already defined, conditional definition aborted!'
call DBGIND-1
end
return(0)
end
otherwise
CryAndDie('Unknown define mode of "' || DefineMode || '"')
end
end
call _valueS SavedAs,HashDefineC
if OptionDebugOn='Y' then
call DBGIND-1
return(0)

PerformReplacementsInCmdsParameters:
tb!Prms=arg(1)
if ReplacementsAllowed<> 'Y' then
return(tb!Prms)
tb!Prms=ReplaceHashAndStandardDefines(arg(1), "PRM")
if ExpandXCmd='Y' then
do
if pos(StartsStdSymbolReplacement_x,tb!Prms)<>0 then
tb!Prms=ReplaceTheXCodesWeKnowExist(tb!Prms)
end
if pos(MarksNewLine,tb!Prms)<>0 then
do
tb!1='Parameters for a PPWIZARD command must never expand to multiple'
tb!2='lines (contain PPWIZARD #commands)!'
tb!4='EXPANDED PARAMETERS'
tb!5='~~~~~~~~~~~~~~~~~~~'
tb!6=tb!Prms
CryAndDie(tb!1,tb!2,,tb!4,tb!5,tb!6)
end
return(tb!Prms)

ReplaceMacros:call TRACE "OFF"
signal _ReplaceMacros

ReplaceHashAndStandardDefines:
if ReplacementsAllowed='N' then
return(arg(1))

_ReplaceMacros:
parse arg HashDefineString,HashDefPrefix,HashDefRecord
ReplLoop=0
do while pos(StartsMacroReplacement,HashDefineString)<>0
BeforeCount=ReplaceCount
HashDefineString=_ReplaceAllHashDefinedVariables(HashDefineString)
if HashDefRecord='Y' then
LastLineAfterMacroRep=HashDefineString
if OptionDebugOn='Y' then
do
if BeforeCount<>ReplaceCount then
do
if HashDefPrefix='' then
call DebugOutputAfterReplacement HashDefineString, 'VCMD'
else
call DebugOutputAfterReplacement HashDefineString, 'V' ||HashDefPrefix
end
end
if pos(MarksNewLine,HashDefineString)<>0 then
leave
if ReplLoop>=InfiniteLoopWhen then
do
if InfiniteLoopWhen<>0 then
do
InfiniteLoopDetected='Y'
if ReplLoop=InfiniteLoopWhen then
do
OptionDebugOn='Y'
call DBG 'Infinite loop detected, debug forced on for a few loops'
call DBGIND 1
call DBG InfiniteLoopWhen|| ' loops detected, possible actions:'
call DBGIND 1
call DBG 'Have have you forgotten to use "#option DefineMacroReplace=ON" somewhere?'
call DBG 'Use "/define:INFINITE_MACRO_LOOP_WHEN=0"    to turn off detection'
call DBG 'Use "/define:INFINITE_MACRO_LOOP_WHEN=1000" to increase detection threshold'
call DBGIND-2
say ''
call DebugStateChanged
end
say ''
if ReplLoop>InfiniteLoopWhen+50 then
CryAndDie("Infinite loop detected (debug turned on above), current line now:", "",HashDefineString)
end
end
ReplLoop=ReplLoop+1
end
if InfiniteLoopDetected='Y' then
CryAndDie("Increase your loop detection value from " || InfiniteLoopWhen || ' with "/define:INFINITE_MACRO_LOOP_WHEN=Value"', "Increase to at least " || ReplLoop || '!')
if pos(StartsStdSymbolReplacement,HashDefineString)<>0 then
do
BeforeCount=ReplaceCount
HashDefineString=ReplaceStandardDefinitions(HashDefineString)
if HashDefRecord='Y' then
LastLineAfterMacroRep=HashDefineString
if OptionDebugOn='Y' then
do
if BeforeCount<>ReplaceCount then
do
if HashDefPrefix='' then
call DebugOutputAfterReplacement HashDefineString, 'SCMD'
else
call DebugOutputAfterReplacement HashDefineString, 'S' ||HashDefPrefix
end
end
end
return(HashDefineString)

_UnknownStandardSymbol:
call CryAndDie 'The standard symbol "' || StartsStdSymbolReplacement || SymbolName || EndsMacroReplacement || '" is unknown!'

ReplaceStandardDefinitions:
RightBit=arg(1)
if pos(MarksNewLine,RightBit)<>0 then
return(RightBit)
LeftBit=''
StartPos=pos(StartsStdSymbolReplacement,RightBit)
do while StartPos<>0
if StartsStdSymbolReplacement==MarksPhpXml then
do
Left4=substr(RightBit,StartPos+2,3)
if Left4='xml' then
do
LeftBit=LeftBit|| '<' ||CodexHexQuestionMark
RightBit=substr(RightBit,3)
StartPos=pos(StartsStdSymbolReplacement,RightBit)
iterate
end
if Left4='php' then
do
StartPos=pos(StartsStdSymbolReplacement,RightBit,StartPos+2)
iterate
end
if left(Left4,1)=' ' then
do
StartPos=pos(StartsStdSymbolReplacement,RightBit,StartPos+2)
iterate
end
end
EndPos=pos(EndsMacroReplacement,RightBit,StartPos+1)
if EndPos=0 then
CryAndDie('Could not find the "' || EndsMacroReplacement || '" end of variable started at: ' ||substr(RightBit,StartPos))
LeftBit=LeftBit||left(RightBit,StartPos-1)
SymbolNameC=substr(RightBit,StartPos+2,(EndPos-StartPos)-2)
RightBit=substr(RightBit,EndPos+1)
if left(SymbolNameC,1)='x' then
do
ReplaceCount=ReplaceCount-1
SymbolValue=StartsStdSymbolReplacement||SymbolNameC||EndsMacroReplacement
end
else
do
if OptionDebugOn='Y' then
call DebugOutputVariableInfo_FOUNDSTDVAR 'Found : ' ||StartsStdSymbolReplacement||SymbolNameC||EndsMacroReplacement
SymbolName=SymbolNameC
Left1=left(SymbolName,1)
if Left1='=' then
DdCodes=''
else
do
SpcPos=pos(' ',SymbolName)
if SpcPos=0 then
DdCodes=''
else
do
DdCodes=translate(substr(SymbolName,SpcPos+1))
SymbolName=left(SymbolName,SpcPos-1)
end
end
ub!Pos=pos(':',SymbolName)
if ub!Pos=0 then
SymbolParms=''
else
do
SymbolParms=substr(SymbolName,ub!Pos+1,length(SymbolName)-ub!Pos)
SymbolName=left(SymbolName,ub!Pos-1)
end
SymbolName=translate(SymbolName)
Left1=left(SymbolName,1)
select
when Left1='?' then
do
SymbolName=substr(SymbolName,2)
if left(SymbolName,1)<> '*' then
do
if symbol(SymbolName)<> 'VAR' then
do
call DumpVarsIfCompoundVariable SymbolName
call CryAndDie 'The rexx variable "' || SymbolName || '" is unknown!'
end
SymbolValue=_valueG(SymbolName)
end
else
do
SymbolName=substr(SymbolName,2)
if right(SymbolName,1)<> '?' then
ub!Die='Y'
else
do
ub!Die='N'
SymbolName=left(SymbolName,length(SymbolName)-1)
end
SymbolValue=GetEnv(SymbolName,ub!Die)
end
end
when Left1='I' then
do
select
when SymbolName="INPUTFILE" then
SymbolValue=FormatSsFile(InputFileFull)
when SymbolName="INPUTCOMPONENT" then
SymbolValue=FormatSsFile(IncludeFileName)
when SymbolName="INPUTCOMPONENTLINE" then
SymbolValue=FormatSsNumber(IncludeLineNumber)
when SymbolName="INPUTFILETIME" then
do
ub!Ts=GetFileTimeStamp(InputFileFull, "D")
SymbolValue=FormatSsTime(ub!Ts, "INPUTFILETIME")
end
when SymbolName="INPUTCOMPONENTTIME" then
do
ub!Ts=GetFileTimeStamp(IncludeFileName, "D")
SymbolValue=FormatSsTime(ub!Ts, "INPUTCOMPONENTTIME")
end
when SymbolName="INCLUDELEVEL" then
SymbolValue=IncludeLevel
otherwise
call _UnknownStandardSymbol
end
end
when Left1='S' then
do
select
when SymbolName="SPACE" then
SymbolValue=CodexHexSpace
when SymbolName="SEMICOLON" then
SymbolValue=CodexSemiColon
when SymbolName="SYNTAXCHECK" then
do
SymbolValue=OutSyntaxCode
if SymbolValue='' then
CryAndDie("We do not know how to insert syntax checking code (or already inserted)!")
OutSyntaxCode=''
end
when SymbolName="SYNTAXCHECKOFF" then
do
OutSyntaxCode=''
OutSyntaxRc=''
OutSyntaxCmd=''
SymbolValue=''
end
otherwise
call _UnknownStandardSymbol
end
end
when Left1='O' then
do
select
when SymbolName="OUTPUTLINE" then
SymbolValue=FormatSsNumber(CurrentOutLine+1)
when SymbolName="OUTPUTLEVEL" then
SymbolValue=OutputLevel
when SymbolName="OPSYS" then
SymbolValue=PpWizardOpSys
when SymbolName="OPSYSSPECIFIC" then
SymbolValue=PpWizardOpSysREAL
when SymbolName="OUTPUTFILE" then
do
call _FileClose CurrentOutFile
SymbolValue=FileQueryExists(CurrentOutFile)
if SymbolValue='' then
CryAndDie('Could not obtain file name information for the "' || StartsStdSymbolReplacement || 'OutputFile>" variable!')
SymbolValue=FormatSsFile(SymbolValue)
end
otherwise
call _UnknownStandardSymbol
end
end
when Left1='P' then
do
select
when SymbolName='PROCESSINGMODE' then
SymbolValue=ProcessingMode
when SymbolName='PROTECTFROMPPWSTART' then
SymbolValue=MarksNewLine||HashPrefix||ProtectFromPpwS||MarksNewLine
when SymbolName='PROTECTFROMPPWEND' then
SymbolValue=MarksNewLine||ProtectFromPpwE||MarksNewLine
when SymbolName='PPWIZARDAUTHORHOMEPAGE' then
SymbolValue=PgmAuthorHomePage
when SymbolName='PPWIZARDAUTHOR' then
SymbolValue=PgmAuthor
when SymbolName='PPWIZARDAUTHOREMAIL' then
SymbolValue=PgmAuthorEmail
when SymbolName='PPWIZARDPGM' then
SymbolValue=FormatSsFile(PpWizardPgmName)
when SymbolName='PPWIZARDHOMEPAGE' then
SymbolValue=PgmHomePage
when SymbolName='PPWIZARDGENERATORMETATAGS' then
SymbolValue=PgmDefaultHtmlMetaTags
when SymbolName='PPWIZARDAUTHORBASEWEBDIR' then
SymbolValue=MyBaseHomeDir
otherwise
call _UnknownStandardSymbol
end
end
when Left1='D' then
do
select
when SymbolName='DEBUGON' then
SymbolValue=OptionDebugOn
when SymbolName='DOLLAR' then
SymbolValue=CodexHexDollar
when SymbolName='DIRSLASH' then
SymbolValue=RexDirChar
otherwise
call _UnknownStandardSymbol
end
end
when SymbolName='NEWLINE' then
SymbolValue=CodexHexNewLine
when SymbolName='NEWLINE?' then
do
CondNlCount=CondNlCount+1
SymbolValue="{?WaNtNl?}"
end
when SymbolName='/' then
SymbolValue=OptionXSlash
when SymbolName='_' then
SymbolValue=CodexNothing
when SymbolName='COMPILETIME' then
SymbolValue=FormatSsTime(PpwCompTs, "COMPILETIME")
when SymbolName='CMDLINETOTAL' then
SymbolValue=CmdLineTotal
when SymbolName='VERSION' then
SymbolValue=PgmVersion
when SymbolName='HASH' then
SymbolValue=CodexHexHash
when SymbolName='HASHPREFIX' then
SymbolValue=HashPrefix
when SymbolName='RESTARTLINE' then
SymbolValue=MarksNewLine
when SymbolName='TOTALOUTPUTLINES' then
SymbolValue=FormatSsNumber(GeneratedLines+1)
when SymbolName='NEWESTFILEDATETIME' then
do
SymbolValue=TsNewestSourcefile
if SymbolParms<> '' then
SymbolValue=FormatSsTime(SymbolValue)
end
when SymbolName='LESSTHAN' then
SymbolValue=CodexHexLessThan
when SymbolName='QUESTIONMARK' then
SymbolValue=CodexHexQuestionMark
when SymbolName='BASEDIR' then
SymbolValue=FormatSsFile(BaseDir4CurrentInputFile)
when SymbolName='UNIQUE' then
do
PPwizardUnique=PPwizardUnique+1
SymbolValue=FormatSsNumber(PPwizardUnique)
end
when SymbolName='TEMPLATEDATAFILE' then
SymbolValue=FormatSsFile(TemplateDataFile)
when SymbolName='TMPDIR' then
do
ub!D=RexGetNameOfTmpDir()
if right(ub!D,1)=RexDirChar then
ub!D=left(ub!D,length(ub!D)-1)
SymbolValue=ub!D
end
when SymbolName='CGISTART' then
SymbolValue='Content-type: text/html' ||CodexHexNewLine||CodexHexNewLine
when SymbolName='REXXSKIP' then
do
RexxSkipCounter=RexxSkipCounter+1
RexxLbl=_filespec("WITHOUTEXTN", _filespec("NAME", IncludeFileName)) || '_' ||RexxSkipCounter
SymbolValue=MarksNewLine||HashPrefix|| 'RexxVar "RexxSkipLbl" = "' || RexxLbl || '"' ||MarksNewLine
SymbolValue=SymbolValue|| 'signal ' || RexxLbl || ';' ||MarksNewLine
SymbolValue=SymbolValue||MarksNewLine||HashPrefix|| 'RexxVar "RexxSkipLbl" PUSH' ||MarksNewLine
end
when SymbolName='REXXSKIPTO' then
do
SymbolValue=MarksNewLine||HashPrefix|| 'RexxVar "RexxSkipLbl" POP' ||MarksNewLine
SymbolValue=SymbolValue||RexxSkipLbl|| ':' ||MarksNewLine
end
when SymbolName='..' then
do
call DBGIND 1
ub!IF=InputFileFull
ub!Bd=BaseDir4CurrentInputFile
call DBG 'Base dir "' || ub!Bd || '"'
call ValidateBaseDirUse ub!BD,ub!IF
ub!SrcDir=_filespec('Location',ub!IF)
ub!RelDir=substr(ub!SrcDir,length(ub!Bd)+1)
call DBG 'Rel dir  "' || ub!RelDir || '"'
ub!DD=''
do while ub!RelDir<> ""
ub!DD=ub!DD|| '..\'
parse var ub!RelDir . (RexDirChar) ub!RelDir
end
SymbolValue=ub!DD
call DBGIND-1
end
when Left1='=' then
do
if OptionDebugOn='Y' then
call DBGIND 1
call ExecRexxCmd 'SymbolValue = ' ||substr(SymbolNameC,2)
if OptionDebugOn='Y' then
call DBGIND-1
SymbolParms=''
end
otherwise
call _UnknownStandardSymbol
end
if DdCodes<> '' then
do
do until DdCodes=''
parse var DdCodes DdCode DdCodes
if OptionDebugOn='Y' then
do
call DebugOutputVariableInfo_FOUNDSTDVAR '$$Bef : ' ||SymbolValue
call DebugOutputVariableInfo_FOUNDSTDVAR '$$Cmd : ' ||DdCode
end
select

when DdCode='$$DSQ' then
SymbolValue=QuoteIt(SymbolValue,TryQuoteListDs, 'Y')

when DdCode='$$SDQ' then
SymbolValue=QuoteIt(SymbolValue,TryQuoteListSd, 'Y')

when DdCode='$$AQ' then
SymbolValue=QuoteIt(SymbolValue, 'ANY', 'Y')

when DdCode='$$UPPER' then
SymbolValue=ToUpperCase(SymbolValue)

when DdCode='$$LOWER' then
SymbolValue=ToLowerCase(SymbolValue)

when DdCode='$$ADDCOMMA' then
SymbolValue=AddCommasToDecimalNumber(SymbolValue)

when DdCode='$$HTMLQ' then
SymbolValue=ReplaceString(SymbolValue, '"', '"')

when DdCode='$$SQX2' then
SymbolValue=ReplaceString(SymbolValue, "'" , "''")

when left(DdCode,8)="$$RXVAR:" then
SymbolValue=_RxVar(DdCode,SymbolValue)

when DdCode="$$RX'" then
SymbolValue=_RXQuote(SymbolValue, "'")

when DdCode='$$RX"' then
SymbolValue=_RXQuote(SymbolValue, '"')

when DdCode='$$SPCPLUS' then
do
if SymbolValue\=='' then
SymbolValue=' ' ||SymbolValue
end

when DdCode='$$ISBLANK' then
do
if SymbolValue='' then
SymbolValue='Y'
else
SymbolValue='N'
end

when DdCode='$$RXEXEC' then
do
RxExec=''
call ExecRexxCmd SymbolValue, 'N'
SymbolValue=RxExec
end

otherwise
do
UserRexx=CfgMacro("REXX_" || DdCode, '')
if UserRexx='' then
CryAndDie('The $$ replacement command of "' || DdCode || '" is unknown!')
TheMacro=""
TheName=SymbolName
TheValue=SymbolValue
call ExecRexxCmd UserRexx, 'N'
if OptionDebugOn='Y' then
do
if SymbolValue=TheValue then
do
call DBGIND 1
call DebugOutputVariableInfo_FOUNDVARPARMS 'The user rexx code did not modify the "TheValue" variable'
call DBGIND-1
end
end
SymbolValue=TheValue
end
end
end
end
if SymbolParms<> '' then
CryAndDie('Unexpected parameters on standard macro:',SymbolNameC)
if OptionDebugOn='Y' then
call DebugOutputVariableInfo_FOUNDSTDVAR 'Value : ' ||DebugRightArrow||SymbolValue||DebugLeftArrow
end
LeftBit=LeftBit||SymbolValue
ReplaceCount=ReplaceCount+1
if pos(MarksNewLine,SymbolValue)<>0 then
leave
StartPos=pos(StartsStdSymbolReplacement,RightBit)
end
return(LeftBit||RightBit)

FormatSsFile:
vb!F=arg(1)
do while SymbolParms<> ''
parse var SymbolParms vb!Cmd ',' SymbolParms
vb!F=_filespec(vb!Cmd,vb!F)
end
return(vb!F)

FormatSsNumber:
if SymbolParms='' then
return(arg(1))
else
do
wb!R=FormatNumber(arg(1),SymbolParms)
SymbolParms=''
return(wb!R)
end

FormatSsTime:
parse arg xb!Ts,xb!CfgSuffix
xb!Fmt=SymbolParms
if xb!Fmt<> '' then
SymbolParms=''
else
do
xb!Fmt=CfgMacro("PPWIZARD_FORMAT_DATETIME", '%c')
xb!Fmt=CfgMacro("PPWIZARD_FORMAT_" ||xb!CfgSuffix,xb!Fmt)
end
xb!Time=FormatTime(xb!Fmt,xb!Ts, "PPWIZARD")
return(xb!Time)

GetDefineContents:
if verify(arg(1),EndsVar, 'M') <> 0 then CryAndDie('The macro name "' || arg(1) || '" is invalid (Any of "' || EndsVar || '" are invalid)')
kb!MacName=arg(1)
kb!MacNameO=kb!MacName
kb!RbPos=pos(MacroIndRight,kb!MacName)
if kb!RbPos<>0 then
do
if OptionDebugOn='Y' then
do
call DBG_DEFINING '[indirection]: ' ||DebugRightArrow||kb!MacName||DebugLeftArrow
call DBGIND 1
end
do while kb!RbPos<>0
kb!LbPos=lastpos(MacroIndLeft,kb!MacName,kb!RbPos)
if kb!LbPos=0 then
CryAndDie('Could not find a matching "' || MacroIndLeft || '" character for "' || MacroIndRight || '"', 'The invalid macro is:', '  ' ||kb!MacName)
kb!L=left(kb!MacName,kb!LbPos-1)
kb!M=substr(kb!MacName,kb!LbPos+1,kb!RbPos-kb!LbPos-1)
kb!R=substr(kb!MacName,kb!RbPos+1)
if OptionDebugOn='Y' then
do
call DBG_DEFINING 'Looking for: ' ||kb!M
call DBGIND 1
end
kb!RepType=''
if symbol(kb!M)='VAR' then
do
kb!RepType='REXX'
kb!RepWith=value(kb!M)
end
else
do
if CsReplacement='N' then
kb!SavedAs='MACRO?.M?'||c2x(translate(kb!M))
else
kb!SavedAs='MACRO?.M?'||c2x(kb!M)
if symbol(kb!SavedAs)='VAR' then
do
kb!RepType='PPWIZARD'
kb!RepWith=value(kb!SavedAs)
end
end
if OptionDebugOn='Y' then
do
if kb!RepType='' then
call DBG_DEFINING 'No such REXX or PPWIZARD symbol!'
else
call DBG_DEFINING kb!RepType|| ' symbol contained: ' ||kb!RepWith
call DBGIND-1
end
if kb!RepType='' then
do
if kb!MacName=kb!MacNameO then
kb!Show=kb!MacName
else
kb!Show=kb!MacName|| ' <= "' ||kb!MacNameO
CryAndDie("Could not find a REXX variable or PPWIZARD macro matching:", '  ' || kb!M, 'In the macro reference:', '  ' ||kb!Show)
end
kb!MacName=kb!L||kb!RepWith||kb!R
if OptionDebugOn='Y' then
call DBG_DEFINING 'New macro reference is "' ||DebugRightArrow||kb!MacName||DebugLeftArrow
kb!RbPos=pos(MacroIndRight,kb!MacName)
end
if OptionDebugOn='Y' then
call DBGIND-1
end
if pos(MacroIndLeft,kb!MacName)<>0 then
CryAndDie('Could not find a matching "' || MacroIndRight || '" character for "' || MacroIndLeft || '"', 'The invalid macro is:', '  ' ||kb!MacName)
yb!MN=kb!MacName
if CsReplacement='N' then
yb!SA='MACRO?.M?'||c2x(translate(kb!MacName))
else
yb!SA='MACRO?.M?'||c2x(kb!MacName)
if symbol(yb!SA)='VAR' then
return(_valueG(yb!SA))
if arg(1)=yb!MN then
yb!New=''
else
yb!New=' ("' || yb!MN || '")'
CryAndDie('Macro named "' || arg(1) || '"' || yb!New || ' does not exist!',_MacroBitNotFoundText())

_SpecialPrm:
call DebugOutputVariableInfo_FOUNDVARPARMS "This is a special variable, it's value is: " ||arg(1)
return

_DieInvPrm:
CryAndDie('The "' || StartsMacroParm || ThisParmName || EndsMacroParm || '" parameter was not supplied (and there is no default value)', '', 'Did you mean to use "' || HidesMacroParm || ThisParmName || EndsMacroParm || '" to hide the reference?',_MacroBitNotFoundText())
return

ReplaceDefinitionsParameters:
do ParmIndex=1 to ParmCount
ParmUsed.ParmIndex='N'
end
zb!DieIfNotUsed='N'
zb!ValPointless='N'
DefaultCnt=0
ParmLeftBit=''
ParmRightBit=VariableCont
ParmPos=pos(StartsMacroParm,ParmRightBit)
do while ParmPos<>0
ParmLeftBit=ParmLeftBit||left(ParmRightBit,ParmPos-1)
ParmRightBit=substr(ParmRightBit,ParmPos+2)
EqualPos=pos('=',ParmRightBit)
MaybeEndPos=pos(EndsMacroParm,ParmRightBit)
if MaybeEndPos=0 then
CryAndDie('Incorrect use of macro parameter, no matching "' || EndsMacroParm || '" for "' || StartsMacroParm || '"')
if EqualPos<>0&EqualPos<MaybeEndPos then
do
if CsReplacement='N' then
ThisParmName=translate(strip(left(ParmRightBit,EqualPos-1)))
else
ThisParmName=strip(left(ParmRightBit,EqualPos-1))
ParmRightBit=substr(ParmRightBit,EqualPos+1)
ParmDefault=GetQuotedText(ParmRightBit, "ParmRightBit", EndsMacroParm, "Getting default for macro parm " ||ThisParmName)
HaveDefault='Y'
CurlyPos=pos(EndsMacroParm,ParmRightBit)
if CurlyPos=0 then
CryAndDie("Expected to find '" || EndsMacroParm || "' " || 'after the parameter default of "' || ParmDefault || '"!')
ParmCmds=left(ParmRightBit,CurlyPos-1)
ParmRightBit=substr(ParmRightBit,CurlyPos+1)
FoundIndex=0
do DefaultIndex=1 to DefaultCnt
if ThisParmName=PrmDefaultName.DefaultIndex then
do
FoundIndex=DefaultIndex
leave
end
end
if FoundIndex=0 then
do
DefaultCnt=DefaultCnt+1
FoundIndex=DefaultCnt
end
PrmDefaultName.FoundIndex=ThisParmName
PrmDefaultValue.FoundIndex=ParmDefault
end
else
do
HaveDefault='N'
if CsReplacement='N' then
ThisParmName=translate(strip(left(ParmRightBit,MaybeEndPos-1)))
else
ThisParmName=strip(left(ParmRightBit,MaybeEndPos-1))
SpcPos=pos(' ',ThisParmName)
if SpcPos=0 then
ParmCmds=''
else
do
ParmCmds=substr(ThisParmName,SpcPos+1)
ThisParmName=left(ThisParmName,SpcPos-1)
end
ParmRightBit=substr(ParmRightBit,MaybeEndPos+1)
end
if OptionDebugOn='Y' then
call DebugOutputVariableInfo_FOUNDVARPARMS 'Parm : ' ||ThisParmName
FndVarIndex=0
do ParmIndex=1 to ParmCount
if ParmName.ParmIndex<> '' then
do
if ThisParmName=ParmName.ParmIndex then
do
ParmUsed.ParmIndex='Y'
FndVarIndex=ParmIndex
end
end
end
if FndVarIndex<>0 then
do
zb!IsPassed='Y'
ReplaceParmWith=ParmValue.FndVarIndex
end
else
do
zb!IsPassed='N'
if HaveDefault='Y' then
ReplaceParmWith=ParmDefault
else
do
if OptionDebugOn='Y' then
do
call DBGIND 1
call DebugOutputVariableInfo_FOUNDVARPARMS 'Parameter not supplied. No default given. Default value stored?'
end
do DefaultIndex=1 to DefaultCnt
if ThisParmName=PrmDefaultName.DefaultIndex then
do
ReplaceParmWith=PrmDefaultValue.DefaultIndex
HaveDefault='Y'
leave
end
end
if OptionDebugOn='Y' then
do
if HaveDefault='N' then
Ans='Oops - not user defined!'
else
Ans='Lucky!'
call DebugOutputVariableInfo_FOUNDVARPARMS Ans
call DBGIND-1
end
if HaveDefault='N' then
do
zb!ReginaBugWorkAround='N'
select
when ThisParmName='?' then
do
zb!ValPointless='Y'
zb!ReginaBugWorkAround='Y'
if OptionDebugOn='Y' then
call _SpecialPrm 'is all unused parms'
ReplaceParmWith=''
do ParmIndex=1 to ParmCount
if ParmName.ParmIndex<> '' then
do
if ParmUsed.ParmIndex='N' then
do
if ReplaceParmWith=='' then
LSPC=''
else
LSPC=' '
if ParmValueT.ParmIndex='NV' then
ReplaceParmWith=ReplaceParmWith||LSPC||ParmNameC.ParmIndex
else
do
if ParmCmds='' then
do
QChar=QuoteIt(ParmValue.ParmIndex,TryQuoteListAny)
ReplaceParmWith=ReplaceParmWith||LSPC||ParmNameC.ParmIndex|| '=' ||QChar||ParmValue.ParmIndex||QChar
end
else
do
ReplaceParmWith=ReplaceParmWith||LSPC||StartsMacroParm||ParmNameC.ParmIndex|| ' ' ||ParmCmds||EndsMacroParm
end
end
end
end
end
ParmCmds=''
end
when ThisParmName='??' then
do
zb!ValPointless='Y'
zb!ReginaBugWorkAround='Y'
if OptionDebugOn='Y' then
call _SpecialPrm 'all parms as rexx array'
RepWith=''
ArrayCnt=0
do ParmIndex=1 to ParmCount
if ParmName.ParmIndex<> '' then
do
ArrayCnt=ArrayCnt+1
RepWith=RepWith|| 'MP.' || ArrayCnt || ".MPNAME  = " ||QuoteAsRexxLit(ParmNameC.ParmIndex)||DefRexxSpecialSepTag
RepWith=RepWith|| '@s@RxVar:' || 'MP.' || ArrayCnt || '.MPVALUE' || ':' || ParmValue.ParmIndex || ':@e@RxVar' ||DefRexxSpecialSepTag
RepWith=RepWith|| 'MP.' || ArrayCnt || ".MPUSED  = '" || ParmUsed.ParmIndex                   || "'" ||DefRexxSpecialSepTag
RepWith=RepWith|| 'MP.' || ArrayCnt || ".MPTYPE  = '" || ParmValueT.ParmIndex                 || "'" ||DefRexxSpecialSepTag
end
end
ReplaceParmWith=RepWith|| 'MP.0 = ' ||ArrayCnt||DefRexxSpecialSepTag
ParmCmds=''
end
when translate(ThisParmName)='?MACNAME' then
do
zb!ReginaBugWorkAround='Y'
if OptionDebugOn='Y' then
call _SpecialPrm 'name of macro being expanded'
ReplaceParmWith=VariableName
end
when translate(ThisParmName)='?RESETUSED' then
do
zb!ReginaBugWorkAround='Y'
if OptionDebugOn='Y' then
call _SpecialPrm 'All parms now marked unused'
do ParmIndex=1 to ParmCount
ParmUsed.ParmIndex='N'
end
zb!ValPointless='Y'
ReplaceParmWith=''
ParmCmds=''
end
when ThisParmName='!' then
do
zb!DieIfNotUsed="Y"
zb!ReginaBugWorkAround='Y'
if OptionDebugOn='Y' then
call _SpecialPrm 'Empty - It is a parameter validation command'
ReplaceParmWith=''
ParmCmds=''
end
otherwise
do
if zb!ReginaBugWorkAround='N' then
call _DieInvPrm
end
end
end
end
end
if ParmCmds<> '' then
do
ParmCmds=translate(strip(ParmCmds))
do until ParmCmds=''
parse var ParmCmds ParmCmd ParmCmds
if OptionDebugOn='Y' then
do
call DBGIND 1
call DebugOutputVariableInfo_FOUNDVARPARMS '$$Bef: ' ||ReplaceParmWith
call DebugOutputVariableInfo_FOUNDVARPARMS '$$Cmd: ' ||ParmCmd
call DBGIND-1
end
select
when ParmCmd='$$PASSAQ' then
do
QChar=QuoteIt(ReplaceParmWith, 'ANY')
ReplaceParmWith=ThisParmName|| '=' ||QChar||ReplaceParmWith||QChar
end
when ParmCmd='$$PASSDSQ' then
do
QChar=QuoteIt(ReplaceParmWith,TryQuoteListDs)
ReplaceParmWith=ThisParmName|| '=' ||QChar||ReplaceParmWith||QChar
end
when ParmCmd='$$IGNORE' then
ReplaceParmWith=''
when ParmCmd='$$ISPASSED' then
ReplaceParmWith=zb!IsPassed

when ParmCmd='$$DSQ' then
ReplaceParmWith=QuoteIt(ReplaceParmWith,TryQuoteListDs, 'Y')

when ParmCmd='$$SDQ' then
ReplaceParmWith=QuoteIt(ReplaceParmWith,TryQuoteListSd, 'Y')

when ParmCmd='$$AQ' then
ReplaceParmWith=QuoteIt(ReplaceParmWith, 'ANY', 'Y')

when ParmCmd='$$UPPER' then
ReplaceParmWith=ToUpperCase(ReplaceParmWith)

when ParmCmd='$$LOWER' then
ReplaceParmWith=ToLowerCase(ReplaceParmWith)

when ParmCmd='$$ADDCOMMA' then
ReplaceParmWith=AddCommasToDecimalNumber(ReplaceParmWith)

when ParmCmd='$$HTMLQ' then
ReplaceParmWith=ReplaceString(ReplaceParmWith, '"', '"')

when ParmCmd='$$SQX2' then
ReplaceParmWith=ReplaceString(ReplaceParmWith, "'" , "''")

when left(ParmCmd,8)="$$RXVAR:" then
ReplaceParmWith=_RxVar(ParmCmd,ReplaceParmWith)

when ParmCmd="$$RX'" then
ReplaceParmWith=_RXQuote(ReplaceParmWith, "'")

when ParmCmd='$$RX"' then
ReplaceParmWith=_RXQuote(ReplaceParmWith, '"')

when ParmCmd='$$SPCPLUS' then
do
if ReplaceParmWith\=='' then
ReplaceParmWith=' ' ||ReplaceParmWith
end

when ParmCmd='$$ISBLANK' then
do
if ReplaceParmWith='' then
ReplaceParmWith='Y'
else
ReplaceParmWith='N'
end

when ParmCmd='$$RXEXEC' then
do
RxExec=''
call ExecRexxCmd ReplaceParmWith, 'N'
ReplaceParmWith=RxExec
end

otherwise
do
UserRexx=CfgMacro("REXX_" || ParmCmd, '')
if UserRexx='' then
CryAndDie('The $$ replacement command of "' || ParmCmd || '" is unknown!')
TheMacro=VariableName
TheName=ThisParmName
TheValue=ReplaceParmWith
call ExecRexxCmd UserRexx, 'N'
if OptionDebugOn='Y' then
do
if ReplaceParmWith=TheValue then
do
call DBGIND 1
call DebugOutputVariableInfo_FOUNDVARPARMS 'The user rexx code did not modify the "TheValue" variable'
call DBGIND-1
end
end
ReplaceParmWith=TheValue
end
end
end
end
if OptionDebugOn='Y' then
do
call DBGIND 1
call DebugOutputVariableInfo_FOUNDVARPARMS 'Use : ' ||ReplaceParmWith
call DBGIND-1
end
ParmRightBit=ReplaceParmWith||ParmRightBit
ParmPos=pos(StartsMacroParm,ParmRightBit)
end
ParmLeftBit=ParmLeftBit||ParmRightBit
if zb!ValPointless='N' then
do
if OptionParmVal<> "S" then
do
zb!DieIfNotUsed=OptionParmVal
end
if zb!DieIfNotUsed='Y' | OptionDebugOn = 'Y' then
do
zb!UnUsed=''
do ParmIndex=1 to ParmCount
if ParmUsed.ParmIndex='N' then
do
call DebugOutputVariableInfo_FOUNDVARPARMS 'The "' || ParmName.ParmIndex  || '" parameter was not referred to by the "' || VariableName || '" macro (either invalid or referenced only in unused default value of another parameter).'
if zb!UnUsed='' then
zb!UnUsed=ParmName.ParmIndex
else
zb!UnUsed=zb!UnUsed|| ', ' ||ParmName.ParmIndex
end
end
if zb!DieIfNotUsed='Y' then
do
if zb!UnUsed<> '' then
do
zb!UnUsed='    ' ||zb!UnUsed
if DefaultCnt=0 then
zb!Def='No macro parameters used default values'
else
do
zb!Def=''
do DefaultIndex=1 to DefaultCnt
if zb!Def='' then
zb!Def=PrmDefaultName.DefaultIndex
else
zb!Def=zb!Def|| ', ' ||PrmDefaultName.DefaultIndex
end
end
zb!Def='    ' ||zb!Def
CryAndDie('The "' || VariableName || '" macro was supplied parameters it', 'does not require! These are:', zb!UnUsed, '', 'These macro parameters used default values:',zb!Def)
end
end
end
end
if pos('{',ParmLeftBit)<>0 then
do
if pos(StartsMacroParm,ParmLeftBit)<>0 then
CryAndDie('Not all "' || VariableName || '" parameters replaced!')
ParmLeftBit=ReplaceString(ParmLeftBit,HidesMacroParm,StartsMacroParm)
end
return(ParmLeftBit)

_ReplaceAllHashDefinedVariables:
RightBit=arg(1)
LeftBit=''
ChangesMade='N'
VarPos=pos(StartsMacroReplacement,RightBit)
do while VarPos<>0
LeftBit=LeftBit||left(RightBit,VarPos-1)
RightBit=substr(RightBit,VarPos+2)
DelPos=verify(RightBit,EndsVar, 'M')
if DelPos=0 then
CryAndDie("Can't find the end of the macro reference at " ||DebugRightArrow||StartsMacroReplacement||RightBit||DebugLeftArrow)
VariableName=left(RightBit,DelPos-1)
MacroBeingExpanded=VariableName
RightBit=strip(substr(RightBit,DelPos), 'L')
if OptionDebugOn='Y' then
do
call DebugOutputVariableInfo_FOUNDVAR 'Found : ' || StartsMacroReplacement || VariableName || ' ...' ||EndsMacroReplacement
call DBGIND 1
end
DefnAsIs='N'
VariableCont=GetDefineContents(VariableName)
if OptionDebugOn='Y' then
do
call DebugOutputVariableInfo_FOUNDVAR 'Value : ' ||DebugRightArrow||VariableCont||DebugLeftArrow
call DBGIND 1
end
ParmCount=0
DDCmdCount=0
PositionalParmCount=0
EndParmDelimiters=EndsMacroReplacement|| '= '
Left1=left(RightBit,1)
do while Left1<>EndsMacroReplacement
if pos(Left1,ArePositionalChars)<>0 then
do
PositionalParmCount=PositionalParmCount+1
ThisParmNameC='#' ||PositionalParmCount
if CsReplacement='N' then
ThisParmName=translate(ThisParmNameC)
else
ThisParmName=ThisParmNameC
ThisParmValType='V'
if Left1='=' then
ThisParmVal=GetQuotedText(substr(RightBit,2), "RightBit", EndsMacroReplacement, 'Getting macro parameter''s value for ' ||ThisParmNameC)
else
ThisParmVal=GetQuotedText(RightBit, "RightBit", EndsMacroReplacement, 'Getting positional macro parameter''s value for ' ||ThisParmNameC)
end
else
do
DelPos=verify(RightBit,EndParmDelimiters, 'M')
if DelPos=0 then
CryAndDie('Macro reference incorrectly formatted, missing "' || EndsMacroReplacement || '"?')
ThisParmNameC=strip(left(RightBit,DelPos-1))
if CsReplacement='N' then
ThisParmName=translate(ThisParmNameC)
else
ThisParmName=ThisParmNameC
DelChar=substr(RightBit,DelPos,1)
if DelChar='=' then
do
ThisParmVal=GetQuotedText(substr(RightBit,DelPos+1), "RightBit", EndsMacroReplacement, 'Getting macro parameter''s value for ' ||ThisParmNameC)
ThisParmValType='V'
end
else
do
RightBit=strip(substr(RightBit,DelPos), 'L')
if left(ThisParmName,2)<> '$$' then
do
ThisParmVal=ThisParmName
ThisParmValType='NV'
end
else
do
if OptionDebugOn='Y' then
call DebugOutputVariableInfo_FOUNDVARPARMS '$$Cmd: ' ||ThisParmName
select
when ThisParmName='$$ASIS' then
DefnAsIs='Y'
otherwise
do
DDCmdCount=DDCmdCount+1
DDCmd.DDCmdCount=ThisParmName
end
end
Left1=left(RightBit,1)
iterate
end
end
end
do ChkIndex=1 to ParmCount
if ThisParmName=ParmName.ChkIndex then
CryAndDie('The macro parameter "' || ThisParmName || '" was specified more than once!')
end
ParmCount=ParmCount+1
ParmName.ParmCount=ThisParmName
ParmNameC.ParmCount=ThisParmNameC
ParmValue.ParmCount=ThisParmVal
ParmValueT.ParmCount=ThisParmValType
Left1=left(RightBit,1)
end
if DefnAsIs='Y' then
do
if ParmCount<>0 then
CryAndDie('You wanted "' || VariableName || '" subsituted ASIS but then specified parameters!')
end
else
do
if ParmCount<>0 then
VariableCont=ReplaceDefinitionsParameters()
else
do
if pos(StartsMacroParm,VariableCont)<>0 then
VariableCont=ReplaceDefinitionsParameters()
else
VariableCont=ReplaceString(VariableCont,HidesMacroParm,StartsMacroParm)
end
end
if DDCmdCount<>0 then
do
do ddIndex=1 to DDCmdCount
ThisDdCmd=DDCmd.ddIndex
select

when ThisDdCmd='$$DSQ' then
VariableCont=QuoteIt(VariableCont,TryQuoteListDs, 'Y')

when ThisDdCmd='$$SDQ' then
VariableCont=QuoteIt(VariableCont,TryQuoteListSd, 'Y')

when ThisDdCmd='$$AQ' then
VariableCont=QuoteIt(VariableCont, 'ANY', 'Y')

when ThisDdCmd='$$UPPER' then
VariableCont=ToUpperCase(VariableCont)

when ThisDdCmd='$$LOWER' then
VariableCont=ToLowerCase(VariableCont)

when ThisDdCmd='$$ADDCOMMA' then
VariableCont=AddCommasToDecimalNumber(VariableCont)

when ThisDdCmd='$$HTMLQ' then
VariableCont=ReplaceString(VariableCont, '"', '"')

when ThisDdCmd='$$SQX2' then
VariableCont=ReplaceString(VariableCont, "'" , "''")

when left(ThisDdCmd,8)="$$RXVAR:" then
VariableCont=_RxVar(ThisDdCmd,VariableCont)

when ThisDdCmd="$$RX'" then
VariableCont=_RXQuote(VariableCont, "'")

when ThisDdCmd='$$RX"' then
VariableCont=_RXQuote(VariableCont, '"')

when ThisDdCmd='$$SPCPLUS' then
do
if VariableCont\=='' then
VariableCont=' ' ||VariableCont
end

when ThisDdCmd='$$ISBLANK' then
do
if VariableCont='' then
VariableCont='Y'
else
VariableCont='N'
end

when ThisDdCmd='$$RXEXEC' then
do
RxExec=''
call ExecRexxCmd VariableCont, 'N'
VariableCont=RxExec
end

otherwise
do
UserRexx=CfgMacro("REXX_" || ThisDdCmd, '')
if UserRexx='' then
CryAndDie('The $$ replacement command of "' || ThisDdCmd || '" is unknown!')
TheMacro=""
TheName=VariableName
TheValue=VariableCont
call ExecRexxCmd UserRexx, 'N'
if OptionDebugOn='Y' then
do
if VariableCont=TheValue then
do
call DBGIND 1
call DebugOutputVariableInfo_FOUNDVARPARMS 'The user rexx code did not modify the "TheValue" variable'
call DBGIND-1
end
end
VariableCont=TheValue
end
end
end
end
if OptionDebugOn='Y' then
call DBGIND-2
RightBit=substr(RightBit,2)
LeftBit=LeftBit||VariableCont
ReplaceCount=ReplaceCount+1
if pos(MarksNewLine,LeftBit)<>0 then
leave
VarPos=pos(StartsMacroReplacement,RightBit)
end
MacroBeingExpanded=''
TheString=LeftBit||RightBit
return(TheString)

CfgMacro:
ac!M=arg(1)
if MacroExists(ac!M)='N' then
do
ac!V=arg(2)
ac!Wrd='not'
end
else
do
ac!V=GetDefineContents(ac!M)
ac!Wrd='was'
end
if OptionDebugOn='Y' then
call DBG_MACROVALORDEF 'Option(Macro) "' || ac!M || '" ' || ac!Wrd || ' found. Using ' ||DebugRightArrow||ac!V||DebugLeftArrow
return(ac!V)

CfgEnv:
bc!V=arg(1)
bc!Rc=GetEnv(bc!V)
if bc!Rc\=='' then
bc!C='was'
else
do
bc!Rc=arg(2)
bc!C='not'
end
if OptionDebugOn='Y' then
call DBG 'Option(Env) "' || bc!V || '" ' || bc!C || ' found. Using ' ||DebugRightArrow||bc!Rc||DebugLeftArrow
return(bc!Rc)

Define_28:
RexxTokens='|=+-/%*<>\,;:()&'
signal LineOut_29

GenerateOneLine:
if CondNlCount=0 then
call GenerateOneLineAsIs arg(1)
else
do
if OptionDebugOn='Y' then
call DBG 'Looking for Conditional newline codes'
BefCodeCount=ReplaceCount
Line2Gen=ReplaceString(arg(1), "{?WaNtNl?}",MarksNewLine)
if BefCodeCount<>ReplaceCount then
do
if OptionDebugOn='Y' then
call DBG 'Found ' ReplaceCount - BefCodeCount || ' conditional newline codes'
CondNlCount=CondNlCount-(ReplaceCount-BefCodeCount)
do until BefCodeCount=ReplaceCount
BefCodeCount=ReplaceCount
Line2Gen=ReplaceString(Line2Gen,MarksNewLine||MarksNewLine,MarksNewLine)
end
if Line2Gen\=='' then
do
if left(Line2Gen,1)=MarksNewLine then
Line2Gen=substr(Line2Gen,2)
if Line2Gen\=='' then
do
if right(Line2Gen,1)=MarksNewLine then
Line2Gen=left(Line2Gen,length(Line2Gen)-1)
end
end
end
do until Line2Gen==''
parse var Line2Gen This1 (MarksNewLine) Line2Gen
call GenerateOneLineAsIs This1
end
end
return

GenerateOneLineAsIs:
Line2Gen2=arg(1)
if CheckSpelling='Y';then
do
if AllowSpell='Y' & Line2Gen2 <> '' then
call SpellCheckOneLine Line2Gen2
end
if OptionFilterOut='' then
do
if HoldingOutput='N' then
call FileCharOut Line2Gen2||NewLineChars
else
HeldOutput=HeldOutput||Line2Gen2||NewLineChars
GeneratedLines=GeneratedLines+1
CurrentOutLine=CurrentOutLine+1
end
else
do
FilterRc=HtmlFilterOut("O",Line2Gen2,CurrentOutFile,CurrentOutLine,GeneratedLines,NewLineChars)
if Left(FilterRc,3)<> "OK:" then
CryAndDie(FilterRc)
else
do
NumWritten=substr(FilterRc,4)
GeneratedLines=GeneratedLines+NumWritten
CurrentOutLine=CurrentOutLine+NumWritten
end
end
return

OutputRexxLine:
RexxLine=arg(1)
if right(RexxLine,1)=';' then
RexxLine=left(RexxLine,length(RexxLine)-1)
if OptionPack='Y' & KeepIndent = 'N' then
do
if AllowPack='Y' then
RexxLine=CompressRexxLine(RexxLine)
else
do
if OptionDebugOn='Y' then
call DBG 'Not allowed to pack this line'
end
end
ElPos=pos(':',RexxLine)
if ElPos<>0 then
do
PossLabel=strip(left(RexxLine,ElPos-1))
if datatype(PossLabel, 'S')=1 then
call GenerateOneLine ''
end
if pos(NotEqualInC,RexxLine)<>0 then
call OutputInformationToScreen '"' || NotEqualInC || '" found.  Did you mean to use "<>" or "\="?'
call GenerateOneLine RexxLine
return

CompressRexxLine:
RexxLine=arg(1)
Spos=lastpos("'",RexxLine)
Dpos=lastpos('"',RexxLine)
EndPos=max(Spos,Dpos)
if EndPos=0 then
return(_CompressRexx(RexxLine))
else
do
Spos=pos("'",RexxLine)
Dpos=pos('"',RexxLine)
StartPos=min(Spos,Dpos)
if StartPos=0 then
StartPos=max(Spos,Dpos)
LeftBit=left(RexxLine,StartPos-1)
RightBit=substr(RexxLine,EndPos+1)
if right(LeftBit,1, "*") == ' ' then
LeftSpace=' '
else
LeftSpace=''
if left(RightBit,1, "*") == ' ' then
RightSpace=' '
else
RightSpace=''
LeftBit=_CompressRexx(LeftBit)
RightBit=_CompressRexx(RightBit)
if LeftSpace==' ' then
do
if right(LeftBit,1)='=' then
LeftSpace=''
end
LeftBit=_CompressRexx(LeftBit)
RightBit=_CompressRexx(RightBit)
return(LeftBit||LeftSpace||substr(RexxLine,StartPos,(EndPos-StartPos)+1)||RightSpace||RightBit)
end

_CompressRexx:
ToCompress=space(arg(1))
Compressed=''
TokenPos=verify(ToCompress,RexxTokens, 'M')
do while TokenPos<>0
Compressed=Compressed||strip(left(ToCompress,TokenPos-1), 'T')||substr(ToCompress,TokenPos,1)
ToCompress=strip(substr(ToCompress,TokenPos+1), 'L')
TokenPos=verify(ToCompress,RexxTokens, 'M')
end
return(Compressed||ToCompress)

LineOut_29:
call InitializeOneLine
signal OneLine_30

InitializeOneLine:
OneLineLevel=0
OneLineBuffer=''
OneLineGCount=0
return

InitializeOneLine4ThisLevel:
OneLineSeperator.OneLineLevel=''
OneLineStartLoc.OneLineLevel=''
OneLineStopper.OneLineLevel=''
OneLineNonPpwCnt.OneLineLevel=0
OneLineCount.OneLineLevel=0
return

AddToOneLine:
_OneLineBit=arg(1)
_Word1=word(_OneLineBit,1)
if translate(_Word1)=CmdHash1Line then
do
if OneLineBuffer\=='' then
do
OneLineBuffer=OneLineBuffer||OneLineSeperator.OneLineLevel
end
call ProcessOneLine subword(_OneLineBit,2),CmdHash1LineEnd
return('')
end
if strip(_OneLineBit)<>OneLineStopper.OneLineLevel then
do
OneLineCount.OneLineLevel=OneLineCount.OneLineLevel+1
OneLineGCount=OneLineGCount+1
if OneLineGCount=1 then
do
if translate(left(_Word1,length(CmdHashDefine)))=CmdHashDefine then
do
PpwCmdDivider2=MarksNewLineInHashDefine
OneLineBuffer=OneLineBuffer||_OneLineBit|| ' '
end
else
do
PpwCmdDivider2=MarksNewLine
OneLineNonPpwCnt.OneLineLevel=OneLineNonPpwCnt.OneLineLevel+1
OneLineBuffer=OneLineBuffer||_OneLineBit
end
end
else
do
if left(_Word1,HashPrefixLng)<>HashPrefix then
do
if OneLineNonPpwCnt.OneLineLevel=0 then
OneLineBuffer=OneLineBuffer||_OneLineBit
else
OneLineBuffer=OneLineBuffer||OneLineSeperator.OneLineLevel||_OneLineBit
OneLineNonPpwCnt.OneLineLevel=OneLineNonPpwCnt.OneLineLevel+1
end
else
do
parse var _OneLineBit _ppwCmd _ppwCmdParm
_OneLineBit=_ppwCmd|| ' ' ||strip(_ppwCmdParm)
OneLineBuffer=OneLineBuffer||PpwCmdDivider2||_OneLineBit||PpwCmdDivider2
end
end
return('')
end
if OptionDebugOn='Y' then
call DBG 'End of #( block - ' || OneLineCount.OneLineLevel || ' line(s)'
OneLineLevel=OneLineLevel-1
call StackPop "#( Nesting"
if OneLineLevel<>0 then
return('')
else
do
_OneLineBit=OneLineBuffer
call InitializeOneLine
return(_OneLineBit)
end

ProcessOneLine:
OneLineLevel=OneLineLevel+1
call StackPush "#( Nesting",,"PPWIZARD's #( command"
call InitializeOneLine4ThisLevel
OneLineStartLoc.OneLineLevel=CurrentSourceLocation()
Rest=PerformReplacementsInCmdsParameters(arg(1))
if Rest='' then
OneLineSeperator.OneLineLevel=' '
else
do
OneLineSeperator.OneLineLevel=GetQuotedText(Rest, "Rest")
end
if Rest<> '' then
OneLineStopper.OneLineLevel=GetQuotedText(Rest)
else
do
OneLineStopper.OneLineLevel=arg(2)
if OneLineStopper.OneLineLevel='' then
OneLineStopper.OneLineLevel=HashPrefix|| 'OneLineEnd'
end
if OptionDebugOn='Y' then
do
call DBG 'Line separator      = ' ||DebugRightArrow||OneLineSeperator.OneLineLevel||DebugLeftArrow
call DBG 'End of block marker = ' || DebugRightArrow || OneLineStopper.OneLineLevel   || DebugLeftArrow || ' (case sensitive!)'
end
return(0)

OneLine_30:
UserHashCmds=''
signal CMDNFND_31

LookForUnknownCmdHandler:
UserHashCmds=CfgMacro("UNKNOWN_HASH_COMMANDS", '')
return

ProcessUnknownHashCommand:
parse arg HashCmd,HashParms
CmdGenerates=''
call ExecRexxCmd UserHashCmds
if CmdGenerates\=='' then
do
do
if InLoop='Y' &LoopLinesFromFile=0 then
do
if IncludeLoopMemBufferNextLine=='' then
IncludeLoopMemBufferNextLine=CmdGenerates
else
IncludeLoopMemBufferNextLine=CmdGenerates||MarksNewLine||IncludeLoopMemBufferNextLine
end
else
do
if IncludeMemBufferNextLine=='' then
IncludeMemBufferNextLine=CmdGenerates
else
IncludeMemBufferNextLine=CmdGenerates||MarksNewLine||IncludeMemBufferNextLine
end
end
end
return(0)

CMDNFND_31:
OptChar='/'
CmdLineQL='"' || "'~`!#$%^=(["
CmdLineQR='"' || "'~`!#$%^=)]"
signal CmdLine_32

InitCommandLineOptions:
Bc02_148='N'
OptChar1='/'
OptChar2='-'
OptionsCmdLine=strip(arg(1))
OptionDebugOn='N'
OptionMaxCol=500
OptionPpwTraceAllowed='N'
DepDelPrev='N'
OptionBaseDirectory=''
InputMasksAllowed='Y'
OptionPrjExtn='DEF_*'
CgiOutputFile=''
OptionCgiModeOn='N'
ProcessingMode=''
OptionCloneUsed='N'
call BuildTitle "HTML"
call BuildTitle "OTHER"
call BuildTitle "REXX"
call BuildTitle "COPY"
OptionMsgReading="* Reading: {.}{F?}({F})"
OptionMsgMaking="- Making: {.}{R?}"
PpwOnOK=''
PpwOnERROR=''
if RexSystemOpSys="UNIX" then
OptionFileSR='NONE'
else
OptionFileSR='UNC'
OptionValidation=''
OptionValidationRc=''
OptionDependsOn=''
OptionWantInfoMsgs='Y'
OptionHashIncludeCnt=0
OptionIncludePathCnt=0
OptionTemplate=''
OptionQuietDependsOn='N'
OptionSummary='Y'
OptionPack='N'
OptionTranslateFileNames='N'
OptionFilterIn=''
OptionFilterOut=''
OptionDefineCount=0
OptionKeepRexxCmts='N'
OptionCompleteAddToToDepFile='Y'
OptionAtEndCommand=''
OptionAtEndCommandOkTest=''
HaveGeneratorTags='N'
OptionHtmlGeneratorTags=''
OptionNoDepFileOnWarnings='Y'
OptionHideCmdS=''
OptionHideCmdE=''
OptionHideCmdS_L=0
OptionHideCmdE_L=0
OptionForceRebuild='N'
OptionOutput=''
OptionOutputDefDir=''
OptionNoFiles=''
OptionCopyModeFuzz=0
Option0FilesPerMaskOk='N'
Option0FilesTotalOk='N'
Option0FilesTotalAfterExcludeOk='N'
OptionXSlash=''
OptionDeleteOnError='Y'
return

InitCommandLineOptions2:
call DBG 'Set up default extension Handlers'
call DBGIND 1
call DBG 'Set EXTN -> Processing mode and default output mask mappings'
call DBGIND 1
call ExtnInfoSet "*,it:PM=^LU:HTML^,OM=^LU:{$OutputDir}*.htm^,DM=^LU:^"
call ExtnInfoSet "v:PM=^LU:OTHER^,OM=^LU:{$OutputDir}*.vbs^,DM=^LU:^"
if RexSystemOpSys="OS/2" then
cc!XE="cmd"
else
cc!XE="rex"
call ExtnInfoSet "x:PM=^LU:REXX^,OM=^LU:{$OutputDir}*." || cc!XE || '^,DM=^LU:^'
call DBGIND-1
call DBG 'Set EXTN -> Output header mappings'
call DBGIND 1
cc!Line=copies('*+',30)
call StoreOutHeader "|VBS|'" || cc!Line || "|' |'" || cc!Line || "|"
call StoreOutHeader "|*REXX|/*" || cc!Line || "|* |" || cc!Line || "*/|"
call DBGIND-1
call DBG 'Set EXTN -> Syntax handlers'
call DBGIND 1
cc!R=PPWIZARD_REGINA_SYNTAX_CMD('N')
if cc!R='' then
call StoreSyntaxCheckCode4Header '|*REXX|*|'
else
call StoreSyntaxCheckCode4Header '|*REXX|' || cc!R || ' !CheckSyntax!|21924|' || PPWIZARD_REGINA_SYNTAX_LINE_MASK() || '|if arg(1)="!CheckSyntax!" then exit(21924)|'
call StoreSyntaxCheckCode4Header '|VBS|cscript.exe "{?}" //NOLOGO !CheckSyntax!|21924|({?}, |?:if Wscript.Arguments.Count = 1 then if Wscript.Arguments(0) = "!CheckSyntax!" then wscript.quit(21924)|'
call DBGIND-1
call DBGIND-1
return

PPWIZARD_REGINA_SYNTAX_CMD:
dc!TH=arg(1)
call DBG 'PPWIZARD_REGINA_SYNTAX_CMD(' || dc!TH || ')'
call DBGIND 1
dc!R=GetEnv("PPWIZARD_REGINA_SYNTAX_CMD")
if dc!R='' & dc!TH = 'Y' then
do
if RexWhich='REGINA' then
dc!R='regina'
else
do
if RexSystemOpSys="OS/2" then
do
dc!R=GetEnv("COMSPEC", "Y") || ' /C'
end
end
end
if dc!R<> '' then
do
dc!N='{?}'
if pos(dc!N,dc!R)=0 then
dc!R=dc!R|| ' "' || dc!N || '"'
end
call DBG 'Returning: ' ||dc!R
call DBGIND-1
return(dc!R)

PPWIZARD_REGINA_SYNTAX_LINE_MASK:
call DBG 'PPWIZARD_REGINA_SYNTAX_LINE_MASK()'
call DBGIND 1
ec!M=GetEnv("PPWIZARD_REGINA_SYNTAX_LINE_MASK")
if ec!M='' then
ec!M='line {?}: '
call DBG 'Returning: ' ||ec!M
call DBGIND-1
return(ec!M)

QuickCheckForDebugSwitch:
OptionsEnvironment=GetEnv('PPWIZARD_OPTIONS')
ec!LI=translate(OptionsEnvironment|| ' ' || OptionsCmdLine) || ' '
ec!P=pos(OptChar1|| 'DEBUG ',ec!LI)
if ec!P=0 then
ec!P=pos(OptChar2|| 'DEBUG ',ec!LI)
if ec!P<>0 then
do
OptionDebugOn='Y'
OptionWantInfoMsgs='Y'
OptionPpwTraceAllowed='Y'
call DebugStateChanged
end
return

ProcessCommandLine:
call SetUpPpwizardOptionDefaults
call InitializeCharCodes
PpwDoing='Starting to processing parameters (from command line + Environment)'
call DBG PpwDoing
InputMaskCount=0
DebugSwitchUsed='N'
OptionWantCopyright='Y'
CmdLineTotal=''
PpwClDep=''
call ProcessCommandLineBit "environment",OptionsEnvironment
PpwDefaultProject=FindProjectFile('ppwizard')
if PpwDefaultProject<> '' then
call ProcessCommandLineBit PpwDefaultProject,OptChar|| 'LIST:' || ReplaceString(PpwDefaultProject, ' ', '{x20}')
call ProcessCommandLineBit "command line",OptionsCmdLine
call DBG 'Finished Processing : ' ||CmdLineTotal
PpwDoing=''
return

AddToSwitchList:
fc!ForDep=arg(1)
fc!ThisParm=ReplaceString(ThisParm, ' ', '{x20}')
if CmdLineTotal='' then
CmdLineTotal=fc!ThisParm
else
CmdLineTotal=CmdLineTotal|| ' ' ||fc!ThisParm
if fc!ForDep='Y' then
do
if PpwClDep='' then
PpwClDep=fc!ThisParm
else
PpwClDep=PpwClDep|| ' ' ||fc!ThisParm
end
return

ProcessCommandLineBit:
parse arg gc!What,gc!CmdLine
call DBGIND 1
call DBG 'Processing switches - ' ||gc!What
call DBGIND 1
do while gc!CmdLine<> ''
gc!CmdLine=strip(gc!CmdLine)
gc!QPos=pos(left(gc!CmdLine,1),CmdLineQL)
if gc!QPos<>0 then
do
gc!SQ=substr(CmdLineQL,gc!QPos,1)
gc!EQ=substr(CmdLineQR,gc!QPos,1)
call DBG 'Item quoted. Left Quote = ' || gc!SQ || ', Looking for end quote of ' ||gc!EQ
gc!Start=gc!CmdLine
gc!CmdLine=substr(gc!CmdLine,2)
gc!QPos=pos(gc!EQ,gc!CmdLine)
if gc!QPos=0 then
UserSyntaxError('Could not find the ending quote of ' || gc!EQ || ' at ==> ' ||gc!Start)
ThisParm=left(gc!CmdLine,gc!QPos-1)
gc!CmdLine=substr(gc!CmdLine,gc!QPos+1)
if gc!CmdLine<> '' then
do
if left(gc!CmdLine,1)\==' ' then
UserSyntaxError('Invalid quoted parameter (space must follow quoted item) at ==> ' ||gc!Start)
end
end
else
do
parse var gc!CmdLine ThisParm gc!CmdLine
end
ParmType=left(ThisParm,1)
select
when ParmType=OptChar1|ParmType=OptChar2 then
do
ThisParmT='Switch'
OptChar=ParmType
end
when ParmType='@' then
ThisParmT='Project'
when ParmType=';' then
ThisParmT='Commented out'
otherwise
do
ThisParmT='FileMask'
ParmType=''
end
end
call DBG ThisParmT|| ' <- "' || ThisParm || '"'
if ParmType=';' then
iterate
call DBGIND 1
ThisParm=ReplaceCurlyHexCodes(ThisParm)
PpwDoing='Processing command line: ' ||ThisParm
if ParmType='@' then
do
PrjFile=substr(ThisParm,2)
PrjFileF=FindProjectFile(PrjFile)
if PrjFileF='' then
CryAndDie('The specified project "' || PrjFile || '" does not exist')
ThisParm=OptChar|| 'LIST:' || ReplaceString(PrjFileF, ' ', '{x20}')
gc!CmdLine=ThisParm|| ' ' ||gc!CmdLine
call DBGIND-1
iterate
end
if ParmType='' then
do
if InputMasksAllowed='N' then
CryAndDie('Sorry but no more input masks can be accepted', 'Input mask "' || ThisParm || '" specified in:', '    ' ||gc!What)
call AddToSwitchList 'N'
gc!FM=MakeAbsolute(ThisParm)
gc!FF='?' ||RexDirChar
if left(gc!FM,2)=gc!FF then
do
gc!Find=substr(gc!FM,3)
gc!FM=FindFile(gc!Find, '!')
end
gc!Marker='{ENDBASE}'
if pos(gc!Marker,gc!FM)<>0 then
do
parse var gc!FM gc!BD (gc!Marker) gc!FM
gc!FM=gc!BD||gc!FM
call DBG 'Without base dir marker = "' || gc!FM || '"'
if left(gc!BD,1)='+' then
gc!BD=substr(gc!BD,2)
end
else
do
if OptionBaseDirectory<> '' then
do
gc!BD=OptionBaseDirectory
end
else
do
if left(gc!FM,1)='+' then
gc!BD=substr(gc!FM,2)
else
gc!BD=gc!FM
gc!BD=_filespec('Location',gc!BD)
end
end
call ValidateBaseDirUse gc!BD,gc!FM, 'Y'
gc!PM=ProcessingMode
gc!OM=OptionOutput
gc!DM=OptionDependsOn
InputMaskCount=InputMaskCount+1
InputMaskBDir.InputMaskCount=gc!BD
InputMaskPMode.InputMaskCount=gc!PM
InputMaskOutMask.InputMaskCount=gc!OM
InputMaskDepMask.InputMaskCount=gc!DM
InputMaskCpyFuzz.InputMaskCount=OptionCopyModeFuzz
InputMask0FilesOk.InputMaskCount=Option0FilesPerMaskOk
gc!U="<Unknown at this time>"
if gc!PM='' then
gc!PM=gc!U
if gc!OM='' then
gc!OM=gc!U
if gc!DM='' then
gc!DM=gc!U
call DBG 'Base Directory  = "' || gc!BD || '"'
call DBG 'Processing Mode = "' || gc!PM || '"'
call DBG 'Output Mask     = "' || gc!OM || '"'
call DBG 'Depends On Mask = "' || gc!DM || '"'
call DBG '0 Files OK      = ' ||Option0FilesPerMaskOk
call DBG 'Copy Fuzz (sec) = ' ||OptionCopyModeFuzz
InputMask.InputMaskCount=gc!FM
call DBGIND-1
iterate
end
ParmPos=verify(ThisParm, ':=', 'M')
if ParmPos=0 then
do
ThisCmd=ThisParm
ThisCmdOptions=''
end
else
do
ThisCmd=left(ThisParm,ParmPos-1)
ThisCmdOptions=substr(ThisParm,ParmPos+1)
end
ThisCmd=translate(substr(ThisCmd,2))
RecordSwitch='Y'
IsDepSwitch='Y'
select
when ThisCmd='PACK' then
OptionPack=SwitchWantsYesOrNo(ThisCmd,ThisCmdOptions, 'Y')
when ThisCmd='DELETEPREV' then
DepDelPrev=SwitchWantsYesOrNo(ThisCmd,ThisCmdOptions, 'Y')
when ThisCmd='CRLF' then
do
if SwitchWantsYesOrNo(ThisCmd,ThisCmdOptions, 'Y') = 'Y' then
NewLineChars=CrLf
else
NewLineChars=MarksNewLine
end
when ThisCmd='CLONE' then
do
if InputMaskCount<>0 then
UserSyntaxError('Clone must be specified before any file masks!')
OptionCloneUsed='Y'
gc!CmdLine='/COPY:' || ThisCmdOptions || ' /CopyRight:N ' ||gc!CmdLine
OptionSummary='N'
end
when ThisCmd='COPY' then
do
if ThisCmdOptions<> '' then
do
OptionCopyModeFuzz=ThisCmdOptions
if datatype(OptionCopyModeFuzz, 'W')=0 then
UserSyntaxError('Invalid /Copy:Fuzz value of "' || OptionCopyModeFuzz || '" supplied!')
end
call PModeSwitch ThisCmd
end
when ThisCmd='OTHER' then
call PModeSwitch ThisCmd,ThisCmdOptions
when ThisCmd='HTML' then
call PModeSwitch ThisCmd,ThisCmdOptions
when ThisCmd='REXX' then
call PModeSwitch ThisCmd,ThisCmdOptions
when ThisCmd='NOFILES' then
OptionNoFiles=ThisCmdOptions
when ThisCmd='OUTPUT' then
do
gc!V=ThisCmdOptions
if right(gc!V,1)=RexDirChar then
do
OptionOutputDefDir=gc!V
call DBG "Setting default output directory"
end
else
do
call DBG "Setting processing mode"
OptionOutput=gc!V
end
end
when ThisCmd='DEPENDSON' then
do
OptionDependsOn=SwitchMustHaveOptions(ThisCmd,ThisCmdOptions)
if left(OptionDependsOn,1)<> '-' then
OptionQuietDependsOn='N'
else
do
OptionQuietDependsOn='Y'
OptionDependsOn=substr(OptionDependsOn,2)
end
end
when ThisCmd='DEPENDSONCOMPLETE' then
OptionCompleteAddToToDepFile=SwitchWantsYesOrNo(ThisCmd,ThisCmdOptions, 'Y')
when ThisCmd='0OK' then
do
if ThisCmdOptions='' then
ThisCmdOptions='YES,YES,YES'
parse var ThisCmdOptions gc!P1 ',' gc!P2 ',' gc!P3
if gc!P1<> '' then
Option0FilesPerMaskOk=SwitchWantsYesOrNo(ThisCmd,gc!P1, 'Y')
if gc!P2<> '' then
Option0FilesTotalOk=SwitchWantsYesOrNo(ThisCmd,gc!P2, 'Y')
if gc!P3<> '' then
Option0FilesTotalAfterExcludeOk=SwitchWantsYesOrNo(ThisCmd,gc!P3, 'Y')
end
when ThisCmd='TEMPLATE' then
OptionTemplate=SwitchMustHaveOptions(ThisCmd,ThisCmdOptions)
when ThisCmd='COLOR' | ThisCmd = 'COLOUR' then
call ColorAllow SwitchWantsYesOrNo(ThisCmd,ThisCmdOptions, 'Y')
when ThisCmd='COLORCFG' then
do
gc!O=SwitchMustHaveOptions(ThisCmd,ThisCmdOptions)
parse var gc!O gc!Var '=' gc!Val
if gc!Val='' then
CryAndDie('Incorrectly formatted color configuration of "' || gc!O || '"')
call ColorCfg gc!Var,gc!Val
end
when ThisCmd='BEEP' then
call BeepsAllow SwitchWantsYesOrNo(ThisCmd,ThisCmdOptions, 'Y')
when ThisCmd='BC' then
do
gc!P=translate(SwitchMustHaveOptions(ThisCmd,ThisCmdOptions))
parse var gc!P gc!F '=' gc!V
gc!FV='BC' || ReplaceString(gc!F, '.', '_')
if gc!V<> 'N' & gc!V <> 'Y' then
CryAndDie('Expected "Y" or "N" for ' || gc!FV || ' flag')
if symbol(gc!FV)<> 'VAR' then
CryAndDie('Invalid backwards compat flag of ' ||gc!FV)
call value gc!FV,gc!V
end
when ThisCmd='WARNINGSRC' then
do
if ThisCmdOptions='' then
WantedWarningRc=1
else
do
WantedWarningRc=GetQuotedText(ThisCmdOptions)
if datatype(WantedWarningRc, 'W')=0 then
CryAndDie('Invalid warning return code of "' || WantedWarningRc || '" supplied!')
end
end
when ThisCmd='OUTHEADER' then
call StoreOutHeader GetQuotedText(ThisCmdOptions)
when ThisCmd='SYNTAX' then
call StoreSyntaxCheckCode4Header GetQuotedText(ThisCmdOptions)
when ThisCmd='EXTNINFO' then
call ExtnInfoSet ThisCmdOptions
when ThisCmd='FILENAMES' then
do
call SwitchMustHaveOptions ThisCmd,ThisCmdOptions
OptionTranslateFileNames=translate(strip(ThisCmdOptions))
if OptionTranslateFileNames<> "LOWER" & OptionTranslateFileNames <> "UPPER" then
UserSyntaxError('Expected "UPPER" or "LOWER" on the "' || TheCmd || '" command, not "' || ThisCmdOptions || '"!')
end
when ThisCmd='DEFINE' then
do
call SwitchMustHaveOptions ThisCmd,ThisCmdOptions
parse var ThisCmdOptions DefineVar'='DefineContents
OptionDefineCount=OptionDefineCount+1
OptionDefine.OptionDefineCount.Var=DefineVar
OptionDefine.OptionDefineCount.Cont=strip(DefineContents)
end
when ThisCmd='OPTION' then
do
call SwitchMustHaveOptions ThisCmd,ThisCmdOptions
call ProcessOption ThisCmdOptions
end
when ThisCmd='REQUIRE' then
do
gc!P=SwitchMustHaveOptions(ThisCmd,ThisCmdOptions)
call ProcessRequireCommon translate(gc!P, ' ', ',')
end
when ThisCmd='FILTERINPUT' then
do
call NotAvailableUnderNtYet ThisCmd
OptionFilterIn=SwitchMustHaveOptions(ThisCmd,ThisCmdOptions)
call DoMacroSpaceOperation "ADD", OptionFilterIn, "HtmlFilterIn"
end
when ThisCmd='FILTEROUTPUT' then
do
call NotAvailableUnderNtYet ThisCmd
OptionFilterOut=SwitchMustHaveOptions(ThisCmd,ThisCmdOptions)
call DoMacroSpaceOperation "ADD", OptionFilterOut, "HtmlFilterOut"
end
when ThisCmd='SPELLSHOWALL' then
SpellShowEachError=SwitchWantsYesOrNo(ThisCmd,ThisCmdOptions, 'Y')
when ThisCmd='SPELLCHECK' then
do
call SwitchMustHaveOptions ThisCmd,ThisCmdOptions
call LoadSpellingDictionary ThisCmdOptions
end
when ThisCmd='SPELLADDWORD' then
do
call SwitchMustHaveOptions ThisCmd,ThisCmdOptions
SpellingAddFile=ThisCmdOptions
if left(SpellingAddFile,1)<> '-' then
SpellingPrompts='Y'
else
do
SpellingPrompts='OK'
SpellingAddFile=substr(SpellingAddFile,2)
end
end
when ThisCmd='**/' then
OptionKeepRexxCmts=SwitchWantsYesOrNo(ThisCmd,ThisCmdOptions, 'Y')
when ThisCmd='INFO' then
OptionWantInfoMsgs=SwitchWantsYesOrNo(ThisCmd,ThisCmdOptions, 'Y')
when ThisCmd='#INCLUDE' | ThisCmd = 'INCLUDE' then
do
if ThisCmdOptions='' then
OptionHashIncludeCnt=0
else
do
OptionHashIncludeCnt=OptionHashIncludeCnt+1
OptionHashInclude.OptionHashIncludeCnt=ThisCmdOptions
end
call DBG OptionHashIncludeCnt|| ' /#Include items stored'
end
when ThisCmd='BASEDIR' then
do
OptionBaseDirectory=MakeAbsolute(ThisCmdOptions)
call DBG "BASEDIR: " ||OptionBaseDirectory
end
when ThisCmd='INCLUDEPATH' then
do
call IncludePath ThisCmdOptions
end
when ThisCmd='CGI' then
call TurnCgiModeOn ThisCmdOptions
when ThisCmd='HTMLGENERATOR' then
do
HaveGeneratorTags='Y'
OptionHtmlGeneratorTags=ThisCmdOptions
end
when ThisCmd='EXCLUDE' then
do
IsDepSwitch='N'
call SwitchMustHaveOptions ThisCmd,ThisCmdOptions
ExcludeList.0=0
TmpMask=ThisCmdOptions
call DBG 'Looking for files matching "' || TmpMask || '"'
if left(TmpMask,1)<> '+' then
FollowDirs='N'
else
do
FollowDirs='Y'
TmpMask=substr(TmpMask,2)
end
call Files4Mask TmpMask, 'ExcludeList',FollowDirs
call DBGIND 1
call DBG 'Found ' || ExcludeList.0 || ' files(s) to exclude'
call DBGIND 1
do InputIndex=1 to ExcludeList.0
TheFile=ExcludeList.InputIndex
call DBG TheFile
call _valueS "_EXCLUDE_._EXF_" || c2x(TheFile), 'you used "' || OptChar || ThisCmd || ':' || ThisCmdOptions || '"'
end
call DBGIND-2
end
when ThisCmd='INC2CACHE' then
IncludeIntoMemory=SwitchWantsYesOrNo(ThisCmd,ThisCmdOptions, 'Y')
when ThisCmd='PPWTRACE' then
OptionPpwTraceAllowed=SwitchWantsYesOrNo(ThisCmd,ThisCmdOptions, 'Y')
when ThisCmd='DEBUGTIME' then
OptionDebugTime=ThisCmdOptions
when ThisCmd='DEBUGCHARS' then
call SetDebugChars ThisCmdOptions
when ThisCmd='HOOK' then
call RexxHookSet ThisCmd,ThisCmdOptions
when ThisCmd='REGSYNTAX' then
do
if RexWhich='REGINA' then
call DBG "/RegSyntax has no effect under Regina!"
NameOfOs2ReginaRexxInterpreter=ThisCmdOptions
end
when ThisCmd='REDIRMETHOD' then
RedirMethod=ThisCmdOptions
when ThisCmd='DEBUG' then
do
call BeepsAllow 'N'
call ColorAllow 'N'
call SwitchMustNotHaveOptions ThisCmd,ThisCmdOptions
DebugSwitchUsed='Y'
OptionDebugOn='Y'
OptionWantInfoMsgs='Y'
OptionPpwTraceAllowed='Y'
call DebugStateChanged
end
when ThisCmd='COPYRIGHT' then
OptionWantCopyright=SwitchWantsYesOrNo(ThisCmd,ThisCmdOptions, 'Y')
when ThisCmd='XSLASH' then
do
YesOrNo=SwitchWantsYesOrNo(ThisCmd,ThisCmdOptions, 'Y')
if YesOrNo='N' then
OptionXSlash=''
else
OptionXSlash=' /'
end
when ThisCmd='GETENV' then
do
FromEnv=GetEnv(ThisCmdOptions)
if FromEnv='' then
CryAndDie('The environment variable "' || ThisCmdOptions || '" does not exist.')
call DBG 'Contained: ' ||FromEnv
gc!CmdLine=FromEnv|| ' ' ||gc!CmdLine
end
when ThisCmd='INPUT' then
gc!CmdLine='"' || SwitchMustHaveOptions(ThisCmd, ThisCmdOptions) || '" ' ||gc!CmdLine
when ThisCmd='LIST' then
do
RecordSwitch='N'
ListFile=FileQueryExists(ThisCmdOptions)
if ListFile='' then
CryAndDie('The list file "' || ThisCmdOptions || '" does not exist')
call DBG 'Processing: "' || ListFile || '"'
call DBGIND 1
call FileClose ListFile, 'N'
LCmt=';' || ';'
LineNum=0
SpecList=''
do while lines(ListFile)<>0
OneSpec=linein(ListFile)
if ExtraWhiteSpace=='' then
OneSpec=strip(OneSpec)
else
OneSpec=strip(translate(OneSpec, '', ExtraWhiteSpace, ' '))
CmtPos=lastpos(LCmt,OneSpec)
LineNum=LineNum+1
if CmtPos<>0 then
OneSpec=strip(left(OneSpec,CmtPos-1), 'T')
if OneSpec='' | left(OneSpec, 1) = ';' then
iterate
OneSpec=ReplaceString(OneSpec, ' ', '{' || 'x20}')
call DBG 'Line #' || LineNum || ': ' ||OneSpec
SpecList=SpecList|| ' ' ||OneSpec
end
call DBGIND-1
gc!CmdLine=strip(SpecList)|| ' ' ||gc!CmdLine
call FileClose ListFile
end
when ThisCmd='DEPENDSONWARNINGS' then
OptionNoDepFileOnWarnings=SwitchWantsYesOrNo(ThisCmd,ThisCmdOptions, 'Y')
when ThisCmd='@EXTN' then
OptionPrjExtn=ThisCmdOptions
when ThisCmd='CONSOLEFILE' then
call UserIsSpecifyingConsoleFileName ThisCmdOptions
when ThisCmd='ERRORFILE' then
call UserIsSpecifyingErrorFileName ThisCmdOptions
when ThisCmd='DEBUGCOLS' then
do
TheValue=SwitchMustHaveOptions(ThisCmd,ThisCmdOptions)
OptValid='N'
if datatype(TheValue, 'W')=1 then
do
if TheValue>=0 then
OptValid='Y'
end
if OptValid='N' then
UserSyntaxError('Invalid /DebugCols value of "' || TheValue || '" supplied!')
OptionMaxCol=TheValue
end
when ThisCmd='DROPFILES' then
do
call DBG 'Dropping all stored input file masks'
InputMaskCount=0
call SwitchMustNotHaveOptions ThisCmd,ThisCmdOptions
end
when ThisCmd='ONOK' then
PpwOnOK=ThisCmdOptions
when ThisCmd='ONERROR' then
do
PpwOnERROR=ThisCmdOptions
if SleepSwitch='N' then
OnExitSleepForError=0
end
when ThisCmd='HIDECMD' then
do
if translate(ThisCmdOptions)='HTML[]' then
ThisCmdOptions='<!--[{?}]-->'
parse var ThisCmdOptions OptionHideCmdS '{?}' OptionHideCmdE
OptionHideCmdS_L=length(OptionHideCmdS)
OptionHideCmdE_L=length(OptionHideCmdE)
if OptionHideCmdS_L=0|OptionHideCmdE_L=0 then
CryAndDie('Your hide template must include "{?}" to indicate where the', 'command would be and must not start or end the template')
end
when ThisCmd='EXEC' then
do
call SplitOffRcTest
call RunExecOrValidateCmd ThisCmd,ExecRcTest,ExecCmd
end
when ThisCmd='VALIDATE' then
do
call SplitOffRcTest
OptionValidationRc=ExecRcTest
OptionValidation=ExecCmd
end
when ThisCmd='SLEEP' then
do
SleepSwitch='Y'
call SwitchMustHaveOptions ThisCmd,ThisCmdOptions
parse var ThisCmdOptions OnExitSleepForOK ',' OnExitSleepForError
if OnExitSleepForError='' then
OnExitSleepForError=2
end
when ThisCmd='DELETEONERROR' then
OptionDeleteOnError=SwitchWantsYesOrNo(ThisCmd,ThisCmdOptions, 'Y')
when ThisCmd='BUILDTITLE' then
do
call SwitchMustHaveOptions ThisCmd,ThisCmdOptions
parse var ThisCmdOptions '/' gc!M '/' gc!T
call BuildTitle gc!M,gc!T
end
when ThisCmd='READING' then
OptionMsgReading=ThisCmdOptions
when ThisCmd='MAKING' then
OptionMsgMaking=ThisCmdOptions
when ThisCmd='FORCEREBUILD' then
do
OptionForceRebuild=SwitchWantsYesOrNo(ThisCmd,ThisCmdOptions, 'Y')
IsDepSwitch='N'
end
when ThisCmd='FILESR' then
OptionFileSR=SwitchMustHaveOptions(ThisCmd,ThisCmdOptions)
when ThisCmd='1' then
do
call DBG 'Rest of command line is one parameter, quoting => ' ||gc!CmdLine
gc!CmdLine='"' || gc!CmdLine || '"'
end
when ThisCmd='CONSOLE' then
call ConsoleWriteAllowed SwitchWantsYesOrNo(ThisCmd,ThisCmdOptions, 'Y')
when ThisCmd='?' then
UserSyntaxError('?')
otherwise
UserSyntaxError('Unknown switch of "' || OptChar || ThisCmd || '" specified')
end
call DBGIND-1
if RecordSwitch='Y' then
call AddToSwitchList IsDepSwitch
end
call DBGIND-3
return

UserSyntaxError:
call AllFollowingOutputGoesToErrorFile
call CgiStartFatalError
call DisplayCopyright
if arg(1)='?' then
Title='SYNTAX'
else
do
call ColorSet 'ERROR'
call Line1 "SYNTAX ERROR"
call Line1 "~~~~~~~~~~~~"
call Line1 '    ' ||arg(1)
Title='CORRECT SYNTAX'
end
call CgiEndFatalError
call Line1 ''
call Line1 Title
call Line1 copies('~',length(Title))
call Line1 '    ' || WizName || ' [-Switch1] [[+]InputMask1] [/Switch2] [@Project] ...'
call Line1 ''
call Line1 'SOME COMMON SWITCHES'
call Line1 '~~~~~~~~~~~~~~~~~~~~'
call Line1 '-Copy  -Html  -Other  -Rexx  (processing modes)'
call Line1 '-Output:?out\*.html  -DependsOn:-?out\*.*.dep  /DependsOnComplete:y|n'
call Line1 '/DeletePrev:y|n  '  || '/DeleteOnError:y|n  /ConsoleFile:file  /ErrorFile:file'
call Line1 '/Define:Macro=Value  '  || '/#Include:file  /Template:file  /Exclude:*.TMP'
call Line1 '/HideCmd:HowSpec (hide PPWIZARD stuff from GUI editors etc)'
call Line1 '/CrLf:y|n  /Color:y|n  /List:file (command line)'
call Line1 '/Debug  /DebugCols:MaxCols'
call Line1 ''
call Line1 'Note that switches can start with "-" or "/", in the above I used "-" to mark'
call Line1 'switches which affect the following input masks and so are more position'
call Line1 'sensitive than most other switches (which generally work more globally).'
call Line1 ''
call Line1 "For more details (and more switches) please see PPWIZARD's documentation at:"
call Line1 '    http://www.labyrinth.net.au/~dbareis/ppwizard.htm'
call ColorSet
call Beeps 2
if arg(1)<> '?' then
AbnormalExit(MyLineNumber(), "Invalid Command Line - " ||arg(1))
else
do
parse version ThisRexxVer
call Line1 ''
call Line1 'ENVIRONMENTAL INFORMATION'
call Line1 '~~~~~~~~~~~~~~~~~~~~~~~~~'
call Line1 'Rexx Version  : ' ||ThisRexxVer
call Line1 'Operating Syst: ' ||DebugGetOpSysText()
call Line1 'PPWIZARD      : ' ||PgmVersion
call Line1 '              : "' || PpWizardPgmName || '"'
AbnormalExit(MyLineNumber(), "User just wanted version number information")
end

SwitchMustHaveOptions:
parse arg TheCmd,TheOptions
if TheOptions='' then
UserSyntaxError('You must supply parameters on the "' || OptChar || TheCmd || '" switch!')
return(TheOptions)

SwitchMustNotHaveOptions:
parse arg TheCmd,TheOptions,Value2Set
if TheOptions<> '' then
UserSyntaxError('No parameters are expected for the "' || OptChar || TheCmd || '" switch!')
return(Value2Set)

SwitchOptionsValidateAgainstList:
TheCmd=arg(1)
TheOption=translate(arg(2))
ValidList=',' || translate(arg(3)) || ','
if pos(',' || TheOption || ',',ValidList)<>0 then
return(TheOption)
UserSyntaxError('An invalid parameter of "' || TheOption || '" was specified on the "' || OptChar || TheCmd || '" switch!')

SwitchWantsYesOrNo:
TheCmd=arg(1)
TheOption=translate(arg(2))
Default=arg(3)
if TheOption='' then
return(Default)
else
return(left(SwitchOptionsValidateAgainstList(TheCmd,TheOption, "Y,N,YES,NO"),1))

NotAvailableUnderNtYet:
TheCmd=arg(1)
if RexWhich='REGINA' then
UserSyntaxError('"' || OptChar || TheCmd || '" can not be performed under Windows (or regina).... Yet...')
return

FindProjectFile:
hc!PrjFile=arg(1)
if pos('.',hc!PrjFile)=0 then
hc!PrjFile=hc!PrjFile|| '.ppw'
if OptionDebugOn='Y' then
do
call DBGIND 1
call DBG 'Looking for the project file "' || hc!PrjFile || '"'
call DBGIND 1
end
hc!Full=FindFile(hc!PrjFile)
if OptionDebugOn='Y' then
do
call DBGIND 1
if hc!Full='' then
call DBG 'Project file not found.'
else
call DBG 'Found project file "' || hc!Full || '"'
call DBGIND-3
end
return(hc!Full)

SplitOffRcTest:
call SwitchMustHaveOptions ThisCmd,ThisCmdOptions
if left(ThisCmdOptions,1)='{' then
parse var ThisCmdOptions '{' ExecRcTest '}' ExecCmd
else
do
ExecCmd=ThisCmdOptions
ExecRcTest=''
end
return

RunExecOrValidateCmd:
parse arg ic!Switch,ic!CmdRc,ic!Cmd
if OptionDebugOn='Y' then
call DBG 'Performing ' || OptChar || ic!Switch || ' command'
ic!Exec=ReplaceString(ic!Cmd, "{?}",CurrentOutFile)
if left(ic!Exec,1)<> '!' then
ic!Redirect='Y'
else
do
ic!Redirect='N'
ic!Exec=substr(ic!Exec,2)
end
if ic!Redirect='N' then
do
call AddressCmd ic!Exec
CmdRc=Rc
end
else
do
TmpFile=RexGetTmpFileName()
call AddressCmd ic!Exec||RedirectStdOutAndErr2(TmpFile),TmpFile
CmdRc=Rc
call _SysFileDelete TmpFile
end
if ic!CmdRc<> '' then
do
call DBGIND 1
ic!ExecOk=0
ic!ExecThis='ic!ExecOk = ' || '(' || ic!CmdRc || ')'
if ProcessedCmdLine='Y' then
call ExecRexxCmd ic!ExecThis
else
do
call DBG 'Interpreting: ' ||ic!ExecThis
interpret ic!ExecThis
end
call DBGIND-1
if\ic!ExecOk then
CryAndDie('User command failed (CmdRc was ' || CmdRc || '):', '     ' || ic!Exec, 'Test was:', '     ' ||ic!CmdRc)
end
return

MakeAbsolute:
jc!Path=arg(1)
if left(jc!Path,1)<> '+' then
jc!Plus=''
else
do
jc!Path=substr(jc!Path,2)
jc!Plus='+'
end
jc!File=jc!Path
if left(jc!File,1)='.' |pos(RexDirChar,jc!File)=0 then
do
DotSlash='.' ||RexDirChar
DotDotSlash='.' ||DotSlash
maDir=GetCurrentDirectory()
if OptionDebugOn='Y' then
do
call DBG 'Converting relative "' || jc!File || '"'
call DBGIND 1
end
if pos(RexDirChar,jc!File)<>0 then
do
do forever
select
when left(jc!File,2)==DotSlash then
do
jc!File=substr(jc!File,3)
end
when left(jc!File,3)==DotDotSlash then
do
LastChar=right(maDir,1)
SlashPos=lastpos(RexDirChar,maDir)
if SlashPos=0|LastChar=RexDirChar|LastChar=':' then
CryAndDie('The spec "' || jc!Path || '" can not be converted to absolute', 'from the current directory "' || GetCurrentDirectory() || '"')
maDir=left(maDir,SlashPos-1)
jc!File=substr(jc!File,4)
end
otherwise
leave
end
end
end
if right(maDir,1)=RexDirChar then
jc!File=maDir||jc!File
else
jc!File=maDir||RexDirChar||jc!File
if OptionDebugOn='Y' then
do
call DBG 'To Absolute "' || jc!File || '"'
call DBGIND-1
end
end
return(jc!Plus||jc!File)

ValidateBaseDirUse:
parse arg kc!BD,kc!FM,kc!MayHavePlus
call DBG 'Validating base directory "' || kc!BD || '" against "' || kc!FM || '"'
if kc!MayHavePlus='Y' then
do
if left(kc!FM,1)='+' then
kc!FM=substr(kc!FM,2)
end
if right(kc!BD,1)<>RexDirChar then
CryAndDie('The base directory "' || kc!Bd || '" does not end with a "' || RexDirChar || '"!')
if RexSystemOpSys="UNIX" then
do
kc!BdU=kc!BD
kc!FmU=kc!FM
end
else
do
kc!BdU=translate(kc!BD)
kc!FmU=translate(kc!FM)
end
if kc!BdU\==left(kc!FmU,length(kc!BdU))then
CryAndDie('The file mask       "' || kc!FmU ||  '"', 'does not begin with "' || kc!BdU || '"')
return

ValidatePMode:
lc!PM=translate(arg(1))
if pos('|' || lc!PM || '|', '|HTML|REXX|OTHER|COPY|')=0 then
CryAndDie('Invalid processing mode of "' || lc!PM || '"')
return(lc!PM)

PModeSwitch:
parse arg mc!PM,mc!Prm
call SwitchMustNotHaveOptions mc!PM,mc!Prm
ProcessingMode=ValidatePMode(translate(mc!PM))
if OptionCloneUsed='Y' then
do
if ProcessingMode<> 'COPY' then
UserSyntaxError('Invalid mode of ' ||ProcessingMode)
end
return

BuildTitle:
parse arg nc!M,nc!T
if nc!T='' then
do
if translate(nc!M)='COPY' then
nc!T='Copying: "{IS}" -> "{OL}"'
else
nc!T='Making ({PM}) - {OL}'
end
call value 'PPWBLDTITLE_' ||nc!M,nc!T
call DBG '/Making Text for ' || nc!M || ' mode is: ' ||nc!T
return

CmdLine_32:
DependsOnFmtVer="FORMAT 00.157"
call ClearCollectedDependancyInfo
call ClearDependancyTimeStampCache
signal DEPENDON_33

NeedToRemake:
DepFile4=arg(1)
if OptionDependsOn='' then
do
call DBG 'No dependancy checking enabled - Need to make'
DepFileName=''
return("Y")
end
DepFileName=GenerateFileName(DepFile4,OptionDependsOn)
if _NeedToRemakeCheckDependencies()='N' then
do
if OptionQuietDependsOn='N' then
call Line1 ''
return('N')
end
if DepDelPrev='Y' then
do
call DBG 'Delete all output dependancy files (made last build)'
call DBGIND 1
call FileOpenReadOnly DepFileName
do while lines(DepFileName)<>0
oc!Line=linein(DepFileName)
if oc!Line='' then
iterate
parse var oc!Line oc!Type oc!Line
if oc!Type='output' then
do
oc!LastTime=GetQuotedText(oc!Line, "oc!Line")
call MustDeleteFile oc!LastTime
end
end
call FileClose DepFileName
call DBGIND-1
end
call MustDeleteFile DepFileName
return('Y')

ClearCollectedDependancyInfo:
DepTmp.0=0
DepIn.0=0
DepOut.0=0
return

ClearDependancyTimeStampCache:
TimeStampCount=0
return

GetFileDateTimeButDontWarnOnError:
tsFile=arg(1)
if FileQueryExists(tsFile)=='' then
Ts=-1
else
Ts=GetFileTimeStamp(tsFile)
return(Ts)

_ShowDependancyCheckProgress:
if OptionQuietDependsOn='N' then
call Line1 '  ?> ' ||arg(1)
else
call DBG arg(1)
return

_NeedToRemakeCheckDependencies:
TitleText='Checking Dependencies - "' || _filespec('name', CurrentOutFile) || '"'
if OptionQuietDependsOn='Y' then
call DBG TitleText
else
do
call ColorSet 'TITLE'
call Line1 TitleText
call Line1 copies('~',length(TitleText))
call ColorSet
end
if OptionForceRebuild='Y' then
do
call _ShowDependancyCheckProgress 'The /ForceRebuild switch forces us to rebuild'
return('Y')
end
if FileQueryExists(DepFileName)='' then
do
call _ShowDependancyCheckProgress DepFileName|| ' does not exist.'
return('Y')
end
call FileClose DepFileName, 'N'
OpenRc=FileOpenReadOnly(DepFileName)
DependLine=linein(DepFileName)
if DependLine<>DependsOnFmtVer then
do
call _ShowDependancyCheckProgress 'Dependency formatting is not at current level'
call FileClose DepFileName
return('Y')
end
ReMake='N'
DepLineNum=1
do while lines(DepFileName)<>0
DependLine=linein(DepFileName)
DepLineNum=DepLineNum+1
if DependLine='' then
iterate
call DBG 'Line #' || DepLineNum || ': ' ||DependLine
call DBGIND 1
parse var DependLine DepType DependLine
WhatStamped=GetQuotedText(DependLine, "DependLine")
LineStamp=GetQuotedRest(DependLine)
call _ShowDependancyCheckProgress 'Checking: "' || WhatStamped || '"'
DependantTime=GetDependsStamp("WhatStamped")
if DependantTime=-1 then
do
call _ShowDependancyCheckProgress "Can't locate the dependant file (" || DepType || ")!"
ReMake='Y'
call DBGIND-1
leave
end
if DependantTime<>LineStamp then
do
call _ShowDependancyCheckProgress "The " || DepType || " dependancy stamp differs from last make."
ReMake='Y'
call DBGIND-1
leave
end
call DBGIND-1
end
call FileClose DepFileName
if ReMake='N' then
call _ShowDependancyCheckProgress 'No need to remake...'
return(ReMake)

IsTempFile:
pc!File=UFILE(arg(1))
do pc!I=1 to DepTmp.0
if pc!File=DepTmp.pc!I then
return(pc!I)
end
return(0)

AddTempFileToDependancyList:call TRACE "OFF"
parse arg qc!Tf
qc!Tf=UFile(qc!Tf)
call DBG 'AddTempFileToDependancyList(' || qc!Tf || ')'
if IsTempFile(qc!Tf)<>0 then
return('N')
DepTmp.0=DepTmp.0+1
qc!I=DepTmp.0
DepTmp.qc!I=qc!Tf
return('Y')

AddInputFileToDependancyList:call TRACE "OFF"
parse arg rc!IFile,rc!TS
rc!IFile=UFile(rc!IFile)
if rc!TS='' then
rc!TS=GetDependsStamp("rc!IFile")
call DBG 'AddInputFileToDependancyList(' || rc!IFile || '): ' ||rc!Ts
do rc!I=1 to DepIn.0
if rc!IFile=DepIn.rc!I then
return('N')
end
DepIn.0=DepIn.0+1
rc!I=DepIn.0
DepIn.rc!I=rc!IFile
DepInTs.rc!I=rc!TS
return('Y')

AddOutputFileToDependancyList:call TRACE "OFF"
sc!OFile=arg(1)
sc!OFile=UFile(sc!OFile)
call DBG 'AddOutputFileToDependancyList(' || sc!OFile || ')'
do sc!I=1 to DepOut.0
if sc!OFile=DepOut.sc!I then
return('N')
end
DepOut.0=DepOut.0+1
sc!I=DepOut.0
DepOut.sc!I=sc!OFile
return('Y')

DeletingOnError:
if symbol('DepOut.0') <> 'VAR' then
return
if OptionDeleteOnError='N' then
return
call DBG 'Deleting any files we created for this build'
call DBGIND 1
do tc!I=1 to DepOut.0
tc!File=DepOut.tc!I
call _FileClose tc!File
if FileQueryExists(tc!File)<> "" then
do
DeleteRc=_SysFileDelete(tc!File)
if FileQueryExists(tc!File)<> "" then
call DBG 'Could not delete "' || tc!File || '"'
end
end
call DBGIND-1
return

_OutputDepWhatToFile:
DepWhat=arg(1)
DepWhatQ=QuoteIt(DepWhat)
DepWhat=DepWhatQ||DepWhat||DepWhatQ
return(DepWhat)

CreateDependancyFileFromLists:
if DepFileName='' then
return
call DBG 'Making the dependancy file (' || DepFileName || ')'
call DBGIND 1
uc!TI=0
do uc!FI=1 to DepIn.0
uc!F=DepIn.uc!FI
uc!Fs=DepInTs.uc!FI
if IsTempFile(uc!F)=0 then
do
uc!Ti=uc!Ti+1
DepIn.uc!TI=uc!F
DepInTs.uc!TI=uc!Fs
end
end
DepIn.0=uc!TI
uc!TI=0
do uc!FI=1 to DepOut.0
uc!F=DepOut.uc!FI
if IsTempFile(uc!F)=0 then
do
uc!Ti=uc!Ti+1
DepOut.uc!TI=uc!F
end
end
DepOut.0=uc!TI
DepDrop=''
DepHook=CfgMacro("HOOK_DEPENDSON", '')
if DepHook<> '' then
do
call ExecRexxCmd DepHook
end
if DepDrop<> '' then
call DBG "User hook said don't create dependancy file : " ||DepDrop
else
do
call MakeDirectoryTree _filespec('drive', DepFileName) || _filespec('path',DepFileName)
call ClearDependancyTimeStampCache
call FileLineOut DepFileName,DependsOnFmtVer
call FileLineOut DepFileName, ''
DepWhatPad=0
do uc!I=1 to DepOut.0
if DepOut.uc!I<> '' then
do
call DBG 'Add OUTPUT dependancy : ' ||DepOut.uc!I
OutputFileTs=GetFileDateTimeButDontWarnOnError(DepOut.uc!I)
call FileLineOut DepFileName, 'output   ' || _OutputDepWhatToFile(DepOut.uc!I) || '   ~' || OutputFileTs || '~'
end
end
call FileLineOut DepFileName, ''
do uc!I=1 to DepIn.0
if DepIn.uc!I<> '' then
do
call DBG 'Add INPUT  dependancy : ' ||DepIn.uc!I
call FileLineOut DepFileName, 'input    ' || _OutputDepWhatToFile(DepIn.uc!I) || '   ~' || DepInTs.uc!I || '~'
end
end
call FileClose DepFileName
end
call DBGIND-1
return

ProcessDependsOn:
Rest=PerformReplacementsInCmdsParameters(arg(1))
DepType=translate(GetQuotedText(Rest, "DependsOnList"))
if DependsOnList='' then
CryAndDie('No files supplied on "#DependsOn ' || DepType || '" command!')
do while DependsOnList<> ''
ThisOne=GetQuotedText(DependsOnList, "DependsOnList")
select
when DepType='OUTPUT' then
Added=AddOutputFileToDependancyList(ThisOne)
when DepType='INPUT' then
Added=AddInputFileToDependancyList(ThisOne)
when DepType='TEMP' then
Added=AddTempFileToDependancyList(ThisOne)
otherwise
CryAndDie('Unknown dependancy type of "' || DepType || '"!')
end
if Added='Y' then
call DBG DepType|| ' dependancy : ' ||ThisOne
end
return(0)

GetDependancyInfo:call TRACE "OFF"
parse arg vc!Type,vc!Which
vc!Type=translate(vc!Type)
if vc!Which='' then
do
select
when vc!Type='INPUT' then
return(DepIn.0)
when vc!Type='OUTPUT' then
return(DepOut.0)
otherwise
_GetDependancyInfoErr(vc!Type)
end
end
else
do
select
when vc!Type='INPUT' then
return(DepIn.vc!Which)
when vc!Type='INPUTSTAMP' then
return(DepInTS.vc!Which)
when vc!Type='OUTPUT' then
return(DepOut.vc!Which)
otherwise
_GetDependancyInfoErr(vc!Type)
end
end

_GetDependancyInfoErr:
CryAndDie('Invalid dependancy query type of "' || arg(1) || '"')

GetDependsStamp:
wc!4WhatVar=arg(1)
wc!4What=value(wc!4WhatVar)
if left(wc!4What,1)<> '*' then
do
wc!Ret=GetFileDateTimeButDontWarnOnError(wc!4What)
end
else
do
Stamp4U=translate(wc!4What)
select
when abbrev(Stamp4U, "*TODAY")then
do
wc!Ret=date('S')
end
when Stamp4U="*CMDLINE" then
do
wc!Ret=PpwClDep
end
when Stamp4U="*PPWPGM" then
do
wc!Ret=PgmVersion||' '||FileQuerySize(PpWizardPgmName)||' '||GetFileDateTimeButDontWarnOnError(PpWizardPgmName)
end
when abbrev(Stamp4U, "*REXX=")then
do
wc!RexxExp=translate(substr(wc!4What,7))
if pos('DEPVALUE',translate(wc!RexxExp))=0 then
wc!RexxExp='DepValue = ' ||wc!RexxExp
DepValue=time('L')
call ExecRexxCmd wc!RexxExp
wc!Ret=DepValue
end
when abbrev(Stamp4U, "*EXPIRES=")then
do
wc!ExpWhen=translate(substr(wc!4What,10))
parse var wc!ExpWhen wc!ExpCmd ';' wc!ExpTs
if wc!ExpWhen='NOW' then
wc!ExpWhen=0
wc!CurrTs=TimeSTamp()
if wc!ExpTs='' then
do
wc!ExpTs=TimeSTamp(wc!ExpWhen)
wc!4What=wc!4What|| ';' ||wc!ExpTs
call value wc!4WhatVar,wc!4What
end
if wc!CurrTs<=wc!ExpTs then
wc!Ret='Tick Tock...'
else
wc!Ret='Expired!'
end
when abbrev(Stamp4U, "*EXEC=")then
do
TheCmd=substr(wc!4What,7)
TmpFile=RexGetTmpFileName("DEPON???.???")
call AddressCmd TheCmd||RedirectStdOutAndErr2(TmpFile),TmpFile
ExecRc=Rc
call DBG 'Depend value is result of (Rc=' || ExecRc || '): ' ||TheCmd
call FileClose TmpFile, 'N'
TheCmdVal=charin(TmpFile,,999999)
call FileClose TmpFile
call _SysFileDelete TmpFile
TheCmdVal=translate(TheCmdVal,, '0D0A1A'x, ' ')
TheCmdVal='RC=' || ExecRc || '->' ||TheCmdVal
wc!Ret=TheCmdVal
end
when abbrev(Stamp4U, "*FILES=")then
do
TheMask=substr(wc!4What,8)
if left(TheMask,1)<> '+' then
wc!Sub='N'
else
do
wc!Sub='Y'
TheMask=substr(TheMask,2)
end
call Files4Mask TheMask, 'DepDirList',wc!Sub
wc!Ret=DepDirList.0|| ' files'
do DepIndex=1 to DepDirList.0
wc!F=DepDirList.DepIndex
call AddTempFileToDependancyList wc!F
wc!Ret=wc!Ret|| '; ' || wc!F || '=' || GetFileDateTimeButDontWarnOnError(wc!F) || ',' ||FileQuerySize(wc!F)
end
end
otherwise
CryAndDie('An incorrectly formatted "special" input dependancy was specified', 'You used "' || wc!4What || '"')
end
end
wc!Mx=20000
wc!L=length(wc!Ret)
if wc!L>wc!Mx then
do
call DBG 'Original STAMP: ' ||wc!Ret
call DBG 'Stamp is ' || wc!L || ' bytes long, as this is greater than ' || wc!Mx || ' we will convert to a CRC!'
wc!C=Crc32PrePostConditioning()
wc!C=UpdateCrc32(wc!C,wc!Ret)
wc!C=Crc32PrePostConditioning(wc!C)
wc!Ret='CRC32 ' || Crc32InDisplayableForm(wc!C) || ', length ' ||AddCommasToDecimalNumber(wc!L)
end
call DBG 'Stamp: ' ||wc!Ret
return(wc!Ret)

DEPENDON_33:
DoingImport=''
signal IMPORT_34

ProcessImport:
if DoingImport<> '' then
CryAndDie("Can't nest #import (started at " || DoingImport || ')')
else
DoingImport=CurrentSourceLocation()
ImportParms=PerformReplacementsInCmdsParameters(arg(1))
if AsIsModeOn='Y' then
CryAndDie("Please turn off #AsIs mode before importing.")
call _InitImportAsIsMemories
ImportFileName=GetQuotedText(ImportParms, "ImportParms")
if ImportParms='' then
CryAndDie('#import is missing import type (parm #2)!')
ImportFileType=translate(GetQuotedText(ImportParms, "ImportParms"))
if substr(ImportFileType,4)<> '-' then
DropLine=0
else
do
ImportFileType=left(ImportFileType,3)
DropLine=1
end
FirstChar=left(ImportFileType,1)
DelimiterSpec=FirstChar||FirstChar||FirstChar
CustomDelimiter='NO'
if(ImportFileType==DelimiterSpec)|(ImportFileType==DelimiterSpec|| '-')then
do
CustomDelimiter=FirstChar
TmpFilePart=''
end
else
do
TmpFilePart=ImportFileType
if pos('*' || ImportFileType || '*', '*TAB*CMA*FIX*SQL*WRAP*T2H*ML*')=0 then
CryAndDie('Invalid #import type of "' || ImportFileType || '" specified!')
end
if ImportFileType<> 'SQL' then
do
if ImportFileName='' then
CryAndDie('#import has no parameters!')
call FileClose ImportFileName, 'N'
FullImportName=FileQueryExists(ImportFileName)
if FullImportName='' then
CryAndDie('The #import file "' || ImportFileName || '" does not exist!')
call ReadingI FullImportName, 'N'
call AddInputFileToDependancyList FullImportName
end
ToInclude=RexGetTmpFileName('I_' || left(TmpFilePart, 4, '_') || '??.???')
call MustDeleteFile ToInclude
if ImportParms='' then
MacroName=''
else
MacroName=GetQuotedText(ImportParms, "ImportParms")
if MacroName='' then
do
select
when ImportFileType='WRAP' then
MacroName='WRAP'
when ImportFileType='T2H' then
MacroName='T2H'
when ImportFileType='ML' then
MacroName='ML'
otherwise
MacroName='IMPORT'
end
end
call DBG_IMPORT '#import options start with "' || MacroName || '_"'
call AsIsPrepare ''
call DBG_IMPORT 'Generating "' || ToInclude || '" for later inclusion (#include).'
ReplaceNewLineChar=''
ReplaceTabChar=''
DisplayingFields=''
ReplaceNewLineChar=''
ReplaceTabChar=''
DoPass2=translate(GetImportValue('DO_PASS_2', 'Y'))
select
when ImportFileType='WRAP' then
ImpLinCnt=HandleLineWrapping()
when ImportFileType='T2H' then
ImpLinCnt=HandleTextToHtmlImport()
otherwise
do
select
when CustomDelimiter<> 'NO' then
wc!Dfc=CustomDelimiter
when ImportFileType='TAB' then
wc!Dfc=TabChar
when ImportFileType='CMA' then
wc!Dfc=','
otherwise
wc!Dfc=''
end
call ImportTablePreparationPass1
if ImportParms='' then
do
if wc!Dfc\=='' then
ImportParms=ExtractFieldInfoFromSimpleCharDelimitedFile(wc!Dfc)
end
call ImportTablePreparationPass2
select
when wc!Dfc\=='' then
ImpLinCnt=HandleSimpleCharDelimitedFile(wc!Dfc)
when ImportFileType='FIX' then
ImpLinCnt=HandleFixedFieldFile()
when ImportFileType='SQL' then
ImpLinCnt=HandleSQLDataBase()
when ImportFileType='ML' then
ImpLinCnt=HandleMultiLineImport()
otherwise
CryAndDie('Unknown import type of "' || ImportFileType || '"')
end
call ImportTableTermination
end
end
if ImportFileType<> 'SQL' then
call FileClose FullImportName
if OptionDebugOn='Y' then
call DBG_IMPORT 'Imported ' || AddCommasToDecimalNumber(ImpLinCnt) || ' line(s) in "' || ImportFileType || '" mode.'
call FileClose ToInclude
call AsIsPrepare ''
if DoPass2='N' then
call DBG_IMPORT 'You have disabled PASS2 processing'
else
do
call DBG_IMPORT 'Now #include the generated temporary file ("' || ToInclude || '").'
call RecursiveIncludeSave
call ProcessInputFile ToInclude, 'N', 'N'
call RecursiveIncludeRestore
call ReadingI
end
if GetImportValue('KEEP_TMP_FILE',  OptionDebugOn) = 'N' then
DeleteRc=_SysFileDelete(ToInclude)
DoingImport=''
return(0)

_ImportValueSpacer:
if OptionDebugOn='Y' then
do
call DBG_MACROVALORDEF ''
if arg(1)<> '' then
call DBG_MACROVALORDEF arg(1)
end
return

ImportValueExists:
xc!Cm=MacroName|| '_' ||arg(1)
xc!Yn=MacroExists(xc!Cm)
if OptionDebugOn='Y' then
call DBG_MACROVALORDEF 'Option(Macro) "' || xc!Cm || '" Exists? : ' ||xc!Yn
return(xc!Yn)

GetImportValue:
yc!V=CfgMacro(MacroName|| '_' ||arg(1),arg(2))
if ImportFileType<> "WRAP" & ImportFileType <> "T2H" then
yc!V=ReplaceString(yc!V,StartsMacroParm|| 'Columns' ||EndsMacroParm,DisplayingFields)
return(yc!V)

GetImportValue_Tabs:
ReplaceTabChar=GetImportValue('TAB_CHAR', '')
return

GetImportValue_RecordFilter:
return(PerformReplacementsInCmdsParameters(GetImportValue('RECORD_FILTER', '')))

GetImportValue_LineFilter:
LineFilter=PerformReplacementsInCmdsParameters(GetImportValue('LINE_FILTER', ''))
return

GetImportValue_Comments:
call _ImportValueSpacer 'Get comment options'
call DBGIND 1
ImportLineCmtChars=GetImportValue( 'LINECMT_CHARS',arg(1))
ImportInlineCmtChars=GetImportValue('INLINECMT_CHARS',arg(2))
call DBGIND-1
return

IsCmtLine:
if ImportLineCmtChars='' then
return(0)
else
return(abbrev(arg(1),ImportLineCmtChars))

ImportOneLine:
FileLine=linein(FullImportName)
if ExtraWhiteSpace\=='' then
FileLine=translate(FileLine, '', ExtraWhiteSpace, ' ')
if LineFilter<> '' then
do
call DBG_IMPORT 'Calling specified line filter'
call DBGIND 1
call ExecRexxCmd LineFilter
call DBGIND-1
end
if ImportInlineCmtChars<> '' then
do
zc!Pos=pos(ImportInlineCmtChars,FileLine)
if zc!Pos<>0 then
FileLine=strip(left(FileLine,zc!Pos-1), 'Trailing')
end
if arg(1)='Y' then
FileLine=AsIs(FileLine)
if ReplaceNewLineChar\=='' then
FileLine=ReplaceString(FileLine,MarksNewLine,ReplaceNewLineChar)
if ReplaceTabChar\=='' then
FileLine=ReplaceString(FileLine,TabChar,ReplaceTabChar)
return(FileLine)

GenerateTagsIfNonEmpty:
OptionalTags=GetImportValue(arg(1),arg(2))
if OptionalTags\=='' then
call PpwLineout ToInclude,OptionalTags
return

GenerateProtectStartTags:
call GenerateTagsIfNonEmpty 'PROTECT_START', StartsStdSymbolReplacement || 'ProtectFromPpwStart' ||EndsMacroReplacement
return

GenerateProtectEndTags:
call GenerateTagsIfNonEmpty 'PROTECT_END',   StartsStdSymbolReplacement || 'ProtectFromPpwEnd' ||EndsMacroReplacement
return

GenerateBeforeTags:
call GenerateTagsIfNonEmpty 'BEFORE',arg(1)
return

GenerateAfterTags:
call GenerateTagsIfNonEmpty 'AFTER',arg(1)
return

HandleImportAsIsOptions:
call _ImportValueSpacer 'Prepare "AS IS" tagging'
call DBGIND 1
ImportAsIsMemory=GetImportValue('ASIS_TAGGING',arg(1))
call DBGIND 1
call AsIsPrepare ImportAsIsMemory
call DBGIND-2
return

_InitImportAsIsMemories:
if symbol('ImpMemInit') = 'VAR' then
return
ImpMemInit='Y'
call DBG_IMPORT 'Initializing named #AsIs tags for HTML Importing'
call DBGIND 1
call _ClearTempMemory
call _AddToTempMemory '&', '&'
call _AddToTempMemory '<', '<'
call _AddToTempMemory '>', '>'
call SetupNamedAsIsStorage 'IMPORT_HTML_BASIC',TmpAtCount
call _ClearTempMemory
call _AddToTempMemory '╔', '+'
call _AddToTempMemory '═', '-'
call _AddToTempMemory '╗', '+'
call _AddToTempMemory '║', '|'
call _AddToTempMemory '╝', '+'
call _AddToTempMemory '╚', '+'
call _AddToTempMemory '┌', '+'
call _AddToTempMemory '─', '-'
call _AddToTempMemory '┐', '+'
call _AddToTempMemory '│', '|'
call _AddToTempMemory '┘', '+'
call _AddToTempMemory '└', '+'
call SetupNamedAsIsStorage 'IMPORT_HTML_BOXGRAPHIC_TO_BOXTEXT',TmpAtCount
call DBGIND-1
return

_ClearTempMemory:
TmpAtCount=0
return

_AddToTempMemory:
TmpAtCount=TmpAtCount+1
ImportB.TmpAtCount=arg(1)
ImportA.TmpAtCount=arg(2)
return

WriteLineToTmpImportFile:call TRACE "OFF"
call PpwLineout ToInclude,arg(1)
return

IMPORT_34:
signal IMPORTT_35

ImportTablePreparationPass1:
call _ImportValueSpacer 'Assorted options'
call DBGIND 1
DropBlankLines=translate(GetImportValue('DROP_BLANK_LINES',  'Y'))
DropLine=GetImportValue('DROP_LINE_COUNT',DropLine)
ReplaceNewLineChar=GetImportValue('NEWLINE_CHAR', '<BR>')
call GetImportValue_Tabs
call GetImportValue_LineFilter
RecordFilter=GetImportValue_RecordFilter()
call DBGIND-1
return

ImportTablePreparationPass2:
if ImportParms='' then
CryAndDie('#import is missing field names (parm #4 onwards)!')
NumberOfFields=0
DisplayingFields=0
do while ImportParms<> ''
NumberOfFields=NumberOfFields+1
HeadingInfo=GetQuotedText(ImportParms, "ImportParms")
ColumnNumber=DisplayingFields+1
ExtraInfo=''
if left(HeadingInfo,1)='{' then
do
EndPosn=pos('}',HeadingInfo)
if EndPosn=0 then
CryAndDie('Leading field codes on heading "' || HeadingInfo || '" invalid (expected "}")')
ExtraInfo=substr(HeadingInfo,2,EndPosn-2)
HeadingInfo=substr(HeadingInfo,EndPosn+1)
if ImportFileType<> 'SQL' then
do
parse var ExtraInfo MaybeColumnNumber','ExtraInfo
if MaybeColumnNumber<> '' & MaybeColumnNumber <> '*' then
ColumnNumber=MaybeColumnNumber
end
end
FieldHeading.NumberOfFields=HeadingInfo
FieldExtra.NumberOfFields=ExtraInfo
if HeadingInfo<> '' then
do
FieldColumn.NumberOfFields=ColumnNumber
DisplayingFields=DisplayingFields+1
end
end
call _ImportValueSpacer 'What happens to blank fields?'
call DBGIND 1
if ProcessingMode='HTML' then
zc!B=' '
else
zc!B=''
ReplaceBlankFields=GetImportValue('BLANK_FIELD',zc!B)
do Index=1 to DisplayingFields
RepBlankCol.Index=GetImportValue('BLANK_COLUMN_' ||Index,ReplaceBlankFields)
end
call DBGIND-1
call _ImportValueSpacer 'What do we do with column titles?'
call DBGIND 1
if ImportValueExists('HEADER') = 'Y' then
ForHeader=GetImportValue('HEADER', '!BUG!')
else
do
DefaultColFormatting=GetImportValue('HEADING_COLUMNS',     'ALIGN=CENTER')
DefaultBeforeData=GetImportValue('HEADING_BEFORE_DATA', '')
DefaultAfterData=GetImportValue('HEADING_AFTER_DATA',  '')
ForHeader='<TR>'
do Index=1 to DisplayingFields
ThisColFormatting=GetImportValue('HEADING_COLUMN_' ||Index,DefaultColFormatting)
ThisBeforeData=GetImportValue('HEADING_BEFORE_DATA_' ||Index,DefaultBeforeData)
ThisAfterData=GetImportValue('HEADING_AFTER_DATA_' ||Index,DefaultAfterData)
ForHeader=ForHeader|| '<TH ' || ThisColFormatting || '>' || ThisBeforeData || StartsMacroParm || 'Column' || Index || EndsMacroParm || ThisAfterData || '</TH>'
end
ForHeader=ForHeader|| '</TR>'
end
call DBGIND-1
call _ImportValueSpacer 'Working out what table data row looks like'
call DBGIND 1
if ImportValueExists('RECORD') = 'Y' then
ForEachRecord=GetImportValue('RECORD', '!BUG!')
else
do
DefaultColFormatting=GetImportValue('RECORD_COLUMNS',     'ALIGN=CENTER')
DefaultBeforeData=GetImportValue('RECORD_BEFORE_DATA', '')
DefaultAfterData=GetImportValue('RECORD_AFTER_DATA',  '')
ForEachRecord='<TR>'
do Index=1 to DisplayingFields
ThisColFormatting=GetImportValue('RECORD_COLUMN_' ||Index,DefaultColFormatting)
ThisBeforeData=GetImportValue('RECORD_BEFORE_DATA_' ||Index,DefaultBeforeData)
ThisAfterData=GetImportValue('RECORD_AFTER_DATA_' ||Index,DefaultAfterData)
ForEachRecord=ForEachRecord|| '<TD ' || ThisColFormatting || '>' || ThisBeforeData || StartsMacroParm || 'Column' || Index || EndsMacroParm  || ThisAfterData || '</TD>'
end
ForEachRecord=ForEachRecord|| '</TR>'
end
call DBGIND-1
call _ImportValueSpacer 'Start output'
call DBGIND 1
call GenerateProtectStartTags
TableAttribs=GetImportValue('TABLE_ATTRIBS', 'BORDER=4 CELLSPACING=0 CELLPADDING=2')
if TableAttribs<> '' then
TableAttribs=' ' ||strip(TableAttribs)
BeforeRecordsDefault='<TABLE' || TableAttribs || '>'
call GenerateBeforeTags BeforeRecordsDefault
call DBG_IMPORT 'Outputting heading fields'
call DBGIND 1
call _NewRecord 'H'
do FieldIndex=1 to NumberOfFields
call _AddField2Record FieldHeading.FieldIndex
end
call GenerateRecordFromFields
call DBGIND-2
call GetImportValue_Comments ';', ';' || ';'
if ProcessingMode='HTML' then
call HandleImportAsIsOptions "IMPORT_HTML_BASIC"
return

ImportTableTermination:
call GenerateAfterTags '</TABLE>'
call GenerateProtectEndTags
return

HandleFixedFieldFile:
if OptionDebugOn='Y' then
call DBG_IMPORT 'Importing fixed field file'
do FieldIndex=1 to NumberOfFields
parse var FieldExtra.FieldIndex StartCol'-'EndCol
if EndCol='' | EndCol = '*' then
FieldLength=''
else
FieldLength=(EndCol-StartCol)+1
FieldStartCol.FieldIndex=StartCol
FieldLength.FieldIndex=FieldLength
end
ImportFileLine=0
call DBG_IMPORT 'Reading "' || FullImportName || '"...'
do while lines(FullImportName)<>0
CurrentRecord=ImportOneLine('Y')
ImportFileLine=ImportFileLine+1
if CurrentRecord='' then
iterate
if ImportFileLine<=DropLine then
iterate
if IsCmtLine(ImportFileLine)then
iterate
call _NewRecord
do FieldIndex=1 to NumberOfFields
if FieldLength.FieldIndex='' then
ThisField=substr(CurrentRecord,FieldStartCol.FieldIndex)
else
ThisField=substr(CurrentRecord,FieldStartCol.FieldIndex,FieldLength.FieldIndex)
call _AddField2Record strip(ThisField)
end
if GenerateRecordFromFields()then
leave
end
return(ImportFileLine)

ExtractFieldInfoFromSimpleCharDelimitedFile:
call DBG_IMPORT 'Field information not supplied, reading the first record!'
call DBGIND 1
if lines(FullImportName)=0 then
CryAndDie("Can't extract field information from an empty file!")
bd!Line=ImportOneLine('Y')
ad!L=bd!Line
ad!Del=arg(1)
ad!MinF=0
ad!MaxF=0
ad!FC=0
ad!Q='"'
ad!Q2='""'
do while ad!L<> ''
ad!Fc=ad!Fc+1
if left(ad!L,1)<>ad!Q then
do
ad!DelPos=pos(ad!Del,ad!L)
if ad!DelPos<>0 then
do
ad!F=left(ad!L,ad!DelPos-1)
ad!L=substr(ad!L,ad!DelPos+1)
end
else
do
ad!F=ad!L
ad!L=''
end
end
else
do
ad!LookFrom=2
do forever
ad!QPos=pos(ad!Q,ad!L,ad!LookFrom)
if ad!QPos=0 then
do
if lines(FullImportName)=0 then
do
CryAndDie('Import of line ' || ImportFileLine || ' failed','A record spans more than one line however there are no more lines!',, 'RECORD', '~~~~~~', bd!Line, 'DETECTED AT', '~~~~~~~~~~~',ad!L)
end
ad!Ln=ImportOneLine('Y')
ImportFileLine=ImportFileLine+1
bd!Line=bd!Line||ad!Ln
ad!L=ad!L||ReplaceNewLineChar||ad!Ln
iterate
end
if substr(ad!L,ad!QPos+1,1)=ad!Q then
ad!LookFrom=ad!QPos+2
else
leave
end
ad!F=ReplaceString(substr(ad!L,2,ad!QPos-2),ad!Q2,ad!Q)
ad!L=substr(ad!L,ad!QPos+1)
if ad!L<> '' then
do
if left(ad!L,1)<>ad!Del then
do
CryAndDie('Import of line ' || ImportFileLine || ' failed','Expected delimiter after field #' || ad!Fc,, 'RECORD', '~~~~~~', bd!Line, 'DETECTED AT', '~~~~~~~~~~~',ad!L)
end
ad!L=substr(ad!L,2)
end
end
bd!Fld.ad!Fc=ad!F
if ad!MaxF<>0 then
do
if ad!Fc>=ad!MaxF then
leave
end
end
if ad!Fc<ad!MinF then
do
do while ad!Fc<ad!MinF
ad!Fc=ad!Fc+1
bd!Fld.ad!Fc=''
end
end
bd!Fld.0=ad!Fc
call DBG_IMPORT 'Found ' || bd!Fld.0 || ' fields:'
call DBGIND 1
bd!Ret=''
do bd!i=1 to bd!Fld.0
bd!F=bd!Fld.bd!i
call DBG_IMPORT bd!F
bd!Ret=bd!Ret||QuoteIt(bd!F, "ANY", "Y") || ' '
end
DropLine=0
call DBGIND-2
return(bd!Ret)

HandleSimpleCharDelimitedFile:
FieldDelimiter=arg(1)
if OptionDebugOn='Y' then
do
DelimiterText=c2d(FieldDelimiter)
if DelimiterText> '32' then
DelimiterText=DelimiterText|| ' ("' || FieldDelimiter || '")'
call DBG_IMPORT 'Importing simple delimited file - delimiter = ASCII ' ||DelimiterText
end
call DBG_IMPORT 'Reading "' || FullImportName || '"...'
ImportFileLine=0
do while lines(FullImportName)<>0
CurrentRecord=ImportOneLine('Y')
ImportFileLine=ImportFileLine+1
if CurrentRecord='' then
do
if DropBlankLines='Y' then
iterate
end
if ImportFileLine<=DropLine then
iterate
if IsCmtLine(CurrentRecord)then
iterate
call _NewRecord
ad!L=CurrentRecord
ad!Del=FieldDelimiter
ad!MinF=NumberOfFields
ad!MaxF=NumberOfFields
ad!FC=0
ad!Q='"'
ad!Q2='""'
do while ad!L<> ''
ad!Fc=ad!Fc+1
if left(ad!L,1)<>ad!Q then
do
ad!DelPos=pos(ad!Del,ad!L)
if ad!DelPos<>0 then
do
ad!F=left(ad!L,ad!DelPos-1)
ad!L=substr(ad!L,ad!DelPos+1)
end
else
do
ad!F=ad!L
ad!L=''
end
end
else
do
ad!LookFrom=2
do forever
ad!QPos=pos(ad!Q,ad!L,ad!LookFrom)
if ad!QPos=0 then
do
if lines(FullImportName)=0 then
do
CryAndDie('Import of line ' || ImportFileLine || ' failed','A record spans more than one line however there are no more lines!',, 'RECORD', '~~~~~~', CurrentRecord, 'DETECTED AT', '~~~~~~~~~~~',ad!L)
end
ad!Ln=ImportOneLine('Y')
ImportFileLine=ImportFileLine+1
CurrentRecord=CurrentRecord||ad!Ln
ad!L=ad!L||ReplaceNewLineChar||ad!Ln
iterate
end
if substr(ad!L,ad!QPos+1,1)=ad!Q then
ad!LookFrom=ad!QPos+2
else
leave
end
ad!F=ReplaceString(substr(ad!L,2,ad!QPos-2),ad!Q2,ad!Q)
ad!L=substr(ad!L,ad!QPos+1)
if ad!L<> '' then
do
if left(ad!L,1)<>ad!Del then
do
CryAndDie('Import of line ' || ImportFileLine || ' failed','Expected delimiter after field #' || ad!Fc,, 'RECORD', '~~~~~~', CurrentRecord, 'DETECTED AT', '~~~~~~~~~~~',ad!L)
end
ad!L=substr(ad!L,2)
end
end
cd!Fld.ad!Fc=ad!F
if ad!MaxF<>0 then
do
if ad!Fc>=ad!MaxF then
leave
end
end
if ad!Fc<ad!MinF then
do
do while ad!Fc<ad!MinF
ad!Fc=ad!Fc+1
cd!Fld.ad!Fc=''
end
end
cd!Fld.0=ad!Fc
do cd!i=1 to cd!Fld.0
call _AddField2Record cd!Fld.cd!i
end
if GenerateRecordFromFields()then
leave
end
return(ImportFileLine)

_NewRecord:
RecordType=arg(1)
if RecordType='H' then
ThisRecordsCodes=ForHeader
else
ThisRecordsCodes=ForEachRecord
FieldCounter=0
ColumnCounter=0
DroppedCounter=0
NonBlankFieldCounter=0
return

_AddField2Record:
FieldCounter=FieldCounter+1
if FieldHeading.FieldCounter='' then
do
DroppedCounter=DroppedCounter+1
Dropped.DroppedCounter=arg(1)
end
else
do
ColumnCounter=ColumnCounter+1
NewValue=arg(1)
if NewValue='' then
NewValue=RepBlankCol.ColumnCounter
else
NonBlankFieldCounter=NonBlankFieldCounter+1
SaveAsIndex=FieldColumn.FieldCounter
Column.SaveAsIndex=NewValue
end
return

GenerateRecordFromFields:
call DBGIND 1
if DropBlankLines='Y' then
do
if NonBlankFieldCounter=0 then
do
call DBG_IMPORT 'Dropping record as all fields were blank'
call DBGIND-1
return(0)
end
end
if RecordFilter<> '' then
do
if RecordType<> 'H' then
do
Column.0=ColumnCounter
Dropped.0=DroppedCounter
call DBG_IMPORT 'Calling specified filter'
call DBGIND 1
Remove=''
call ExecRexxCmd RecordFilter
if Remove<> '' then
do
if abbrev(Remove, "EOF:")then
do
call DBG_IMPORT 'This Record and all following dropped ==> ' ||Remove
call DBGIND-2
return(1)
end
else
do
call DBG_IMPORT 'Record dropped ==> ' ||Remove
call DBGIND-2
return(0)
end
end
call DBGIND-1
end
end
do ThisOne=1 to ColumnCounter
ThisRecordsCodes=ReplaceString(ThisRecordsCodes,StartsMacroParm|| 'Column' ||ThisOne||EndsMacroParm,Column.ThisOne)
end
if ThisRecordsCodes<> '' then
do
call DBG_IMPORT 'Generating: ' ||DebugRightArrow||ThisRecordsCodes||DebugLeftArrow
call PpwLineout ToInclude,ThisRecordsCodes
end
call DBGIND-1
return(0)

PpwLineout:
parse arg gFile,gLine
do until gLine==''
parse var gLine This1 (MarksNewLine) gLine
if 0<>charout(gFile,This1||NewLineChars)then
do
IoReason=FileDescription(gFile)
CryAndDie('Write to "' || gFile || '" failed (' || IoReason || ')!')
end
end
return

IMPORTT_35:
signal REXXSQL_36

LoadRexxSql:
signal on SYNTAX name RexxSqlMissing
dd!Rc=RXFuncAdd('SQLLoadFuncs', 'rexxsql', 'SQLLoadFuncs')
call DBG_IMPORT "RXFuncAdd(rexxsql.dll), RC = " ||dd!Rc
call SQLLoadFuncs
call DBG_IMPORT "rexxsql.dll functions loaded"
return

RexxSqlMissing:
ed!Em="Can't locate/load rexxsql.dll (Mark Hessling's SQL support)!"
ed!Reason='UNKNOWN'
signal on SYNTAX name RexxSqlEmFailed
if RexWhich='REGINA' then
do
ed!Tmp=RxFuncErrMsg()
ed!Reason=ed!Tmp
end

RexxSqlEmFailed:
CryAndDie(ed!Em, 'REASON:',ed!Reason)

ed!Line:
ed!Count=ed!Count+1
ed!L.ed!Count=arg(1)
return

ErrorSql:
do ed!I=1 to 10
ed!L.ed!I=''
end
ed!Count=0
do ed!I=1 to arg()
call ed!Line arg(ed!I)
end
if ed!Count>6 then
ed!Count=6
signal on NOVALUE name SqlVarMissing1
if ed!L.1='' then
do
ed!Count=1
ed!L.1='REXXSQL ' || SQLCA.FUNCTION || '() call failed.'
end
call ed!Line ''
if sqlca.intcode=-1 Then
do
call ed!Line 'SQLCODE:' sqlca.sqlcode
call ed!Line 'SQLERRM:' sqlca.sqlerrm
call ed!Line 'SQLTEXT:' sqlca.sqltext
end
else
do
call ed!Line 'INTCODE:' sqlca.intcode
call ed!Line 'INTERRM:' sqlca.interrm
end

SqlVarMissing2:
CryAndDie(ed!L.1,ed!L.2,ed!L.3,ed!L.4,ed!L.5,ed!L.6,ed!L.7,ed!L.8,ed!L.9,ed!L.10)

SqlVarMissing1:
call ed!Line 'The REXXSQL variable "' || condition('D') || '" is unknown.'
call ed!Line "ErrorSQL() was trying to display REXXSQL information..."
signal SqlVarMissing2

HandleSqlDataBase:
if OptionDebugOn='Y' then
do
call DBG_IMPORT "Importing SQL via Mark Hessling's REXXSQL interface"
call DBGIND 1
end
call LoadRexxSql
fd!Imported=0
call DBG_IMPORT "REXXSQL VERSION: " || SqlVariable("VERSION")
do FieldIndex=1 to NumberOfFields
fd!FNAME=FieldExtra.FieldIndex
if fd!FNAME='' then
fd!FNAME=FieldHeading.FieldIndex
FieldName.FieldIndex=fd!FNAME
end
if OptionDebugOn='Y' then
do
call SqlVariable "DEBUG", GetImportValue('SQL_DEBUG', '3')
end
fd!Id="SQL"
fd!UserId=GetImportValue('SQL_USERID',   "")
fd!Password=GetImportValue('SQL_USERPW',   "")
fd!DataSourceId=GetImportValue('SQL_DATABASE', "")
if fd!DataSourceId='' then
CryAndDie('An SQL database was not specified')
fd!Server=GetImportValue('SQL_SERVER',   "")
call DBG_IMPORT "Connecting to the database"
if SQLConnect(fd!Id,fd!UserId,fd!Password,fd!DataSourceId,fd!Server)<0 then
ErrorSql('Connection failed to "' || fd!DataSourceId || '", have you set up ODBC datasource (control panel)?')
call DBG_IMPORT "DATABASE INFO: " || SqlGetInfo(fd!Id, 'DBMSNAME')
fd!Cmds=GetImportValue('SQL_COMMANDS', "")
if fd!Cmds<> '' then
do
call DBGIND 1
do fd!I=1 to words(fd!Cmds)
fd!Mac=word(fd!Cmds,fd!I)
fd!Cmd=GetDefineContents(fd!Mac)
if left(fd!Cmd,1)<> '-' then
fd!Doe='Y'
else
do
fd!Doe='N'
fd!Cmd=substr(fd!Cmd,2)
end
call DBG_IMPORT "Executing: " ||fd!Cmd
fd!Rc=SQLCommand(fd!Mac,fd!Cmd)
call DBGIND 1
if fd!Rc>=0 then
call DBG_IMPORT "OK, RC=" ||fd!Rc
else
do
if fd!Doe='Y' then
ErrorSql('User command from "' || fd!Mac || '" failed!')
if sqlca.intcode=-1 Then
do
fd!1='SQLCODE:' sqlca.sqlcode
fd!2='SQLERRM:' sqlca.sqlerrm
fd!3='SQLTEXT:' sqlca.sqltext
end
else
do
fd!1='INTCODE:' sqlca.intcode
fd!2='INTERRM:' sqlca.interrm
fd!3=''
end
call DBG_IMPORT "Command failed"
call DBG_IMPORT fd!1
call DBG_IMPORT fd!2
call DBG_IMPORT fd!3
end
call DBGIND-1
end
call DBGIND-1
end
fd!Query=GetImportValue('SQL_QUERY', "")
if fd!Query='' then
CryAndDie('An SQL query was not specified')
if SqlPrepare('SQLQUERY',fd!Query)<0 then
ErrorSql()
if OptionDebugOn='Y' then
do
call DBG_IMPORT "Returned Column information"
call DBGIND 1
fd!Attribs=SqlGetInfo(fd!Id, 'DESCRIBECOLUMNS')
if sqlca.intcode<0 then
fd!Attribs='NAME TYPE SIZE SCALE NULLABLE PRECISION'
fd!Pad2=0
do fd!I=1 to words(fd!Attribs)
fd!This=word(fd!Attribs,fd!I)
if length(fd!This)>fd!Pad2 then
fd!Pad2=length(fd!This)
end
fd!NumCols=SqlDescribe('SQLQUERY', 'fd!Det')
if fd!NumCols<0 then
ErrorSql()
do fd!ColIndex=1 to fd!NumCols
call DBG_IMPORT "Query Field " ||fd!ColIndex
call DBGIND 1
do fd!I=1 to words(fd!Attribs)
fd!Attrib=word(fd!Attribs,fd!I)
fd!Value=value('fd!Det.COLUMN.' || fd!Attrib || '.fd!ColIndex')
if left(fd!Value,1)='' | right(fd!Value, 1) = '' then
fd!Value='""'
call DBG_IMPORT right(fd!Attrib,fd!Pad2)|| ' = ' ||fd!Value
end
call DBGIND-1
end
call DBGIND-1
end
if SqlOpen('SQLQUERY')<0 then
ErrorSql()
fd!Rc=SqlFetch('SQLQUERY')
do while fd!Rc>0
call _NewRecord
do FieldIndex=1 to NumberOfFields
fd!ColVar='SQLQUERY.' ||FieldName.FieldIndex
if fd!Imported=0 then
do
if symbol(fd!ColVar)<> 'VAR' then
CryAndDie('The query did not return a field called "' || FieldName.FieldIndex || '"')
end
call _AddField2Record value(fd!ColVar)
end
fd!Imported=fd!Imported+1
if GenerateRecordFromFields()then
leave
fd!Rc=SqlFetch('SQLQUERY')
end
if fd!Rc<0 then
ErrorSql()
if SqlClose('SQLQUERY')<0 then
ErrorSql()
if SqlDispose('SQLQUERY')<0 then
ErrorSql()
call DBG_IMPORT "Disconnecting from the database"
if SQLDisconnect(fd!Id)<0 then
ErrorSql()
if OptionDebugOn='Y' then
call DBGIND-1
return(fd!Imported)

REXXSQL_36:
signal IMPORTTX_37

HandleTextToHtmlImport:
if ProcessingMode<> 'HTML' then
CryAndDie("Text to html file importing is only allowed when generating HTML")
if ImportParms<> '' then
CryAndDie('There are too many parameters on the T2H #import!')
UrlNameVar=StartsMacroParm|| 'Url' ||EndsMacroParm
UrlTypeVar=StartsMacroParm|| 'UrlType' ||EndsMacroParm
HeadingVar=StartsMacroParm|| 'Heading' ||EndsMacroParm
call GenerateProtectStartTags
call GenerateBeforeTags '<PRE><FONT SIZE=-1>'
T2hFilter=GetImportValue_RecordFilter()
call GetImportValue_LineFilter
call GetImportValue_Tabs
BlankLinesTo=GetImportValue('BLANK_LINES_TO', '')
HttpLink=GetImportValue('HTTP_LINK',   '<A HREF="' || UrlTypeVar || UrlNameVar || '" TARGET=_top>' || UrlTypeVar || UrlNameVar || '</A>')
FtpLink=GetImportValue('FTP_LINK',    '<A HREF="' || UrlTypeVar || UrlNameVar || '">' || UrlTypeVar || UrlNameVar || '</A>')
MailLink=GetImportValue('MAILTO_LINK', '<A HREF="mailto:' || UrlNameVar || '">' || UrlNameVar || '</A>')
DefaultAllStd=UpperCase||LowerCase||DecimalDigits
AlwaysOkInUrl=GetImportValue('ALWAYS_OK_IN_URL_CHARS',DefaultAllStd)
if AlwaysOkInUrl\=='' then
DefaultAllStd=''
ExtraValidHttpChar=GetImportValue('EXTRA_VALID_HTTP_CHARS',         DefaultAllStd || './?%+:~_')
ExtraValidFtpChar=GetImportValue('EXTRA_VALID_FTP_CHARS',ExtraValidHttpChar)
ExtraValidEmailName=GetImportValue('EXTRA_VALID_EMAIL_NAME_CHARS',   DefaultAllStd || '_.')
ExtraValidEmailSvr=GetImportValue('EXTRA_VALID_EMAIL_SVR_CHARS',    DefaultAllStd || '_.')
ValidEmailDelimiters=GetImportValue('EXTRA_VALID_EMAIL_DELIMITERS',   " '" || '",;')
ValidInHttpUrl=AlwaysOkInUrl||ExtraValidHttpChar
ValidInFtpUrl=AlwaysOkInUrl||ExtraValidFtpChar
ValidInEmailL=AlwaysOkInUrl||ExtraValidEmailName
ValidInEmailR=AlwaysOkInUrl||ExtraValidEmailSvr
call GetImportValue_Comments '', ''
if ProcessingMode='HTML' then
call HandleImportAsIsOptions "IMPORT_HTML_BASIC IMPORT_HTML_BOXGRAPHIC_TO_BOXTEXT"
T2hLineNumber=0
call DBG_IMPORT 'Reading "' || FullImportName || '"...'
do while lines(FullImportName)<>0
T2hFileLine=ImportOneLine('Y')
T2hLineNumber=T2hLineNumber+1
if IsCmtLine(T2hFileLine)then
iterate
if T2hFileLine='' then
do
if BlankLinesTo\=='' then
T2hNewLine=BlankLinesTo
else
T2hNewLine=''
end
else
do
T2hNewLine=T2hFileLine
if MailLink\=='' then
T2hNewLine=_MakeTextImportEmailChanges(T2hNewLine,ValidInEmailL,ValidInEmailR,ValidEmailDelimiters,MailLink)
if HttpLink\=='' then
T2hNewLine=_MakeTextImportLinkChanges(T2hNewLine, 'http:',ValidInHttpUrl,HttpLink)
if FtpLink\=='' then
T2hNewLine=_MakeTextImportLinkChanges(T2hNewLine, 'ftp:',ValidInFtpUrl,FtpLink)
end
if T2hFilter<> '' then
do
call DBG_IMPORT 'Calling specified filter'
call DBGIND 1
Remove=''
call ExecRexxCmd T2hFilter
if Remove<> '' then
do
if abbrev(Remove, "EOF:")then
do
call DBG_IMPORT 'This Record and all following dropped ==> ' ||Remove
call DBGIND-1
leave
end
else
do
call DBG_IMPORT 'Record dropped ==> ' ||Remove
call DBGIND-1
iterate
end
end
call DBGIND-1
end
call PpwLineout ToInclude,T2hNewLine
end
call GenerateAfterTags '</FONT></PRE>'
call GenerateProtectEndTags
return(T2hLineNumber)

_MakeTextImportLinkChanges:
parse arg RightBit,UrlType,tlOkInUrl,tlTransformSpec
LeftBit=''
UrlPos=pos(UrlType,RightBit)
lUrlType=length(UrlType)
do while UrlPos<>0
LeftBit=LeftBit||left(RightBit,UrlPos-1)
RightBit=substr(RightBit,UrlPos+lUrlType)
NotUrlCharPos=verify(RightBit,tlOkInUrl)
if NotUrlCharPos=0 then
do
TheUrl=RightBit
RightBit=''
end
else
do
TheUrl=left(RightBit,NotUrlCharPos-1)
RightBit=substr(RightBit,NotUrlCharPos)
end
UrlBit=ReplaceString(tlTransformSpec,UrlTypeVar,UrlType)
UrlBit=ReplaceString(UrlBit,UrlNameVar,TheUrl)
LeftBit=LeftBit||UrlBit
UrlPos=pos(UrlType,RightBit)
end
return(LeftBit||RightBit)

_MakeTextImportEmailChanges:
parse arg RightBit,tlOkInEmailName,tlOkInEmailSvr,tlDelimiters,tlTransformSpec
LeftBit=''
SnailPos=pos('@',RightBit)
do while SnailPos<>0
lRightBit=length(RightBit)
if SnailPos=1|SnailPos=lRightBit then
do
LeftBit=LeftBit||left(RightBit,SnailPos)
RightBit=substr(RightBit,SnailPos+1)
end
else
do
LeftPos=SnailPos-1
do until LeftPos=0
OneChar=substr(RightBit,LeftPos,1)
if pos(OneChar,tlDelimiters)<>0 then
do
LeftPos=LeftPos+1
leave
end
LeftPos=LeftPos-1
end
if LeftPos=0 then
LeftPos=LeftPos+1
EmailLeftBit=substr(RightBit,LeftPos,SnailPos-LeftPos)
RightPos=SnailPos+1
do until RightPos>lRightBit
OneChar=substr(RightBit,RightPos,1)
if pos(OneChar,tlDelimiters)<>0 then
do
RightPos=RightPos-1
leave
end
RightPos=RightPos+1
end
if RightPos>lRightBit then
RightPos=lRightBit
if substr(RightBit,RightPos,1)='.' then
RightPos=RightPos-1
EmailRightBit=substr(RightBit,SnailPos+1,RightPos-SnailPos)
if verify(EmailLeftBit,tlOkInEmailName)<>0|verify(EmailRightBit,tlOkInEmailSvr)<>0|pos('.',EmailRightBit)=0 then
do
LeftBit=LeftBit||left(RightBit,SnailPos)
RightBit=substr(RightBit,SnailPos+1)
end
else
do
EmailBit=ReplaceString(tlTransformSpec,UrlTypeVar, 'mailto:')
EmailBit=ReplaceString(EmailBit,UrlNameVar,EmailLeftBit|| '@' ||EmailRightBit)
LeftBit=LeftBit||left(RightBit,LeftPos-1)||EmailBit
RightBit=substr(RightBit,RightPos+1)
end
end
SnailPos=pos('@',RightBit)
end
return(LeftBit||RightBit)

IMPORTTX_37:
signal IMPORTWR_38

HandleLineWrapping:
if ImportParms<> '' then
CryAndDie('There are too many parameters on the WRAP #import!')
DropBlankLines=translate(GetImportValue('DROP_BLANK_LINES',  'Y'))
call GetImportValue_Tabs
WrapFilter=GetImportValue_RecordFilter()
call GetImportValue_LineFilter
call GetImportValue_Comments ';', ';' || ';'
if ProcessingMode='HTML' then
call HandleImportAsIsOptions ""
WrapLineNumber=0
NewDoubleQuote='" || d2c(34) || "'
call DBG_IMPORT 'Reading "' || FullImportName || '"...'
do while lines(FullImportName)<>0
WrapLine=ImportOneLine('Y')
WrapLineNumber=WrapLineNumber+1
if WrapLine='' then
do
if DropBlankLines='Y' then
iterate
end
if IsCmtLine(WrapLine)then
iterate
if WrapFilter='' then
do
RebuildCmd='"' || ReplaceString(WrapLine, '"', NewDoubleQuote) || '"'
SafeQuote=QuoteIt(RebuildCmd,TryQuoteListAny)
call PpwLineout ToInclude,StartsMacroReplacement||MacroName|| ' Line=' ||SafeQuote||RebuildCmd||SafeQuote||EndsMacroReplacement
end
else
do
call DBG_IMPORT 'Calling filter for line #' ||WrapLineNumber
call DBGIND 1
Remove=''
call ExecRexxCmd WrapFilter
if Remove<> '' then
do
if abbrev(Remove, "EOF:")then
do
call DBG_IMPORT 'This Record and all following dropped ==> ' ||Remove
call DBGIND-1
leave
end
else
do
call DBG_IMPORT 'Line dropped ==> ' ||Remove
call DBGIND-1
iterate
end
end
call DBGIND-1
call PpwLineout ToInclude,WrapLine
end
end
return(WrapLineNumber)

IMPORTWR_38:
MultiLineImportInProgress='N'
signal I_ML_39

HandleMultiLineImport:
if OptionDebugOn='Y' then
call DBG_IMPORT 'Importing multi line record file'
mlDelimiter=GetImportValue('DELIMITER',         '=')
mlLineSep=GetImportValue('SEPARATOR',         ' ')
mlStripL=translate(GetImportValue('STRIP_LEADING', 'Y'))
mlLineCmtChar=GetImportValue('LINE_COMMENT_CHAR',LineComment)
if mlLineCmtChar='' then
mlLineCmtChar=' '
call GetImportValue_LineFilter
MultiLineFilter=PerformReplacementsInCmdsParameters(GetImportValue('MULTILINE_FILTER', ''))
drop mlFIndex?.
do FieldIndex=1 to NumberOfFields
parse value translate(FieldExtra.FieldIndex)with FieldName ',' FieldOptions
if FieldName='' then
CryAndDie('No {field name} supplied for field #' ||FieldIndex)
call _valueS 'mlFIndex?.mli?' ||c2x(FieldName),FieldOptions
MlFieldName.FieldIndex=FieldName
end
MultiLineImportInProgress='Y'
LastMlStoredAs=''
ImportFileLine=0
LastCommentLine=''
call DBG_IMPORT 'Reading "' || FullImportName || '"...'
call _MlNewRecord
do while lines(FullImportName)<>0
MultiLine=strip(ImportOneLine('N'))
ImportFileLine=ImportFileLine+1
if MultiLine='' then
do
if MlFieldCnt<>0 then
do
gd!Eof=_MlGenerateRecord()
call _MlNewRecord
if gd!Eof then
leave
end
end
else
do
if left(MultiLine,1)=LineComment then
iterate
if MultiLineFilter<> '' then
do
call DBG_IMPORT 'Calling specified multi line filter'
call DBGIND 1
Remove=''
call ExecRexxCmd MultiLineFilter
if Remove<> '' then
do
if abbrev(Remove, "EOF:")then
do
call DBG_IMPORT 'Line #' || ImportFileLine || ' to EOF dropped ==> ' ||Remove
call DBGIND-1
leave
end
else
do
call DBG_IMPORT 'Line #' || ImportFileLine || ' dropped ==> ' ||Remove
call DBGIND-1
iterate
end
end
call DBGIND-1
end
parse var MultiLine MultiVar (mlDelimiter) MultiValue
if mlStripL='Y' then
MultiValue=strip(MultiValue, 'L')
else
do
if left(MultiValue,1)=' ' then
MultiValue=substr(MultiValue,2)
end
if MultiVar<> '' then
call _MlRememberFieldsValue strip(MultiVar, 'T'),MultiValue
else
do
if LastMlStoredAs='' then
CryAndDie('Line #' || ImportFileLine || ': No field to continue!')
mlNew=_valueG(LastMlStoredAs)||mlLineSep||MultiValue
call _valueS LastMlStoredAs,mlNew
end
end
end
call FileClose FullImportName
if MlFieldCnt<>0 then
call _MlGenerateRecord
MultiLineImportInProgress='N'
return(ImportFileLine)

_MlNewRecord:
call _NewRecord
MlFieldCnt=0
drop mlFValues?.
return

_MlRememberFieldsValue:
parse arg FieldN,FieldV
UFieldN=translate(FieldN)
StoredAs='mlFIndex?.mli?' ||c2x(UFieldN)
if symbol(StoredAs)<> 'VAR' then
CryAndDie('Line #' || ImportFileLine || ' - Unknown field name of "' || FieldN || '"')
FieldOptions=_valueG(StoredAs)
StoredAs='mlFValues?.mlv?' ||c2x(UFieldN)
LastMlStoredAs=StoredAs
if symbol(StoredAs)='VAR' then
CryAndDie('Line #' || ImportFileLine || ' - Field name of "' || FieldN || '" specified more than once')
if FieldV='' then
do
if pos('NONBLANK',FieldOptions)<>0 then
CryAndDie('Line #' || ImportFileLine || ' - Field "' || FieldN || '" contains a blank value')
end
if pos('NOASIS',FieldOptions)=0 then
call _valueS StoredAs,AsIs(FieldV)
else
call _valueS StoredAs,FieldV
MlFieldCnt=MlFieldCnt+1
return

_MlGenerateRecord:
do FieldIndex=1 to NumberOfFields
FieldName=MlFieldName.FieldIndex
StoredAs='mlFValues?.mlv?' ||c2x(FieldName)
if symbol(StoredAs)='VAR' then
call _AddField2Record _valueG(StoredAs)
else
do
FieldOptions=_valueG('mlFIndex?.mli?' ||c2x(FieldName))
if pos('REQUIRED',FieldOptions)<>0 then
CryAndDie('Line #' || ImportFileLine || ' - Required field "' || FieldName || '" was not specified')
call _AddField2Record ''
end
end
hd!Eof=GenerateRecordFromFields()
LastMlStoredAs=''
return(hd!Eof)

GetMlField:call TRACE "OFF"
if MultiLineImportInProgress<> 'Y' then
CryAndDie('GetMlField(): Multi line import is not in progress!')
FieldName=translate(arg(1))
StoredAs='mlFValues?.mlv?' ||c2x(FieldName)
if symbol(StoredAs)='VAR' then
return(_valueG(StoredAs))
CryAndDie('Line #' || ImportFileLine || ' - GetMlField(): Field "' || FieldName || '" is unknown!')

I_ML_39:
call LoopInit
signal LOOP_40

LoopInit:
InLoop='N'
LoopCnt=0
LoopLine=1
LoopID=0
LoopContinueIndex=0
LoopFirstLineNumber=-1
LoopAtEndLineNumber=-1
LoopIfNesting=-1
LoopLinesFromFile=-1
return

LoopPush:
SavedAs=arg(1)
SFI_InLoop.SavedAs=InLoop
SFI_LoopCnt.SavedAs=LoopCnt
SFI_LoopLine.SavedAs=LoopLine
SFI_LoopLinesFromFile.SavedAs=LoopLinesFromFile
SFI_LoopFirstLineNumber.SavedAs=LoopFirstLineNumber
SFI_LoopAtEndLineNumber.SavedAs=LoopAtEndLineNumber
SFI_LoopIfNesting.SavedAs=LoopIfNesting
SFI_LoopContIndex.SavedAs=LoopContinueIndex
do SaveIndex=1 to LoopCnt
SavedPpwLoop.SaveIndex.SavedAs=PpwLoop.SaveIndex
end
call LoopInit
return

LoopPop:
SavedAs=arg(1)
InLoop=SFI_InLoop.SavedAs
LoopCnt=SFI_LoopCnt.SavedAs
LoopLine=SFI_LoopLine.SavedAs
LoopLinesFromFile=SFI_LoopLinesFromFile.SavedAs
LoopFirstLineNumber=SFI_LoopFirstLineNumber.SavedAs
LoopAtEndLineNumber=SFI_LoopAtEndLineNumber.SavedAs
LoopIfNesting=SFI_LoopIfNesting.SavedAs
LoopContinueIndex=SFI_LoopContIndex.SavedAs
do SaveIndex=1 to LoopCnt
PpwLoop.SaveIndex=SavedPpwLoop.SaveIndex.SavedAs
end
return

ProcessLoopStart:
if InLoop='Y' then
CryAndDie("Can't nest loops (within one source file)", "The outer loop starts on line " ||LoopFirstLineNumber)
InLoop='Y'
LoopID=LoopID+1
LoopCnt=0
LoopLine=1
id!A=arg(1)
if id!A="" then
id!LoopType=''
else
do
id!A=PerformReplacementsInCmdsParameters(id!A)
parse var id!A id!LoopType id!A
id!LoopType=translate(id!LoopType)
select
when id!LoopType='FOR' then
do
parse value translate(id!A)with id!Var "=" id!Strt " TO " id!End
if id!End="" then
CryAndDie("Incorrect FOR spec ==> " ||id!A)
id!Var=strip(id!Var)
id!Strt=strip(id!Strt)
call _valueS id!Var,id!Strt
end
when id!LoopType='SET' then
do
if translate(word(id!A,1))<> 'COUNTER' then
id!Var='SetLoopVar' ||LoopID
else
do
id!Var=word(id!A,2)
id!A=subword(id!A,3)
end
id!SetCnt=0
id!InitSet=''
id!LoopSetCnt=0
id!IndexList=''
id!NewArray='SETITEMS' ||LoopID
do while id!A<> ''
id!SetName=GetQuotedText(id!A, "id!A")
if pos('=',id!SetName)<>0 then
do
parse var id!SetName id!SetName '=' id!Rest
parse var id!Rest '{' id!Del '}' id!2Split
if id!2Split=='' then
do
id!Del=' '
id!2Split=id!Rest
end
call ArraySplit id!SetName,id!2Split,id!Del
end
id!SetVAR="SET_" ||id!SetName
id!SetStem=id!SetName|| '.'
id!SetCnt=id!SetCnt+1
id!IndexVar='id!' ||id!SetCnt
id!InitSet=id!InitSet|| 'do ' || id!IndexVar || ' = 1 to ' || id!SetStem || '0; '
if id!SetCnt<>1 then
id!IndexList=id!IndexList|| ' || '
id!IndexList=id!IndexList|| '"' || id!SetVar || '=' || id!SetStem || '" || ' || id!IndexVar || ' || ";"'
end
id!InitSet=id!InitSet|| 'id!LoopSetCnt=id!LoopSetCnt+1; '
id!InitSet=id!InitSet||id!NewArray|| '.id!LoopSetCnt=strip(' || id!IndexList || '); '
do id!I=1 to id!SetCnt
id!InitSet=id!InitSet|| 'end; '
end
call ExecRexxCmd id!InitSet
call _valueS id!NewArray|| '.0',id!LoopSetCnt
id!End=id!LoopSetCnt
call _valueS id!Var,1
end
otherwise
CryAndDie('Invalid loop specification (command "' || id!LoopType || '" unknown)')
end
end
if id!LoopType='FOR' | id!LoopType = 'SET' then
do
call DBG 'Adding FOR/SET loop lines'
LoopCnt=LoopCnt+1
PpwLoop.LoopCnt='#if [' || id!Var || ' > ' || id!End || ']'
LoopCnt=LoopCnt+1
PpwLoop.LoopCnt='#break'
LoopCnt=LoopCnt+1
PpwLoop.LoopCnt='#endif'
if id!LoopType='SET' then
do
call DBG 'Adding SET loop lines for ' || id!LoopSetCnt || ' loops'
LoopCnt=LoopCnt+1
PpwLoop.LoopCnt='#evaluate ^^ ^<' || '??' || id!NewArray || '.' || id!Var || '>^'
end
end
LoopFirstLineNumber=IncludeLineNumber
LoopIfNesting=IfNesting
if IncludeMemBufferNextLine=='' then
LoopLinesFromFile=1
else
LoopLinesFromFile=0
LengthEndCmd=length(CmdHashLoopE)
FoundEnd='N'
do forever
if LoopLinesFromFile=1 then
do
if IncludeFileLines()=0 then
leave
LoopCnt=LoopCnt+1
PpwLoop.LoopCnt=IncludeFileLineIn()
InputLines=InputLines+1
end
else
do
if IncludeMemBufferNextLine=='' then
leave
LoopCnt=LoopCnt+1
parse var IncludeMemBufferNextLine PpwLoop.LoopCnt (MarksNewLine) IncludeMemBufferNextLine
end
id!MaybeEnd=left(strip(translate(PpwLoop.LoopCnt,,TabChar), 'L'),LengthEndCmd)
if id!MaybeEnd=CmdHashLoopE then
do
FoundEnd='Y'
LoopCnt=LoopCnt-1
if LoopCnt=0 then
CryAndDie("No commands found in body of loop!")
leave
end
end
LoopAtEndLineNumber=IncludeLineNumber
if FoundEnd='N' then
do
if LoopLinesFromFile then
eLoop='EOF'
else
eLoop='end of macro'
CryAndDie('Could not find "' || CmdHashLoopE || '" before ' || eLoop, 'Searched ' || LoopCnt || ' line(s)')
end
if id!LoopType='FOR' | id!LoopType = 'SET' then
do
call DBG 'Adding FOR/SET loop lines'
LoopCnt=LoopCnt+1
PpwLoop.LoopCnt='#RexxVar ^' || id!Var || '^ + 1'
LoopContinueIndex=LoopCnt
end
else
do
LoopContinueIndex=1
end
call DBG 'Loop is ' || LoopCnt || ' line(s) long and ends on line ' ||AddCommasToDecimalNumber(IncludeLineNumber)
return(0)

GetLoopLineIntoFileLine:
FileLine=PpwLoop.LoopLine
if LoopLinesFromFile then
IncludeLineNumber=LoopFirstLineNumber+LoopLine
LoopLine=LoopLine+1
if LoopLine>LoopCnt then
LoopLine=1
return(FileLine)

ProcessLoopBreak:
call DBG 'Exiting loop'
InLoop='N'
IfNesting=LoopIfNesting
IncludeLineNumber=LoopAtEndLineNumber
return(0)

ProcessLoopContinue:
LoopLine=LoopContinueIndex
call DBG 'Back to "start" of loop - Loop Line #' ||LoopContinueIndex
IfNesting=LoopIfNesting
return(0)

LOOP_40:
_RestrictKeyMinimum=CharsLUN
_giCounter=0
signal GetId_41

GetIdPrepare:call TRACE "OFF"
giHandle=arg(1)
giUniqueId=translate(arg(2))
interpret 'drop GI?'  || giHandle || '.'
call _valueS 'GI?'  || giHandle || '.GI?UID',giUniqueId
return

SetId:call TRACE "OFF"
giHandle=arg(1)
giName=arg(2)
giId=arg(3)
giSaveAsPrefix='GI?'  || giHandle || '.GI?'
if giName\=='' then
do
if _valueG(giSaveAsPrefix|| 'UID') = 'Y' then
CryAndDie("You have asked for UNIQUE ID's to be generated. Don't use SetId()!!!")
giKeySavedAs=giSaveAsPrefix|| 'KEY_' ||c2x(giName)
if symbol(giKeySavedAs)='VAR' then
CryAndDie('SetId(): The KEY of "' || giName || '" has already been used')
call _valueS giKeySavedAs,giId
end
IdSavedAs=giSaveAsPrefix|| 'ID_' ||c2x(giId)
if symbol(IdSavedAs)='VAR' then
CryAndDie('SetId(): The ID of "' || giId || '" has already been used')
call _valueS IdSavedAs, ''
return('')

GetId:call TRACE "OFF"
giHandle=arg(1)
giType=translate(arg(2))
giName=arg(3)
giSaveAsPrefix='GI?'  || giHandle || '.GI?'
giUniqueId=_valueG(giSaveAsPrefix|| 'UID')
if giUniqueId<> 'Y' then
do
giKeySavedAs=giSaveAsPrefix|| 'KEY_' ||c2x(giName)
if symbol(giKeySavedAs)='VAR' then
return(_valueG(giKeySavedAs))
end
GiMaxLength=''
select
when giType="MAXCHARS" then
do
CanBeDuplicated='Y'
GiMaxLength=arg(5)
if GiMaxLength='' then
GiMaxLength=8
giId=_Id_2_(giName,arg(4))
if length(giId)>GiMaxLength then
giId=left(giId,GiMaxLength)
end
when giType="C2X" then
do
CanBeDuplicated='N'
giId=_Id_c2x(giName,arg(4))
end
when giType="2_" then
do
CanBeDuplicated='Y'
giId=_Id_2_(giName,arg(4))
end
otherwise
CryAndDie('GetId(): Invalid type of "' || giType || '" specified')
end
if CanBeDuplicated='Y' then
do
IdSavedAs=giSaveAsPrefix|| 'ID_' ||c2x(giId)
if symbol(IdSavedAs)='VAR' then
do
GiIndex=1
do forever
if GiMaxLength='' then
giTryId=giId||GiIndex
else
do
giChopLength=GiMaxLength-length(GiIndex)
if length(giId)>giChopLength then
giTryId=left(giId,giChopLength)||GiIndex
else
giTryId=giId||GiIndex
end
GiIndex=GiIndex+1
IdSavedAs=giSaveAsPrefix|| 'ID_' ||c2x(giTryId)
if symbol(IdSavedAs)<> 'VAR' then
do
giId=giTryId
leave
end
end
end
call _valueS IdSavedAs, ''
end
if giUniqueId<> 'Y' then
call _valueS giKeySavedAs,giId
return(giId)

_Id_2_:
parse arg KeyR,RestrictTo
RestrictTo=_RestrictKeyMinimum||RestrictTo
KeyL=''
InvPos=verify(KeyR,RestrictTo)
do while InvPos<>0
KeyL=KeyL||left(KeyR,InvPos-1)|| '_'
KeyR=substr(KeyR,InvPos+1)
InvPos=verify(KeyR,RestrictTo)
end
KeyL=strip(KeyL||KeyR,, '_')
do until BeforeCount=ReplaceCount
BeforeCount=ReplaceCount
KeyL=ReplaceString(KeyL, "__", "_")
end
if KeyL='' then
return('_')
else
return(KeyL)

_Id_c2x:
parse arg KeyR,RestrictTo
RestrictTo=_RestrictKeyMinimum||RestrictTo
KeyL=''
InvPos=verify(KeyR,RestrictTo)
do while InvPos<>0
KeyL=KeyL||left(KeyR,InvPos-1)|| 'x' ||c2x(substr(KeyR,InvPos,1))
KeyR=substr(KeyR,InvPos+1)
InvPos=verify(KeyR,RestrictTo)
end
return(KeyL||KeyR)

GetId_41:
call GetIdPrepare "IMAGEHW"
Add2Stem=''
_ValCharsHttp=UpperCase||LowerCase||DecimalDigits|| "./?%+:~_-,"
_ValCharsFtp=_ValCharsHttp
signal Evaluate_42

_ScaleSide:
parse arg SideBefore,SideScale
PercentPos=pos('%',SideScale)
if PercentPos=0 then
return(SideScale)
else
return((SideBefore*left(SideScale,PercentPos-1))%100)

_GetSizeTags:
if OptionDebugOn='Y' then
do
call DBGIND 1
call DBG_EVALUATE 'Real size = ' || ImageWidth || 'x' ||ImageHeight
call DBGIND-1
end
ImgScaleW=ImageScaleW
ImgScaleH=ImageScaleH
if ImgScaleW='?' | ImgScaleH = '?' then
do
if ImgScaleW='?' then
do
NewHeight=_ScaleSide(ImageHeight,ImgScaleH)
ImgScaleW=(NewHeight*100)%ImageHeight|| '%'
NewWidth=_ScaleSide(ImageWidth,ImgScaleW)
end
else
do
NewWidth=_ScaleSide(ImageWidth,ImgScaleW)
ImgScaleH=(NewWidth*100)%ImageWidth|| '%'
NewHeight=_ScaleSide(ImageHeight,ImgScaleH)
end
end
else
do
NewWidth=_ScaleSide(ImageWidth,ImgScaleW)
NewHeight=_ScaleSide(ImageHeight,ImgScaleH)
end
if ImageOldFormat='Y' then
ImageReturn='WIDTH='  || NewWidth || ' HEIGHT=' ||NewHeight
else
ImageReturn='WIDTH="' || NewWidth || '" HEIGHT="' || NewHeight || '"'
if ImageCacheKey<> '' then
call value ImageCacheKey,ImageReturn
return(ImageReturn)

CheckFileInfo:
parse arg iFile,iType,iId,iExpected
if iId==iExpected then
return
call FileClose iFile
Line1='"' || iFile || '" does not appear to be a "' || iType || '" file.'
Line2='It is ' || FileQuerySize(iFile) || ' bytes long. '
if iId=='' then
Line2=Line2|| 'This appears to be too short.'
else
Line2=Line2|| 'The ID is "x' || c2x(iId) || '" (expected "x' || c2x(iExpected) || '")'
CryAndDie(Line1,Line2)

_GetGifSize:
GifFormatId=left(charin(ImageFile,1,6),3)
call CheckFileInfo ImageFile, 'GIF', GifFormatId, 'GIF'
WidthLow=charin(ImageFile,,1)
WidthHigh=charin(ImageFile,,1)
ImageWidth=c2d(WidthHigh||WidthLow)
HeightLow=charin(ImageFile,,1)
HeightHigh=charin(ImageFile,,1)
ImageHeight=c2d(HeightHigh||HeightLow)
call FileClose ImageFile
return(_GetSizeTags())

_GetPngSize:
PngFormatId=charin(ImageFile,1,8)
call CheckFileInfo ImageFile, 'PNG', PngFormatId, '89'x || 'PNG' || '0D 0A 1A 0A'x
PngFormatId=charin(ImageFile,,4)
PngFormatId=charin(ImageFile,,4)
call CheckFileInfo ImageFile, 'PNG', PngFormatId, 'IHDR'
ImageWidth=c2d(charin(ImageFile,,4))
ImageHeight=c2d(charin(ImageFile,,4))
call FileClose ImageFile
return(_GetSizeTags())

_GetJpgSize:
FileType=c2x(Charin(ImageFile,1,2))
call CheckFileInfo ImageFile, 'JPEG', FileType, "FFD8"
NxtSeg=3
ImageHeight="IMAGEHEIGHT"
Type=''
do while(Type<> "D9") & (NxtSeg <> -1) & (Imageheight = "IMAGEHEIGHT")
NxtSeg=_ReadJpgSegment(NxtSeg)
end
call FileClose ImageFile
return(_GetSizeTags())

_ReadJpgSegment:
SegPos=arg(1)
Marker=c2x(charIn(ImageFile,SegPos))
if Marker<> "FF" then
return(-1)
Type=c2x(charIn(ImageFile))
Res=SegPos+2
select
when Type="01" | Type >= "D0" & Type <= "D9" then
SegmentLength=0
otherwise
SegmentLength=c2d(CharIn(ImageFile,,2))
End
Res=Res+SegmentLength
if Type="C0" | Type = "C2" then
do
Imagebps=c2d(CharIn(ImageFile))
ImageHeight=c2d(CharIn(ImageFile,,2))
ImageWidth=c2d(CharIn(ImageFile,,2))
end
return(Res)

GetImageHeightWidth:call TRACE "OFF"
parse arg ImageFile,ImageScaleW,ImageScaleH,ImageOldFormat,ImageNoCache
if ImageScaleW='' then
ImageScaleW='100%'
if ImageScaleH='' then
ImageScaleH='?'
if OptionDebugOn='Y' then
call DBG_EVALUATE 'GetImageHeightWidth("' || ImageFile || '", "' || ImageScaleW || '", "' || ImageScaleH || '")'
if ImageNoCache='Y' then
ImageCacheKey=''
else
do
ImageCacheKey='I_' || ImageFile || '_w' || c2x(ImageScaleW) || '_h' || c2x(ImageScaleH) || '_f' ||ImageOldFormat
ImageCacheKey=GetId("IMAGEHW", 'MAXCHARS',ImageCacheKey,,200)
if symbol(ImageCacheKey)='VAR' then
do
if OptionDebugOn='N' then
return(value(ImageCacheKey))
else
do
SizeString=value(ImageCacheKey)
call DBG_EVALUATE 'Returning "' || SizeString || '" (from cache)'
return(SizeString)
end
end
end
DotPos=lastpos('.',ImageFile)
if DotPos=0 then
CryAndDie('Unknown graphic file type on "' || ImageFile || '".')
ImageExtn=translate(substr(ImageFile,DotPos+1))
if FileQueryExists(ImageFile)='' then
do
CryAndDie('Graphic file "' || ImageFile || '" does not exist.')
return('')
end
call DBGIND 1
select
when ImageExtn='GIF' then
SizeString=_GetGifSize()
when ImageExtn='PNG' then
SizeString=_GetPngSize()
when ImageExtn='JPG' | ImageExtn = 'JPEG' then
SizeString=_GetJpgSize()
otherwise
CryAndDie('Currently only support "GIF", "JPEG" & "PNG" files.')
end
if OptionDebugOn='Y' then
call DBG_EVALUATE 'Returning "' || SizeString || '"'
call DBGIND-1
return(SizeString)

ToUpperCase:call TRACE "OFF"
if OptionDebugOn='Y' then
call DBG_EVALUATE 'ToUpperCase()'
call GetUserLcCfg
return(translate(arg(1),CfgUpper,CfgLower))

ToLowerCase:call TRACE "OFF"
if OptionDebugOn='Y' then
call DBG_EVALUATE 'ToLowerCase()'
call GetUserLcCfg
return(translate(arg(1),CfgLower,CfgUpper))

EnsureFileHasCorrectCase:call TRACE "OFF"
cFileI=arg(1)
if OptionTranslateFileNames='N' then
return(cFileI)
if OptionTranslateFileNames='UPPER' then
cFileO=translate(cFileI)
else
cFileO=translate(cFileI,LowerCase,UpperCase)
if OptionDebugOn='Y' then
do
if cFileI<>cFileO then
do
call DBG_EVALUATE 'A files case was adjusted'
call DBGIND 1
call DBG_EVALUATE 'FROM: "' || cFileI || '"'
call DBG_EVALUATE '  TO: "' || cFileO || '"'
call DBGIND-1
end
end
return(cFileO)

GetAmPmTime:call TRACE "OFF"
return(GetAmPmTimeFromHhMmSs(time('N'),arg(1),arg(2)))

GetAmPmTimeFromHhMmSs:call TRACE "OFF"
parse arg jd!PT,jd!AddSS,jd!AmPm
if jd!AmPm='' then
jd!AmPm='am;pm'
parse var jd!AmPm jd!AmTxt ';' jd!PmTxt
if pos(':',jd!PT)=0 then
parse var jd!PT jd!HH 3 jd!MM 5 jd!SS
else
parse var jd!PT jd!HH ':' jd!MM ':' jd!SS
if jd!HH>=12 then
jd!AmPm=jd!PmTxt
else
jd!AmPm=jd!AmTxt
if jd!HH>12 then
jd!HH=jd!HH-12
jd!HH=jd!HH+0
jd!MM=right(jd!MM,2, '0')
if jd!AddSS='' then
do
if jd!SS='' then
jd!AddSS='N'
else
jd!AddSS='Y'
end
if jd!AddSS='N' then
jd!SS=''
else
jd!SS=':' || right(jd!SS, 2, '0')
jd!T=jd!HH|| ':' ||jd!MM||jd!SS||jd!AmPm
return(jd!T)

AddCommasToDecimalNumber:procedure;call TRACE "OFF"
kd!Str=strip(arg(1))
if pos(',',kd!Str)<>0 then
return(kd!Str)
kd!P=pos('.',kd!Str)
if kd!P=0 then
kd!After=''
else
do
if kd!P=1 then
return("0" ||kd!Str)
kd!After=substr(kd!Str,kd!P+1)
kd!Str=left(kd!Str,kd!P-1)
end
kd!Str=reverse(kd!Str)
kd!With=""
do while length(kd!Str)>3
kd!With=kd!With||left(kd!Str,3)|| ','
kd!Str=substr(kd!Str,4)
end
kd!With=kd!With||kd!Str
kd!With=reverse(kd!With)
if kd!After<> '' then
kd!With=kd!With|| '.' ||kd!After
return(kd!With)

PadString:procedure;call TRACE "OFF"
parse arg TheString,TheMaxSize,PadType
StringSize=length(TheString)
if StringSize>=TheMaxSize then
return(TheString)
SpacesRequired=TheMaxSize-StringSize
if PadType='R' then
return(copies(' ',SpacesRequired)||TheString)
else
do
if PadType<> 'C' then
return(TheString||copies(' ',SpacesRequired))
else
do
SpacesOnLeft=SpacesRequired%2
return(copies(' ', SpacesOnLeft) || TheString || copies(' ',SpacesRequired-SpacesOnLeft))
end
end

BreakAt:call TRACE "OFF"
parse arg ld!Max,ld!Str,ld!Chars,ld!With
if ld!Chars=='' then
ld!Chars=CfgMacro("PPWIZARD_BREAKAT_AFTER", './:#')
if ld!With='' then
ld!With=CfgMacro("PPWIZARD_BREAKAT_USE",   '<br>')
baPos=pos('-',ld!Max)
if baPos=0 then
baMinSize=ld!Max%3
else
parse var ld!Max baMinSize'-'ld!Max
ld!Rc=''
do while length(ld!Str)>ld!Max
ld!Left=left(ld!Str,ld!Max)
ld!Str=substr(ld!Str,ld!Max+1)
ld!BestPos=0
ld!CharList=ld!Chars
do while ld!CharList\==''
ld!ThisChar=left(ld!CharList,1)
ld!CharList=substr(ld!CharList,2)
ld!Pos=lastpos(ld!ThisChar,ld!Left)
if ld!Pos>ld!BestPos then
do
ld!BestPos=ld!Pos
end
end
if ld!Rc<> '' then
ld!Rc=ld!Rc||ld!With
if ld!BestPos=0 then
ld!Rc=ld!Rc||ld!Left
else
do
ld!Rc=ld!Rc||left(ld!Left,ld!BestPos)
ld!Str=substr(ld!Left,ld!BestPos+1)||ld!Str
end
end
if ld!Rc<> '' then
return(ld!Rc||ld!With||ld!Str)
else
return(ld!Rc||ld!Str)

Wbr:call TRACE "OFF"
parse arg md!Str,md!Chars,md!Use,md!Min
if md!Use='' then
md!Use=CfgMacro("PPWIZARD_WBR_USE", '<wbr>')
if md!Chars=='' then
md!Chars=CfgMacro("PPWIZARD_WBR_AFTER", '/\?&')
if md!Min='' then
md!Min=CfgMacro("PPWIZARD_WBR_MIN",0)
md!Rc=''
md!Start=1
do while md!Str\==''
md!Pos=verify(md!Str,md!Chars, 'M',md!Start)
if md!Pos=0 then
leave
if md!Pos<md!Min then
do
md!Start=md!Pos+1
iterate
end
md!Rc=md!Rc||left(md!Str,md!Pos)||md!Use
md!Str=substr(md!Str,md!Pos+1)
md!Start=1
end
md!Rc=md!Rc||md!Str
return(md!Rc)

MacroGet:call TRACE "OFF"
if OptionDebugOn='Y' then
call DBG_EVALUATE 'MacroGet()'
GotValue=GetDefineContents(arg(1))
if OptionDebugOn='Y' then
call DBG_EVALUATE 'MacroGet("' || arg(1) || '") = ' ||DebugRightArrow||GotValue||DebugLeftArrow
return(GotValue)

Defined:call TRACE "OFF"
if OptionDebugOn='N' then
return(MacroExists(arg(1)))
else
do
call DBG_EVALUATE 'Defined("' || arg(1) || '")?'
call DBGIND 1
nd!Yn=MacroExists(arg(1))
call DBG_EVALUATE 'Returning: ' ||nd!Yn
call DBGIND-1
return(nd!Yn)
end

DataSave:call TRACE "OFF"
if OptionDebugOn='Y' then
call DBG_EVALUATE 'DataSave()'
parse arg StoreApp,StoreKey,StoreData
call _valueS "DSAP_" || c2x(StoreApp) || '.DSKY_' ||c2x(StoreKey),StoreData
return

DataGet:call TRACE "OFF"
if OptionDebugOn='Y' then
call DBG_EVALUATE 'DataGet()'
parse arg StoreApp,StoreKey,StoreDefault
DataVarName="DSAP_" || c2x(StoreApp) || '.DSKY_' ||c2x(StoreKey)
if symbol(DataVarName)<> 'VAR' then
return(StoreDefault)
else
return(_valueG(DataVarName))

UrlEncode:call TRACE "OFF"
if OptionDebugOn='Y' then
call DBG_EVALUATE 'UrlEncode()'
UrlIn=arg(1)
ueCmd=translate(arg(2))
SpaceToPlus='N'
select
when ueCmd='TO%' then
do
UrlBadChars=arg(3)
if UrlBadChars=='' then
UrlBadChars='+<>%"/?# '
end
when ueCmd='TO%EXCEPT' then
do
UrlOkChars=arg(3)
if UrlOkChars=='' then
UrlOkChars=CharsLUN|| '-._'
UrlBadChars=space(translate(xrange('00'x, 'FF'x), '',UrlOkChars),0)
if pos(' ',UrlOkChars)=0 then
UrlBadChars=UrlBadChars|| ' '
end
when ueCmd='ENCODEALL' then
UrlBadChars=xrange('00'x, 'FF'x)
otherwise
CryAndDie('Invalid UrlEncode() command of "' || ueCmd || '"')
end
UrlOut=''
UrlCount=length(UrlIn)
do CharPosn=1 to UrlCount
ThisChar=substr(UrlIn,CharPosn,1)
if pos(ThisChar,UrlBadChars)=0 then
UrlOut=UrlOut||ThisChar
else
do
if ThisChar==' ' & SpaceToPlus = 'Y' then
UrlOut=UrlOut|| '+'
else
UrlOut=UrlOut|| '%' || right(c2x(ThisChar), 2, '0')
end
end
return(UrlOut)

UrlDecode:call TRACE "OFF"
if OptionDebugOn='Y' then
call DBG_EVALUATE 'UrlDecode()'
parse arg UrlIn,udCmd
UrlPlusIsSpace='Y'
if udCmd<> '' then
do
if translate(udCmd)='LEAVE+' then
UrlPlusIsSpace='N'
else
CryAndDie('Invalid UrlDecode() command of "' || udCmd || '"')
end
UrlOut=''
CharPosn=1
UrlCount=length(UrlIn)
do while CharPosn<=UrlCount
ThisChar=substr(UrlIn,CharPosn,1)
CharPosn=CharPosn+1
if UrlPlusIsSpace<> 'N' & ThisChar = '+' then
ThisChar=' '
else
do
if ThisChar='%' then
do
ThisChar=substr(UrlIn,CharPosn,2)
CharPosn=CharPosn+2
if CharPosn>(UrlCount+1)then
CryAndDie('Invalid URL encoding of "%' || strip(ThisChar) || '" at end of URL')
ThisChar=x2c(ThisChar)
end
end
UrlOut=UrlOut||ThisChar
end
return(UrlOut)

Warning:call TRACE "OFF"
call OutputWarningToScreen arg(1),arg(2)
return(0)

Error:call TRACE "OFF"
call CryAndDie 'Rexx code called Error()', '------------------------',arg(1),arg(2),arg(3),arg(4),arg(5),arg(6),arg(7),arg(8),arg(9),arg(10)
return(0)

Info:call TRACE "OFF"
call OutputInformationToScreen arg(1)
return(0)

DieIfIoErrorOccurred:call TRACE "OFF"
od!F=arg(1)
if OptionDebugOn='Y' then
call DBG_EVALUATE 'DieIfIoErrorOccurred("' || od!F || '")'
FileState=FileState(od!F)
if FileState='READY' then
return
IoReason=FileDescription(od!F)
if IoReason\=='NOTREADY:EOF' then
do
if RexWhich='REGINA' & IoReason = '' then
do
if OptionDebugOn='Y' then
do
call DBG 'DieIfIoErrorOccurred(): Bug first reported to Mark Hessling 3/10/99 for 0.08h beta'
call DBGIND 1
call DBG 'I/O failure on "' || od!F || '" (' || IoReason || ').'
call DBGIND-1
end
return
end
call _FileClose od!F
call CryAndDie 'I/O failure on "' || od!F || '" (' || IoReason || ').'
end
return

_ValidateIcLevel:
pd!L=arg(1)
if pd!L='' then
pd!L=IncludeLevel
if datatype(pd!L, 'WholeNumber')<>1 then
return(0)
if pd!L<1|pd!L>IncludeLevel then
return(0)
return(pd!L)

InputComponentLevel:call TRACE "OFF"
if OptionDebugOn='Y' then
call DBG_EVALUATE 'InputComponentLevel()'
qd!L=_ValidateIcLevel(arg(1))
if qd!L=0 then
return('')
else
return(IncludeFileName.qd!L)

InputComponentLineLevel:call TRACE "OFF"
if OptionDebugOn='Y' then
call DBG_EVALUATE 'InputComponentLineLevel()'
rd!L=_ValidateIcLevel(arg(1))
if rd!L=0 then
return('')
else
return(GetLineNumber4Level(rd!L))

GetLineNumber4Level:
sd!L=arg(1)
if sd!L=IncludeLevel then
return(IncludeLineNumber)
else
return(_IncludeLineNumber.sd!L)

FileSlashReduction:call TRACE "OFF"
parse arg td!F,td!M
if td!M='' then
td!M=OptionFileSR
call DBG 'FileSlashReduction(' || td!F || ') in "' || td!M || '" mode'
call DBGIND 1
td!M=translate(td!M)
if td!M<> 'NONE' then
do
if td!M='UNC' then
do
parse var td!F td!P+1 td!F
end
else
do
if td!M<> 'ALL' then
CryAndDie('Invalid file slash reduction mode of "' || td!M || '"')
else
do
td!P=''
end
end
do until td!PC=ReplaceCount
td!PC=ReplaceCount
td!F=ReplaceString(td!F,RexDirChar||RexDirChar,RexDirChar)
end
td!F=td!P||td!F
end
call DBG 'Returning "' || td!F || '"'
call DBGIND-1
return(td!F)

GenerateFileName:call TRACE "OFF"
parse arg ud!SrcFile,ud!EdtMsk
if OptionDebugOn='Y' then
do
call DBG 'GenerateFileName(' || ud!SrcFile || ') using "' || ud!EdtMsk || '"'
call DBGIND 1
call DBG 'Current directory is "' || GetCurrentDirectory() || '"'
end
ShortName=_filespec('name',ud!SrcFile)
ShortNameNE=_filespec('withoutextn',ShortName)
InputPath=_filespec('location',ud!SrcFile)
ud!Full=ReplaceString(ud!EdtMsk, "?",InputPath)
ud!Full=ReplaceString(ud!Full, "*.*",ShortName)
ud!Full=ReplaceString(ud!Full, "*",ShortNameNE)
ud!Full=ReplaceString(ud!Full, "{$PATH}",InputPath)
ud!Full=ReplaceString(ud!Full, "{$BASE}",ShortNameNE)
ud!Full=ReplaceString(ud!Full, "{$SHORT}",ShortName)
ud!Full=ReplaceString(ud!Full, "{$FULL}",ud!SrcFile)
ud!Full=ReplaceString(ud!Full, "{$OutputDir}",OptionOutputDefDir)
if pos('{$path}',ud!Full)<>0 then
do
call DBGIND 1
ud!Bd=BaseDir4CurrentInputFile
call DBG '{$path} found, base directory is "' || ud!Bd || '"'
call ValidateBaseDirUse ud!BD,ud!SrcFile
ud!SrcDir=_filespec('Location',ud!SrcFile)
ud!RelDir=substr(ud!SrcDir,length(ud!Bd)+1)
call DBG '{$path} = "' || ud!RelDir || '"'
ud!Full=ReplaceString(ud!Full, "{$path}",ud!RelDir)
call DBGIND-1
end
ud!Full=FileSlashReduction(ud!Full)
ud!Full=EnsureFileHasCorrectCase(ud!Full)
if OptionDebugOn='Y' then
call DBG 'Generated Name = "' || ud!Full || '"'
if OptionDebugOn='Y' then
call DBGIND 1
call MakeDirectoryTree _filespec('drive', ud!Full) || _filespec('path',ud!Full)
if OptionDebugOn='Y' then
call DBGIND-2
return(ud!Full)

ProcessNext:call TRACE "OFF"
if OptionDebugOn='Y' then
call DBG_EVALUATE 'ProcessNext()'
do
if InLoop='Y' &LoopLinesFromFile=0 then
do
if IncludeLoopMemBufferNextLine=='' then
IncludeLoopMemBufferNextLine=arg(1)
else
IncludeLoopMemBufferNextLine=arg(1)||MarksNewLine||IncludeLoopMemBufferNextLine
end
else
do
if IncludeMemBufferNextLine=='' then
IncludeMemBufferNextLine=arg(1)
else
IncludeMemBufferNextLine=arg(1)||MarksNewLine||IncludeMemBufferNextLine
end
end
return

Tabs2Spaces:call TRACE "OFF"
if OptionDebugOn='Y' then
call DBG_EVALUATE 'Tabs2Spaces()'

ExpandTabs:
parse arg t2sRightBit,t2sTabWidth
if pos('09'x,t2sRightBit)=0 then
return(t2sRightBit)
t2sLeftBit=''
t2sLeftBitL=0
t2sTabPos=pos('09'x,t2sRightBit)
if t2sTabWidth='' then
t2sTabWidth=8
do while t2sTabPos<>0
t2sLeftBit=t2sLeftBit||left(t2sRightBit,t2sTabPos-1)
t2sLeftBitL=t2sLeftBitL+(t2sTabPos-1)
Spaces4Tab=t2sTabWidth-((t2sLeftBitL+1)//t2sTabWidth)
t2sLeftBit=t2sLeftBit||copies(' ',Spaces4Tab)
t2sLeftBitL=t2sLeftBitL+Spaces4Tab
t2sRightBit=substr(t2sRightBit,t2sTabPos+1)
t2sTabPos=pos('09'x,t2sRightBit)
end
return(t2sLeftBit||t2sRightBit)

RexxVarDefined:call TRACE "OFF"
if OptionDebugOn='Y' then
call DBG_EVALUATE 'RexxVarDefined()'
vsValue=symbol(arg(1))
if vsValue='BAD' then
do
vsLength=length(arg(1))
if symbol(copies('A', vsLength)) <> 'BAD' then
Reason=''
else
Reason='A symbol length of "' || vsLength || ' bytes seems to be too long for your rexx interpreter!'
CryAndDie('RexxVarDefined()', 'Invalid symbol of "' || arg(1) || '" passed.',Reason)
end
if vsValue='VAR' then
return(1)
else
return(0)

ReplaceCurlyHexCodes:call TRACE "OFF"
if OptionDebugOn='Y' then
call DBG_EVALUATE 'ReplaceCurlyHexCodes()'
Before=arg(1)
RightBit=Before
LeftBit=''
StartPos=pos('{x',RightBit)
do while StartPos<>0
Codes2=substr(RightBit,StartPos+2,2)
if datatype(Codes2, 'X') <> 1 | substr(RightBit, StartPos+4, 1) <> '}' then
do
LeftBit=LeftBit||left(RightBit,StartPos+1)
RightBit=substr(RightBit,StartPos+2)
end
else
do
LeftBit=LeftBit||left(RightBit,StartPos-1)||x2c(Codes2)
RightBit=substr(RightBit,StartPos+5)
end
StartPos=pos('{x',RightBit)
end
LeftBit=LeftBit||RightBit
if OptionDebugOn='Y' then
do
if Before<>LeftBit then
call DebugOutputAfterReplacement LeftBit, '{xXX}'
end
return(LeftBit)

RandomString:call TRACE "OFF"
parse arg RsString,RsPickFrom
if RsPickFrom='' then
RsPickFrom=DecimalDigits||UpperCase
RsMax=length(RsPickFrom)
QPos=pos('?',RsString)
do while QPos<>0
RsString=left(RsString,QPos-1)||substr(RsPickFrom,random(1,RsMax),1)||substr(RsString,QPos+1)
QPos=pos('?',RsString)
end
return(RsString)

_FindFileInPathList:
parse arg vd!Look4,vd!PathList
call DBGIND 1
if OptionDebugOn='Y' then
call DBG_EVALUATE 'Searching for "' || vd!Look4 || '" in "' || vd!PathList || '"'
if RexSystemOpSys="UNIX" then
vd!SepChar=':'
else
vd!SepChar=';'
vd!Found=''
do while vd!PathList<> ''
parse var vd!PathList vd!Path (vd!SepChar) vd!PathList
if right(vd!Path,1)<>RexDirChar then
vd!Path=vd!Path||RexDirChar
vd!Found=_FileQueryExists(vd!Path||vd!Look4)
if vd!Found<> '' then
leave
end
if OptionDebugOn='Y' then
call DBG_EVALUATE 'Found "' || vd!Found || '"'
call DBGIND-1
return(vd!Found)

FindFileInPath:call TRACE "OFF"
parse arg wd!Look4,wd!LookIn
if RexSystemOpSys="UNIX" then
wd!SepChar=':'
else
wd!SepChar=';'
if OptionDebugOn='Y' then
call DBG_EVALUATE 'FindFileInPath(): Looking for "' || wd!Look4 || '" in "' || wd!LookIn || '"'
call DBGIND 1
wd!Searched=''
do while wd!LookIn<> ''
parse var wd!LookIn wd!ThisBit (wd!SepChar) wd!LookIn
if wd!ThisBit='' then
iterate
wd!Left1=left(wd!ThisBit,1)
select
when wd!Left1='*' then
do
wd!LookIn=GetEnv(substr(wd!ThisBit,2))||wd!SepChar||wd!LookIn
end
when wd!Left1='+' then
do
wd!Comb=substr(wd!ThisBit,2)
wd!Mask=wd!Comb
if right(wd!Mask,1)<>RexDirChar then
wd!Mask=wd!Mask||RexDirChar
wd!Mask=wd!Mask|| '*.*'
wd!List.0=0
call Dirs4Mask wd!Mask, 'wd!List', 'Y'
do wd!Index=1 to wd!List.0
wd!Comb=wd!Comb||wd!SepChar||wd!List.wd!Index
end
wd!LookIn=wd!Comb||wd!SepChar||wd!LookIn
end
otherwise
do
if wd!Searched='' then
wd!Searched=wd!ThisBit
else
wd!Searched=wd!Searched||wd!SepChar||wd!ThisBit
end
end
end
wd!Found=_FindFileInPathList(wd!Look4,wd!Searched)
if wd!Found<> '' then
wd!Found=FileQueryExists(wd!Found)
if OptionDebugOn='Y' then
call DBG_EVALUATE 'Result: "' || wd!Found || '"'
call DBGIND-1
return(wd!Found)

IncludePath:call TRACE "OFF"
xd!P=arg(1)
if xd!P='' then
OptionIncludePathCnt=0
else
do
OptionIncludePathCnt=OptionIncludePathCnt+1
OptionIncludePath.OptionIncludePathCnt=xd!P
end
return

FindFile:call TRACE "OFF"
parse arg yd!Look4,yd!Die
yd!Found=''
if OptionDebugOn='Y' then
call DBG_EVALUATE 'FindFile(): Looking for "' || yd!Look4 || '"'
call DBGIND 1
if yd!Found='' then
do
call DBG_EVALUATE 'Looking in current directory'
yd!Found=FileQueryExists(yd!Look4)
end
if yd!Found='' then
do
if symbol("InputFileFull") = 'VAR' then
do
call DBG_EVALUATE 'Looking in same directory the input file "' || InputFileFull || '"'
yd!Found=_filespec('Location',InputFileFull)||yd!Look4
if FileQueryExists(yd!Found)='' then
yd!Found=''
end
end
if yd!Found='' then
do
do yd!Index=1 to OptionIncludePathCnt until yd!Found<> ''
yd!Found=FindFileInPath(yd!Look4,OptionIncludePath.yd!Index)
end
end
if yd!Found='' then
yd!Found=FindFileInPath(yd!Look4, '*PPWIZARD_INCLUDE')
if yd!Found='' then
yd!Found=FindFileInPath(yd!Look4, '*INCLUDE')
if yd!Found='' then
do
call DBG_EVALUATE 'Looking in same directory as PPWIZARD'
parse source . . yd!Found
yd!Found=_filespec('Location',yd!Found)||yd!Look4
if FileQueryExists(yd!Found)='' then
yd!Found=''
end
if yd!Found<> '' then
yd!Found=FileQueryExists(yd!Found)
if OptionDebugOn='Y' then
call DBG_EVALUATE 'Result: "' || yd!Found || '"'
if yd!Found='' then
do
if yd!Die<> '' then
do
if yd!Die='!' then
yd!T=''
else
yd!T=yd!Die|| ' '
CryAndDie('The ' || yd!T || 'file "' || yd!Look4 || '" could not be found!')
end
end
call DBGIND-1
return(yd!Found)

_SysSearchPath:call TRACE "OFF"
return(FindFileInPath(arg(2), '*' ||arg(1)))

SSTRIP:call TRACE "OFF"
parse arg zd!S,zd!M,zd!C
if zd!M=='' then
zd!M='B'
if zd!C=='' then
zd!C='00'x
zd!S=translate(zd!S, '', zd!C, ' ')
return(strip(zd!S,zd!M))

Add2:call TRACE "OFF"
parse arg ae!V,ae!S
if ae!S<> '' then
Add2Stem=ae!S|| '.'
if Add2Stem='' then
CryAndDie("Add to which array?")
ae!CV=Add2Stem|| '0'
if symbol(ae!CV)<> 'VAR' then
ae!C=0
else
ae!C=value(ae!CV)
ae!C=ae!C+1
call value Add2Stem||ae!C,ae!V
call value ae!CV,ae!C
return(ae!C)

OptionGet:call TRACE "OFF"
if OptionDebugOn='Y' then
call DBG_EVALUATE 'OptionGet()'
call DBGIND 1
be!Ans=OptionGetValue(arg(1))
call DBGIND-1
return(be!Ans)

OptionSet:call TRACE "OFF"
if OptionDebugOn='Y' then
call DBG_EVALUATE 'OptionSet()'
call DBGIND 1
call OptionSetValue arg(1),arg(2)
call DBGIND-1
return

MakeWebLinks:call TRACE "OFF"
parse arg ce!R,ce!ProtU,ce!T
ce!Prot=ce!ProtU|| '://'
ce!Pos=pos(ce!Prot,ce!R)
if ce!Pos=0 then
return(ce!R)
if ce!ProtU='ftp' then
ce!Valid=_ValCharsFtp
else
ce!Valid=_ValCharsHttp
ce!ProtL=length(ce!Prot)
if ce!T='' then
ce!T='<a href="{URL}">{URL}</a>'
ce!L=''
do until ce!Pos=0
ce!L=ce!L||left(ce!R,ce!Pos-1)
ce!R=substr(ce!R,ce!Pos)
ce!Pos=verify(ce!R,ce!Valid, 'N')
if ce!Pos=0 then
do
ce!Url=ce!R
ce!R=''
end
else
do
ce!Url=left(ce!R,ce!Pos-1)
ce!R=substr(ce!R,ce!Pos)
end
ce!Insert=ReplaceString(ce!T, "{URL}",ce!Url)
ce!Insert=ReplaceString(ce!Insert, "{URL-}",substr(ce!Url,ce!ProtL+1))
ce!L=ce!L||ce!Insert
ce!Pos=pos(ce!Prot,ce!R)
end
return(ce!L||ce!R)

TimeStamp:call TRACE "OFF"
parse arg de!CmdList,de!Ts
de!AddSec=0
do while de!CmdList<> ''
parse var de!CmdList de!Cmd de!CmdList
de!Unit=translate(right(de!Cmd,1))
de!Units=left(de!Cmd,length(de!Cmd)-1)
select
when de!Unit='W' then
de!CmdSec=de!Units*604800
when de!Unit='D' then
de!CmdSec=de!Units*86400
when de!Unit='H' then
de!CmdSec=de!Units*3600
when de!Unit='M' then
de!CmdSec=de!Units*60
when de!Unit='S' then
de!CmdSec=de!Units
otherwise
de!CmdSec=de!Cmd
end
de!AddSec=de!AddSec+de!CmdSec
end
if de!Ts='' then
do
de!Bd=basedate()
de!Sec=time('S')
end
else
do
de!Bd=basedate(left(de!Ts,8))
parse value substr(de!Ts,9)with de!HH+2 de!MM+2 de!SS
de!Sec=(de!HH*3600)+(de!MM*60)+de!SS
end
de!TotSec=de!Sec+de!AddSec
de!PlusDay=de!TotSec%86400
de!Sec=de!TotSec//86400
de!Date=Bd2Date(de!Bd+de!PlusDay)
de!HH=right(de!Sec%3600,2, '0')
de!Sec=de!Sec//3600
de!MM=right(de!Sec%60,2, '0')
de!Sec=de!Sec//60
de!SS=right(de!Sec,2, '0')
return(de!Date||de!HH||de!MM||de!SS)

ArraySplit:call TRACE "OFF"
parse arg ee!Stem,ee!Value,ee!Del,ee!Spaces,ee!KeepBlank
ee!Stem=ee!Stem|| '.'
if ee!Del=='' then
ee!Del=' '
if ee!Spaces='' then
ee!Spaces='B'
ee!Cnt=0
do while ee!Value\==''
parse var ee!Value ee!Before (ee!Del) ee!Value
if ee!Spaces<> 'K' then
do
if ee!Spaces='BM' then
ee!Before=space(ee!Before)
else
ee!Before=strip(ee!Before,ee!Spaces)
end
if ee!Before='' then
do
if ee!KeepBlank<> 'Y' then
iterate
end
ee!Cnt=ee!Cnt+1
call _valueS ee!Stem||ee!Cnt,ee!Before
end
call _valueS ee!Stem|| '0',ee!Cnt
return(ee!Cnt)

ArrayRemoveDup:
parse arg fe!Stem,fe!MaxInRow
if fe!MaxInRow='' then
fe!MaxRpt=0
else
fe!MaxRpt=fe!MaxInRow-1
fe!Stem=fe!Stem|| '.'
fe!End=value(fe!Stem|| '0')
fe!DstI=0
fe!Last=''
fe!RepeatCnt=0
do fe!SrcI=1 to fe!End
fe!Value=value(fe!Stem||fe!SrcI)
if fe!Value\==fe!Last then
fe!RepeatCnt=0
else
do
if fe!SrcI<>1 then
do
fe!RepeatCnt=fe!RepeatCnt+1
if fe!RepeatCnt>fe!MaxRpt then
iterate
end
end
fe!Last=fe!Value
fe!DstI=fe!DstI+1
call value fe!Stem||fe!DstI,fe!Value
end
call value fe!Stem|| '0',fe!DstI
return(fe!DstI)

ArrayTranslate:
parse arg ge!Stem,ge!Spaces,ge!Case
ge!Stem=ge!Stem|| '.'
if ge!Spaces='' then
ge!Spaces='B'
ge!End=value(ge!Stem|| '0')
do ge!SrcI=1 to ge!End
ge!Value=value(ge!Stem||ge!SrcI)
if ge!Spaces<> 'K' then
do
if ge!Spaces='BM' then
ge!Value=space(ge!Value)
else
ge!Value=strip(ge!Value,ge!Spaces)
end
if ge!Case<> '' then
do
if ge!Case='L' then
ge!Value=ToLowerCase(ge!Value)
else
ge!Value=ToUpperCase(ge!Value)
end
call value ge!Stem||ge!SrcI,ge!Value
end
return(ge!End)

ReverseArray:

ArrayReverse:call TRACE "OFF"
if OptionDebugOn='Y' then
call DBG_EVALUATE 'ReverseArray()'
riArray=translate(arg(1))|| '.'
riCount=_valueG(riArray||0)
riHalfWay=riCount%2
do riFrom=1 to riHalfWay
riTo=(riCount-riFrom)+1
riTemp=_valueG(riArray||riFrom)
call _valueS riArray||riFrom,_valueG(riArray||riTo)
call _valueS riArray||riTo,riTemp
end
return(riCount)

MakeDirectoryTree:call TRACE "OFF"
parse arg he!Tree,he!Die
if he!Die='' then
he!Die='N'
if right(he!Tree,1)=RexDirChar then
he!Tree=left(he!Tree,length(he!Tree)-1)
if he!Tree='' then
return(0)
if OptionDebugOn='Y' then
do
call DBG 'MakeDirectoryTree("' || he!Tree || '")'
call DBGIND 1
end
if DirQueryExists(he!Tree)<> '' then
do
if OptionDebugOn='Y' then
do
call DBG 'Directory already exists (no need to make)'
call DBGIND-1
end
return(0)
end
if RexSystemOpSys="DOS" then
he!Dq=''
else
he!Dq='"'
if RexSystemOpSys="UNIX" then
MakeDirCmd='mkdir '
else
MakeDirCmd='md '
SearchFromPosn=1
do until SlashPosn=0
SlashPosn=pos(RexDirChar,he!Tree,SearchFromPosn)
if SlashPosn<>1 then
do
if SlashPosn=0 then
MakeDir=he!Tree
else
MakeDir=left(he!Tree,SlashPosn-1)
DirBit=filespec('name',MakeDir)
if right(MakeDir,1)<> ':' & DirBit <> '.' & DirBit <> '..' then
do
if OptionDebugOn='N' then
call AddressCmd MakeDirCmd||he!Dq||MakeDir||he!Dq||AllCmdOutput2Nul()
else
do
TmpMkDirFile=RexGetTmpFileName()
call AddressCmd MakeDirCmd||he!Dq||MakeDir||he!Dq||RedirectStdOutAndErr2(TmpMkDirFile),TmpMkDirFile
if Rc=0 then
call DBG 'Made Directory "' || MakeDir || '"'
call _SysFileDelete TmpMkDirFile
end
end
end
SearchFromPosn=SlashPosn+1
end
if DirQueryExists(he!Tree)<> '' then
he!Rc=0
else
do
he!Rc=3
he!T='We failed to create the "' || he!Tree || '" directory!'
if OptionDebugOn='Y' then
call DBG he!T
if he!Die<> 'N' then
CryAndDie(he!T)
end
if OptionDebugOn='Y' then
call DBGIND-1
return(he!Rc)

HhMmSs2Seconds:
parse value arg(1)with he!HH+2 he!MM+2 he!SS
return((he!HH*3600)+(he!MM*60)+he!SS)

AreFilesEqual:
parse arg ie!F1,ie!F2,ie!Fuzz
if ie!Fuzz='' then
ie!Fuzz=0
call DBG 'AreFilesEqual?: "' || ie!F1 || '" <-> "' || ie!F2 || '" (Fuzziness of ' || ie!Fuzz || ' seconds)'
call DBGIND 1
if FileQueryExists(ie!F1)='' then
ie!Rc='The file "' || ie!F1 || '" does not exist.'
else
do
if FileQueryExists(ie!F2)='' then
ie!Rc='The file "' || ie!F2 || '" does not exist.'
else
do
ie!1s=stream(ie!F1, 'c', 'query size')
ie!2s=stream(ie!F2, 'c', 'query size')
ie!1t=GetFileTimeStamp(ie!F1, 'Q')
ie!2t=GetFileTimeStamp(ie!F2, 'Q')
call DBG 'SRC: ' || ie!1s || ' - ' ||ie!1t
call DBG 'DST: ' || ie!2s || ' - ' ||ie!2t
if ie!1s<>ie!2s then
ie!Rc='File sizes differ'
else
do
parse var ie!1t ie!1dd+8 ie!1dt
parse var ie!2t ie!2dd+8 ie!2dt
if ie!1dd<>ie!2dd then
ie!Rc='Files created on different days'
else
do
ie!Diff=abs(HhMmSs2Seconds(ie!2dt)-HhMmSs2Seconds(ie!1dt))
call DBG '     Files differ by ' || ie!Diff || ' seconds'
if ie!Diff>ie!Fuzz then
ie!Rc='Files differ by more than ' || ie!Fuzz || ' seconds.'
else
ie!Rc=''
end
end
end
end
call DBG 'Rc = "' || ie!Rc || '"'
call DBGIND-1
return(ie!Rc)

FileCopy:call TRACE "OFF"
parse arg je!Src,je!Dst,je!When,je!ContOnError
call DBG 'Copy "' || je!Src || '" to "' || je!Dst || '"?'
if FileQueryExists(je!Src)='' then
do
if je!ContOnError<> 'Y' then
CryAndDie('The FileCopy() source file "' || je!Src || '" does not exist...')
return(2)
end
call DBGIND 1
je!When=translate(je!When)
je!Do=''
select
when je!When='' then
je!Do='We always copy'
when left(je!When,5)='EQUAL' then
do
parse var je!When . ':' je!Fuzz
je!Do=AreFilesEqual(je!Src,je!Dst,je!Fuzz)
end
otherwise
CryAndDie('Unknown FileCopy() mode of "' || je!When || '"')
end
if je!Do<> '' then
call DBG 'Source will be copied: ' ||je!Do
else
do
call DBG 'The source does not need copying'
call DBGIND-1
return(0)
end
call AddInputFileToDependancyList je!Src
call AddOutputFileToDependancyList je!Dst
je!QSD='"' || je!Src || '" "' || je!Dst || '"'
select
when RexSystemOpSys="UNIX" then
je!CpyS='cp --force --verbose'
when RexSystemOpSys="WIN32" then
do
if RexSystemOpSysREAL="WINNT" then
je!CpyS='copy /B'
else
je!CpyS='copy /Y /B'
end
when RexSystemOpSys="OS/2" then
je!CpyS='copy'
otherwise
je!CpyS='copy'
end
CopyCmd=je!CpyS|| ' ' ||je!QSD
TmpMkDirFile=RexGetTmpFileName()
je!CpyRc=AddressCmd(CopyCmd||RedirectStdOutAndErr2(TmpMkDirFile),TmpMkDirFile)
if je!CpyRc=0 then
call DBG 'File successfully copied'
else
do
call DBG 'Copy failed'
if je!ContOnError<> 'Y' then
do
do je!i=1 to 5
je!L.je!i=linein(TmpMkDirFile)
end
call FileDelete TmpMkDirFile, 'N'
CryAndDie('File copy failed (Rc=' || je!CpyRc || ')!', 'From: "' || je!Src || '"', 'To  : "' || je!Dst || '"', "",je!L.1,je!L.2,je!L.3,je!L.4,je!L.5)
end
end
call FileDelete TmpMkDirFile, 'N'
call DBGIND-1
return(je!CpyRc)

QuoteAsRexxLit:call TRACE "OFF"
return( "'" || ReplaceString(arg(1), "'", "''") || "'" )

FormatNumber:call TRACE "OFF"
parse arg ke!Numb,ke!Fmt
if ke!Fmt='' then
ke!Fmt='%,%N'
if OptionDebugOn='Y' then
do
call DBG_EVALUATE 'FormatInt(' || ke!Numb || ') - ' ||ke!Fmt
call DBGIND 1
end
parse var ke!Numb ke!Int '.' ke!Rem
ke!Comma='N'
ke!R=''
ke!Pos=pos('%',ke!Fmt)
ke!LN=ke!Numb
do while ke!Pos<>0
ke!R=ke!R||left(ke!Fmt,ke!Pos-1)
ke!C=substr(ke!Fmt,ke!Pos+1,1)
ke!Fmt=substr(ke!Fmt,ke!Pos+2)
ke!Div=0
ke!N=''
ke!Ac='N'
select
when ke!C='?' then
do
parse var ke!Fmt ke!1 ',' ke!2 ';' ke!Fmt
if ke!LN=1 then
ke!N=ke!1
else
ke!N=ke!2
end
when ke!C='N' then
do
ke!N=ke!Numb
ke!LN=ke!N
ke!Ac='Y'
end
when ke!C='I' then
do
ke!N=ke!Int
ke!LN=ke!N
ke!Ac='Y'
end
when ke!C='1' then
ke!N=left(ke!Rem,1, '0')
when ke!C='2' then
ke!N=left(ke!Rem,2, '0')
when ke!C='3' then
ke!N=left(ke!Rem,3, '0')
when ke!C='4' then
ke!N=left(ke!Rem,4, '0')
when ke!C='R' then
ke!N=ke!Rem
when ke!C='K' then
ke!Div=1024
when ke!C='k' then
ke!Div=1000
when ke!C='M' then
ke!Div=1024*1024
when ke!C='m' then
ke!Div=1000*1000
when ke!C=',' then
ke!Comma='Y'
when ke!C='_' then
ke!N=' '
when ke!C='%' then
ke!N='%'
otherwise
ke!N='%' ||ke!C
end
if ke!Div<>0 then
do
ke!N=ke!Numb%ke!Div
parse value ke!Numb/ke!Div with . '.' ke!Rem
ke!Div=0
ke!Ac='Y'
ke!LN=ke!N
end
if ke!Ac='Y' then
do
if ke!Comma='Y' then
ke!N=AddCommasToDecimalNumber(ke!N)
end
ke!R=ke!R||ke!N
ke!Pos=pos('%',ke!Fmt)
end
ke!R=ke!R||ke!Fmt
if OptionDebugOn='Y' then
do
call DBG_EVALUATE 'Returning: ' ||ke!R
call DBGIND-1
end
return(ke!R)

FormatTime:call TRACE "OFF"
parse arg le!Fmt,le!Ts,le!Pre
if le!Ts='' then
le!Ts=TimeStamp()
if le!Pre='' then
le!Pre='FORMATTIME'
if OptionDebugOn='Y' then
do
call DBG_EVALUATE 'FormatTime(' || le!Ts || ')'
call DBGIND 1
end
if le!Fmt=='' then
le!Fmt=CfgMacro(le!Pre|| '_DEFAULT_TIME_FORMAT', '%c')
parse var le!Ts le!YYYY+4 le!MM+2 le!DD+2 le!HH+2 le!Min+2 le!SS
le!R=''
le!Pos=pos('%',le!Fmt)
do while le!Pos<>0
le!R=le!R||left(le!Fmt,le!Pos-1)
le!C=substr(le!Fmt,le!Pos+1,1)
le!Fmt=substr(le!Fmt,le!Pos+2)
if le!HH>12 then
le!II=le!HH-12
else
le!II=le!HH+0
if le!II=0 then
le!II=12
select
when le!C='d' then
le!N=le!DD
when le!C='e' then
le!N=right(le!DD+0,2, ' ')
when le!C='#' then
le!N=le!DD+0
when le!C='m' then
le!N=le!MM
when le!C='y' then
le!N=right(le!YYYY,2)
when le!C='Y' then
le!N=le!YYYY
when le!C='H' then
le!N=le!HH
when le!C='!' then
le!N=le!HH+0
when le!C='I' then
le!N=right(le!II,2, '0')
when le!C='@' then
le!N=le!II
when le!C='M' then
le!N=le!Min
when le!C='S' then
le!N=le!SS
when le!C='j' then
le!N=right(BaseDate(le!Ts)-basedate(le!YYYY|| '0101')+1, 3, '0')
when le!C='$' then
le!N=BaseDate(le!Ts)-basedate(le!YYYY|| '0101')+1
when le!C='Z' then
le!N=''
when le!C='%' then
le!N='%'
when le!C='_' then
le!N=' '
when le!C='a' then
do
le!N=CfgMacro(le!Pre|| '_DAY_NAMES_SHORT',    'Mon Tue Wed Thu Fri Sat Sun')
le!N=word(le!N,(BaseDate(le!Ts)//7)+1)
end
when le!C='A' then
do
le!N=CfgMacro(le!Pre|| '_DAY_NAMES_LONG',    'Monday Tuesday Wednesday Thursday Friday Saturday Sunday')
le!N=word(le!N,(BaseDate(le!Ts)//7)+1)
end
when le!C='b' then
do
le!N=CfgMacro(le!Pre|| '_MONTH_NAMES_SHORT', 'Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec')
le!N=word(le!N,le!MM)
end
when le!C='B' then
do
le!N=CfgMacro(le!Pre|| '_MONTH_NAMES_LONG',  'January February March April May June July August September October November December')
le!N=word(le!N,le!MM)
end
when le!C='p' then
do
if le!HH>=12 then
le!N=CfgMacro(le!Pre|| '_PM_TEXT', 'pm')
else
le!N=CfgMacro(le!Pre|| '_AM_TEXT', 'am')
end
when le!C='x' then
do
le!N=CfgMacro(le!Pre|| '_DATE_FORMAT', '%a %b %# %Y')
le!Fmt=le!N||le!Fmt
le!N=''
end
when le!C='X' then
do
le!N=CfgMacro(le!Pre|| '_TIME_FORMAT', '%@:%M:%S%p')
le!Fmt=le!N||le!Fmt
le!N=''
end
when le!C='c' then
do
le!N=CfgMacro(le!Pre|| '_DATE_TIME_FORMAT', '%x at %X')
le!Fmt=le!N||le!Fmt
le!N=''
end
when le!C='D' then
do
le!Fmt='%m/%d/%y' ||le!Fmt
le!N=''
end
when le!C='v' then
do
le!Fmt='%e-%b-%Y' ||le!Fmt
le!N=''
end
when le!C='R' then
do
le!Fmt='%H:%M' ||le!Fmt
le!N=''
end
when le!C='r' then
do
le!Fmt='%I:%M:%S%p' ||le!Fmt
le!N=''
end
when le!C='T' then
do
le!Fmt='%H:%M:%S' ||le!Fmt
le!N=''
end
otherwise
le!N='%' ||le!C
end
le!R=le!R||le!N
le!Pos=pos('%',le!Fmt)
end
le!R=le!R||le!Fmt
if OptionDebugOn='Y' then
do
call DBG_EVALUATE 'Returning: ' ||le!R
call DBGIND-1
end
return(le!R)

GetCurrentDirectory:call TRACE "OFF"
me!Dir=DirGetCurrent()
if OptionDebugOn='Y' then
call DBG 'Current Directory = "' || me!Dir || '"'
return(me!Dir)

HtmlGeneratorTags:call TRACE "OFF"
parse arg ne!T,ne!G
if ne!G='Y' then
do
ne!R=OptionHtmlGeneratorTags
OptionHtmlGeneratorTags=ne!T
end
else
do
ne!R=HtmlGeneratorTags
HtmlGeneratorTags=ne!T
end
return(ne!R)

SortArray:

ArraySort:call TRACE "OFF"
if OptionDebugOn='Y' then
call DBG_EVALUATE 'ArraySort()'
parse arg oe!Array,oe!KeyFrom,oe!KeyTo,oe!Strict
oe!Array=translate(oe!Array)|| '.'
oe!Count=_valueG(oe!Array||0)
do oe!I=1 to oe!Count
oe!DATA.oe!I=_valueG(oe!Array||oe!I)
end
oe!DATA.0=oe!Count
if oe!KeyFrom=='' then
do
oe!SepKey='N'
call DBG_EVALUATE 'No separate key array'
end
else
do
oe!SepKey='Y'
oe!KEY.0=oe!DATA.0
if oe!KeyFrom=='@' then
do
if symbol('CfgLower') = 'VAR' then
do
call GetUserLcCfg
oe!KeyFrom=CfgLower
oe!KeyTo=CfgUpper
end
else
do
oe!KeyFrom=LowerCase
oe!KeyTo=UpperCase
end
end
if datatype(oe!KeyFrom, 'W')==1 then
do
call DBG_EVALUATE 'Separate key array built from columns ' || oe!KeyFrom || ' - ' ||oe!KeyTo
if oe!KeyTo='' then
oe!Length=0
else
oe!Length=oe!KeyTo-oe!KeyFrom
do oe!I=1 to oe!KEY.0
if oe!Length=0 then
do
oe!KEY.oe!I=substr(oe!DATA.oe!I,oe!KeyFrom)
end
else
do
oe!KEY.oe!I=substr(oe!DATA.oe!I,oe!KeyFrom,oe!Length)
end
end
end
else
do
if oe!KeyTo=='' then
do
oe!From=oe!KeyFrom|| '.'
call DBG_EVALUATE 'Separate key array built and passed by caller - ' ||oe!From
oe!D=oe!KEY.0
oe!K=_valueG(oe!From|| "0")
if oe!D<>oe!K then
CryAndDie("User supplied sort key array does not have correct number of elements!", "The data array has " || oe!D || " elements while the key array has " ||oe!K)
do oe!I=1 to oe!KEY.0
oe!KEY.oe!I=_valueG(oe!From||oe!I)
end
end
else
do
call DBG_EVALUATE 'Separate key array built by translation'
do oe!I=1 to oe!KEY.0
oe!KEY.oe!I=translate(oe!DATA.oe!I,oe!KeyTo,oe!KeyFrom)
end
end
end
end
oe!M=1
do while(9*oe!M+4)<oe!Count
oe!M=oe!M*3+1
end
do while oe!M>0
oe!K=oe!Count-oe!M
do oe!J=1 to oe!K
oe!Index1=oe!J
do while oe!Index1>0
oe!Index2=oe!Index1+oe!M
if oe!SepKey='N' then
do
oe!Val1=oe!DATA.oe!Index1
oe!Val2=oe!DATA.oe!Index2
end
else
do
oe!Val1=oe!Key.oe!Index1
oe!Val2=oe!Key.oe!Index2
end
if oe!Strict='Y' then
oe!Greater=oe!Val1>>oe!Val2
else
oe!Greater=oe!Val1>oe!Val2
if oe!Greater then
do
oe!Temp=oe!DATA.oe!Index1
oe!DATA.oe!Index1=oe!DATA.oe!Index2
oe!DATA.oe!Index2=oe!Temp
if oe!SepKey='Y' then
do
oe!Temp=oe!Key.oe!Index1
oe!Key.oe!Index1=oe!Key.oe!Index2
oe!Key.oe!Index2=oe!Temp
end
end
else
leave
oe!Index1=oe!Index1-oe!M
end
end
oe!M=oe!M%3
end
oe!Count=_valueG(oe!Array||0)
do oe!I=1 to oe!Count
call _valueS oe!Array||oe!I,oe!DATA.oe!I
end
Drop oe!DATA.
Drop oe!KEY.
return(oe!Count)

FileNameRelative:call TRACE "OFF"
parse arg pe!F,pe!Rel,pe!If
if pe!If='' then
pe!If=2
if pe!Rel='' then
pe!Rel=DirGetCurrent()
pe!S=RexDirChar
pe!S2=pe!S||pe!S
if right(pe!Rel,1)<>pe!S then
pe!Rel=pe!Rel||pe!S
if left(pe!F,2)=pe!S2|left(pe!Rel,2)=pe!S2 then
return(pe!F)
pe!P=compare(ufile(pe!Rel),ufile(pe!F))
if pe!P=0|right(pe!F,1)=pe!S then
Die('The file "' || pe!F || '" appears to be a directory!')
else
do
if pe!P=1 then
return(pe!F)
pe!P=min(lastpos(pe!S,pe!Rel,pe!P),lastpos(pe!S,pe!F,pe!P))+1
pe!Fc=substr(pe!F,pe!P)
pe!Fr=substr(pe!Rel,pe!P)
pe!Cnt=0
pe!P=pos(pe!S,pe!Fr)
do while pe!P<>0
pe!Cnt=pe!Cnt+1
pe!P=pos(pe!S,pe!Fr,pe!P+1)
end
pe!Rel=copies('..' ||pe!S,pe!Cnt)||pe!Fc
select
when datatype(pe!If, 'W')then
do
if pe!Cnt<=pe!If then
pe!F=pe!Rel
end
when translate(pe!If)='S' then
do
if length(pe!Rel)<=length(pe!F)then
pe!F=pe!Rel
end
otherwise
pe!F=pe!Rel
end
end
return(pe!F)

Files4Mask:call TRACE "OFF"
parse arg qe!Msk,qe!Stm,qe!Fol,qe!Srt
if qe!Fol='' then
qe!Fol='N'
if qe!Srt='' then
qe!Srt='Y'
call DBG 'Files4Mask("' || qe!Msk || '"): Follow Directories = "' || qe!Fol || '"'
call DBGIND 1
call _valueS qe!Stm|| '.0',0
if RexxHookGetFileList='' then
do
if qe!Fol='N' then
qe!Fol=''
else
qe!Fol='S'
call DBG 'Using "_SysFileTree()" as "GetFileList" hook not used'
call _SysFileTree qe!Msk,qe!Stm, 'F' ||qe!Fol
end
else
do
call DBG 'Not using "_SysFileTree()" as user specified use of "' || RexxHookGetFileList || '"'
glfTmpFile=RexGetTmpFileName()
call MustDeleteFile glfTmpFile
glfLocn=_filespec('Location',qe!Msk)
glfName=_filespec('Name',qe!Msk)
call CallHook "GETFILELIST",,glfLocn,glfName,qe!Fol,glfTmpFile
if FileQueryExists(glfTmpFile)='' then
CryAndDie('"' || RexxHookGetFileList || '" did not create the file list!')
glfLine=0
glfCount=0
do while lines(glfTmpFile)<>0
CurrentLine=linein(glfTmpFile)
glfLine=glfLine+1
if CurrentLine<> '' then
do
FullFile=FileQueryExists(CurrentLine)
if FullFile='' then
CryAndDie('"' || RexxHookGetFileList || '" specified an invalid file of "' || CurrentLine || '" on line #' ||glfLine)
glfCount=glfCount+1
call _valueS qe!Stm|| '.' ||glfCount,CurrentLine
end
end
call FileClose glfTmpFile
call _valueS qe!Stm|| '.0',glfCount
if OptionDebugOn='N' then
call MustDeleteFile glfTmpFile
end
if qe!Srt<> 'N' then
call ArraySort qe!Stm, '@'
call DBGIND-1
return

Dirs4Mask:call TRACE "OFF"
parse arg re!Msk,re!Stm,re!Fol,re!Srt
if re!Fol='' then
re!Fol='N'
if re!Srt='' then
re!Srt='Y'
call DBG 'Dirs4Mask("' || re!Msk || '"): Follow Directories = "' || re!Fol || '"'
call DBGIND 1
call _valueS re!Stm|| '.0',0
if re!Fol='N' then
re!Fol=''
else
re!Fol='S'
call _SysFileTree re!Msk,re!Stm, 'D' ||re!Fol
if re!Srt<> 'N' then
call ArraySort re!Stm, '@'
call DBGIND-1
return

_FileWriteFailed:
CryAndDie('Write to "' || arg(1) || '" failed (' || FileDescription(arg(1)) || ')!')

FileLineOut:call TRACE "OFF"
parse arg se!File,se!Line
if 0=lineout(se!File,se!Line)then
return
_FileWriteFailed(se!File)

FileCharOut:call TRACE "OFF"
if 0=charout(CurrentOutFile,arg(1))then
return
_FileWriteFailed(CurrentOutFile)

QuoteIt:call TRACE "OFF"
parse arg te!Q4,te!TryQ,te!What
if te!What='' then
te!What='N'
if te!TryQ='' then
te!TryQ='"' || "'"
else
do
if translate(te!TryQ)='ANY' then
te!TryQ=TryQuoteListAny
end
te!I=verify(te!TryQ,te!Q4)
if te!I=0 then
CryAndDie('QuoteIt(): Could not find suitable quote for ' ||DebugRightArrow||te!Q4||DebugLeftArrow)
else
do
te!Q=substr(te!TryQ,te!I,1)
if te!What='N' then
return(te!Q)
else
return(te!Q||te!Q4||te!Q)
end

FileGetTmpName:call TRACE "OFF"
return(RexGetTmpFileName(arg(1)))

FileClose:call TRACE "OFF"
parse arg te!F,te!C
if te!C='' then
te!C='Y'
if te!C<> 'N' then
call DieIfIoErrorOccurred te!F
call _FileClose te!F
return

MustDeleteFile:call TRACE "OFF"
call FileDelete arg(1)
return

FileDelete:call TRACE "OFF"
parse arg te!F,te!D
if te!D='' then
te!D='Y'
if OptionDebugOn='Y' then
do
call DBG_EVALUATE 'FileDelete(' || te!F || ') : MustDelete = ' ||te!D
call DBGIND 1
end
call _FileClose te!F
if FileQueryExists(te!F)='' then
do
te!Rc=0
if OptionDebugOn='Y' then
call DBG_EVALUATE 'File does not exist'
end
else
do
if OptionDebugOn='Y' then
call DBG_EVALUATE 'Deleting the file'
call _FileClose te!F
if OptionDebugOn='Y' then
call DBGIND 1
te!Rc=_SysFileDelete(te!F)
if OptionDebugOn='Y' then
call DBGIND-1
if FileQueryExists(te!F)="" then
te!Rc=0
else
do
if te!D<> 'N' then
CryAndDie('Could not delete "' || te!F || '", it must be in use (DosRc=' || DeleteRc || ')...')
if te!Rc=0 then
te!Rc=987
end
end
if OptionDebugOn='Y' then
do
call DBG_EVALUATE 'Rc = ' ||te!Rc
call DBGIND-1
end
return(te!Rc)

QueryExists:

FileQueryExists:call TRACE "OFF"
parse arg ue!F,ue!ME
if ue!ME='' then
ue!ME='N'
if ue!F='' then
CryAndDie('The filename "" is invalid!')
else
do
ue!Rc=_FileQueryExists(ue!F)
if ue!Rc='' & ue!ME <> 'N' then
CryAndDie('The filename "' || ue!F || '" does not exist!')
return(ue!Rc)
end

Bd2Date:call TRACE "OFF"
parse arg ve!Bd,ve!Fmt,ve!Cfg,ve!T
ve!S=_Bd2Date(ve!Bd)
if ve!Fmt<> "" then
do
if ve!T="" then
ve!T='000000'
ve!S=FormatTime(ve!Fmt,ve!S||ve!T,ve!Cfg)
end
return(ve!S)

FileQueryDateTime:call TRACE "OFF"
parse arg ve!F,ve!Fmt,ve!Cfg,ve!D
if ve!D='' then
ve!D='Y'
if OptionDebugOn='Y' then
do
call DBG_EVALUATE 'FileQueryDateTime(' || ve!F || ') : Fmt = ' ||ve!Fmt
call DBGIND 1
end
ve!Ts=GetFileTimeStamp(ve!F, 'Q')
if ve!Ts=-1 then
do
if ve!D='N' then
ve!Ft=''
else
CryAndDie('Failed getting file time for "' || ve!F || '"')
end
else
do
ve!Ft=FormatTime(ve!Fmt,ve!Ts,ve!Cfg)
end
call DBGIND-1
return(ve!Ft)

GetFileTimeStamp:call TRACE "OFF"
parse arg we!FN,we!OnErr,we!Fmt
we!OnErr=translate(we!OnErr)
if OptionDebugOn='Y' then
do
call DBG_EVALUATE 'GetFileTimeStamp("' || we!FN || '")'
call DBGIND 1
end
we!ST=FileInMemoryTimeStamp(we!FN)
if we!ST='' then
do
we!FT=_FileQueryDateTime(we!FN)
if OptionDebugOn='Y' then
call DBG_EVALUATE 'Is time stamped : "' || we!FT || '"'
if we!FT='' then
do
we!M='The file "' || we!FN || '" does not exist.'
select
when we!OnErr='Q' then
call DBG we!M
when we!OnErr='D' then
CryAndDie(we!M)
otherwise
call OutputWarningToScreen 'TS00',we!M
end
if OptionDebugOn='Y' then
call DBGIND-1
return(-1)
end
we!FT=space(we!FT)
parse var we!FT Month'-'Day'-'Year' 'Hour':'Minute':'Second
if Year<80 then
Year=100+Year
Year=1900+Year
we!ST=Year||Month||Day||Hour||Minute||Second
end
if we!Fmt<> '' then
do
call DBG_EVALUATE 'Time Stamp      : "' || we!ST || '"'
we!ST=FormatTime(we!Fmt,we!ST)
end
if OptionDebugOn='Y' then
do
call DBG_EVALUATE 'Returning       : "' || we!ST || '"'
call DBGIND-1
end
return(we!ST)

Evaluate_42:
TraceBpListsLoaded=''
TraceAutoAliasCnt=0
TraceAutoAliasMax=0
TraceLineInBuffer=""
signal ExecCmd_43

ExecRexxCmd:
parse arg InterpretThisAsPassed,xe!Exp
if xe!Exp='Y' then
InterpretThisRexx=PerformReplacementsInCmdsParameters(InterpretThisAsPassed)
else
InterpretThisRexx=InterpretThisAsPassed
if RexWhich='REGINA' then
xe!UseEos=MarksNewLine
else
xe!UseEos=';'
InterpretThisRexx=ExpandAnyRxVarHacks(InterpretThisRexx)
InterpretThisRexx=ReplaceEos(InterpretThisRexx)
InterpretThis=InterpretThisRexx
if OptionDebugOn='Y' then
call DBG_INTERPRET 'ExecRexxCmd(' || AddCommasToDecimalNumber(length(InterpretThisRexx)) || ' bytes): ' ||DebugRightArrow||InterpretThisRexx||DebugLeftArrow
call DBGIND 1
if OptionPpwTrace='OFF' then
TraceBreakPoint=''
else
call SetUpBp strip(CfgMacro('REXX_BP', ''))
if OptionDebugOn='Y' then
do
if bitand(DebugLevel,SeeRexxTrace)==SeeRexxTrace then
do
if RexWhich='REGINA' then
xe!Def='OFF'
else
xe!Def='INTERMEDIATES'
TraceLevel4Rexx=translate(CfgMacro('REXXTRACE',xe!Def))
if TraceLevel4Rexx<> 'OFF' then
InterpretThis='TRACE ' || TraceLevel4Rexx || ';' || InterpretThisRexx || ';call TRACE "OFF";'
call Line1 ''
call Line1 '---------- START REXX CODE (RexxTrace=' || TraceLevel4Rexx || ') ----------'
end
end
signal ON SYNTAX NAME _SyntaxErrorDuringInterpret
signal ON NOVALUE NAME _UnknownVariableDuringInterpret
InitializedBp='N'
TraceLineInBuffer=""
PrevTracedLine=''
interpret InterpretThis
TraceBreakPoint=''
if OptionDebugOn='Y' then
do
if bitand(DebugLevel,SeeRexxTrace)==SeeRexxTrace then
do
call Line1 '---------- END   REXX CODE (RexxTrace=' || TraceLevel4Rexx || ') ----------'
call Line1 ''
end
end
call DBGIND-1
return

_UnknownVariableDuringInterpret:
TrappingLine=SIGL
call TRACE "OFF"
call CommonTrapHandler TrappingLine, 'N', 'Unknown Variable', condition('D'),space(InterpretThisRexx),TraceBreakPoint

_SyntaxErrorDuringInterpret:
TrappingLine=SIGL
call TRACE "OFF"
call CommonTrapHandler TrappingLine, 'S', 'Reason',errortext(Rc),space(InterpretThisRexx),TraceBreakPoint

ReplaceEos:
return(ReplaceString(arg(1),DefRexxSpecialSepTag,xe!UseEos))

SetUpBp:
TraceBreakPoint=arg(1)
if TraceBreakPoint<> '' then
do
if left(TraceBreakPoint,1)='=' then
do
xe!Mac=strip(substr(TraceBreakPoint,2))
if MacroExists(xe!Mac)='N' then
do
xe!T='The breakpoint macro "' || xe!Mac || '" does not exist!'
if arg(2)<> 'U' then
CryAndDie(xe!T, 'The "REXX_BP" macro contains an invalid value')
else
do
call ColorSet 'ERROR'
call Line1 xe!T
call Beeps
TraceBreakPoint="?"
end
end
else
do
TraceBreakPoint=GetDefineContents(xe!Mac)
TraceBreakPoint='=' ||ReplaceEos(PerformReplacementsInCmdsParameters(TraceBreakPoint))
end
end
else
do
if TraceBreakPoint<> '?' & left(TraceBreakPoint, 1) = '?' then
do
TraceBreakPoint='=if (' || strip(substr(TraceBreakPoint, 2)) || ') then; do; rtStop="Y"; end;'
end
end
end
return

AddToBpSearch:
RtSearchText=RtSearchText|| '{SOL}' || space(arg(1)) || '{EOL}'
return

TraceLineIn:
if TraceLineInBuffer="" then
do
xe!RL=linein()
xe!Tmp=_ConsoleWriteAllowed
_ConsoleWriteAllowed='N'
call line1 xe!RL
_ConsoleWriteAllowed=xe!Tmp
end
else
do
parse var TraceLineInBuffer xe!RL '{NL}' TraceLineInBuffer
call line1 xe!RL
end
return(strip(xe!RL))

UserBreakPoint:call TRACE "OFF"
RtUserBreakPoint='Y'
signal _UserBreakPoint

RexxTrace:call TRACE "OFF"
RtUserBreakPoint='N'

_UserBreakPoint:
signal on NOVALUE name RexxTrapUninitializedVariable
signal on SYNTAX name RexxTrapSyntaxError
parse arg rtText,rtDumpList,rtDbgCmd,rtDbgTrapped
rtSay='$TRACE: ' ||rtText
call ColorSet 'RexxTrace'
call Line1 rtSay
call ColorSet 'RexxOther'
RtSearchText=''
call AddToBpSearch rtText
if rtDbgTrapped<> 'Y' then
do
rtThis=''
if rtDbgCmd='Y' then
do
rtThis=PrevTracedLine|| ' ' ||rtText
PrevTracedLine=rtText
end
else
rtThis=rtDumpList
if rtThis<> '' then
do
if rtThis<> '?' then
call DumpVarsInExpression rtThis, '', '', 'TraceVarSay'
else
do
call Line1 'ALL KNOWN VARIABLES'
call Line1 '~~~~~~~~~~~~~~~~~~~'
call DumpVarsInExpression InterpretThisRexx, '', '', 'TraceVarSay'
end
end
end
call Line1 ''
if RtUserBreakPoint='Y' | rtDbgTrapped = 'Y' then
rtStop='Y'
else
do
if TraceBreakPoint='' then
rtStop='N'
else
do
select
when TraceBreakPoint='?' then
rtStop='Y'
when left(TraceBreakPoint,1)='=' then
do
rtStop='N'
xe!B=BeepsAllow('N')
call ExecuteUsersTraceCmd substr(TraceBreakPoint,2)
call BeepsAllow xe!B
end
otherwise
do
if pos(TraceBreakPoint,RtSearchText)<>0 then
rtStop='Y'
else
rtStop='N'
end
end
end
end
if rtStop='N' then
return
call LoadBpLists
TraceLineInBuffer=strip(CfgMacro('REXX_BP_AUTO_CMD', ''))
do forever
call ColorSet 'PromptText'
call Char1 'BreakPoint (' || BpAliasCnt || ' aliases) => '
call ColorSet 'RexxOther'
rtCmd=TraceLineIn()
if rtCmd='' then
do
call ColorSet
return
end
rtCmdU=translate(rtCmd)
select
when left(rtCmd,1)='/' then
do
EqPos=pos('=',rtCmd)
if EqPos<>0 then
do
call AddBpAlias rtCmd, "user"
STo=SaveBpAliasFile()
if STo='' then
STxt='Done (not permanently saved)!'
else
STxt='Done, saved to "' || STo || '".'
call ColorSet 'HIGHLIGHT'
call Line1 STxt
call ColorSet 'RexxOther'
end
else
do
rtAlias=strip(substr(rtCmd,2))
if left(rtAlias,1)='#' | datatype(rtAlias, 'W')then
do
if left(rtAlias,1)='#' then
rtAliasI=strip(substr(rtAlias,2))
else
rtAliasI=rtAlias
if rtAliasI>TraceAutoAliasCnt then
do
call ColorSet 'ERROR'
call Line1 '#Alias "#' || rtAliasI || '" does not exist!'
call ColorSet 'RexxOther'
call Beeps
iterate
end
rtAliasI=(TraceAutoAliasCnt-rtAliasI)+1
rtCmd=Aalias.rtAliasI
end
else
do
xe!Mac="REXX_BP_ALIAS:" ||rtAlias
if MacroExists(xe!Mac)='Y' then
rtCmd=GetDefineContents(xe!Mac)
else
do
rtCmd=FindBpAlias(rtAlias)
if rtCmd='' then
do
call ColorSet 'ERROR'
call Line1 'Alias "' || rtAlias || '" not found!'
call ColorSet 'RexxOther'
call Beeps
iterate
end
end
end
TraceLineInBuffer=rtCmd
iterate
end
end
when left(rtCmd,1)='?' then
do
xe!Rest=substr(rtCmdU,2)
rtCmdU=word(xe!Rest,1)
call ColorSet 'RexxOther'
select
when rtCmdU='' then
do
call Line1 rtText
end
when abbrev('VARIABLES',rtCmdU)then
do
if words(xe!Rest)=1 then
do
call Line1 'ALL KNOWN VARIABLES'
call Line1 '~~~~~~~~~~~~~~~~~~~'
call DumpVarsInExpression InterpretThisRexx, '', '', 'TraceVarSay'
end
else
do
xe!Exists=''
xe!Unknown=''
do xe!I=2 to words(xe!Rest)
xe!V=word(xe!Rest,xe!I)
if symbol(xe!V)='VAR' then
xe!Exists=xe!Exists|| ' ' ||xe!V
else
xe!Unknown=xe!Unknown|| ' ' ||xe!V
end
if xe!Unknown<> '' then
do
call ColorSet 'ERROR'
call Line1 'Unknown Variables: ' ||strip(xe!Unknown)
call ColorSet 'RexxOther'
end
if xe!Exists<> '' then
call DumpVarsInExpression xe!Exists, '', '', 'TraceVarSay'
end
end
when abbrev('LOCATION',rtCmdU)then
call Line1 'AT: ' ||CurrentSourceLocation()
when abbrev('ALIASES',rtCmdU)then
do
call Line1 'ALL ALIASES'
call Line1 '~~~~~~~~~~~'
do Index=1 to BpAliasCnt
call Line1 left(BpAlias.Index.BpAName,BpLongestAlias)|| ' = ' ||BpAlias.Index.BpAValue
end
end
when abbrev('#ALIASES',rtCmdU)then
do
if TraceAutoAliasCnt=0 then
do
call ColorSet 'ERROR'
call Line1 'No commands have been remembered yet!'
call Beeps
end
else
do
MaxLng=length(TraceAutoAliasCnt)
call Line1 'ALL # ALIASES'
call Line1 '~~~~~~~~~~~~~'
do Index=1 to TraceAutoAliasCnt
IndexR=(TraceAutoAliasCnt-Index)+1
call Line1 '/#' || left(IndexR, MaxLng)  || ' = ' ||Aalias.Index
end
end
end
when abbrev('MACRO',rtCmdU)then
do
xe!Mac=word(rtCmd,2)
if MacroExists(xe!Mac)='N' then
do
call ColorSet 'ERROR'
call Line1 'The macro "' || xe!Mac || '" does not exist'
call Beeps
end
else
do
xe!T='MACRO: ' ||xe!Mac
call ColorSet 'HIGHLIGHT'
call line1 xe!T
call line1 copies('~',length(xe!T))
call ColorSet 'INFO'
call Char1 '"'
call ColorSet 'RexxOther'
call Char1 GetDefineContents(xe!Mac)
call ColorSet 'INFO'
call Line1 '"'
end
end
otherwise
do
call ColorSet 'ERROR'
call Line1 'Unknown ? command of "' || rtCmd || '"!'
call Beeps
end
end
call ColorSet 'RexxOther'
end
when rtCmdU='BP' then
do
call ColorSet 'PromptText'
call Char1 "New Breakpoint (blank = none) => "
call ColorSet 'RexxOther'
call SetUpBp TraceLineIn(), 'U'
end
otherwise
do
if ExecuteUsersTraceCmd(rtCmd)=0 then
do
if AddAutoAlias(rtCmd)<>0 then
call SaveBpAliasFile
end
end
end
end
Die("NeverGetsHere:Trace")

TraceVarSay:
call ColorSet 'RexxOther'
call Line1 "      | " ||arg(1)
call ColorSet 'RexxOther'
call AddToBpSearch arg(1)
return

ExecuteUsersTraceCmd:
signal ON SYNTAX NAME _SyntaxErrorDuringExecuteUsersTraceCmd
signal ON NOVALUE NAME _UnknownVariableDuringExecuteUsersTraceCmd
interpret arg(1)
return(0)

_SyntaxErrorDuringExecuteUsersTraceCmd:
ErrNo=Rc
call ColorSet 'ERROR'
call Line1 'SYNTAX ERROR: ' ||errortext(ErrNo)
call ColorSet 'RexxOther'
call Line1 ''
call Beeps
return(1)

_UnknownVariableDuringExecuteUsersTraceCmd:
call ColorSet 'ERROR'
call Line1 'The rexx variable "' || condition('D') || '" is unknown!'
call ColorSet 'RexxOther'
call Line1 ''
call Beeps
return(1)

LoadBpLists:
TraceBpList=CfgMacro('REXX_BP_ALIAS_FILES', '')
if TraceBpList<>TraceBpListsLoaded then
TraceBpListsLoaded=''
if TraceAutoAliasMax=0 then
do
TraceAutoAliasMax=CfgMacro('REXX_BP_MAX_AUTO_CMD',22)
if datatype(TraceAutoAliasMax, 'W')=0 then
TraceAutoAliasMax=22
if TraceAutoAliasMax<10 then
TraceAutoAliasMax=22
end
if TraceBpListsLoaded<> '' then
return
BpSaveTo=''
BpList=TraceBpList
BpAliasCnt=0
BpFileNumb=0
BpLongestAlias=0
do while BpList<> ''
parse var BpList BpList1';'BpList
BpFileNumb=BpFileNumb+1
if BpFileNumb=1 then
BpSaveTo=BpList1
if BpList1='' then
iterate
BpList1=FindFile(BpList1)
if BpList1='' then
iterate
call FileClose BpList1, 'N'
BpListLine=0
do while lines(BpList1)<>0
CurrentLine=strip(linein(BpList1))
BpListLine=BpListLine+1
if CurrentLine='' | left(CurrentLine, 1) = ';' then
iterate
AliasSource='line #' || BpListLine || ' of ' ||BpList1
call AddBpAlias CurrentLine,AliasSource,BpFileNumb
end
call FileClose BpList1
end
TraceBpListsLoaded=TraceBpList
return

AddBpAlias:
parse arg AliasCmd,AliasSrc,FromFile
parse var AliasCmd '/'BpAliasName'='BpAliasValue
if BpAliasValue='' then
do
call DBG 'Alias Command from ' || AliasSrc || ' incorrectly formatted!'
return
end
BpAliasName=translate(BpAliasName)
if left(BpAliasName,1)=='#' then
do
call AddAutoAlias BpAliasValue
return
end
if length(BpAliasName)>BpLongestAlias then
BpLongestAlias=length(BpAliasName)
FoundIndex=0
do Index=1 to BpAliasCnt
if BpAliasName=BpAlias.Index.BpAName then
do
FoundIndex=Index
leave
end
end
if FoundIndex<>0 then
do
if FromFile<> '' then
return
end
else
do
BpAliasCnt=BpAliasCnt+1
FoundIndex=BpAliasCnt
end
BpAlias.FoundIndex.BpAName=BpAliasName
BpAlias.FoundIndex.BpAValue=BpAliasValue
BpAlias.FoundIndex.BpFNumb=FromFile
return

FindBpAlias:
BpAliasName=translate(strip(arg(1)))
do Index=1 to BpAliasCnt
if BpAliasName=BpAlias.Index.BpAName then
return(BpAlias.Index.BpAValue)
end
return('')

SaveBpAliasFile:
if BpSaveTo='' then
return('')
call MustDeleteFile BpSaveTo
call lineout BpSaveTo, ';***'
call lineout BpSaveTo, ';*** Automatically saved at: ' ||NiceDateTime()
call lineout BpSaveTo, ';***'
call lineout BpSaveTo, ''
FoundF='N'
do Index=1 to BpAliasCnt
if BpAlias.Index.BpFNumb=1 then
do
if FoundF='N' then
call lineout BpSaveTo, ';--- Loaded From File ---'
FoundF='Y'
call lineout BpSaveTo, '/' || BpAlias.Index.BpAName || '=' ||BpAlias.Index.BpAValue
end
end
call FileClose BpSaveTo
FoundU='N'
do Index=1 to BpAliasCnt
if BpAlias.Index.BpFNumb=''then
do
if FoundU='N' then
do
if FoundF='Y' then
call lineout BpSaveTo, ''
call lineout BpSaveTo, ';--- User Modified This Session ---'
end
FoundU='Y'
call lineout BpSaveTo, '/' || BpAlias.Index.BpAName || '=' ||BpAlias.Index.BpAValue
end
end
call FileClose BpSaveTo
if TraceAutoAliasCnt<>0 then
do
call lineout BpSaveTo, ''
call lineout BpSaveTo, ';--- Last Few Commands Used ---'
do Index=1 to TraceAutoAliasCnt
IndexN=(TraceAutoAliasCnt-Index)+1
call lineout BpSaveTo, '/#' || IndexN  || '=' ||Aalias.Index
end
end
call FileClose BpSaveTo
return(BpSaveTo)

FindAutoAlias:
FindWhat=arg(1)
do FndIndex=1 to TraceAutoAliasCnt
if FindWhat=Aalias.FndIndex then
return(FndIndex)
end
return(0)

DeleteAutoAlias:
DelIndex=arg(1)
do DelIndexT=DelIndex to TraceAutoAliasCnt-1
DelIndexF=DelIndexT+1
Aalias.DelIndexT=Aalias.DelIndexF
end
TraceAutoAliasCnt=TraceAutoAliasCnt-1
return

AddAutoAlias:
SaveWhat=strip(arg(1))
if SaveWhat='' then
return(0)
FoundAt=FindAutoAlias(SaveWhat)
if FoundAt<>0 then
call DeleteAutoAlias FoundAt
if TraceAutoAliasCnt>=TraceAutoAliasMax then
call DeleteAutoAlias 1
TraceAutoAliasCnt=TraceAutoAliasCnt+1
Aalias.TraceAutoAliasCnt=SaveWhat
return(TraceAutoAliasCnt)

ExecCmd_43:
ExpandXEarly='N'
ExpandXLate='N'
ExpandXCmd='N'
signal EndExpandX

EXPANDX_DEBUG:
if OptionDebugOn='Y' then
do
if ExpandX='NONE' then
call OptionDebugShow 'EXPANDX', 'X codes are never expanded'
else
call OptionDebugShow 'EXPANDX', 'X codes are expanded "' || ExpandX || '"'
end
return

EXPANDX_GET:
call EXPANDX_DEBUG
return(ExpandX)

EXPANDX_SET:
ExpandX=translate(arg(1))
if ProcessedCmdLine='N' then
do
call OptionDebugShow 'EXPANDX', 'Setting default value of "X" var expansion to "' || EXPANDX || '"'
Default4_EXPANDX=ExpandX
return(0)
end
if ExpandX=='' then
ExpandX=Default4_EXPANDX
ExpandXEarly='N'
ExpandXLate='N'
ExpandXCmd='N'
if ExpandX<> 'NONE' then
do
TmpList=translate(ExpandX)
do while TmpList<> ''
parse var TmpList ThisItem','TmpList
select
when ThisItem='COMMAND' then
ExpandXCmd='Y'
when ThisItem='EARLY' then
ExpandXEarly='Y'
when ThisItem='LATE' then
ExpandXLate='Y'
otherwise
CryAndDie('Unknown EXPANDX option of "' || ThisItem || '"')
end
end
end
call EXPANDX_DEBUG
return

SetXCode:call TRACE "OFF"
parse arg ye!N,ye!V
ye!XN='XVAR?.X?' ||c2x(translate(ye!N))
call _valueS ye!XN,ye!V
return

InitializeCharCodes:
call DBG_DEFINING 'Initializing <' || '?x00-FF> codes + <' || '?xRexxEos> + some others'
do CharCode=0 to 255
call _valueS 'XVAR?.X?' ||c2x(translate(d2x(CharCode,2))),d2c(CharCode)
end
call _valueS 'XVAR?.X?'  || c2x(translate("RexxEos")),MarksNewLine
call _valueS 'XVAR?.X?'  || c2x(translate("Nothing")), ""
Val='<' || '?xml version="1.0" encoding="UTF-8"?>' ||MarksNewLine
Val=Val|| '<' || '!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "DTD/xhtml1-strict.dtd">' ||MarksNewLine
Val=Val|| '<html xmlns="http://www.w3.org/1999/xhtm" xml:lang="en" lang="en">' ||MarksNewLine
call _valueS 'XVAR?.X?'  || c2x(translate("HTML10")),Val
return

ExpandXCodes:call TRACE "OFF"

RepXCodes:
if pos(StartsStdSymbolReplacement_x,arg(1))=0 then
return(arg(1))

ReplaceTheXCodesWeKnowExist:
LeftBit=''
RightBit=arg(1)
StartPos=pos(StartsStdSymbolReplacement_x,RightBit)
do while StartPos<>0
ReplaceCount=ReplaceCount+1
EndPos=pos(EndsMacroReplacement,RightBit,StartPos+1)
XVarName='XVAR?.X?' ||c2x(translate(substr(RightBit,StartPos+3,(EndPos-StartPos)-3)))
if symbol(XVarName)='VAR' then
LeftBit=LeftBit||left(RightBit,StartPos-1)||_valueG(XVarName)
else
do
CryAndDie(StartsStdSymbolReplacement_x||substr(RightBit,StartPos+3,(EndPos-StartPos)-3)||EndsMacroReplacement|| ' is not defined (use "#RexxVar =x=" command)!')
end
RightBit=substr(RightBit,EndPos+1)
StartPos=pos(StartsStdSymbolReplacement_x,RightBit)
end
if OptionDebugOn='Y' then
call DebugOutputAfterReplacement LeftBit||RightBit, '?xXX'
return(LeftBit||RightBit)

EndExpandX:
call InitOnExitProcessing
signal OnExit_44

InitOnExitProcessing:
OnExitCnt=0
LinesFromOnExit='N'
do ze!I=1 to 100
OnExitLst.ze!I=''
end
return

SetUpOnExitProcessingIfEndOfMainFile:
if IncludeLevel=1 then
do
if OnExitCnt<>0 then
do
call DBG ''
call DBG '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
call DBG '!!! "#OnExit" processing follows !!!'
call DBG '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
call DBG ''
call DBGIND 1
ze!All=''
do ze!I=1 to 100
ze!Txt=OnExitLst.ze!I
if ze!Txt\=='' then
do
call DBG 'FROM: ' ||OnExitLoc.ze!I
call DBGIND 1
call DBG 'SLOT #' || ze!I || ': ' ||ze!Txt
call DBGIND-1
if ze!All='' then
ze!All=ze!Txt
else
ze!All=ze!All||MarksNewLine||ze!Txt
end
end
call DBGIND-1
IncludeMemBufferNextLine=ze!All
LinesFromOnExit='Y'
OnExitCnt=0
return('Y')
end
end
return('N')

ProcessOnExit:
af!R=strip(arg(1))
if left(af!R,1)<> '#' then
af!Slot=50
else
do
af!Slot=substr(word(af!R,1),2)
af!R=subword(af!R,2)
if translate(af!Slot)='EXEC' then
do
af!R=PerformReplacementsInCmdsParameters(af!R)
if left(af!R,1)='{' then
parse var af!R '{' af!RcTest '}' af!R
else
do
af!R=af!R
af!RcTest=''
end
if OptionValidation<> '' then
CryAndDie("Already have a command specified for execution!")
OptionValidation=af!R
OptionValidationRc=af!RcTest
return(0)
end
end
if af!R='' then
CryAndDie('No #OnExit text specified!')
if datatype(af!Slot, 'W')=0|af!Slot<1|af!Slot>100 then
CryAndDie('Invalid slot number of "' || af!Slot || '"')
call DBG '#OnExit (slot #' || af!Slot || ') we will process => ' ||DebugRightArrow||af!R||DebugLeftArrow
OnExitCnt=OnExitCnt+1
if OnExitLst.af!Slot='' then
do
OnExitLst.af!Slot=af!R
OnExitLoc.af!Slot=CurrentSourceLocation()
end
else
do
if af!Slot<>50 then
CryAndDie('You are attempting to reuse #OnExit slot ' || af!Slot, 'The slot was already used at ' || OnExitLoc.af!Slot, 'Only slot 50 can be reused.')
OnExitLst.af!Slot=OnExitLst.af!Slot||MarksNewLine||af!R
end
return(0)

OnExit_44:
IncludeIntoMemory=''
signal Include_45

RecursiveIncludeSave:
call LoopPush IncludeLevel
_DebugCurrentFileNumber.IncludeLevel=DebugCurrentFileNumber
_IncludeMemHandle.IncludeLevel=IncludeMemHandle
_IncludeEofLine.IncludeLevel=IncludeEofLine
_IncludeFragmentSpec.IncludeLevel=IncludeFragmentSpec
_IncludeLineNumber.IncludeLevel=IncludeLineNumber
_IncludeMemBufferNextLine.IncludeLevel=IncludeMemBufferNextLine
_IncludeLoopMemBufferNextLine.IncludeLevel=IncludeLoopMemBufferNextLine
_EofForced.IncludeLevel=EofForced
EofForced=''
return

RecursiveIncludeRestore:
DebugCurrentFileNumber=_DebugCurrentFileNumber.IncludeLevel
IncludeMemHandle=_IncludeMemHandle.IncludeLevel
IncludeEofLine=_IncludeEofLine.IncludeLevel
IncludeFragmentSpec=_IncludeFragmentSpec.IncludeLevel
IncludeLineNumber=_IncludeLineNumber.IncludeLevel
IncludeMemBufferNextLine=_IncludeMemBufferNextLine.IncludeLevel
IncludeLoopMemBufferNextLine=_IncludeLoopMemBufferNextLine.IncludeLevel
EofForced=_EofForced.IncludeLevel
IncludeFileName=IncludeFileName.IncludeLevel
call HandleIncludeFragment
call LoopPop IncludeLevel
return

FileInMemoryTimeStamp:
fimFullFileName=arg(1)
if RexSystemOpSys="UNIX" then
ifHandle='_IF_' || c2x(fimFullFileName) || '.'
else
ifHandle='_IF_' || c2x(translate(fimFullFileName)) || '.'
if symbol(ifHandle|| '!TS') <> 'VAR' then
return('')
else
do
Ts=_valueG(ifHandle|| '!TS')
if OptionDebugOn='Y' then
call DBG 'Cached Timestamp: "' || Ts || '"'
return(Ts)
end

IncludeFileOpen:
ifFullFileName=arg(1)
ifLoad2Mem=arg(2)
if RexSystemOpSys="UNIX" then
ifHandle='_IF_' || c2x(ifFullFileName) || '.'
else
ifHandle='_IF_' || c2x(translate(ifFullFileName)) || '.'
if symbol(ifHandle|| '0') = 'VAR' then
do
if OptionDebugOn='Y' then
call DBG '"' || ifFullFileName || '" will be read from memory cache'
return(_valueG(ifHandle|| '0') || ';' ||ifHandle)
end
call FileClose ifFullFileName, 'N'
OpenRc=FileOpenReadOnly(ifFullFileName)
if ifLoad2Mem='' then
ifLoad2Mem=IncludeIntoMemory
if ifLoad2Mem='N' then
do
if OptionDebugOn='Y' then
call DBG 'Will read "' || ifFullFileName || '" directly from file'
return('')
end
if OptionDebugOn='Y' then
call DBG 'Will read "' || ifFullFileName || '" into memory cache'
Ts=GetFileTimeStamp(ifFullFileName)
call _valueS ifHandle|| '!TS',Ts
ifLineNum=0
do while lines(ifFullFileName)<>0
ifLineNum=ifLineNum+1
ifLineTxt=linein(ifFullFileName)
call _valueS ifHandle||ifLineNum,ifLineTxt
end
call _valueS ifHandle|| '0',ifLineNum
call FileClose ifFullFileName
if OptionDebugOn='Y' then
do
call DBGIND 1
call DBG 'Read ' || AddCommasToDecimalNumber(ifLineNum) || ' lines'
call DBGIND-1
end
return(ifLineNum|| ';' ||ifHandle)

IncludeFileClose:
if IncludeMemHandle='' then
do
call FileClose IncludeFileName
end
return

IncludeFileLines:
if IncludeMemHandle='' then
return(lines(IncludeFileName))
else
return(IncludeLineNumber<IncludeEofLine)

IncludeFileLineIn:
IncludeLineNumber=IncludeLineNumber+1
if IncludeMemHandle='' then
ifLineTxt=linein(IncludeFileName)
else
ifLineTxt=_valueG(IncludeMemHandle||IncludeLineNumber)
if ExtraWhiteSpace=='' then
return(ifLineTxt)
else
return(translate(ifLineTxt, '', ExtraWhiteSpace, ' '))

Include_45:
SummaryUserAllBldCount=0
SummaryUserOverallCount=0
SummaryUserThisBldCount=0
signal Summary_46

Summary:call TRACE "OFF"
parse arg SummaryLeft,SummaryRight,SummaryMode
SummaryLeft=strip(SummaryLeft)
SummaryMode1=translate(left(SummaryMode,1))
select
when SummaryMode1='D' then
do
call DBG "Don't" || ' want "' || SummaryLeft || '" in any summaries'
call _valueS '!SUMMDROP.!' ||c2x(SummaryLeft),CurrentSourceLocation()
end
when SummaryMode1='O' then
do
SummaryUserOverallCount=SummaryUserOverallCount+1
SummaryUserOverallL.SummaryUserOverallCount=SummaryLeft
SummaryUserOverallR.SummaryUserOverallCount=SummaryRight
end
when SummaryMode1='A' then
do
SummaryUserAllBldCount=SummaryUserAllBldCount+1
SummaryUserAllBldL.SummaryUserAllBldCount=SummaryLeft
SummaryUserAllBldR.SummaryUserAllBldCount=SummaryRight
end
otherwise
do
SummaryUserThisBldCount=SummaryUserThisBldCount+1
SummaryUserThisBldL.SummaryUserThisBldCount=SummaryLeft
SummaryUserThisBldR.SummaryUserThisBldCount=SummaryRight
end
end
return

GenerateUserSummaryThisBuild:
do SummLine=1 to SummaryUserThisBldCount
call AddSummaryLine SummaryUserThisBldL.SummLine,SummaryUserThisBldR.SummLine
end
SummaryUserThisBldCount=0
return

GenerateUserSummaryAllBuilds:
do SummLine=1 to SummaryUserAllBldCount
call AddSummaryLine SummaryUserAllBldL.SummLine,SummaryUserAllBldR.SummLine
end
return

GenerateUserSummaryOverall:
do SummLine=1 to SummaryUserOverallCount
call AddSummaryLine SummaryUserOverallL.SummLine,SummaryUserOverallR.SummLine
end
return

AboutToGenerateSummary:
MaxSummaryLeft=0
SummaryLines=0
call Line1 ''
if arg(1)<> 'N' then
do
TitleText='Summary'
call ColorSet 'TITLE'
call Line1 TitleText
call Line1 copies('~',length(TitleText))
call ColorSet
end
return

AddSummaryLine:
parse arg SummaryLeft,SummaryRight
SummaryLeft=strip(SummaryLeft)
DropSym='!SUMMDROP.!' ||c2x(SummaryLeft)
if symbol(DropSym)='VAR' then
do
call DBG 'Summary line for "' || SummaryLeft || '" unwanted (dropped at ' || _valueG(DropSym) || ')'
return
end
if length(SummaryLeft)>MaxSummaryLeft then
MaxSummaryLeft=length(SummaryLeft)
SummaryLines=SummaryLines+1
SummaryL.SummaryLines=SummaryLeft
SummaryR.SummaryLines=SummaryRight
return

GenerateSummaryLines:
call ColorSet 'SUMMARY'
do SummLine=1 to SummaryLines
call Line1 "   " || left(SummaryL.SummLine, MaxSummaryLeft) || ': ' ||SummaryR.SummLine
end
call ColorSet
return

Summary_46:
PpwCompTime=NiceDateTime()
PpwCompTs=TimeStamp()
InputInterfaceVer="98.131"
OutputInterfaceVer="98.132"
call SetEnv "PPWIZARD_VER_II",InputInterfaceVer
call SetEnv "PPWIZARD_VER_OI",OutputInterfaceVer
ProtectPrefix='{PROTECT_' || time('Seconds') || '}'
ProtectFromPpwS="option PUSH LeaveBlankLines=YES KeepIndent=YES linecomment='NULL' LineContinuation='NULL' HashPrefix='" || ProtectPrefix || "'"
ProtectFromPpwE=ProtectPrefix|| 'option POP'
call QuickCheckForDebugSwitch
signal on NOVALUE name RexxTrapUninitializedVariable
signal on SYNTAX name RexxTrapSyntaxError
signal on HALT name RexxCtrlC
TrapHandler='FULL'
call InitCommandLineOptions2
call ProcessCommandLine
if InputMaskCount=0 then
do
if OptionNoFiles="" then
UserSyntaxError("No input masks specified and no default configured (/NOFILES)")
else
do
call ProcessCommandLineBit "/NOFILES",OptionNoFiles
if InputMaskCount=0 then
UserSyntaxError("No input masks specified and /NOFILES did not include a file mask!")
end
end
call CheckRexxInterpreter 'Y'
call DebugShowAsMuchEnvironmentDetailAsPossible
PpwUserDescription='PPWIZARD version ' || PgmVersion || ' on ' || PpWizardOpSysREAL ||  ', FREE tool for Windows, OS/2, DOS and UNIX by ' || PgmAuthor || ' (' || PgmHomePage || ')'
PgmDefaultHtmlMetaTags='<meta name="GENERATOR" content="' || PpwUserDescription || '"' || OptionXSlash || '>'
if HaveGeneratorTags='N' then
OptionHtmlGeneratorTags=PgmDefaultHtmlMetaTags
if OptionCloneUsed='Y' then
do
if InputMaskCount<2 then
UserSyntaxError('No clone destination supplied!')
CloneOutputMask=InputMask.InputMaskCount||RexDirChar|| '{' || '$path}' || RexDirChar || '*.*'
call ProcessCommandLineBit "CLONE", OptChar || 'Output:' || ReplaceString(CloneOutputMask, ' ', '{x20}')
InputMaskCount=InputMaskCount-1
end
InputMasksAllowed='N'
InpFileCount=0
InpFileCountActuallyMade=0
AllSameExtn=''
do SpecIndex=1 to InputMaskCount
InputList.0=0
TmpMask=InputMask.SpecIndex
call DBG 'Looking for files matching "' || TmpMask || '"'
if left(TmpMask,1)<> '+' then
FollowDirs='N'
else
do
FollowDirs='Y'
TmpMask=substr(TmpMask,2)
end
call Files4Mask TmpMask, 'InputList',FollowDirs
call DBGIND 1
call DBG 'Found ' || InputList.0 || ' files(s)'
call DBGIND 1
if InputList.0=0 then
do
call CheckForNotBeingAbleToExecAnything
WeWantToDie='Y'
if LookLikeASingleFile(TmpMask)='Y' then
do
if OptionDebugOn='N' then
do
call BeepsAllow 'N'
call ColorAllow 'N'
OptionDebugOn='Y'
OptionWantInfoMsgs='Y'
call DebugStateChanged
call DBG 'Debug forced on as we seem to have a file find problem!'
call DBGIND 1
call DBG 'We could not find "' || TmpMask || '", yet it seems to exist! We will solder on!'
call DBG 'Please send redirected output to "' || PgmAuthor || '" (' || PgmAuthorEmail || ')'
call DBG 'You could easily use a "GetFileList" ' || OptChar || 'Hook to workaround this.'
call DBGIND 1
call Files4Mask TmpMask, 'InputList',FollowDirs
call DBGIND-2
call DBG 'Turning off debug again'
OptionDebugOn='N'
call DebugStateChanged
end
InputList.0=1
InputList.1=TmpMask
WeWantToDie='N'
end
if WeWantToDie='Y' then
do
if InputMask0FilesOk.SpecIndex='Y' then
call DBG 'You indicated that 0 files were OK...'
else
do
Left1=left(InputMask.SpecIndex,1)
if Left1<> '-' & Left1 <> '/' then
Extra=''
else
Extra=' (all switches under ' || PpWizardOpSysREAL || ' must start with "' || OptChar || '")'
UserSyntaxError('No input files matched "' || InputMask.SpecIndex || '"' ||Extra)
end
end
end
do InputIndex=1 to InputList.0
TheFile=InputList.InputIndex
call DBG TheFile
InpFileCount=InpFileCount+1
InpFile.InpFileCount=TheFile
InpFileMaskIndex.InpFileCount=SpecIndex
DotPos=lastpos('.',TheFile)
if DotPos<>0 then
do
FileExtn=translate(substr(TheFile,DotPos+1))
if InpFileCount=1 then
AllSameExtn=FileExtn
if AllSameExtn<>FileExtn then
AllSameExtn=''
end
end
call DBGIND-2
end
if InpFileCount=0 then
do
if Option0FilesTotalOk='N' then
UserSyntaxError('No files matched any of the input file masks (' || InputMaskCount || ') supplied!')
end
if AllSameExtn<> '' then
do
call DBG 'All input files end in the same extension (".' || AllSameExtn || '")'
call DBGIND 1
if OptionPrjExtn='' then
call DBG 'User has turned off Extensions based project files'
else
do
ExtnFile=ReplaceString(OptionPrjExtn, '*',AllSameExtn)
ExtnFile=FindProjectFile(ExtnFile)
if ExtnFile<> '' then
call ProcessCommandLineBit ExtnFile,OptChar|| 'LIST:' || ReplaceString(ExtnFile, ' ', '{x20}')
end
call DBGIND-1
end
if NewLineChars==CrLf then
LinesEndWith="CR followed by LF"
else
LinesEndWith="LF only"
call DBG 'Output lines are terminated with ' ||LinesEndWith
call DBG 'HTML Generator Tags are ' ||DebugRightArrow||OptionHtmlGeneratorTags||DebugLeftArrow
if OptionWantCopyright='Y' then
do
if OptionQuietDependsOn='N' then
call DisplayCopyright
end
call DebugStateChanged
if IncludeIntoMemory='' then
do
if InpFileCount=1 then
IncludeIntoMemory='N'
else
IncludeIntoMemory='Y'
end
call DBG 'Will read files into memory cache: ' ||IncludeIntoMemory
LastProcessingMode=ProcessingMode
LastOptionOutput=OptionOutput
LastOptionDependsOn=OptionDependsOn
PpwExitRc=0
ActuallyProcessed=0
FailedProcessingWarning=0
do InputIndex=1 to InpFileCount
ThisFile=InpFile.InputIndex
if symbol("_EXCLUDE_._EXF_" || c2x(ThisFile)) = 'VAR' then
do
call DBG ThisFile|| ' excluded - ' || _valueG("_EXCLUDE_._EXF_" ||c2x(ThisFile))
iterate
end
ActuallyProcessed=ActuallyProcessed+1
call _valueS "_EXCLUDE_._EXF_" || c2x(ThisFile), "Already processed"
SpecIndex=InpFileMaskIndex.InputIndex
BaseDir4CurrentInputFile=InputMaskBDir.SpecIndex
bf!Pm=InputMaskPMode.SpecIndex
bf!Om=InputMaskOutMask.SpecIndex
bf!Dm=InputMaskDepMask.SpecIndex
CopyModeFuzz=InputMaskCpyFuzz.SpecIndex
if bf!Om='' then
do
if OptionCloneUsed='Y' then
bf!Om=CloneOutputMask
end
call DBG 'In 02.148 backwards compatability mode? : ' ||Bc02_148
if Bc02_148='Y' then
do
if bf!Pm='' then
bf!Pm=LastProcessingMode
if bf!Om='' then
bf!Om=LastOptionOutput
if bf!Dm='' then
bf!Dm=LastOptionDependsOn
end
else
do
if bf!Om='' then
do
bf!Om=GetEiOrLu(ThisFile, 'OM',LastOptionOutput)
if bf!Om='' then
CryAndDie('No default output mask configured for "' || ThisFile || '"', "See /ExtnInfo")
end
if bf!Pm='' then
do
bf!Pm=GetEiOrLu(ThisFile, 'PM',LastProcessingMode)
if bf!Pm='' then
CryAndDie('No default processing mode configured "' || ThisFile || '"', "See /ExtnInfo")
end
if bf!Dm='' then
bf!Dm=GetEiOrLu(ThisFile, 'DM',LastOptionDependsOn)
end
ProcessingMode=bf!Pm
OptionOutput=bf!Om
OptionDependsOn=bf!Dm
if OptionTemplate='' then
GenerateRc=GenerateOutput(ThisFile, '')
else
GenerateRc=GenerateOutput(OptionTemplate,ThisFile)
if GenerateRc>PpwExitRc then
PpwExitRc=GenerateRc
if OptionDebugOn='Y' then
call DBG 'The Exit Rc is currently "' || PpwExitRc || '"'
end
if ActuallyProcessed=0 then
do
if InpFileCount<>0 then
do
if Option0FilesTotalAfterExcludeOk='N' then
UserSyntaxError('All input files (' || InpFileCount || ') were excluded by you!')
end
end
call OutputAnySpellingAdditions
if OptionQuietDependsOn='Y' &InpFileCountActuallyMade=0 then
OptionSummary='N'
if OptionSummary='Y' then
do
if ActuallyProcessed<>1 then
do
call AboutToGenerateSummary
call GenerateUserSummaryOverall
call AddSummaryLine 'Operating Syst' ,PpWizardOpSys
call AddSummaryLine 'Rexx Version' ,RexVersionInfo
if InpFileCount=InpFileCountActuallyMade then
call AddSummaryLine '# files' ,InpFileCount
else
call AddSummaryLine '# files made' ,InpFileCountActuallyMade || ' out of ' ||InpFileCount
call AddSummaryLine 'Exit Code' ,PpwExitRc
if FailedProcessingWarning<>0 then
call AddSummaryLine '# Warnings' ,FailedProcessingWarning
call AddSummaryLine 'Elapsed Time'     ,trunc(time('Elapsed'), 2) || ' seconds'
call GenerateSummaryLines
end
end
ThatsAllFolks(PpwExitRc)

GetSourceFileDateTimeDieOnError:
DateTimeRc=GetFileDateTimeButDontWarnOnError(arg(1))
if DateTimeRc=-1 then
CryAndDie('Could not get date/time stamp of "' || arg(1) || '".')
return(DateTimeRc)

InitLuCaseCfg:
CfgLower=''
CfgUpper=''
return

GetUserLcCfg:
if CfgLower=='' then
do
CfgLower=CfgMacro("PPWIZARD_LOWERCASE",LowerCase)
CfgUpper=CfgMacro("PPWIZARD_UPPERCASE",UpperCase)
end
return

GenerateOutput:
InputFile=arg(1)
TemplateDataFile=arg(2)
call ClearCollectedDependancyInfo
if OptionTemplate='' then
do
call DBG 'Main file is not a template, no point loading into memory'
InFile=InputFile
ForceBaseFile2Mem='N'
end
else
do
call DBG 'Main file is a template'
InFile=TemplateDataFile
ForceBaseFile2Mem=''
end
CurrentOutFile=GenerateFileName(InFile,OptionOutput)
call ClearDependancyTimeStampCache
InputFileFull=FileQueryExists(InputFile)
if NeedToRemake(InFile)='N' then
return(0)
if OptionDependsOn='' then
do
if ProcessingMode='COPY' then
do
cf!Rc=AreFilesEqual(InputFileFull,CurrentOutFile,CopyModeFuzz)
if cf!Rc='' then
return(0)
end
end
InpFileCountActuallyMade=InpFileCountActuallyMade+1
if OptionWantCopyright='Y' then
do
if OptionQuietDependsOn='Y' then
call DisplayCopyright
end
cf!T=value('PPWBLDTITLE_' ||ProcessingMode)
cf!T=ReplaceString(cf!T, '{IS}', _filespec('N',InputFileFull))
cf!T=ReplaceString(cf!T, '{OS}', _filespec('N',CurrentOutFile))
cf!T=ReplaceString(cf!T, '{ID}', _filespec('L',InputFileFull))
cf!T=ReplaceString(cf!T, '{OD}', _filespec('L',CurrentOutFile))
cf!T=ReplaceString(cf!T, '{IL}',InputFileFull)
cf!T=ReplaceString(cf!T, '{OL}',CurrentOutFile)
cf!T=ReplaceString(cf!T, '{PM}',ProcessingMode)
call ColorSet 'TITLE'
call Line1 cf!T
if ProcessingMode<> 'COPY' then
call Line1 copies('~',length(cf!T))
call ColorSet
if OptionTemplate='' then
TmpTemplate=''
else
TmpTemplate=TemplateDataFile
call RexxHookSetBuildingParms InFile,CurrentOutFile,TmpTemplate
if RexxHookBefore<> '' then
call CallHook "BEFORE"
call SetUpOptionsForThisBuild
Dummy=time('Reset')
call DBGINDInit
call InitLuCaseCfg
call StackInitForBuild
call CompletelyInitializeAutoTagState
call InitINTERCEPTCode
call InitTransformationCode
call InitOutputHold
call InitializeCharCodes
call InitializeDefineRexx
call InitializeOneLine
call InitCondNlCount
call InitOnExitProcessing
call InitNextId
DebugIncludeNumber=0
Warnings=0
LineSourceBeingProcessed='?'
GeneratedLines=0
InputLines=0
PartialLine=''
IncludeLevel=0
EofForced=''
LineQueued=''
PPwizardUnique=0
StackCnt=0
OptionStackCnt=0
HtmlGeneratorTags=OptionHtmlGeneratorTags
AsIsModeOn='N'
if OptionCompleteAddToToDepFile='Y' then
do
call AddInputFileToDependancyList "*PpwPgm"
call AddInputFileToDependancyList "*CmdLine"
end
call PrepareSpellingForThisBuild
TsNewestSourcefile=GetSourceFileDateTimeDieOnError(PpWizardPgmName)
call InitializeHashDefinesForThisCompile
IfNesting=0
IfState.WantLines.0='Y'
IfState.IfTrue.0='Y'
IfState.InTrue.0='Y'
WantLineCache='Y'
GenerateRc=0
call CheckRexxInterpreter
if ProcessingMode='COPY' then
do
cf!Rc=FileCopy(InputFileFull,CurrentOutFile)
call CreateDependancyFileFromLists
return(0)
end
OutputLevel=0
Ok2OutputHeader='Y'
call HaveNewOutputFile CurrentOutFile,,'N',ProcessingMode
do cf!HI=1 to OptionHashIncludeCnt
cf!List=OptionHashInclude.cf!HI
do while cf!List<> ''
parse var cf!List cf!This (PathDelimiterChar) cf!List
if cf!This<> '' then
do
call DBG '/#Include "' ||cf!This
GenerateRc=GenerateRc+ProcessInputFile(cf!This)
end
end
end
GenerateRc=GenerateRc+ProcessInputFile(InputFile,,ForceBaseFile2Mem)
if GenerateRc=0 then
do
call StackValidation
if OptionDebugOn='Y' then
call DBG 'Generation successful so far, look for nesting and other errors'
select
when IfNesting<>0 then
do
do Index=1 to IfNesting
NestingLevel=(IfNesting-Index)+1
call DBG 'Missing #endif at EOF - Nesting Level #' ||NestingLevel||MatchesIfDebugText(NestingLevel)
end
CryAndDie('Missing #endif at EOF' ||MatchesIfDebugText(IfNesting))
end
when StackCnt<>0 then
do
do Index=1 to StackCnt
NestingLevel=(StackCnt-Index)+1
call DBG 'Missing #RexxVar pop at EOF - Nesting Level #' ||NestingLevel||MatchesStackPushDebugText(NestingLevel)
end
CryAndDie('Incorrect #RexxVar push/pop nesting at EOF' ||MatchesStackPushDebugText(StackCnt))
end
when OptionStackCnt<>0 then
do
do Index=1 to OptionStackCnt
NestingLevel=(OptionStackCnt-Index)+1
call DBG 'Missing pop() at EOF - Nesting Level #' ||NestingLevel||MatchesOptionStackPushDebugText(NestingLevel)
end
CryAndDie('Missing #Option pop at EOF' ||MatchesOptionStackPushDebugText(OptionStackCnt))
end
when AutoTagStateCnt<>0 then
do
do Index=1 to AutoTagStateCnt
NestingLevel=(AutoTagStateCnt-Index)+1
call DBG 'Missing #AutoTagState- at EOF - Nesting Level #' ||NestingLevel||MatchesAutoTagStateIncDebugText(NestingLevel)
end
CryAndDie('Missing #AutoTagState- at EOF' ||MatchesAutoTagStateIncDebugText(AutoTagStateCnt))
end
when DefRexxVar<> '' then
CryAndDie('Missing #DefineRexx[+] at EOF', 'Block started at ' ||DefRexxStartLoc)
when OutputLevel>1 then
CryAndDie('Missing ' || OutputLevel - 1 || ' #output command(s) at EOF')
when OutputHoldLvl<>0 then
CryAndDie('Missing #OutputHold (end) at EOF', 'LAST Block started at ' ||OutHold_.OutputHoldLvl.!OutpHoldStartLoc)
otherwise
call DieIfHoldingOutput
end
if GeneratedLines=0 then
call OutputWarningToScreen 'GEN0', 'No output lines generated'
if OptionDebugOn='Y' then
call DBG 'No fatal errors detected so far'
end
call _FileClose CurrentOutFile
if RexxHookAfter<> '' then
call CallHook "AFTER"
if GenerateRc=0 then
do
if OptionDebugOn='Y' then
call DBG 'Looks OK so far, look for even more errors'
if PartialLine<> '' then
CryAndDie('A line continued to EOF')
call DoSyntaxCheckingOnFileIfEnabled CurrentOutFile
if OptionValidation<> '' then
do
ToExec=ReplaceHashAndStandardDefines(OptionValidation)
call RunExecOrValidateCmd 'VALIDATE',OptionValidationRc,ToExec
end
if Warnings<>0 then
do
FailedProcessingWarning=FailedProcessingWarning+1
GenerateRc=WantedWarningRc
end
if OptionNoDepFileOnWarnings='Y' &Warnings<>0 then
call DBG 'Dependancy file not created as warnings exist'
else
call CreateDependancyFileFromLists
if OptionSummary='Y' then
do
if InpFileCount=1 then
call AboutToGenerateSummary
else
call AboutToGenerateSummary 'N'
call GenerateUserSummaryThisBuild
call GenerateUserSummaryAllBuilds
if InpFileCount=1 then
call GenerateUserSummaryOverall
if Warnings<>0 then
call AddSummaryLine 'Warnings'        ,'YES (' || AddCommasToDecimalNumber(Warnings) || ')'
if InpFileCount=1 then
do
call AddSummaryLine 'Operating Syst' ,PpWizardOpSys
call AddSummaryLine 'Rexx Version' ,RexVersionInfo
end
call AddSummaryLine 'Return Code' ,GenerateRc
call AddSummaryLine 'Elapsed Time'        ,trunc(time('Elapsed'), 2) || ' seconds'
call GenerateSummaryLines
end
end
call Line1 ''
call RexxHookSetBuildingParms
return(GenerateRc)

MyLineNumber:
return(SIGL)

HandleIncludeFragment:
df!U=translate(IncludeFragmentSpec)
select
when left(df!U,3)='SE:' then
do
parse var IncludeFragmentSpec +3 df!Del +1 df!S (df!Del) df!E (df!Del) df!Crap
if df!Crap<> '' then
do
IncludeLevel=IncludeLevel-1
if IncludeLevel<>0 then
call RecursiveIncludeRestore
CryAndDie('The "SE:" fragment spec:', '    ' || IncludeFragmentSpec, 'is not correctly formatted. ("' || df!Crap || '" was unexpected)')
end
end
otherwise
do
df!S=IncludeFragmentSpec
df!E=df!S
end
end
IncludeFragmentS=df!S
IncludeFragmentE=df!E
return

ProcessInputFile:
parse arg RequestedFile,ef!AddToDepFile,ef!ForceLoad2Mem,IncludeFragmentSpec
call HandleIncludeFragment
IncludeLineNumber=0
IncludeMemBufferNextLine=''
IncludeLoopMemBufferNextLine=''
DebugIncludeNumber=DebugIncludeNumber+1
DebugCurrentFileNumber=DebugIncludeNumber
IncludeFileName=FindFile(RequestedFile)
if IncludeFileName='' then
do
if IncludeLevel<>0 then
call RecursiveIncludeRestore
CryAndDie('File "' || RequestedFile || '" does not exist!')
end
IncludeLevel=IncludeLevel+1
IncludeFileName.IncludeLevel=IncludeFileName
if IncludeLevel>=InfiniteIncludeLoopWhen then
do
if InfiniteIncludeLoopWhen<>0 then
do
say 'Infinite #include loop detected, at level #' ||IncludeLevel
say 'Use "/define:INFINITE_INCLUDE_LOOP_WHEN=0"   to turn off detection'
say 'Use "/define:INFINITE_INCLUDE_LOOP_WHEN=100" to increase detection threshold etc'
IncludeLevel=IncludeLevel-1
call RecursiveIncludeRestore
CryAndDie("We seem to be in an infinite #include loop!")
end
end
MemUpdateIndex=0
do IncIndex=1 to IncludeLevel-1
if RexSystemOpSys="UNIX" then
IncSame=(IncludeFileName=IncludeFileName.IncIndex)
else
IncSame=(translate(IncludeFileName)=translate(IncludeFileName.IncIndex))
if IncSame=1 then
do
if _IncludeMemHandle.IncIndex<> '' then
call DBG 'File already being processed, already reading from memory cache!'
else
do
call DBG 'File already being processed, forcing use from memory cache'
call _FileClose IncludeFileName
MemUpdateIndex=IncIndex
ef!ForceLoad2Mem='Y'
end
leave
end
end
if ef!AddToDepFile<> 'N' then
call AddInputFileToDependancyList(/*RequestedFile*/IncludeFileName)
call ReadingI
ThisDateTime=GetSourceFileDateTimeDieOnError(IncludeFileName)
if ThisDateTime>TsNewestSourcefile then
TsNewestSourcefile=ThisDateTime
parse value IncludeFileOpen(IncludeFileName,ef!ForceLoad2Mem)with IncludeEofLine ';' IncludeMemHandle
if MemUpdateIndex<>0 then
do
_IncludeMemHandle.MemUpdateIndex=IncludeMemHandle
_IncludeEofLine.MemUpdateIndex=IncludeEofLine
end
if IncludeFragmentS<> '' then
do
call DBG 'Looking for the start of the fragment: ' ||IncludeFragmentS
do while IncludeFileLines()<>0
InputLines=InputLines+1
FileLine=IncludeFileLineIn()
if pos(IncludeFragmentS,FileLine)<>0 then
leave
end
if IncludeFileLines()=0 then
do
ef!FR=IncludeFragmentS
ef!FN=IncludeFileName
ef!LP=IncludeLineNumber
IncludeLevel=IncludeLevel-1
if IncludeLevel<>0 then
call RecursiveIncludeRestore
CryAndDie('Did not find the START of the code fragment "' || ef!FR || '" (searched ' || AddCommasToDecimalNumber(ef!LP) || ' lines in "' || ef!FN || '")')
end
call DBG 'Found it'
end
do forever
LastLineAfterMacroRep=''
select
when IncludeLoopMemBufferNextLine\=='' then
do
ef!LC='<<#{'
parse var IncludeLoopMemBufferNextLine FileLine (MarksNewLine) IncludeLoopMemBufferNextLine
LastLine=FileLine
LineSrc='M'
if OptionDebugOn='Y' then
call DebugShowCurrentLineWithLineNumber FileLine,ef!LC
end
when InLoop='Y' &LoopLinesFromFile=0 then
do
ef!LC='<<ML'
FileLine=GetLoopLineIntoFileLine()
LastLine=FileLine
LineSrc='M'
if OptionDebugOn='Y' then
call DebugShowCurrentLineWithLineNumber FileLine,ef!LC
end
when IncludeMemBufferNextLine\=='' then
do
ef!LC='<<<<'
parse var IncludeMemBufferNextLine FileLine (MarksNewLine) IncludeMemBufferNextLine
LastLine=FileLine
LineSrc='M'
if LinesFromOnExit='Y' then
LastFileLine=FileLine
if OptionDebugOn='Y' then
call DebugShowCurrentLineWithLineNumber FileLine,ef!LC
end
when LineQueued\=='' then
do
call FlushQueuedOutput
iterate
end
when InLoop='Y' |IncludeFileLines()<>0 then
do
if EofForced<> '' then
do
if OptionDebugOn='Y' then
call DBG '#EOF (at ' || EofForced || ') told us to stop processing this file any further'
if SetUpOnExitProcessingIfEndOfMainFile()='Y' then
iterate
leave
end
if InLoop='Y' then
do
FileLine=GetLoopLineIntoFileLine()
ef!LC='<<FL'
end
else
do
InputLines=InputLines+1
FileLine=IncludeFileLineIn()
ef!LC=''
end
LastFileLine=FileLine
LastLine=FileLine
LineSrc='F'
if OptionDebugOn='Y' then
call DebugShowCurrentLineWithLineNumber FileLine,ef!LC
if IncludeFragmentE<> '' then
do
if pos(IncludeFragmentE,FileLine)<>0 then
do
call DBG 'Found the end of the fragment'
IncludeFragmentE=''
leave
end
end
if OptionFilterIn<> '' then
do
FileLine=HtmlFilterIn("I",FileLine,IncludeFileName,IncludeLineNumber,InputLines,MarksNewLine)
if pos(MarksNewLine,FileLine)<>0 then
do
IncludeMemBufferNextLine=FileLine
iterate
end
if left(FileLine,1)=NullChar then
do
if FileLine=NullChar then
iterate
else
CryAndDie(substr(FileLine,2))
end
end
end
otherwise
do
if SetUpOnExitProcessingIfEndOfMainFile()='Y' then
iterate
leave
end
end
if LineSrc<> 'F' then
do
LineContinued='N'
Word1=word(FileLine,1)
end
else
do
if InterceptCode<> '' then
do
if FileLine=InterceptOffMarker then
do
if OptionDebugOn='Y' then
call DBG 'Intercepted line looks like end of block, not processed'
end
else
do
BeforeLine=FileLine
call ExecRexxCmd InterceptCode
if OptionDebugOn='Y' then
do
if BeforeLine==FileLine then
call DBG 'Intercepted line was not changed'
else
call DBG 'Intercepted Line changed to ' ||DebugRightArrow||FileLine||DebugLeftArrow
end
if BeforeLine\==FileLine then
do
if pos(MarksNewLine,FileLine)<>0 then
do
do
if InLoop='Y' &LoopLinesFromFile=0 then
do
if IncludeLoopMemBufferNextLine=='' then
IncludeLoopMemBufferNextLine=FileLine
else
IncludeLoopMemBufferNextLine=FileLine||MarksNewLine||IncludeLoopMemBufferNextLine
end
else
do
if IncludeMemBufferNextLine=='' then
IncludeMemBufferNextLine=FileLine
else
IncludeMemBufferNextLine=FileLine||MarksNewLine||IncludeMemBufferNextLine
end
end
iterate
end
end
end
end
if NextIdReplOn='Y' then
do
NidReplaceCount=ReplaceCount
FileLine=ReplaceString(FileLine,NextIdMarker,NextIdNew)
if NidReplaceCount<>ReplaceCount then
NextIdUsed='Y'
end
if AsIsModeOn='Y' then
FileLine=ExpandAsIsTags(FileLine)
if AutoTagOn='Y' then
FileLine=AutoTag(FileLine)
if pos(TabChar,FileLine)<>0 then
do
if OptionDebugOn='Y' then
call DBG 'Tab(s) found'
select
when OptionTabs='W' then
do
call OutputWarningToScreen 'T000', 'There are TABS in the source (converted to spaces)!'
FileLine=translate(FileLine, ' ',TabChar)
end
when OptionTabs='T' then
do
FileLine=translate(FileLine, ' ',TabChar)
end
when OptionTabs='E' then
do
FileLine=ExpandTabs(FileLine,WidthOfTab)
end
otherwise
do
end
end
end
if OptionHideCmdS_L<>0 then
do
PosS=pos(OptionHideCmdS,FileLine)
if PosS<>0 then
do
if OptionDebugOn='Y' then
do
call DBG 'At least one hidden command'
call DBGIND 1
end
RightBit=FileLine
LeftBit=''
do while PosS<>0
PosE=pos(OptionHideCmdE,RightBit,PosS)
if PosE=0 then
CryAndDie('Found start of hidden command ("' || OptionHideCmd || '"), but not the end!')
Hidden=strip(substr(RightBit,PosS+OptionHideCmdS_L,(PosE-PosS)-OptionHideCmdS_L))
if OptionDebugOn='Y' then
call DBG 'Found: ' ||DebugRightArrow||Hidden||DebugLeftArrow
LeftBit=LeftBit||left(RightBit,PosS-1)||Hidden
RightBit=substr(RightBit,PosE+OptionHideCmdE_L)
PosS=pos(OptionHideCmdS,RightBit)
end
FileLine=LeftBit||RightBit
if OptionDebugOn='Y' then
do
call DBG 'NewLine: ' ||DebugRightArrow||FileLine||DebugLeftArrow
call DBGIND-1
end
end
end
FileLine=strip(FileLine, 'T')
CmtPos=lastpos(InLineComment,FileLine)
if CmtPos<>0 then
do
AddToEnd=''
if right(FileLine,1)=LineContChar then
do
Right2=right(FileLine,2)
if Right2=LineContAddNewLine|Right2=LineContAddNewLineObs|Right2=LineContWithoutSpace|Right2=LineContWithSpace|Right2=LineContDefault then
do
AddToEnd=' ' ||Right2
end
end
FileLine=strip(left(FileLine,CmtPos-1), 'T')||AddToEnd
end
if ProcessingMode='REXX' then
do
if OptionDebugOn='N' then
do
if OptionKeepRexxCmts='N' &right(FileLine,2)=RexxCmtEnd then
do
StartCmtPos=lastpos(RexxCmtStart,FileLine)
if StartCmtPos<>0 then
do
if StartCmtPos=0 then
FileLine=''
else
FileLine=strip(left(FileLine,StartCmtPos-1), 'T')
if FileLine='' then
iterate
end
end
end
end
if LineContChar=NullChar then
LineContinued='N'
else
do
if right(FileLine,1)<>LineContChar then
LineContinued='N'
else
do
Right2=right(FileLine,2)
MainBit=strip(left(FileLine,length(FileLine)-2), 'T')
select
when Right2=LineContWithoutSpace then
do
LineContinued='Y'
FileLine=MainBit
end
when Right2=LineContWithSpace|Right2=LineContDefault then
do
FileLine=MainBit
LineContinued='YS'
end
when Right2=LineContAddNewLine then
do
LineContinued='Y'
FileLine=MainBit||CodexNewLine
end
when Right2=LineContAddNewLineObs then
do
call WarnAboutDepreciatedFeature 'Line continuation using downarrow.  Replace with -> "%\"'
LineContinued='Y'
FileLine=MainBit||CodexNewLine
end
otherwise
LineContinued='N'
end
end
end
if FileLine='' then
do
if LeaveBlankLines='N' then
do
if OptionDebugOn='Y' then
call DebugShowLineDropped "Blank Line"
if LineContinued='N' & PartialLine \== '' then
do
do
if InLoop='Y' &LoopLinesFromFile=0 then
do
if IncludeLoopMemBufferNextLine=='' then
IncludeLoopMemBufferNextLine=PartialLine
else
IncludeLoopMemBufferNextLine=PartialLine||MarksNewLine||IncludeLoopMemBufferNextLine
end
else
do
if IncludeMemBufferNextLine=='' then
IncludeMemBufferNextLine=PartialLine
else
IncludeMemBufferNextLine=PartialLine||MarksNewLine||IncludeMemBufferNextLine
end
end
PartialLine=''
end
iterate
end
end
Word1=word(FileLine,1)
if left(Word1,1)=LineComment then
do
if LineContinued='N' & PartialLine \== '' then
do
if OptionDebugOn='Y' then
call DebugWarning 'Line continuation ends with a comment line'
do
if InLoop='Y' &LoopLinesFromFile=0 then
do
if IncludeLoopMemBufferNextLine=='' then
IncludeLoopMemBufferNextLine=PartialLine
else
IncludeLoopMemBufferNextLine=PartialLine||MarksNewLine||IncludeLoopMemBufferNextLine
end
else
do
if IncludeMemBufferNextLine=='' then
IncludeMemBufferNextLine=PartialLine
else
IncludeMemBufferNextLine=PartialLine||MarksNewLine||IncludeMemBufferNextLine
end
end
PartialLine=''
end
iterate
end
if LineSrc='F' then
do
if KeepIndent='N' then
FileLine=strip(FileLine, 'L')
else
FileLine=LeftIndent||FileLine
end
if PartialLine<> '' then
do
if left(Word1,HashPrefixLng)<>HashPrefix then
do
PartialLine=PartialLine||FileLine
end
else
do
parse var FileLine TheHashCmd TheRest
TheRest=strip(TheRest)
FileLine=TheHashCmd|| ' ' ||TheRest
PartialLine=PartialLine||PpwCmdDivider1||FileLine||PpwCmdDivider1
if LineContinued='YS' then
LineContinued='Y'
end
end
if LineContinued='N' then
do
if PartialLine\=='' then
do
do
if InLoop='Y' &LoopLinesFromFile=0 then
do
if IncludeLoopMemBufferNextLine=='' then
IncludeLoopMemBufferNextLine=PartialLine
else
IncludeLoopMemBufferNextLine=PartialLine||MarksNewLine||IncludeLoopMemBufferNextLine
end
else
do
if IncludeMemBufferNextLine=='' then
IncludeMemBufferNextLine=PartialLine
else
IncludeMemBufferNextLine=PartialLine||MarksNewLine||IncludeMemBufferNextLine
end
end
PartialLine=''
iterate
end
end
else
do
if PartialLine=='' then
do
PartialLine=FileLine
if translate(left(Word1,length(CmdHashDefine)))=CmdHashDefine then
PpwCmdDivider1=MarksNewLineInHashDefine
else
PpwCmdDivider1=MarksNewLine
end
if LineContinued='YS' then
PartialLine=PartialLine|| ' '
iterate
end
end
if OneLineLevel<>0 then
do
FileLine=AddToOneLine(FileLine)
if FileLine=='' then
iterate
else
do
do
if InLoop='Y' &LoopLinesFromFile=0 then
do
if IncludeLoopMemBufferNextLine=='' then
IncludeLoopMemBufferNextLine=FileLine
else
IncludeLoopMemBufferNextLine=FileLine||MarksNewLine||IncludeLoopMemBufferNextLine
end
else
do
if IncludeMemBufferNextLine=='' then
IncludeMemBufferNextLine=FileLine
else
IncludeMemBufferNextLine=FileLine||MarksNewLine||IncludeMemBufferNextLine
end
end
LastFileLine=FileLine
iterate
end
end
if left(Word1,HashPrefixLng)=HashPrefix then
do
parse var FileLine HashCmd SecondWordEtc
HashCmd=translate(HashCmd)
HashRc='?'
select
when HashCmd=CmdHashIf then
do
HashRc=ProcessHashIfTest(FileLine)
end
when HashCmd=CmdHashIfDef then
do
HashRc=ProcessHashIfTest(FileLine)
end
when HashCmd=CmdHashIfnDef then
do
HashRc=ProcessHashIfTest(FileLine)
end
when HashCmd=CmdHashElseifL|HashCmd=CmdHashElseifS then
HashRc=ProcessHashElse(SecondWordEtc)
when HashCmd=CmdHashEndifL|HashCmd=CmdHashEndifS then
HashRc=ProcessHashEndif(SecondWordEtc)
otherwise
end
if HashRc<> '?' then
do
if HashRc<> 'OK' then
call CryAndDie 'Hash command failed, Rc = ' ||HashRc
else
do
WantLineCache=WantLine()
iterate
end
end
end
if WantLineCache='N' then
do
if OptionDebugOn='Y' then
call DebugShowLineDropped "False"
iterate
end
if left(Word1,HashPrefixLng)=HashPrefix then
do
call ProcessHashCommand FileLine
end
else
do
if DefRexxVar<> '' then
do
call AddDefineRexxLine FileLine
iterate
end
if ReplacementsAllowed='Y' then
do
NowCount=ReplaceCount
FileLine=ReplaceHashAndStandardDefines(FileLine,, 'Y')
if ExpandXEarly='Y' then
do
if pos(StartsStdSymbolReplacement_x,FileLine)<>0 then
FileLine=ReplaceTheXCodesWeKnowExist(FileLine)
end
if NowCount<>ReplaceCount then
do
if pos(MarksNewLine,FileLine)<>0 then
do
do
if InLoop='Y' &LoopLinesFromFile=0 then
do
if IncludeLoopMemBufferNextLine=='' then
IncludeLoopMemBufferNextLine=FileLine
else
IncludeLoopMemBufferNextLine=FileLine||MarksNewLine||IncludeLoopMemBufferNextLine
end
else
do
if IncludeMemBufferNextLine=='' then
IncludeMemBufferNextLine=FileLine
else
IncludeMemBufferNextLine=FileLine||MarksNewLine||IncludeMemBufferNextLine
end
end
iterate
end
end
if ExpandXLate='Y' then
do
if pos(StartsStdSymbolReplacement_x,FileLine)<>0 then
FileLine=ReplaceTheXCodesWeKnowExist(FileLine)
end
end
if TransformCodeLvl<>0 then
do
ef!Drop='N'
do ef!TNumb=TransformCodeLvl to 1 by-1 until DoPrevious<> 'Y'
call DBG 'Executing #transform #' ||ef!TNumb
ef!TF=TransformCode.ef!TNumb
if ef!TF='' then
leave
call DBGIND 1
FileRest=FileLine
FileAfter=''
AppendWith=''
Remove=''
DoPrevious='N'
do until FileRest==''
parse var FileRest FileLine (MarksNewLine) FileRest
Remove=''
BeforeLine=FileLine
call ExecRexxCmd ef!TF
if Remove<> '' then
call DBG 'Transform line dropped ==> ' ||Remove
else
do
FileAfter=FileAfter||AppendWith||FileLine
AppendWith=MarksNewLine
if OptionDebugOn='Y' then
do
if BeforeLine==FileLine then
call DBG 'Line was not transformed'
else
call DBG 'Line transformed to ' ||DebugRightArrow||FileLine||DebugLeftArrow
end
end
end
call DBGIND-1
if FileAfter='' & Remove <> '' then
do
ef!Drop='Y'
leave
end
FileLine=FileAfter
end
if ef!Drop='Y' then
iterate
end
if LineSrc='M' then
do
LineQueued=LineQueued||FileLine
iterate
end
do until FileLine == ''
parse var FileLine This1 (MarksNewLine) FileLine
if  ProcessingMode  = 'REXX' then
call OutputRexxLine This1
else
do
if  ProcessingMode <> 'HTML' then
call GenerateOneLine This1
else
do
if  ProcessingMode  = 'HTML' & HtmlGeneratorTags <> '' then
do
This1U  = translate(This1)
InsertTags = 'N'
InsBef     = ''
InsAft     = ''
LookFor = "<HEAD>"
TagPos  = pos(LookFor, This1U)
if  TagPos <> 0 then
do
InsertTags = "Y"
InsBef     = MarksNewLine
InsAft     = InsBef
InsertAt   = TagPos + length(LookFor)
end
else
do
LookFor = "<BODY"
TagPos  = pos(LookFor, This1U)
if  TagPos <> 0 then
do
InsertTags = "Y"
InsBef     = '<head>' || MarksNewLine || '  '
InsAft     = MarksNewLine || '</head>' || MarksNewLine
InsertAt   = TagPos
end
end
if  InsertTags = 'Y' then
do
call DBG 'Found "' || LookFor || '" so inserted HTML generator tags'
cf!Ins = ReplaceHashAndStandardDefines(HtmlGeneratorTags)
cf!Ins = RepXCodes(cf!Ins)
cf!Ins = InsBef || cf!Ins || InsAft
FileLine = insert(cf!Ins, This1, InsertAt-1) || MarksNewLine || FileLine
HtmlGeneratorTags = ''
iterate
end
end
call GenerateOneLine This1
end
end
end
end
end
EofForced=''
call IncludeFileClose
if IncludeFragmentE<> '' then
CryAndDie('Did not find the END of the code fragment "' || IncludeFragmentE || '" (in "' || IncludeFileName || '")!')
IncludeLevel=IncludeLevel-1
if OptionDebugOn='Y' then
call DBG 'Finished processing the input file'
return(0)

FlushQueuedOutput:
if LineQueued=='' then
return
LineSrc='Q'
FileLine=LineQueued
LineQueued=''
if OptionDebugOn='Y' then
call DebugShowCurrentLineWithLineNumber FileLine, '>>>>'
do until FileLine == ''
parse var FileLine This1 (MarksNewLine) FileLine
if  ProcessingMode  = 'REXX' then
call OutputRexxLine This1
else
do
if  ProcessingMode <> 'HTML' then
call GenerateOneLine This1
else
do
if  ProcessingMode  = 'HTML' & HtmlGeneratorTags <> '' then
do
This1U  = translate(This1)
InsertTags = 'N'
InsBef     = ''
InsAft     = ''
LookFor = "<HEAD>"
TagPos  = pos(LookFor, This1U)
if  TagPos <> 0 then
do
InsertTags = "Y"
InsBef     = MarksNewLine
InsAft     = InsBef
InsertAt   = TagPos + length(LookFor)
end
else
do
LookFor = "<BODY"
TagPos  = pos(LookFor, This1U)
if  TagPos <> 0 then
do
InsertTags = "Y"
InsBef     = '<head>' || MarksNewLine || '  '
InsAft     = MarksNewLine || '</head>' || MarksNewLine
InsertAt   = TagPos
end
end
if  InsertTags = 'Y' then
do
call DBG 'Found "' || LookFor || '" so inserted HTML generator tags'
cf!Ins = ReplaceHashAndStandardDefines(HtmlGeneratorTags)
cf!Ins = RepXCodes(cf!Ins)
cf!Ins = InsBef || cf!Ins || InsAft
FileLine = insert(cf!Ins, This1, InsertAt-1) || MarksNewLine || FileLine
HtmlGeneratorTags = ''
iterate
end
end
call GenerateOneLine This1
end
end
end
return

OutputInformationToScreen:
if OptionWantInfoMsgs='Y' then
do
InfoText=arg(1)
if IncludeLevel=0 then
LineText=''
else
LineText='(@' || AddCommasToDecimalNumber(IncludeLineNumber) || ')'
call ColorSet 'INFO'
call Line1 ReadingIndent()|| '  ' || LineText || 'INFO: ' ||InfoText
call ColorSet
end
return

ProcessHashCommand:
HashCmdMc=word(arg(1),1)
HashCmd=translate(HashCmdMc)
HashCmdParms=subword(arg(1),2)
select
when HashCmd=CmdHashDefine then
return(ProcessDefine(HashCmdParms))
when HashCmd=CmdHashDefinePlus then
return(ProcessDefine(HashCmdParms, 'Y'))
when HashCmd=CmdHashRexxVar then
return(ProcessRexxVar(HashCmdParms))
when HashCmd=CmdHashEvaluateL|HashCmd=CmdHashEvaluateS then
return(ProcessEvaluate(HashCmdParms))
when HashCmd=CmdHashEvaluatePlusL|HashCmd=CmdHashEvaluatePlusS then
return(ProcessEvaluate(HashCmdParms, 'Y'))
when HashCmd=CmdHashAutoTag then
do
ProcessRc=ProcessAutoTag(HashCmdParms)
return(ProcessRc)
end
when HashCmd=CmdHashUndefL|HashCmd=CmdHashUndefS then
return(HandleUndefCommand(HashCmdParms))
when HashCmd=CmdHashOption then
return(ProcessOption(HashCmdParms))
when HashCmd=CmdHashLoopS then
return(ProcessLoopStart(HashCmdParms))
when HashCmd=CmdHashLoopBreak then
return(ProcessLoopBreak(HashCmdParms))
when HashCmd=CmdHashLoopContinue then
return(ProcessLoopContinue(HashCmdParms))
when HashCmd=CmdHashInclude then
do
IncludeParms=strip(PerformReplacementsInCmdsParameters(HashCmdParms))
if IncludeParms="" then
return(CryAndDie("No filename specified on #include line!"))
QuoteChar=left(IncludeParms,1)
if QuoteChar<> '"' & QuoteChar <> "'" & QuoteChar <> "<" then
do
parse var IncludeParms IncludeName Fragment
end
else
do
if QuoteChar="<" then
QuoteChar='>'
IncludeParms=substr(IncludeParms,2)
QuotePos=pos(QuoteChar,IncludeParms)
if QuotePos=0 then
CryAndDie('Could not find the ending quote for the included filename')
IncludeName=left(IncludeParms,QuotePos-1)
Fragment=substr(IncludeParms,QuotePos+1)
if IncludeName='' then
CryAndDie('Invalid #include command, no filename passed!')
end
if Fragment<> '' then
Fragment=GetQuotedText(Fragment)
call RecursiveIncludeSave
call ProcessInputFile IncludeName,,,Fragment
call RecursiveIncludeRestore
call ReadingI
return(0)
end
when HashCmd=CmdHashImport then
return(ProcessImport(HashCmdParms))
when HashCmd=CmdHashOutput then
return(ProcessHashOutput(HashCmdParms))
when HashCmd=CmdHashOutputHold then
return(ProcessHashOutputHold(HashCmdParms))
when HashCmd=CmdHashDefineRexx then
return(ProcessDefineRexx(HashCmdParms))
when HashCmd=CmdHashDefineRexxPlus then
return(ProcessDefineRexx(HashCmdParms, 'Y'))
when HashCmd=CmdHashDefineIfReq then
return(ProcessDefine(HashCmdParms, '?'))
when HashCmd=CmdHash1Line then
return(ProcessOneLine(HashCmdParms,CmdHash1LineEnd))
when HashCmd=CmdHashOneLine then
return(ProcessOneLine(HashCmdParms))
when HashCmd=CmdHashMacroSpace then
do
call NotAvailableUnderNtYet HashCmd
Rest=PerformReplacementsInCmdsParameters(HashCmdParms)
MsCommand=translate(GetQuotedText(Rest, "Rest"))
MsFile=GetQuotedText(Rest, "Rest")
if Rest='' then
MsFunction=''
else
MsFunction=GetQuotedText(Rest)
if MsCommand<> 'ADD' & MsCommand <> 'DROP' then
CryAndDie('The macro space command "' || MsCommand || '" is unknown!')
if FileQueryExists(MsFile)='' then
CryAndDie('The rexx file "' || MsFile || '" does not exist!')
call DoMacroSpaceOperation MsCommand,MsFile,MsFunction
return(0)
end
when HashCmd=CmdHashAsIs then
return(ProcessAsIs(HashCmdParms))
when HashCmd=CmdHashWarningL|HashCmd=CmdHashWarningS then
return(ProcessHashWarning(HashCmdParms))
when HashCmd=CmdHashInfo then
do
InfoMsg=PerformReplacementsInCmdsParameters(HashCmdParms)
InfoMsg=GetQuotedRest(InfoMsg)
call OutputInformationToScreen InfoMsg
return(0)
end
when HashCmd=CmdHashPush then
return(ProcessPush(HashCmdParms))
when HashCmd=CmdHashPop then
return(ProcessPop(HashCmdParms))
when HashCmd=CmdHashAutoTagState then
return(ProcessAutoTagState(HashCmdParms))
when HashCmd=CmdHashAutoTagClear then
return(ProcessAutoTagClear(HashCmdParms))
when HashCmd=CmdHashDependsOn then
return(ProcessDependsOn(HashCmdParms))
when HashCmd=CmdHashOnExit then
return(ProcessOnExit(HashCmdParms))
when HashCmd=CmdHashEof then
do
if HashCmdParms<> '' then
do
EndifCounter=GetQuotedText(HashCmdParms)
EndifCounter=PerformReplacementsInCmdsParameters(EndifCounter)
if datatype(EndifCounter, 'W')=0 then
CryAndDie('Invalid #endif simulate count of "' || EndifCounter || '" supplied!')
do EndifIndex=1 to EndifCounter
call ProcessHashEndif
end
end
EofForced=CurrentSourceLocation()
return(0)
end
when HashCmd=CmdHashTransform then
return(ProcessTransform(HashCmdParms))
when HashCmd=CmdHashIntercept then
return(ProcessIntercept(HashCmdParms,HashCmdMc))
when HashCmd=CmdHashSystem then
return(ProcessSystem(HashCmdParms))
when HashCmd=CmdHashDebug then
return(ProcessHashDebug(HashCmdParms))
when HashCmd=CmdHashRequire then
return(ProcessRequire(HashCmdParms))
when HashCmd=CmdHashNextId then
return(ProcessNextId(HashCmdParms))
when HashCmd=CmdHashErrorL|HashCmd=CmdHashErrorS then
call ProcessHashError HashCmdParms
otherwise
do
if UserHashCmds='' then
call LookForUnknownCmdHandler
if UserHashCmds<> '' then
return(ProcessUnknownHashCommand(HashCmd,HashCmdParms))
if HashCmd=CmdHashLoopE then
CryAndDie('Missing "' || CmdHashLoopS || '" command')
else
CryAndDie("Invalid '#' command line of: " ||HashCmd)
end
end
return(0)

ProcessHashError:
ErrorMsg=GetQuotedRest(PerformReplacementsInCmdsParameters(arg(1)))
ErrorMsg=ReplaceString(ErrorMsg, '{NL}',MarksNewLine)
CryAndDie(ErrorMsg)

IsStringOnOrOffCmd:
OoCmd=translate(arg(1))
if OoCmd='+' | OoCmd = 'YES' |  OoCmd = 'ON' then
return('Y')
else
do
if OoCmd='-' | OoCmd = 'NO' |  OoCmd = 'OFF' then
return('N')
end
return('')

SetOnorOffVariable:
parse arg OnOffSrc,VarName
OnOrOffText=translate(GetQuotedText(OnOffSrc))
OnOrOff=IsStringOnOrOffCmd(OnOrOffText)
if OnOrOff='' then
CryAndDie(HashCmd|| ' command does not specify a correct value value (ON/OFF)!')
call _valueS VarName,OnOrOff
return(0)

DisplayCopyright:
if CopyrightDisplayed='N' then
do
if symbol("WizName") <> "VAR" then
WizName='PPWIZARD.REX'
call ColorSet 'HIGHLIGHT'
call Line1 '[]---------------------------------------------------------[]'
call Line1 '| ' || WizName || ': Version ' || PgmVersion || ' (' || PgmAuthorEmail || ')   |'
call Line1 '| ' || PgmAuthorHomePage || '            |'
call Line1 '| (C)opyright ' || PgmAuthor || ' 1997-2002. ALL RIGHTS RESERVED. |'
call Line1 '[]---------------------------------------------------------[]'
call ColorSet
call Line1 ''
CopyrightDisplayed='Y'
end
return

CheckRexxInterpreter:
if RexWhich='REGINA' then
do
if pos(RexVerRegina,GetEnv("PPWIZARD_TEST_REGINA_VER") || ' ' ||SupportedReginaVersions)<>0 then
return(0)
criText='The Regina "' || RexVerRegina || '" interpreter is unsupported, use ' || SupportedReginaVersions || ' instead! I recommend "' || RecommendedReginaVersions || '"'
if arg(1)='Y' then
call DBG criText
else
call OutputWarningToScreen 'URI0',criText
return(1)
end
return(0)

NiceDateTime:
return(date('Weekday') || ', ' || date() || ' ' ||GetAmPmTime())

GetInputFileNameAndLine:call TRACE "OFF"

CurrentSourceLocation:
if IncludeLevel<>0 then
return('line ' || AddCommasToDecimalNumber(IncludeLineNumber) || ' of "' || IncludeFileName || '"')
else
do
if arg(1, 'E')then
return(arg(1))
else
return("unknown")
end

GetLineBeingProcessed:call TRACE "OFF"
return(strip(LastLine))

GetFileLineBeingProcessed:call TRACE "OFF"
return(strip(LastFileLine))

DumpVarsIfCompoundVariable:
if pos('.',arg(1))<>0 then
ExpressionKilledUs=arg(1)
return

CheckForNotBeingAbleToExecAnything:
if RexWhich='REGINA' then
do
if RexSystemOpSys="UNIX" then
Exe=''
else
Exe='.exe'
RexxExe="rexx" ||Exe
ReginaExe="regina" ||Exe
DoWhat='Test for use of buggy regina "' || ReginaExe || '" rather than "' || RexxExe || '" executable'
call DBG DoWhat
TmpFile=RexGetTmpFileName()
call AddressCmd 'echo ' ||DoWhat||RedirectStdOutAndErr2(TmpFile),TmpFile
if FileQueryExists(TmpFile)='' then
do
Line1="Can't execute shell functions!"
if RexSystemOpSys<> "UNIX" then
do
Line3='It''s possible that your "TMP" or "TEMP" environment variables'
Line4='are corrupt.'
end
else
do
Line3='If you used regina''s "' || ReginaExe || '" executable then try the "' || RexxExe || '"'
Line4='one instead!'
end
Line5='Could not create "' || TmpFile || '"'
Line7='Please report the problem to "' || PgmAuthorEmail || '" (please attach'
Line8='zipped output with "' || OptChar  || 'debug" switch used)!'
CryAndDie(Line1, '', Line3, Line4, Line5, '',Line7,Line8)
end
call _SysFileDelete TmpFile
call DBG 'Looks OK to me!'
end
return

LookLikeASingleFile:
FileName=arg(1)
call DBG 'No files matched "' || FileName || '", does it look like a single file?'
if verify(FileName, '*?', 'M')<>0 then
NormalFile='N'
else
do
if FileQueryExists(FileName)='' then
NormalFile='N'
else
NormalFile='Y'
end
call DBGIND 1
call DBG 'Normal File: ' ||NormalFile
call DBGIND-1
return(NormalFile)

CryAndDie:
SynErrLine=SIGL
SynErrLineC=AddCommasToDecimalNumber(SynErrLine)
call DBGINDInit
call DBG 'Fatal Error Detected (at line ' || SynErrLineC || ' of ppwizard)'
call DBGIND 1
PpwSize=FileQuerySize(PpWizardPgmName)
if PpwSize<> '' then
PpwSize=AddCommasToDecimalNumber(PpwSize)
PpwDateTime=GetFileTimeStamp(PpWizardPgmName)
call AllFollowingOutputGoesToErrorFile
call ColorSet 'ERROR'
call Line1 ''
call Line1 copies('!!',38)
call Line1 copies('!!', 15) || '[ Fatal  Error ]' || copies('!!',15)
call Line1 copies('!!',38)
call CgiStartFatalError
if IncludeLevel<>0 then
do
LastFileLine=strip(LastFileLine)
LastLine=strip(LastLine)
call Line1 'Location  : ' ||CurrentSourceLocation()
ef!S=GetIncludeStack()
if ef!S<> '' then
call Line1 'File Stack: ' ||ef!S
call Line1 'File Line : ' ||LastFileLine
if LastLine<>LastFileLine then
call Line1 'Fail Line : ' ||LastLine
if LastLineAfterMacroRep<> '' &LastLine<>LastLineAfterMacroRep&LastFileLine<>LastLineAfterMacroRep then
call Line1 'After Repl: ' ||LastLineAfterMacroRep
if MacroBeingExpanded<> '' then
call Line1 'Expanding : ' || StartsMacroReplacement || MacroBeingExpanded || ' ...' ||EndsMacroReplacement
end
else
do
if PpwDoing<> '' then
call Line1 'Doing What: ' ||PpwDoing
end
call SeeAlsoFile 10
call Line1 'Detected @: Line ' || SynErrLineC || ' of ' || _filespec('name', PpWizardPgmName) || ' (v' || PgmVersion || ')'
call Line1 'PPWIZARD  : Length ' || PpwSize || ' bytes.  TimeStamped ' ||PpwDateTime
call Line1 'Running In: ' || DebugGetOpSysText() || ', ' ||RexVersionInfo
call Line1 'Reason'
call Line1 '~~~~~~'
LastArg=1
do LineIndex=1 to arg()
if arg(LineIndex)<> '' then
LastArg=LineIndex
end
do LineIndex=1 to LastArg
call Line1 arg(LineIndex)
end
if ExpressionKilledUs<> '' then
call DumpVarsInExpression ExpressionKilledUs,, "KNOWN VARIABLES"
call CgiEndFatalError
call Line1 copies('!!',38)
call Line1 ''
call Line1 ''
call ColorSet
call Beeps
if RexxHookError<> '' then
do
do LineIndex=1 to LastArg
call SetEnv "PPWH_ERROR" ||LineIndex,arg(LineIndex)
end
call CallHook "ERROR",,LastArg
do LineIndex=1 to LastArg
call SetEnv "PPWH_ERROR" || LineIndex, ''
end
end
AbnormalExit(SynErrLine)

RexSystemFailure:
FailedAt=SIGL
if TrapHandler='FULL' then
call DBG 'RexSystemFailure(REXSYSTM.XH routine failed)'
call DisplayCopyright
call RexDumpSystemInfo
say ''
if TrapHandler='FULL' then
CryAndDie(arg(1))
say 'ERROR'
say '~~~~~'
say arg(1)
call CallErrorHookForSimpleOneLiner arg(1)
ExitNowCallingAnyHandlers(FailedAt)

CallErrorHookForSimpleOneLiner:
if RexxHookError<> '' then
do
call SetEnv "PPWH_ERROR1",arg(1)
call CallHook "ERROR",,1
call SetEnv "PPWH_ERROR1", ''
end
return

AbnormalExit:
call DBG 'AbnormalExit(' || arg(1) || ') called.'
if arg(2)<> '' then
call CallErrorHookForSimpleOneLiner arg(2)
ThatsAllFolks(arg(1))

ThatsAllFolks:
ff!Rc=arg(1)
call DBG 'ThatsAllFolks() called to exit program.'
if CurrentOutFile<> '' then
call _FileClose CurrentOutFile
if IncludeLevel<>0 then
do
do FileIndex=1 to IncludeLevel
call _FileClose IncludeFileName.FileIndex
end
end
call CloseCgiFileIfOpen
if OptionFilterIn<> '' then
call DoMacroSpaceOperation "DROP", OptionFilterIn,  "HtmlFilterIn",  "QUIET"
if OptionFilterOut<> '' then
call DoMacroSpaceOperation "DROP", OptionFilterOut, "HtmlFilterOut", "QUIET"
call DBG 'Exiting with a return code of ' ||ff!Rc
if OptionCgiModeOn='N' then
do
if ff!Rc<=1 then
OnExitSleepFor=OnExitSleepForOk
else
OnExitSleepFor=OnExitSleepForError
if OnExitSleepFor<>0 then
do
call DBG 'Sleeping for ' || OnExitSleepFor || ' second(s)'
call _SysSleep OnExitSleepFor
end
end
ExitNowCallingAnyHandlers(ff!Rc)

_ReplaceConsoleHandlers:
parse arg ff!Val,ff!Bef,ff!Aft
ff!Before='{' || ff!Bef || '}'
if pos(ff!Before,ff!Val)<>0 then
do
if ff!Aft='' then
do
call Line1 'No value known for "' || ff!Before || '"' ||d2c(7)
call Sleep 3
return('')
end
ff!Val=ReplaceString(ff!Val,ff!Before,ff!Aft)
end
return(ff!Val)

_CallExitHandler:
gf!Handler=arg(1)
gf!Type=arg(2)
if gf!Handler<> '' then
do
call DBG 'A ' || gf!Type || ' exit handler exists...'
call DBGIND 1
gf!Handler=_ReplaceConsoleHandlers(gf!Handler, 'ConsoleFile',ConsoleFile)
gf!Handler=_ReplaceConsoleHandlers(gf!Handler, 'ErrorFile',ConsoleErrorFile)
if gf!Handler<> '' then
call AddressCmd gf!Handler
call DBGIND-1
end
return

ExitNowCallingAnyHandlers:
hf!Rc=arg(1)
if hf!Rc=0|hf!Rc=1 then
call _CallExitHandler PpwOnOK, "success"
else
do
call DeletingOnError
call _CallExitHandler PpwOnERROR, "failure"
end
call ColorSet 'RESET'
exit(hf!Rc)
signal INDENT_47

EXTRAINDENT_DEBUG:
if OptionDebugOn='Y' then
call OptionDebugShow 'EXTRAINDENT', 'Extra left indent is now "' || LeftIndent || '"'
return

EXTRAINDENT_GET:
call EXTRAINDENT_DEBUG
return(LeftIndentSet2)

EXTRAINDENT_SET:
LeftIndentSet2=arg(1)
if ProcessedCmdLine='N' then
do
call OptionDebugShow 'EXTRAINDENT', 'Setting default value of extra left indent to "' || LeftIndentSet2 || '"'
Default4_LeftIndent=LeftIndentSet2
return(0)
end
if LeftIndentSet2=='' then
LeftIndentCmd=Default4_LeftIndent
else
LeftIndentCmd=LeftIndentSet2
if translate(LeftIndentCmd)='NULL' then
LeftIndent=''
else
call ExecRexxCmd "LeftIndent = " ||LeftIndentCmd
call EXTRAINDENT_DEBUG
return

INDENT_47:

_DieAsNoTextConditionSupplied:
CryAndDie('No test condition supplied on "#if" command')

_PerformSimpleHashIfTest:
SimpleTest=arg(1)
if left(SimpleTest,1)<> '[' | right(SimpleTest, 1) <> ']' then
CryAndDie('Incorrectly bracketed simple #if command.')
SimpleTest=substr(SimpleTest,2,length(SimpleTest)-2)
if SimpleTest='' then
call _DieAsNoTextConditionSupplied
Parm1=GetSimpleRexxValue(SimpleTest, "SimpleTest")
parse var SimpleTest FastOperator SimpleTest
if SimpleTest='' then
CryAndDie('#if [] has too few parameters (you must put spaces around operator!)')
Parm3=GetSimpleRexxValue(SimpleTest, "SimpleTest")
if SimpleTest<> '' then
CryAndDie('#if [] has too many parameters, expected 3!')
select
when FastOperator='==' then
return(Parm1==Parm3)
when FastOperator='<>' then
return(Parm1<>Parm3)
when FastOperator='=' then
return(Parm1=Parm3)
when FastOperator='<' then
return(Parm1<Parm3)
when FastOperator='>' then
return(Parm1>Parm3)
when FastOperator='<=' then
return(Parm1<=Parm3)
when FastOperator='>=' then
return(Parm1>=Parm3)
otherwise
CryAndDie("Unsupported operator of '" || FastOperator || "' used on simple " || HashCmd, '', 'ONLY "==, <>, =, <, >, <=, >=" are supported!')
end
CryAndDie('BUG: Did not expect to get here!')

MatchesIfDebugText:
MatchIndex=arg(1)
if MatchIndex<=0 then
return('')
else
return(' (matches #if at ' || IfState.IfAtLine.MatchIndex || ')')

WantLine:
if IfState.WantLines.IfNesting='N' then
return('N')
else
do
if IfState.IfTrue.IfNesting=IfState.InTrue.IfNesting then
return('Y')
else
return('N')
end

ProcessHashIfTest:
if OptionDebugOn='Y' then
do
call DBG_CONDITIONAL '#If? at nesting level ' ||IfNesting+1
call DBGIND 1
end
WantTheLines=WantLine()
if WantTheLines='N' then
IfResult='N'
else
do
if OptionDebugOn='Y' then
call DBGIND 1
parse value PerformReplacementsInCmdsParameters(arg(1))with HashCmd TestCondition
TestCondition=strip(TestCondition)
if translate(HashCmd)=CmdHashIf then
do
if left(TestCondition,1)<> '[' then
do
if TestCondition='' then
call _DieAsNoTextConditionSupplied
call ExecRexxCmd 'IfResult = (' || TestCondition || ')'
end
else
do
IfResult=_PerformSimpleHashIfTest(TestCondition)
end
if IfResult then
IfResult='Y'
else
IfResult='N'
end
else
do
if TestCondition='' then
CryAndDie(HashCmd|| ' command does not specify the macro name!')
if pos('CommentBlock  /* ',TestCondition)<>0 then
IfResult='N'
else
IfResult=MacroExists(TestCondition)
if translate(HashCmd)=CmdHashIfndef then
IfResult=translate(IfResult, 'YN', 'NY')
end
if OptionDebugOn='Y' then
do
call DBGIND-1
if IfResult='N' then
Tf='FALSE'
else
Tf='TRUE'
if OptionDebugOn='Y' then
call DBG_CONDITIONAL 'Answer is ' ||Tf
end
end
IfNesting=IfNesting+1
IfState.WantLines.IfNesting=WantTheLines
IfState.InTrue.IfNesting='Y'
IfState.IfTrue.IfNesting=IfResult
IfState.IfAtLine.IfNesting=CurrentSourceLocation()
if OptionDebugOn='Y' then
call DBGIND-1
return('OK')

ProcessHashElse:
if OptionDebugOn='Y' then
call DBG_CONDITIONAL '#elseif at level #' ||IfNesting||MatchesIfDebugText(IfNesting)
if IfNesting=0 then
CryAndDie("Found #elseif without matching #if")
if IfState.InTrue.IfNesting='N' then
CryAndDie("Found unexpected #elseif - duplicated #elseif?" ||MatchesIfDebugText(IfNesting))
if arg(1)<> '' then
CryAndDie('The #elseif command does not take parameters')
IfState.InTrue.IfNesting='N'
return('OK')

ProcessHashEndif:
if OptionDebugOn='Y' then
call DBG_CONDITIONAL 'Endif at level #' ||IfNesting||MatchesIfDebugText(IfNesting)
if IfNesting=0 then
CryAndDie("Found #endif without matching #if")
IfNesting=IfNesting-1
return('OK')

HaveNewOutputFile:
parse arg if!OutFile,if!GenMask,if!Append,if!Mode
if OutputLevel<>0 then
call _FileClose CurrentOutFile
if OptionCgiModeOn='Y' then
do
CurrentOutFile=RexStdoutStream
call DBG 'In CGI mode, will output to "' || CurrentOutFile || '" (standard output)'
end
else
do
if if!GenMask<> '' then
CurrentOutFile=GenerateFileName(if!OutFile,if!GenMask)
else
do
CurrentOutFile=if!OutFile
call MakeDirectoryTree _filespec('drive', CurrentOutFile) || _filespec('path',CurrentOutFile)
end
end
if!OutLine=CurrentOutLine
CurrentOutLine=0
do ChkIndex=1 to OutputLevel
if RexSystemOpSys="UNIX" then
OutSame=(Output.ChkIndex.File=CurrentOutFile)
else
OutSame=(translate(Output.ChkIndex.File)=translate(CurrentOutFile))
if OutSame then
do
if if!Append='Y' then
call OutputWarningToScreen 'OFO0', 'Appending to currently opened file ("' || CurrentOutFile || '")!'
else
do
WhereOpened=Output.ChkIndex.!Locn
if WhereOpened='' then
Extra='Check "/Output" mask for correctness'
else
Extra='File opened at ' ||WhereOpened
CryAndDie('Already have "' || CurrentOutFile || '" open for output!',Extra)
end
end
end
OutputLevel=OutputLevel+1
Output.OutputLevel.File=CurrentOutFile
Output.OutputLevel.Line=if!OutLine
Output.OutputLevel.!Locn=CurrentSourceLocation('')
Output.OutputLevel.!PMODE=ProcessingMode
Output.OutputLevel.!HTAGS=HtmlGeneratorTags
if ProcessingMode<>if!Mode then
do
call DBG 'Processing mode for "' || CurrentOutFile || '" is "' || if!Mode || '" (changed from "' || ProcessingMode || '")'
ProcessingMode=if!Mode
end
if!Hdr='Y'
if OptionCgiModeOn='N' then
do
if FileQueryExists(CurrentOutFile)<> "" then
do
if if!Append='Y' then
do
call DBG 'Appending to "' || CurrentOutFile || '"'
if!Hdr='N'
end
else
do
call DBG 'Deleting "' || CurrentOutFile || '"'
call MustDeleteFile CurrentOutFile
end
end
end
call AddOutputFileToDependancyList CurrentOutFile
HtmlGeneratorTags=OptionHtmlGeneratorTags
call charout CurrentOutFile, ""
call _FileClose CurrentOutFile
call Making,'C'
call _ExecUserHook 'START'
if if!Hdr='Y' then
do
if Ok2OutputHeader='Y' then
call OutputHeaderIfWantedOrRequired
end
Output.OutputLevel.!SYNRC=OutSyntaxRc
Output.OutputLevel.!SYNCMD=OutSyntaxCmd
Output.OutputLevel.!SYNMSG=OutSyntaxMsg
Output.OutputLevel.!SYNCODE=OutSyntaxCode
Output.OutputLevel.!SYNELM=OutSyntaxErrLineMask
call OutputSyntaxCheckingHeaderIfWantedOrRequired
call _ExecUserHook 'AFTER_HEADERS'
return

_BackToPreviousOutput:
call _ExecUserHook 'END'
call _FileClose CurrentOutFile
call DBG 'Closed the Output file = "' || CurrentOutFile || '" (wrote ' || CurrentOutLine || ' line(s))'
call DoSyntaxCheckingOnFileIfEnabled CurrentOutFile
if OutputLevel<=1 then
CryAndDie('No output files on stack!')
else
do
HtmlGeneratorTags=Output.OutputLevel.!HTAGS
OutSyntaxRc=Output.OutputLevel.!SYNRC
OutSyntaxCmd=Output.OutputLevel.!SYNCMD
OutSyntaxMsg=Output.OutputLevel.!SYNMSG
OutSyntaxCode=Output.OutputLevel.!SYNCODE
OutSyntaxErrLineMask=Output.OutputLevel.!SYNELM
CurrentOutLine=Output.OutputLevel.Line
OutputLevel=OutputLevel-1
CurrentOutFile=Output.OutputLevel.File
if ProcessingMode<>Output.OutputLevel.!PMODE then
do
ProcessingMode=Output.OutputLevel.!PMODE
call DBG 'Restoring mode for "' || CurrentOutFile || '" to "' || ProcessingMode || '"'
end
call DieIfHoldingOutput
call OutputHoldPop
end
call Making,'R'
return

ExtnInfoSet:
jf!S=arg(1)
call DBG 'ExtnInfoSet(' || jf!S || ')'
call DBGIND 1
if jf!S='' then
do
call DBG 'Clearning all configured EXTNINFO'
drop PPWEXTNINFO.
end
else
do
parse var jf!S jf!E ':' jf!Parms
if jf!Parms='' then
CryAndDie("Invalid EXTNINFO value of:",jf!S)
if RexSystemOpSys<> "UNIX" then
jf!E=translate(jf!E)
do while jf!E<> ''
parse var jf!E jf!1 ',' jf!E
call DBG 'Extn Info for .' ||jf!1
call DBGIND 1
jf!R=jf!Parms
do while jf!R<> ''
parse var jf!R jf!Var '=' jf!R
jf!Var=strip(jf!Var)
jf!Val=GetQuotedText(jf!R, "jf!R", ',')
if jf!Var="PM" then
do
if translate(left(jf!Val,3))='LU:' then
jf!T=substr(jf!Val,4)
else
jf!T=jf!Val
call ValidatePMode jf!T
end
call DBG jf!Var|| ' = ' ||jf!Val
jf!Key='PPWEXTNINFO.PPWEI_' || c2x(jf!Var) || '_' ||c2x(jf!1)
call value jf!Key,jf!Val
jf!R=strip(jf!R)
if left(jf!R,1)=',' then
jf!R=substr(jf!R,2)
end
call DBGIND-1
end
end
call DBGIND-1
return

ExtnInfoGet:
parse arg kf!E,kf!W,kf!Def
if RexSystemOpSys<> "UNIX" then
kf!E=translate(kf!E)
kf!Pre='PPWEXTNINFO.PPWEI_' || c2x(kf!W) || '_'
kf!Key=kf!Pre||c2x(kf!E)
if symbol(kf!Key)='VAR' then
kf!R=value(kf!Key)
else
do
kf!Key=kf!Pre||c2x('*')
if symbol(kf!Key)='VAR' then
kf!R=value(kf!Key)
else
kf!R=kf!Def
end
call DBG 'ExtnInfoGet(EXTN=' || kf!E || ', WANT=' || kf!W || ') => ' ||kf!R
return(kf!R)

GetEiOrLu:
parse arg lf!F,lf!W,lf!LU
call DBG 'GetEiOrLu(' || lf!F || ')'
call DBGIND 1
lf!E=_filespec('E',lf!F)
OptionSrcExtn="PPWSRC"
if RexSystemOpSys<> "UNIX" then
lf!E=translate(lf!E)
if lf!E=OptionSrcExtn then
do
lf!E=_filespec('E', _filespec('W',lf!F))
call DBG 'The file has the single SRC extension, so process as extension "' || lf!E || '"!'
end
lf!R=ExtnInfoGet(lf!E,lf!W)
if translate(left(lf!R,3))='LU:' then
do
if lf!LU<> '' then
lf!R=lf!LU
else
lf!R=substr(lf!R,4)
end
call DBG 'Returning: ' ||lf!R
call DBGIND-1
return(lf!R)

StoreOutHeader:
mf!Spec=arg(1)
mf!Del=left(mf!Spec,1)
call DBG '/OutHeader SPEC: ' ||mf!Spec
parse var mf!Spec (mf!Del) mf!Extn (mf!Del) mf!S (mf!Del) mf!M (mf!Del) mf!E (mf!Del) .
if RexSystemOpSys<> "UNIX" then
mf!Extn=translate(mf!Extn)
mf!Key='OUTHDR_' ||c2x(mf!Extn)
call value mf!Key,mf!S|| '00'x || mf!M || '00'x||mf!E
return

StoreSyntaxCheckCode4Header:
nf!Spec=arg(1)
nf!Del=left(nf!Spec,1)
call DBG '/Syntax SPEC: ' ||nf!Spec
parse var nf!Spec (nf!Del) nf!Extn (nf!Del) nf!Cmd (nf!Del) nf!Rc (nf!Del) nf!Mask (nf!Del) nf!Lines (nf!Del)
if RexSystemOpSys<> "UNIX" then
nf!Extn=translate(nf!Extn)
nf!Key='OUTHDRSYN_' ||c2x(nf!Extn)
if nf!Cmd='' then
drop(nf!Key)
else
do
ReplaceCount=0
nf!Lines=ReplaceString(nf!Lines,nf!Del, 'FF'x)
call value nf!Key,nf!Cmd|| '00'x || nf!Rc || '00'x || nf!Mask || '00'x||nf!Lines
end
return

OutputHeaderIfWantedOrRequired:
of!CmtS=''
of!CmtM=''
of!CmtE=''
of!Extn=_filespec('EXTN',CurrentOutFile)
if RexSystemOpSys<> "UNIX" then
of!Extn=translate(of!Extn)
of!KeyE='OUTHDR_' ||c2x(of!Extn)
of!KeyM='OUTHDR_' || c2x('*' ||ProcessingMode)
of!KeyA='OUTHDR_' || c2x('*')
if symbol(of!KeyE)='VAR' then
of!UseKey=of!KeyE
else
do
if symbol(of!KeyM)='VAR' then
of!UseKey=of!KeyM
else
do
if symbol(of!KeyA)='VAR' then
of!UseKey=of!KeyA
else
of!UseKey=''
end
end
if of!UseKey='' then
call DBG 'No output header definition found'
else
do
call DBG 'Output Header definition was found'
parse value value(of!UseKey)with of!CmtS '00'x of!CmtM '00'x of!CmtE
end
if of!CmtS||of!CmtM||of!CmtE\=='' then
do
if left(of!CmtS,1)='@' & of!CmtM||of!CmtE = '' then
do
of!Inc=substr(of!CmtS,2)
call DBG 'Include output header - "' ||of!Inc
if IncludeLevel=0 then
GenerateRc=GenerateRc+ProcessInputFile(of!Inc)
else
do
call RecursiveIncludeSave
GenerateRc=GenerateRc+ProcessInputFile(of!Inc)
call RecursiveIncludeRestore
end
end
else
do
call GenerateOneLine of!CmtS
call GenerateOneLine of!CmtM|| 'Generator   : PPWIZARD version ' ||PgmVersion
call GenerateOneLine of!CmtM|| '            : FREE tool for Windows, OS/2, DOS and UNIX by ' || PgmAuthor  || ' (' || PgmAuthorEmail || ')'
call GenerateOneLine of!CmtM|| '            : ' ||PgmHomePage
call GenerateOneLine of!CmtM|| "Time        : " ||space(PpwCompTime)
call GenerateOneLine of!CmtM|| "Input File  : " ||InputFile
call GenerateOneLine of!CmtM|| "Output File : " ||FileQueryExists(Output.OutputLevel.File)
call GenerateOneLine of!CmtE
call GenerateOneLine ''
end
end
return

OutputSyntaxCheckingHeaderIfWantedOrRequired:
OutSyntaxCmd=''
OutSyntaxRc=''
OutSyntaxMsg=''
OutSyntaxCode=''
OutSyntaxErrLineMask=''
of!Lines=''
of!KeyE='OUTHDRSYN_' ||c2x(of!Extn)
of!KeyM='OUTHDRSYN_' || c2x('*' ||ProcessingMode)
of!KeyA='OUTHDRSYN_' || c2x('*')
if symbol(of!KeyE)='VAR' then
of!UseKey=of!KeyE
else
do
if symbol(of!KeyM)='VAR' then
of!UseKey=of!KeyM
else
do
if symbol(of!KeyA)='VAR' then
of!UseKey=of!KeyA
else
of!UseKey=''
end
end
if of!UseKey='' then
call DBG 'No output syntax definition found'
else
do
call DBG 'Output syntax checking header code definition was found'
parse value value(of!UseKey)with OutSyntaxCmd '00'x OutSyntaxRc '00'x OutSyntaxErrLineMask '00'x of!Lines
end
if OutSyntaxCmd<> '' then
do
if OutSyntaxCmd="*" then
do
if ProcessingMode='REXX' then
do
of!Lines='if arg(1)="' || SyntaxOkText || '" then exit(' || SyntaxOkRc || ')'
OutSyntaxRc='*REXX'
end
else
do
CryAndDie("Don't have an internal syntax handler for current file type")
end
end
if left(OutSyntaxCmd,1)='@' & (OutSyntaxRc || of!Lines) = '' then
do
of!Inc=substr(OutSyntaxCmd,2)
call DBG 'Include output header - "' ||of!Inc
OutSyntaxRc=''
OutSyntaxCmd=''
OutSyntaxMsg=''
if IncludeLevel=0 then
GenerateRc=GenerateRc+ProcessInputFile(of!Inc)
else
do
call RecursiveIncludeSave
GenerateRc=GenerateRc+ProcessInputFile(of!Inc)
call RecursiveIncludeRestore
if OutSyntaxCmd='' | OutSyntaxRc = '' then
CryAndDie('You must set the rexx variables:', ' * OutSyntaxCmd', ' * OutSyntaxRc')
end
end
else
do
if left(of!Lines,2)='?:' then
do
OutSyntaxCode=d2c(10)||ReplaceString(substr(of!Lines,3), 'FF'x,CodexNewLine)
end
else
do
do while of!Lines<> ''
parse var of!Lines of!This 'FF'x of!Lines
call GenerateOneLine of!This
end
call GenerateOneLine ''
end
end
end
return

DoSyntaxCheckingOnFileIfEnabled:
call DBG 'Need to do a syntax check on this file?'
if OutSyntaxRc='' then
return
pf!File=FileQueryExists(arg(1))
pf!Cmd=ReplaceString(OutSyntaxCmd, '{?}',pf!File)
if OutSyntaxCode<> '' then
do
call OutputWarningToScreen 'SYNS', 'Syntax checking stub "<' || '?SyntaxCheck>" missing in "' || pf!File || '"'
return
end
if OutSyntaxCmd="*" then
do
call DBG 'Calling internal validation code'
if OutSyntaxRc="*REXX" then
call CheckRexxModuleForSyntaxErrors
return
end
call DBGIND 1
call DBG 'Calling stub in generated code ("' || pf!File || '")'
CheckRc='*?*'
pf!Tmp=RexGetTmpFileName()
CheckRc=AddressCmd(pf!Cmd||RedirectStdOutAndErr2(pf!Tmp),pf!Tmp)
if CheckRc<>OutSyntaxRc then
do
pf!O=MarksNewLine
pf!O=pf!O|| "SYNTAX CHECK'S OUTPUT" ||MarksNewLine
pf!O=pf!O|| '~~~~~~~~~~~~~~~~~~~~~' ||MarksNewLine
pf!LN=-1
do while lines(pf!Tmp)<>0
pf!L=linein(pf!Tmp)
if pf!L<> '' then
do
pf!O=pf!O||pf!L||MarksNewLine
if pf!LN=-1&OutSyntaxErrLineMask<>0 then
do
pf!Num="?"
pf!M=ReplaceString(OutSyntaxErrLineMask, "{?}", "' pf!Num '")
interpret "parse var pf!L '" || pf!M || "'"
if pf!Num<> "" then
do
if datatype(pf!Num, 'W')then
do
if pf!Num>0 then
pf!LN=pf!Num
end
end
end
end
end
CloseRc=stream(pf!Tmp, 'c', 'close')
if pf!LN<>-1 then
do
pf!T='SYNTAX ERROR ON LINE #' ||pf!LN
pf!T=pf!T||MarksNewLine||copies('~',length(pf!T))||MarksNewLine
pf!FL=0
pf!Min=pf!LN-8
pf!Max=pf!Ln+2
if pf!Min<1 then
pf!Min=1
do pf!Fl=pf!Min to pf!Max
pf!L=FileLineIn(pf!File,pf!Fl)
if pf!L<> '' |pf!Fl=pf!LN then
do
if pf!FL=pf!Ln then
pf!M='>'
else
pf!M=':'
pf!T=pf!T||pf!FL||pf!M|| ' ' ||pf!L||MarksNewLine
end
end
CloseRc=stream(pf!File, 'c', 'close')
pf!O=pf!O||MarksNewLine||pf!T
end
if left(OutSyntaxMsg,1)<> '-' then
CryAndDie('Probable Syntax Error detected while checking generated file', 'Got unexpected RC of "' || CheckRc || '" (expected RC of ' || OutSyntaxRc || ')', 'Error checking "' || pf!File || '"',OutSyntaxMsg,pf!O)
else
do
CryAndDie(substr(OutSyntaxMsg,2),pf!O)
end
end
call _SysFileDelete pf!Tmp
call say ''
call DBGIND-1
return

ProcessHashOutput:
call DieIfCgiModeOn
if LineQueued\=='' then
do
if OptionDebugOn='Y' then
do
call DBG 'Need to flush queued data'
call DBGIND 3
end
call FlushQueuedOutput
if OptionDebugOn='Y' then
call DBGIND-3
end
qf!Parms=PerformReplacementsInCmdsParameters(arg(1))
if qf!Parms='' then
call _BackToPreviousOutput
else
do
qf!NewFile=GetQuotedText(qf!Parms, "qf!Parms")
qf!Parms=translate(qf!Parms)
qf!AsIs='N'
qf!Append='N'
Ok2OutputHeader='Y'
qf!Mode=ProcessingMode
do while qf!Parms<> ''
ThisParm=GetQuotedText(qf!Parms, "qf!Parms")
select
when ThisParm="ASIS" then
qf!AsIs='Y'
when ThisParm="NOHEADER" then
Ok2OutputHeader='N'
when ThisParm="APPEND" then
qf!Append='Y'
when ThisParm="HTML" | ThisParm = "REXX" | ThisParm = "OTHER" then
qf!Mode=ThisParm
otherwise
CryAndDie('The parameter "' || ThisParm || '" is unknown!')
end
end
call OutputHoldPushAndClear
if qf!AsIs='N' then
call HaveNewOutputFile qf!NewFile,OptionOutput,qf!Append,qf!Mode
else
call HaveNewOutputFile qf!NewFile,,qf!Append,qf!Mode
end
return(0)

_ExecUserHook:
rf!R=CfgMacro('HOOK_OUTPUT', '')
if rf!R<> '' then
do
call DBG 'Calling #OUTPUT HOOK : ' ||arg(1)
call DBGIND 1
rf!R=PerformReplacementsInCmdsParameters(rf!R)
OutputState=arg(1)
call ExecRexxCmd rf!R
call DBGIND-1
end
return

GetQuotedText:
parse arg sf!Str,sf!Rest,sf!Del,sf!Doing
sf!Str=strip(sf!Str, 'L')
sf!Del=' ' ||sf!Del
if OptionDebugOn='Y' then
do
call DBG_QUOTING 'GetQuotedText(): ' ||DebugRightArrow||sf!Str||DebugLeftArrow
call DBGIND 1
end
if sf!Str='' then
call _ErrorNoQuotedParm
QuoteChar=left(sf!Str,1)
if datatype(QuoteChar, 'Alphanumeric')then
do
if OptionDebugOn='Y' then
call DBG_QUOTING 'Text is unquoted'
DelPos=verify(sf!Str,sf!Del, 'M')
if DelPos=0 then
do
QuotedString=sf!Str
TheRest=''
end
else
do
QuotedString=substr(sf!Str,1,DelPos-1)
TheRest=substr(sf!Str,DelPos)
end
end
else
do
if OptionDebugOn='Y' then
call DBG_QUOTING 'Text is quoted with ' ||DebugRightArrow||QuoteChar||DebugLeftArrow
SecondQuotePosn=pos(QuoteChar,sf!Str,2)
if SecondQuotePosn=0 then
call _ErrorNoEndQuote
QuotedString=substr(sf!Str,2,SecondQuotePosn-2)
TheRest=substr(sf!Str,SecondQuotePosn+1)
end
if TheRest<> '' then
do
if sf!Del<> 'Y' then
do
if pos(left(TheRest,1),sf!Del)=0 then
do
sf!1='There is no whitespace after the 2nd quote char of "' || QuoteChar || '" (did not expect to find "' || left(TheRest, 1) || '")'
sf!2='The rest of the line:'
sf!3=copies(' ',8)||DebugRightArrow||TheRest||DebugLeftArrow
if sf!Doing<> '' then
sf!4=''
else
sf!4='Doing: ' ||sf!Doing
CryAndDie(sf!1,sf!2,sf!3,sf!4)
end
end
end
TheRest=strip(TheRest, 'L')
if sf!Rest<> '' then
call _valueS sf!Rest,TheRest
else
do
if TheRest<> '' then
call DieIfExtraUnexpectedParms TheRest
end
if OptionDebugOn='Y' then
do
call DBG_QUOTING 'Text is ' ||DebugRightArrow||QuotedString||DebugLeftArrow
call DBGIND-1
end
return(QuotedString)

GetQuotedRest:
parse arg sf!Str,sf!Doing
sf!Str=strip(sf!Str)
if OptionDebugOn='Y' then
do
call DBG_QUOTING 'GetQuotedRest(): ' ||DebugRightArrow||sf!Str||DebugLeftArrow
call DBGIND 1
end
if sf!Str='' then
call _ErrorNoQuotedParm
QuoteChar=left(sf!Str,1)
if datatype(QuoteChar, 'Alphanumeric')then
do
QuotedString=sf!Str
if OptionDebugOn='Y' then
call DBG_QUOTING 'Text is unquoted'
end
else
do
if OptionDebugOn='Y' then
call DBG_QUOTING 'Text is quoted with '||DebugRightArrow||QuoteChar||DebugLeftArrow
SecondQuotePosn=length(sf!Str)
if SecondQuotePosn<2|substr(sf!Str,SecondQuotePosn,1)<>QuoteChar then
call _ErrorNoEndQuote
QuotedString=substr(sf!Str,2,SecondQuotePosn-2)
end
if OptionDebugOn='Y' then
do
call DBG_QUOTING 'Text is  ' ||DebugRightArrow||QuotedString||DebugLeftArrow
call DBGIND-1
end
return(QuotedString)

DieIfExtraUnexpectedParms:
if arg(1)='' then
return
CryAndDie('Unexpected parameter(s) of "' || strip(arg(1)) || '" found!')

_ErrorNoQuotedParm:
if sf!Doing<> '' then
sf!Doing='Doing: ' ||sf!Doing
CryAndDie('Expect a quoted string, not enough parameters available!',sf!Doing)

_ErrorNoEndQuote:
sf!1='Could not find a matching end quote character of "' || QuoteChar || '"!'
sf!2='Processing:'
sf!3=copies(' ',8)||DebugRightArrow||sf!Str||DebugLeftArrow
if sf!Doing<> '' then
sf!4='Doing: ' ||sf!Doing
else
sf!4=''
CryAndDie(sf!1,sf!2,sf!3,sf!4)

GetRexxVarValueOrDie:
grvVar=arg(1)
if symbol(grvVar)='VAR' then
return(_valueG(grvVar))
else
do
if symbol(grvVar)='BAD' then
Reason="contains invalid character(s)"
else
Reason="is unknown"
call DumpVarsIfCompoundVariable grvVar
CryAndDie('The rexx variable "' || grvVar || '" ' || Reason || '!')
end

ProcessRexxVar:
ResultVar=GetQuotedText(PerformReplacementsInCmdsParameters(arg(1)), "Rest")
XVarName=''
ResultVarU=translate(ResultVar)
if ResultVarU="PUSH" then
do
do while Rest<> ''
ResultVar=GetQuotedText(Rest, "Rest")
call _StackPush GetRexxVarValueOrDie(ResultVar)
end
return(0)
end
if ResultVarU="POP" then
do
TmpVarCnt=0
do while Rest<> ''
ResultVar=GetQuotedText(Rest, "Rest")
TmpVarCnt=TmpVarCnt+1
TmpVar.TmpVarCnt=ResultVar
end
do while TmpVarCnt<>0
call _valueS TmpVar.TmpVarCnt,_StackPop()
TmpVarCnt=TmpVarCnt-1
end
return(0)
end
parse var Rest FastOperator Rest
if FastOperator<> '=' then
do
FastOperator=translate(FastOperator)
if left(FastOperator,1)='=' then
do
if FastOperator='=X=' then
do
XVarName=ResultVar
ResultVar='XVAR?.X?' ||c2x(translate(XVarName))
end
else
do
Rest=strip(Rest)
if symbol(Rest)='VAR' then
ResultValue=GetRexxVarValueOrDie(Rest)
else
ResultValue=GetQuotedRest(Rest)
select
when FastOperator='=VALUE=' then
do
RestVar=value(ResultValue)
end
when FastOperator='=ASIS=' then
do
RestVar=AsIs(ResultValue)
end
otherwise
CryAndDie('Unsupported "=?=" operator of "' || FastOperator || '" used on ' ||HashCmd)
end
Rest='RestVar'
end
FastOperator='='
end
end
select
when FastOperator='=' then
do
Rest=strip(Rest)
if symbol(Rest)='VAR' then
ResultValue=GetRexxVarValueOrDie(Rest)
else
ResultValue=GetQuotedRest(Rest)
end
when FastOperator='PUSH' then
do
call DieIfExtraUnexpectedParms Rest
call _StackPush GetRexxVarValueOrDie(ResultVar)
return(0)
end
when FastOperator='POP' then
do
call DieIfExtraUnexpectedParms Rest
ResultValue=_StackPop()
end
otherwise
do
AfterOperator=GetSimpleRexxValue(Rest, "Rest")
if Rest<> '' then
SourceValue=GetSimpleRexxValue(Rest)
else
SourceValue=GetRexxVarValueOrDie(ResultVar)
if OptionDebugOn='Y' then
call DBG_REXXVAR 'Evaluating: ' || SourceValue || ' ' || FastOperator || ' ' ||AfterOperator
select
when FastOperator='+' then
ResultValue=SourceValue+AfterOperator
when FastOperator='-' then
ResultValue=SourceValue-AfterOperator
when FastOperator='||' then
ResultValue=SourceValue||AfterOperator
when FastOperator='*' then
ResultValue=SourceValue*AfterOperator
when FastOperator='/' then
ResultValue=SourceValue/AfterOperator
when FastOperator='//' then
ResultValue=SourceValue//AfterOperator
when FastOperator='%' then
ResultValue=SourceValue%AfterOperator
otherwise
CryAndDie("Unsupported operator of '" || FastOperator || "' used on " ||HashCmd)
end
end
end
call _valueS ResultVar,ResultValue
if OptionDebugOn='Y' then
do
call DBGIND 1
if XVarName='' then
DbgPrefix=ResultVar
else
DbgPrefix='"X" Variable ' ||XVarName
call DBG_REXXVAR DbgPrefix|| ' = ' ||DebugRightArrow||ResultValue||DebugLeftArrow
call DBGIND-1
end
return(0)

GetSimpleRexxValue:
sParm=strip(arg(1), 'L')
sRestVar=arg(2)
sQuote=left(sParm,1)
if sQuote="'" | sQuote = '"' then
do
sEndPos=pos(sQuote,sParm,2)
if sEndPos=0 then
CryAndDie('Incorrectly quoted rexx literal (could not find ending quote)')
sValue=substr(sParm,2,sEndPos-2)
sRest=substr(sParm,sEndPos+1)
end
else
do
parse var sParm sValue sRest
if datatype(sValue, 'Number')=0 then
sValue=GetRexxVarValueOrDie(sValue)
end
if sRestVar<> '' then
call _valueS sRestVar,sRest
else
do
if sRestVar<> '' then
CryAndDie('Extra unexpected parameters of "' || sRestVar || '" found')
end
return(sValue)

_StackPush:
StackCnt=StackCnt+1
Stack.StackCnt.StackData=arg(1)
Stack.StackCnt.StackPosn=CurrentSourceLocation()
if OptionDebugOn='Y' then
call DBG_REXXVAR 'Stack Push(#' || StackCnt || ') = ' ||DebugRightArrow||arg(1)||DebugLeftArrow
return

_StackPop:
if StackCnt<=0 then
CryAndDie('There is nothing on the stack!')
spData=Stack.StackCnt.StackData
if OptionDebugOn='Y' then
do
call DBG_REXXVAR 'Stack pop(#' || StackCnt || ') = ' ||DebugRightArrow||spData||DebugLeftArrow
call DBG_REXXVAR 'matched push() at ' ||Stack.StackCnt.StackPosn
end
StackCnt=StackCnt-1
return(spData)

MatchesStackPushDebugText:
MatchIndex=arg(1)
if MatchIndex<=0 then
return('')
else
return(' (matches "#RexxVar PUSH" at ' || Stack.MatchIndex.StackPosn || ')')

XVarDefined:call TRACE "OFF"
parse arg tf!Xv,tf!Wn
tf!Sa='XVAR?.X?' ||c2x(translate(tf!Xv))
if tf!Wn<> 'N' then
do
if symbol(tf!Sa)<> 'VAR' then
do
if tf!Wn='D' then
CryAndDie('The XVAR "' || tf!Xv || '" does not exist!')
tf!Sa=''
end
end
if OptionDebugOn='Y' then
call DBG_EVALUATE 'XVarDefined(' || tf!Xv || ') : ' ||tf!sa
return(tf!Sa)

_EnsureVersionY2KSafe:
TheVer=ReplaceString(translate(arg(1)), '2K', '00')
if datatype(TheVer, 'Number')=0|(length(TheVer)<>6&length(TheVer)<>8)then
CryAndDie('The version number "' || TheVer || '" is not valid')
if TheVer<100 then
do
if TheVer>98 then
TheVer='19' ||TheVer
else
TheVer='20' ||TheVer
end
return(TheVer)

ProcessRequireCommon:
uf!MinVer=_EnsureVersionY2KSafe(GetQuotedText(arg(1), 'uf!Rest'))
if uf!Rest='' then
uf!MaxVer='9999.99'
else
do
uf!MaxVer=_EnsureVersionY2KSafe(GetQuotedText(uf!Rest))
uf!Rest='"' || uf!MaxVer || '"'
end
uf!ThisVer=_EnsureVersionY2KSafe(PgmVersion)
if OptionDebugOn='Y' then
do
call DBG 'You require "' || uf!MinVer || '" - ' ||uf!Rest
call DBG 'You have    "' || uf!ThisVer || '"'
end
uf!U='You are using version "' || uf!ThisVer || '"'
if uf!ThisVer<uf!MinVer then
CryAndDie('You required at least PPWIZARD version "' || uf!MinVer || '"',uf!U)
if uf!ThisVer>uf!MaxVer then
CryAndDie('You need a PPWIZARD version EARLIER than "' || uf!MaxVer || '"',uf!U)
return(0)

ProcessRequire:
return(ProcessRequireCommon(PerformReplacementsInCmdsParameters(arg(1))))

RexxCtrlC:
LineCtrlC=SIGL
TRACE OFF
call AllFollowingOutputGoesToErrorFile
call Line1 ''
call ColorSet 'HIGHLIGHT'
call Line1 copies('=+',39)
call ColorSet 'ERROR'
call CgiStartFatalError
call Line1 "Come on, you pressed Ctrl+C or Break didn't you!"
call CgiEndFatalError
call ColorSet 'HIGHLIGHT'
call Line1 copies('=+',39)
call ColorSet
AbnormalExit(LineCtrlC, "CTRL+C Pressed")

QuickSourceLine:
LineNum=arg(1)
slKey='PPWSL!.' ||LineNum
if symbol(slKey)='VAR' then
return(_valueG(slKey))
SrcLine=sourceline(LineNum)
call _valueS slKey,SrcLine
return(SrcLine)

_FindLastLabel:
FailedOnLine=arg(1)
TryLine=FailedOnLine
do while TryLine>1
TryLine=TryLine-1
TheLine=QuickSourceLine(TryLine)
ColonPos=pos(':',TheLine)
if ColonPos<>0 then
do
MaybeLabel=strip(left(TheLine,ColonPos-1))
if symbol(MaybeLabel)<> 'BAD' then
do
FoundLabelOnLine=TryLine
return(MaybeLabel|| ':  (line #' || AddCommasToDecimalNumber(TryLine) || ')')
end
end
end
FoundLabelOnLine=0
return('')

GetIncludeStack:
vf!R=''
if IncludeLevel>1 then
do
do vf!F=1 to IncludeLevel
if vf!R<> '' then
vf!R=vf!R|| ' -> '
vf!R=vf!R||_filespec('n', IncludeFileName.vf!F) || '(' || GetLineNumber4Level(vf!f) || ')'
end
end
return(vf!R)

SeeAlsoFile:
wf!W=arg(1)
wf!T=left('More Info?', wf!W) || ': '
if ConsoleFile<> '' then
do
call Line1 wf!T||ConsoleFile|| ' (console file)'
wf!T=left('', wf!W) || ': '
end
if ConsoleErrorFile<> '' then
call Line1 wf!T||ConsoleErrorFile|| ' (error file)'
return

CommonTrapHandler:
signal on NOVALUE name SimpleRexxTrapUninitializedVariable
signal on SYNTAX name SimpleRexxTrapSyntaxError
FailingLine=arg(1)
TrapType=arg(2)
TextDescription=arg(3)
Text=arg(4)
CmdBeingEvaluated=arg(5)
UserBreakPoint=arg(6)
if TrapType='N' then
TrapHeading='NoValue Abort!'
else
TrapHeading='Syntax Error!'
HaveCapturedTrapDetails='Y'
call AllFollowingOutputGoesToErrorFile
call Line1 ''
call ColorSet 'HIGHLIGHT'
call Line1 copies('=+',39)
call ColorSet 'ERROR'
call CgiStartFatalError
call Line1 TrapHeading
call Line1 copies('~',length(TrapHeading))
call Line1 substr(TextDescription,1,16)|| ': ' ||Text
BetterErrorText=Condition('D')
if BetterErrorText<> '' &BetterErrorText<>Text then
call Line1 copies(' ',18)||BetterErrorText
if IncludeLevel<>0 then
do
call Line1 'Processing locn : ' ||CurrentSourceLocation()
wf!S=GetIncludeStack()
if wf!S<> '' then
call Line1 'File Stack      : ' ||wf!S
LastFileLine=strip(LastFileLine)
LastLine=strip(LastLine)
call Line1 'Line from file  : ' ||LastFileLine
if LastLine<>LastFileLine then
call Line1 'Failing line    : ' ||LastLine
if LastLineAfterMacroRep<> '' &LastLine<>LastLineAfterMacroRep&LastFileLine<>LastLineAfterMacroRep then
call Line1 'After Replace   : ' ||LastLineAfterMacroRep
if MacroBeingExpanded<> '' then
call Line1 'Expanding Macro : ' || StartsMacroReplacement || MacroBeingExpanded || ' ...' ||EndsMacroReplacement
end
else
do
if PpwDoing<> '' then
call Line1 'PPWIZARD was    : ' ||PpwDoing
end
if CmdBeingEvaluated<> '' then
do
CmdBeingEvaluatedTmp=ReplaceString(CmdBeingEvaluated,DefRexxSpecialSepTag, ";")
EvPrefix='Evaluating This : '
ShowThisS=CmdBeingEvaluatedTmp
if length(ShowThisS)>300 then
ShowThisS=left(ShowThisS,300)|| ' ...(Too much to show all)'
ShowThisS=EvPrefix||ShowThisS
CmdSepL=RexEOL||copies(' ',length(EvPrefix))
ShowThisL=EvPrefix||ReplaceString(CmdBeingEvaluatedTmp, ";",CmdSepL)
ShowThisL=ReplaceString(ShowThisL, '0D'x, '')
call Line1 ShowThisS,ShowThisL
call Line1 ''
if TrapType='S' then
do
wf!FailedAt='Could not be determined...'
wf!C=PPWIZARD_REGINA_SYNTAX_CMD('Y')
if wf!C<> "" & pos('SYNTAX',translate(TrapHeading))<>0 then
do
wf!Msk=ReplaceString(PPWIZARD_REGINA_SYNTAX_LINE_MASK(), "{?}", "' wf!Line '")
Contents=ReplaceString(CmdBeingEvaluated,DefRexxSpecialSepTag,RexEOL)
wf!TmpRx=RexGetTmpFileName('EV?????.CMD')
call MustDeleteFile wf!TmpRx
call lineout wf!TmpRx, "/* Keep OS/2 Happy */"
call lineout wf!TmpRx, "exit(0);"
wf!Extra=2
call charout wf!TmpRx,Contents
call FileClose wf!TmpRx, 'N'
wf!Cmd=ReplaceString(wf!C, '{?}',wf!TmpRx)
wf!TmpO=RexGetTmpFileName()
wf!CheckRc=AddressCmd(wf!Cmd||RedirectStdOutAndErr2(wf!TmpO),wf!TmpO)
if wf!CheckRc<>0 then
do
wf!ErrText=charin(wf!TmpO,,99999)
call FileClose wf!TmpO, 'N'
interpret "parse var wf!ErrText '" || wf!Msk || "'"
if wf!Line<> '' & DataType(wf!Line, 'W')=1 then
do
wf!FailedAt='#' || wf!Line - wf!Extra || ' : ' ||FileLineIn(wf!TmpRx,wf!Line)
call FileClose wf!TmpRx, 'N'
end
end
call _SysFileDelete wf!TmpRx
call _SysFileDelete wf!TmpO
end
call Line1 'Rexx Invalid at : ' ||wf!FailedAt
end
end
if RexWhich='REGINA' then
ReginaUname=' (' || uname() || ')'
else
ReginaUname=''
FailingLineText=AddCommasToDecimalNumber(FailingLine)
call SeeAlsoFile 16
call Line1 'Operating System: ' ||RexSystemOpSys||ReginaUname
call Line1 'Rexx Version    : ' ||RexVersionInfo
if CmdBeingEvaluated='' then
DumpPpwSrc='Y'
else
do
DumpPpwSrc='N'
call DumpVarsInExpression CmdBeingEvaluatedTmp,, 'KNOWN VARIABLES', 'Line1'
end
if DumpPpwSrc='Y' then
do
call Line1 'Failing Module  : ' || PpWizardPgmName || ' (' || PgmVersion || ')'
call Line1 'Failing Line #  : ' ||FailingLineText
InRoutine=_FindLastLabel(FailingLine)
StartAt=FailingLine-7
if FoundLabelOnLine<>0 then
do
if FoundLabelOnLine>StartAt then
StartAt=FoundLabelOnLine
else
do
if FoundLabelOnLine<>0 then
do
if(FailingLine-FoundLabelOnLine)<10 then
StartAt=FoundLabelOnLine
else
call Line1 'After label     : ' ||InRoutine
end
end
end
call Line1 'SOURCE'
call Line1 '~~~~~~'
vlist.0=0
do ShowLine=StartAt to FailingLine
FailingSrcLineTxt=strip(QuickSourceLine(ShowLine))
call Line1 left(AddCommasToDecimalNumber(ShowLine),length(FailingLineText))|| ' : ' ||FailingSrcLineTxt
call DumpVarsInExpression FailingSrcLineTxt, 'vlist'
end
call DumpVarsInExpressionNow 'vlist', 'KNOWN VARIABLES', 'Line1'
end
HookText=TrapHeading|| ' at line ' || FailingLineText || '. ' || TextDescription || ': ' ||Text
call CgiEndFatalError
call ColorSet 'HIGHLIGHT'
call Line1 copies('=+',39)
call ColorSet
call Line1 ''
if UserBreakPoint<> '' then
do
call RexxTrace HookText,,,'Y'
end
AbnormalExit(FailingLine,HookText)

RexxTrapUninitializedVariable:
TrappingLine=SIGL
call CommonTrapHandler TrappingLine, 'N', 'Unknown Variable', condition('D')

RexxTrapSyntaxError:
TrappingLine=SIGL
call CommonTrapHandler TrappingLine, 'S', 'Reason',errortext(Rc)

SimpleCommonTrapHandler:
if HaveCapturedTrapDetails='N' then
do
FailingLine=arg(1)
TrapType=arg(2)
TextDescription=arg(3)
Text=arg(4)
if TrapType='N' then
TrapHeading='NoValue Abort!'
else
TrapHeading='Syntax Error!'
end
FailingLineText=AddCommasToDecimalNumber(FailingLine)
say ''
say copies('*-',39)
say TrapHeading
say copies('~',length(TrapHeading))
if HaveCapturedTrapDetails='Y' then
say 'Trap within Trap: Original trap details saved and displayed below!'
say substr(TextDescription,1,16)|| ': ' ||Text
BetterErrorText=Condition('D')
if BetterErrorText<> '' &BetterErrorText<>Text then
call Line1 copies(' ',18)||BetterErrorText
parse source . . PpWizardPgmName
parse version VersionOfRexx
FailingSrcLineTxt=strip(QuickSourceLine(FailingLine))
say 'Failed at       : ' || PpWizardPgmName || ' (line ' || FailingLineText || ', version ' || PgmVersion || ')'
say 'Source Code     : ' ||FailingSrcLineTxt
say 'Rexx Version    : ' ||VersionOfRexx
call DumpVarsInExpression FailingSrcLineTxt, '', 'KNOWN VARIABLES'
HookText=TrapHeading|| ' at line ' || FailingLineText || '. ' || TextDescription || ': ' ||Text
if HaveCapturedTrapDetails='Y' then
do
FailingLine=arg(1)
TrapHeading=arg(2)
TextDescription=arg(3)
Text=arg(4)
say ''
say 'Reason for secondary trap'
say '~~~~~~~~~~~~~~~~~~~~~~~~~'
say substr(TextDescription,1,16)|| ': ' ||Text
say 'Failed at       : ' || PpWizardPgmName || ' (line ' || FailingLineText || ', version ' || PgmVersion || ')'
say 'Source Code     : ' ||strip(QuickSourceLine(FailingLine))
end
say copies('*-',39)
call CallErrorHookForSimpleOneLiner HookText
ExitNowCallingAnyHandlers(FailingLine)

SimpleRexxTrapUninitializedVariable:
TrappingLine=SIGL
call SimpleCommonTrapHandler TrappingLine, 'N', 'Unknown Variable', condition('D')

SimpleRexxTrapSyntaxError:
TrappingLine=SIGL
call SimpleCommonTrapHandler TrappingLine, 'S', 'Reason',errortext(Rc)