Chip 2002 March/Chip_2002-03_cd1.bin/sharewar/Slunec/app/ppww32.exe/PPWIZARD.REX

OS/2 REXX Batch file | 2002-01-17 | 370KB | 14,415 lines

/*
 * Generator   : PPWIZARD version 02.012
 *             : FREE tool for Windows, OS/2, DOS and UNIX by Dennis Bareis ([e-mail])
 *             : http://www.labyrinth.net.au/~dbareis/ppwizard.htm
 * Time        : Thursday, 17 Jan 2002 6:27:06pm
 * 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.017"
SupportedReginaVersions='2.0, 2.2 or 3.0BETA2'
RecommendedReginaVersions='2.2'
PpwStartSec=(time('S') || substr(time('L'),9,3))
TrapHandler=''
RedirMethod=''
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
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=''
OutSyntaxMsg=''
OutSyntaxCmd=''
OutSyntaxRc=''
IncludeLevel=0
Warnings=0
LineSourceBeingProcessed='?'
OnExitSleepForOk=0
OnExitSleepForError=2
SleepSwitch='N'
call RemoveColorCodes
call RemoveBeepCode
if translate(strip(arg(1)))='DEBUG' then
call DisplayCopyright
/*
*REXSYSTM.XH Version 01.331 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='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) || '\.', '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

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   ?
   FileLinein    ?
   FileLineOut   ?
*/

REXSYSTM_1:
PpWizardPgmName=RexSystmRexxPgmName
PpWizardOpSysREAL=RexSystemOpSysREAL
PpWizardOpSys=RexSystemOpSys
WizName=translate(_filespec('name',PpWizardPgmName))
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>'
LastSystemCmd="none"
LastSystemCmdFull="none"
LastSystemRc=999
signal System_2

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_2:
signal stack_3

StackInitForBuild:
STK_CNT=0
return

StackValidation:
call DBG "Validating the " || STK_CNT || " stack(s)"
call DBGIND+1
d_Invalid=0
do d_S=1 to STK_CNT
d_ID=STK.d_S
d_Desc=value(d_ID|| '_DESC')
call DBG 'Validating: ' ||d_Desc
d_Lvl=value(d_ID|| '.0')
call DBGIND+1
if d_Lvl=0 then
call DBG 'OK'
else
do
d_Invalid=d_Invalid+1
call DBG 'There are ' || d_Lvl || ' items still on the stack!'
d_T='STACK "' || d_Desc || '" has ' || d_Lvl || ' errors'
call Say ''
call Say d_T
call Say copies('~',length(d_T))
do d_Inv=1 to d_Lvl
call say 'Push #:' ||d_Inv
call say 'Locn  :' || value(d_ID || '_LOCN.' ||d_Inv)
call say 'Doing :' || value(d_ID || '_DOING.' ||d_Inv)
call say ''
end
end
call DBGIND-1
end
if d_Invalid<>0 then
CryAndDie('There are ' || d_Invalid || ' stacks with errors (details above).')
call DBGIND-1
return

StackPush:call TRACE "OFF"
parse arg e_Desc,e_What,e_Doing
e_ID='STK_' ||c2x(e_Desc)
if symbol(e_ID|| '.0') = 'VAR' then
e_L=value(e_ID|| '.0')+1
else
do
e_L=1
STK_CNT=STK_CNT+1
STK.STK_CNT=e_ID
call value e_ID|| '_DESC',e_Desc
end
call value e_ID|| '.0',e_L
call value e_ID|| '.' ||e_L,e_What
call value e_ID|| '_LOCN.' ||e_L,GetInputFileNameAndLine()
if e_Doing='' then
e_Doing=GetFileLineBeingProcessed()
call value e_ID|| '_DOING.' ||e_L,e_Doing
return

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

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

ProcessPop:
h_R=PerformReplacementsInCmdsParameters(arg(1))
h_Typ=translate(GetQuotedText(h_R, "h_R"))
h_C=0
do until h_R=''
h_C=h_C+1
h_S.h_C=GetQuotedText(h_R, "h_R")
end
do h_I=h_C to 1 by-1
select
when h_Typ='MACRO' then
do
call MacroSet h_S.h_I,StackPop('#Push MACRO'), 'Y'
end
when h_Typ='REXXVAR' then
do
call _valueS h_S.h_I,StackPop('#Push REXXVAR')
end
otherwise
CryAndDie('Unsupported #POP type of ' ||h_Typ)
end
end
return(0)

stack_3:
call InitTransformationCode
signal Transfrm_4

InitTransformationCode:
TransformCode=''
return

ProcessTransform:
HashDefRexx=arg(1)
if HashDefRexx<> '' then
do
HashDefRexx=PerformReplacementsInCmdsParameters(HashDefRexx)
HashDefRexx=GetQuotedText(HashDefRexx)
end
if HashDefRexx<> '' then
do
if OptionDebugOn='Y' then
call DBG 'Start of transformation block "' || HashDefRexx || '"'
if TransformCode<> '' then
CryAndDie("Already in tranformation block started at " ||TransformStartLoc)
TransformStartLoc=CurrentSourceLocation()
TransformCode=MacroGet(HashDefRexx)
TransformCode=PerformReplacementsInCmdsParameters(TransformCode)
end
else
do
if OptionDebugOn='Y' then
call DBG "End of transformation block"
if TransformCode='' then
CryAndDie('We were not in a tranformation block!')
TransformCode=''
end
return(0)

Transfrm_4:
ReplaceCount=0
NextIdUnique=0
NextIdReplOn='N'
NextIdMarker='@' || '@'
NextIdMask='*_'
NextIdNewCounter=NextIdUnique
NextIdNew=_GetNextIdPrefix()
NextIdUsed='N'
NextIdLocked=''
signal NextId_5

ProcessNextId:
i_P=arg(1)
if i_P='' then
call _NextIdInc
else
do
i_P=PerformReplacementsInCmdsParameters(i_P)
i_Cmd=GetQuotedText(i_P, 'i_P')
i_CmdU=translate(i_Cmd)
select
when i_CmdU='OFF' then
NextIdReplOn='N'
when i_CmdU='ON' then
NextIdReplOn='Y'
when i_CmdU='LOCK' then
do
call _DieIfLocked i_Cmd
if i_P='' then
i_P='"?"'
NextIdLocked=GetQuotedRest(i_P)
if NextIdLocked='' then
CryAndDie('You must specify a KEY to lock Next ID incrementing.')
end
when i_CmdU='UNLOCK' then
do
if NextIdLocked='' then
CryAndDie('Not locked!')
if i_P='' then
i_P='"?"'
i_Key=GetQuotedRest(i_P)
if i_Key<>NextIdLocked then
CryAndDie('Incorrect key used, required "' || NextIdLocked || '"')
NextIdLocked=''
end
when i_CmdU='REPLACE' then
do
call _DieIfLocked i_Cmd
NextIdMarker=GetQuotedRest(i_P)
if NextIdMarker='' then
NextIdMarker='@' || '@'
end
when i_CmdU='MASK' then
do
call _DieIfLocked i_Cmd
NextIdMask=GetQuotedRest(i_P)
if NextIdMask='' then
NextIdMask='*_'
NextIdNew=_GetNextIdPrefix()
end
when i_CmdU='PUSH' then
do
i_Info=NextIdReplOn|| '00'x || NextIdMarker || '00'x || NextIdMask || '00'x || NextIdNew || '00'x || NextIdNewCounter || '00'x || NextIdUsed || '00'x||NextIdLocked
call StackPush "#NextId PUSH",i_Info
NextIdLocked=''
NextIdUsed='Y'
call _NextIdInc
NextIdReplOn='N'
end
when i_CmdU='POP' then
do
i_Info=StackPop("#NextId PUSH")
parse var i_Info NextIdReplOn '00'x NextIdMarker '00'x NextIdMask '00'x NextIdNew '00'x NextIdNewCounter '00'x NextIdUsed '00'x NextIdLocked
end
otherwise
CryAndDie('Unknown #NextID command of "' || i_Cmd || '"')
end
end
if OptionDebugOn='Y' then
do
if NextIdReplOn='N' then
i_T='off'
else
i_T='on'
i_I=NextIdLocked
if i_I='' then
i_I='unlocked'
else
i_I='locked (KEY = "' || NextIdLocked || '")'
call DBG '#NextID processing is turned ' ||i_T
call DBG '#NextID incrementing is ' ||i_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 || '"')
return

_GetNextIdPrefix:
j_Dec=NextIdNewCounter
j_Digits=LowerCase
j_Base=length(j_Digits)
j_P=''
do until j_Dec=0
j_P=substr(j_Digits,(j_Dec//j_Base)+1,1)||j_P
j_Dec=j_Dec%j_Base
end
j_P=ReplaceString(NextIdMask, '*',j_P)
NextIdUsed='N'
return(j_P)

NextId_5:
call InitINTERCEPTCode
signal Intercpt_6

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_6:
OutputHoldLvl=0
call InitOutputHold
signal OutpHold_7

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 DirectToOutputFile HeldOutput
end
call InitOutputHold
end
return(0)

OutpHold_7:
signal RexxHook_8

RexxHookSetBuildingParms:
parse arg HookBuildParmInput,HookBuildParmOutput,HookBuildParmTemplate
return

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

RexxHookSet:
parse arg ThisCmd,ThisCmdOptions
parse var ThisCmdOptions rhWhen';'rhCmd
rhWhen=translate(rhWhen)
do until rhWhen=''
parse var rhWhen rhWhen1','rhWhen
rhDone='N'
if rhWhen1='' | abbrev("BEFORE",rhWhen1)then
do
rhDone='Y'
RexxHookBefore=rhCmd
end
if rhWhen1='' | abbrev("AFTER",rhWhen1)then
do
rhDone='Y'
RexxHookAfter=rhCmd
end
if rhWhen1='' | abbrev("WARNING",rhWhen1)then
do
rhDone='Y'
RexxHookWarning=rhCmd
end
if rhWhen1='' | abbrev("ERROR",rhWhen1)then
do
rhDone='Y'
RexxHookError=rhCmd
end
if rhWhen1='' | abbrev("GETFILELIST",rhWhen1)then
do
rhDone='Y'
RexxHookGetFileList=rhCmd
end
if rhDone='N' then
CryAndDie('The hook type of "' || rhWhen1 || '" 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_8:
WarningSpecs=''
signal Warning_9

OutputWarningToScreen:
WarningPrefix=strip( 'WARNING ' ||strip(arg(1)))
WarningTextP=arg(2)
if IncludeLevel=0 then
LineText=''
else
LineText='(@' || AddCommasToDecimalNumber(IncludeLineNumber) || ')'
WarningTextUn=WarningPrefix|| ': ' ||WarningTextP
WarningText=LineText||WarningTextUn
WarningTextU=translate(WarningText)
IgnoreList=WarningSpecs
do while IgnoreList<> ''
parse var IgnoreList IgnoreThis (PathDelimiterChar) IgnoreList
IgnoreThis1=left(IgnoreThis,1)
IgnoreThisR=substr(IgnoreThis,2)
if IgnoreThis1<> '-' & IgnoreThis1 <> '+' & IgnoreThis1 <> '!' then
do
IgnoreThis1='-'
IgnoreThisR=IgnoreThis
IgnoreThis=IgnoreThis1||IgnoreThisR
end
if IgnoreThisR='' then
iterate
if IgnoreThisR='*' |pos(IgnoreThisR,WarningTextU)<>0 then
do
if OptionDebugOn='Y' then
call DBG 'Warning matched the spec => ' ||IgnoreThis
select
when IgnoreThis1='!' then
do
if OptionDebugOn='Y' then
call DBG 'Normal Warning => ' ||WarningText
leave
end
when IgnoreThis1='+' then
do
CryAndDie(WarningTextUn,, 'This warning was promoted to a fatal error by "' || IgnoreThis || '"')
end
when IgnoreThis1='-' then
do
if OptionDebugOn='Y' then
call DBG 'Ignoring Warning => ' ||WarningText
return
end
end
end
end
if RexxHookWarning<> '' then
do
WarnHookRc=translate(CallHook("WARNING", 'Y',WarningTextP))
if WarnHookRc='IGNORE+' then
Warnings=Warnings+1
if WarnHookRc='IGNORE' | WarnHookRc = 'IGNORE+' then
do
if OptionDebugOn='Y' then
call DBG "HOOK said to drop warning: " ||WarningTextP
return
end
if WarnHookRc<> '' then
CryAndDie('Unknown warning hook return code of: ' ||WarnHookRc)
end
call Line1 copies("  ", IncludeLevel) || WarningColor || '   ' ||WarningText||Reset
Warnings=Warnings+1
return

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

ProcessHashWarning:
Rest=PerformReplacementsInCmdsParameters(arg(1))
WarningCde=GetQuotedText(Rest, "Rest")
WarningMsg=GetQuotedRest(Rest)
call OutputWarningToScreen WarningCde,WarningMsg
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_9:
signal Tabs_10

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_10:
SrTypePre=d2c(254)||d2c(174)
SrTypeSuf=d2c(175)
call SrInit
signal SR_TYPE_11

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

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)
if DictFile='' then
CryAndDie('The dictionary file "' || DictFileS || '" does not exist!')
call DBG_SPELLING 'Loading "' || DictFile || '"'
SpellDictFileCount=SpellDictFileCount+1
SpellDictFile.SpellDictFileCount=DictFile
SpellDictTime.SpellDictFileCount=GetFileDateTimeButDontWarnOnError(DictFile)
call FileClose DictFile
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 charout,ThisWord|| ' <- OK (Yes/yes All/No/Quit asking)?'
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
if QueryExists(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 DieIfIoErrorOccurred SpellingAddFile
call FileClose SpellingAddFile
call OutputInformationToScreen AddCommasToDecimalNumber(SpellingAddCount)|| ' word(s) added to "' || SpellingAddFile || '"'
call DBGIND-1
return

SPELLING_12:
OptionDebugOn='N'
OptionMaxCol=500
if RexWhich='REGINA' then
do
if pos('0.0',RexVerRegina)<>0 then
OptionDebugTime='L'
else
OptionDebugTime='S'
end
else
do
OptionDebugTime='S'
end
call DBGINDInit
signal Debug_13

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:
call _DBG1 _DebugPrefix()|| '         >' ||translate(arg(1),DebugNewline,MarksNewLine)
return

_DebugPrefix:
if OptionDebugTime='N' then
return(copies("  ",IncludeLevel+DebugIndent))
else
do
if OptionDebugTime='L' then
return( '[' || left(time('L'),11)               || ']' || copies("  ",IncludeLevel+DebugIndent))
else
return( '[' || (time('S') || substr(time('L'), 9, 3)) - PpwStartSec || ']' || copies("  ",IncludeLevel+DebugIndent))
end

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=copies(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
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 || ')'
call _DBG1 ''
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:
k_Line=arg(1)
if OptionMaxCol=0 then
call Line1 k_Line
else
do
if length(k_Line)<=OptionMaxCol then
call Line1 k_Line
else
call Line1 left(k_Line,OptionMaxCol)|| ' <-[' || OptionMaxCol || ']'
end
return

_SetDebugChar:
l_Var=arg(1)
l_CurValVar=arg(2)
parse value strip(value(l_Var)) with l_Val ',' l_Rest
call value l_Var,l_Rest
if l_Val=-1 then
l_NewVal=''
else
do
l_Val=strip(l_Val)
if l_Val='' then
l_NewVal=value(l_CurValVar)
else
do
if datatype(l_Val, 'W')then
l_NewVal=d2c(l_Val)
else
l_NewVal=l_Val
end
end
return(l_NewVal)

SetDebugChars:
m_Chars=arg(1)
m_MakDef=arg(2)
if m_Chars='' then
do
DebugLeftArrow=_DebugLeftArrow
DebugRightArrow=_DebugRightArrow
DebugNewline=_DebugNewline
end
else
do
DebugRightArrow=_SetDebugChar('m_Chars', 'DebugRightArrow')
DebugLeftArrow=_SetDebugChar('m_Chars', 'DebugLeftArrow' )
DebugNewline=_SetDebugChar('m_Chars', 'DebugNewline' )
end
if m_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_13:
AllBitsOff='000000'x
AllBitsOn='FFFFFF'x
UserBitsOn='000003'x
AllBitsOnExceptUser=bitxor(AllBitsOn,UserBitsOn)
DebugLevel=AllBitsOnExceptUser
DebugLevelCnt=0
SeeLevelAll=_SaveDebugLevel("ALL",           "FFFFFF")
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)
signal DebugOpt_14

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))=AllBitsOff 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=bitor(DebugLevel,OptionBinary)
else
DebugLevel=bitxor(DebugLevel,OptionBinary)
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_14:
OptionCgiModeOn='N'
CgiOutputFile=''
CgiFatalError='N'
signal CGI_15

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

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:
n_ConFile=arg(1)
if ConsoleFile<> '' then
do
call FileClose ConsoleFile
ConsoleFile=''
end
if n_ConFile<> '' then
do
if left(n_ConFile,1)='+' then
do
n_ConFile=substr(n_ConFile,2)
end
else
do
call MustDeleteFile n_ConFile
end
end
if n_ConFile='' then
OutputToConsoleLog='N'
else
do
call MakeDirectoryTree _filespec('Location',n_ConFile)
OutputToConsoleLog='y'
ConsoleFile=n_ConFile
end
return

AllFollowingOutputGoesToErrorFile:
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)
if TheFile<> '' then
call Say2ErrorFile copies(' ',(78-length(TheFile))%2)||TheFile
call Say2ErrorFile copies(' ',(78-length(TheTime))%2)||TheTime
call Say2ErrorFile copies('*+',38)
call Say2ErrorFile ''
return

Say2ErrorFile:
if OutputToErrorLog='Y' then
do
o_L=arg(1)
do until o_L==''
parse var o_L o_Nxt (MarksNewLine) o_L
call lineout ConsoleErrorFile,o_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 copies(' ',(78-length(TheTime))%2)||TheTime
call _Lne2CFle copies('*+',38)
call _Lne2CFle ''
return

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

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

Say:call TRACE "OFF"

Line1:
parse arg Lne1S,Lne1L
if Lne1L='' then
Lne1L=Lne1S
if OptionCgiModeOn='N' then
do
say Lne1S
if OutputToErrorLog='Y' then
call Say2ErrorFile Lne1L
if OutputToConsoleLog<> 'N' then
do
if OutputToConsoleLog='y' then
call AddConsoleHdr
call _Lne2CFle Lne1L
end
end
else
do
if CgiOutputFile<> '' then
call lineout CgiOutputFile,Lne1S
if CgiFatalError='Y' then
say _MustSeeAsIsInHtmlViewer(Lne1S)
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 RemoveColorCodes
call RemoveBeepCode
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_15:
signal EndLineCrLfXH

CrLfClose:
_CrlfBuffer=''
return(FileClose(arg(1)))

CrLfOpen:
call CrLfClose arg(1)
_CrLfEOL=CrLf
_CrLfEOLLng=length(_CrLfEOL)
if arg(2)<> '' then
do
if chars(arg(1))<>0 then
do
_CrLf2Read=arg(2)
if _CrLf2Read<5000 then
_CrLf2Read=5000
_CrlfBuffer=charin(arg(1),,_CrLf2Read)
if pos(_CrLfEOL,_CrlfBuffer)=0 then
do
if pos(MarksNewLine,_CrlfBuffer)<>0 then
do
_CrLfEOL=MarksNewLine
_CrLfEOLLng=1
end
end
end
end
return(0)

CrLfLines:
if _CrlfBuffer<> '' then
return(1)
else
do
if chars(arg(1))=0 then
return(0)
else
return(1)
end

CrLfLineIn:
_CrLfPos=pos(_CrLfEOL,_CrlfBuffer)
do while _CrLfPos=0
if chars(arg(1))=0 then
leave
_CrlfBuffer=_CrlfBuffer||charin(arg(1),,5000)
_CrLfPos=pos(_CrLfEOL,_CrlfBuffer)
end
if _CrLfPos=0 then
do
_CrLfReturn=_CrlfBuffer
_CrlfBuffer=''
end
else
do
_CrLfReturn=left(_CrlfBuffer,_CrLfPos-1)
_CrlfBuffer=substr(_CrlfBuffer,_CrLfPos+_CrLfEOLLng)
end
return(_CrLfReturn)

EndLineCrLfXH:
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:
_C.0='00000000'x
_C.1='77073096'x
_C.2='EE0E612C'x
_C.3='990951BA'x
_C.4='076DC419'x
_C.5='706AF48F'x
_C.6='E963A535'x
_C.7='9E6495A3'x
_C.8='0EDB8832'x
_C.9='79DCB8A4'x
_C.10='E0D5E91E'x
_C.11='97D2D988'x
_C.12='09B64C2B'x
_C.13='7EB17CBD'x
_C.14='E7B82D07'x
_C.15='90BF1D91'x
_C.16='1DB71064'x
_C.17='6AB020F2'x
_C.18='F3B97148'x
_C.19='84BE41DE'x
_C.20='1ADAD47D'x
_C.21='6DDDE4EB'x
_C.22='F4D4B551'x
_C.23='83D385C7'x
_C.24='136C9856'x
_C.25='646BA8C0'x
_C.26='FD62F97A'x
_C.27='8A65C9EC'x
_C.28='14015C4F'x
_C.29='63066CD9'x
_C.30='FA0F3D63'x
_C.31='8D080DF5'x
_C.32='3B6E20C8'x
_C.33='4C69105E'x
_C.34='D56041E4'x
_C.35='A2677172'x
_C.36='3C03E4D1'x
_C.37='4B04D447'x
_C.38='D20D85FD'x
_C.39='A50AB56B'x
_C.40='35B5A8FA'x
_C.41='42B2986C'x
_C.42='DBBBC9D6'x
_C.43='ACBCF940'x
_C.44='32D86CE3'x
_C.45='45DF5C75'x
_C.46='DCD60DCF'x
_C.47='ABD13D59'x
_C.48='26D930AC'x
_C.49='51DE003A'x
_C.50='C8D75180'x
_C.51='BFD06116'x
_C.52='21B4F4B5'x
_C.53='56B3C423'x
_C.54='CFBA9599'x
_C.55='B8BDA50F'x
_C.56='2802B89E'x
_C.57='5F058808'x
_C.58='C60CD9B2'x
_C.59='B10BE924'x
_C.60='2F6F7C87'x
_C.61='58684C11'x
_C.62='C1611DAB'x
_C.63='B6662D3D'x
_C.64='76DC4190'x
_C.65='01DB7106'x
_C.66='98D220BC'x
_C.67='EFD5102A'x
_C.68='71B18589'x
_C.69='06B6B51F'x
_C.70='9FBFE4A5'x
_C.71='E8B8D433'x
_C.72='7807C9A2'x
_C.73='0F00F934'x
_C.74='9609A88E'x
_C.75='E10E9818'x
_C.76='7F6A0DBB'x
_C.77='086D3D2D'x
_C.78='91646C97'x
_C.79='E6635C01'x
_C.80='6B6B51F4'x
_C.81='1C6C6162'x
_C.82='856530D8'x
_C.83='F262004E'x
_C.84='6C0695ED'x
_C.85='1B01A57B'x
_C.86='8208F4C1'x
_C.87='F50FC457'x
_C.88='65B0D9C6'x
_C.89='12B7E950'x
_C.90='8BBEB8EA'x
_C.91='FCB9887C'x
_C.92='62DD1DDF'x
_C.93='15DA2D49'x
_C.94='8CD37CF3'x
_C.95='FBD44C65'x
_C.96='4DB26158'x
_C.97='3AB551CE'x
_C.98='A3BC0074'x
_C.99='D4BB30E2'x
_C.100='4ADFA541'x
_C.101='3DD895D7'x
_C.102='A4D1C46D'x
_C.103='D3D6F4FB'x
_C.104='4369E96A'x
_C.105='346ED9FC'x
_C.106='AD678846'x
_C.107='DA60B8D0'x
_C.108='44042D73'x
_C.109='33031DE5'x
_C.110='AA0A4C5F'x
_C.111='DD0D7CC9'x
_C.112='5005713C'x
_C.113='270241AA'x
_C.114='BE0B1010'x
_C.115='C90C2086'x
_C.116='5768B525'x
_C.117='206F85B3'x
_C.118='B966D409'x
_C.119='CE61E49F'x
_C.120='5EDEF90E'x
_C.121='29D9C998'x
_C.122='B0D09822'x
_C.123='C7D7A8B4'x
_C.124='59B33D17'x
_C.125='2EB40D81'x
_C.126='B7BD5C3B'x
_C.127='C0BA6CAD'x
_C.128='EDB88320'x
_C.129='9ABFB3B6'x
_C.130='03B6E20C'x
_C.131='74B1D29A'x
_C.132='EAD54739'x
_C.133='9DD277AF'x
_C.134='04DB2615'x
_C.135='73DC1683'x
_C.136='E3630B12'x
_C.137='94643B84'x
_C.138='0D6D6A3E'x
_C.139='7A6A5AA8'x
_C.140='E40ECF0B'x
_C.141='9309FF9D'x
_C.142='0A00AE27'x
_C.143='7D079EB1'x
_C.144='F00F9344'x
_C.145='8708A3D2'x
_C.146='1E01F268'x
_C.147='6906C2FE'x
_C.148='F762575D'x
_C.149='806567CB'x
_C.150='196C3671'x
_C.151='6E6B06E7'x
_C.152='FED41B76'x
_C.153='89D32BE0'x
_C.154='10DA7A5A'x
_C.155='67DD4ACC'x
_C.156='F9B9DF6F'x
_C.157='8EBEEFF9'x
_C.158='17B7BE43'x
_C.159='60B08ED5'x
_C.160='D6D6A3E8'x
_C.161='A1D1937E'x
_C.162='38D8C2C4'x
_C.163='4FDFF252'x
_C.164='D1BB67F1'x
_C.165='A6BC5767'x
_C.166='3FB506DD'x
_C.167='48B2364B'x
_C.168='D80D2BDA'x
_C.169='AF0A1B4C'x
_C.170='36034AF6'x
_C.171='41047A60'x
_C.172='DF60EFC3'x
_C.173='A867DF55'x
_C.174='316E8EEF'x
_C.175='4669BE79'x
_C.176='CB61B38C'x
_C.177='BC66831A'x
_C.178='256FD2A0'x
_C.179='5268E236'x
_C.180='CC0C7795'x
_C.181='BB0B4703'x
_C.182='220216B9'x
_C.183='5505262F'x
_C.184='C5BA3BBE'x
_C.185='B2BD0B28'x
_C.186='2BB45A92'x
_C.187='5CB36A04'x
_C.188='C2D7FFA7'x
_C.189='B5D0CF31'x
_C.190='2CD99E8B'x
_C.191='5BDEAE1D'x
_C.192='9B64C2B0'x
_C.193='EC63F226'x
_C.194='756AA39C'x
_C.195='026D930A'x
_C.196='9C0906A9'x
_C.197='EB0E363F'x
_C.198='72076785'x
_C.199='05005713'x
_C.200='95BF4A82'x
_C.201='E2B87A14'x
_C.202='7BB12BAE'x
_C.203='0CB61B38'x
_C.204='92D28E9B'x
_C.205='E5D5BE0D'x
_C.206='7CDCEFB7'x
_C.207='0BDBDF21'x
_C.208='86D3D2D4'x
_C.209='F1D4E242'x
_C.210='68DDB3F8'x
_C.211='1FDA836E'x
_C.212='81BE16CD'x
_C.213='F6B9265B'x
_C.214='6FB077E1'x
_C.215='18B74777'x
_C.216='88085AE6'x
_C.217='FF0F6A70'x
_C.218='66063BCA'x
_C.219='11010B5C'x
_C.220='8F659EFF'x
_C.221='F862AE69'x
_C.222='616BFFD3'x
_C.223='166CCF45'x
_C.224='A00AE278'x
_C.225='D70DD2EE'x
_C.226='4E048354'x
_C.227='3903B3C2'x
_C.228='A7672661'x
_C.229='D06016F7'x
_C.230='4969474D'x
_C.231='3E6E77DB'x
_C.232='AED16A4A'x
_C.233='D9D65ADC'x
_C.234='40DF0B66'x
_C.235='37D83BF0'x
_C.236='A9BCAE53'x
_C.237='DEBB9EC5'x
_C.238='47B2CF7F'x
_C.239='30B5FFE9'x
_C.240='BDBDF21C'x
_C.241='CABAC28A'x
_C.242='53B39330'x
_C.243='24B4A3A6'x
_C.244='BAD03605'x
_C.245='CDD70693'x
_C.246='54DE5729'x
_C.247='23D967BF'x
_C.248='B3667A2E'x
_C.249='C4614AB8'x
_C.250='5D681B02'x
_C.251='2A6F2B94'x
_C.252='B40BBE37'x
_C.253='C30C8EA1'x
_C.254='5A05DF1B'x
_C.255='2D02EF8D'x
signal CRC32REX_16

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

UpdateCrc32:call TRACE "OFF"
q_Crc=arg(1)
q_Buffer=arg(2)
q_BufferLng=length(q_Buffer)
do while q_BufferLng<>0
if q_BufferLng<=2000 then
do
q_UseSize=q_BufferLng
q_PerfBuffer=q_Buffer
end
else
do
q_UseSize=2000
q_PerfBuffer=left(q_Buffer,q_UseSize)
q_Buffer=substr(q_Buffer,q_UseSize+1)
end
q_BufferLng=q_BufferLng-q_UseSize
do q_ThisByte=1 to q_UseSize
q_ArrayEl=c2d(right(bitand(bitxor(q_Crc, '000000'x || substr(q_PerfBuffer, q_ThisByte, 1)), '000000FF'x),1))
q_Crc=Bitxor(bitand('00'x || left(q_Crc, 3), '00FFFFFF'x),_C.q_ArrayEl)
end
end
return(q_Crc)

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

CRC32REX_16:
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_17

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_17:
signal LineCmt_18

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_18:
signal WhiteSpc_19

_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_19:
signal LineCont_20

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_20:
AsIsCount=0
AsIsUsing=''
signal AsIs_21

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_21:
AtChangeType=''
AtChangeTypeDesc="CASESENSITIVE"
signal AutoTag_22

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

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
SelectOn=translate(AtChangeTypeDesc)
select
when SelectOn="CASESENSITIVE" then
AtChangeType=''
when SelectOn="CASEINSENSITIVE" then
AtChangeType=SrCaseIns
when SelectOn="FIXED" then
AtChangeType=SrFixed
otherwise
CryAndDie('Unknown ATCHANGETYPE option of "' || AtChangeTypeDesc || '"')
end
call ATCHANGETYPE_DEBUG
return

AutoTag_22:
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 "REPLACEMENTTAGS"
call _OptionsAdd "TABS"
call _OptionsAdd "WARNINGS"
call _OptionsAdd "WHITESPACE"
signal OPTION_23

_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 'ALL,-USER1,-USER2'
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"
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 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
call DBG_OPTIONS left(arg(1),LongestPpwOptionLng)|| ': ' ||arg(2)
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="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="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_23:
DefRexxSpecialSepTag='<' || '?xRexxEos>'
call SetDollarTraceState 'N'
call InitializeDefineRexx
signal Def_Rexx_24

SetDollarTraceState:
DefRexxDolTrace=arg(1)
return

MakeSafeInSQuotes:
r_Str=arg(1)
r_Str=ReplaceString(r_Str, "'", "''")
r_L1M=left(StartsMacroReplacement,1)
r_Str=ReplaceString(r_Str,r_L1M, "' || '" || r_L1M || "' || '")
r_L1P=left(StartsMacroParm,1)
r_Str=ReplaceString(r_Str,r_L1P, "' || '" || r_L1P || "' || '")
return(r_Str)

InitializeDefineRexx:
DefRexxVar=''
DefRexxAddType=''
DefRexxCode=''
DefRexxStartLoc=''
DefRexxPack='Y'
DefRexxTraceNext='N'
DefRexxLineCnt=0
DefRexxTraceAll=DefRexxDolTrace
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 OptionDebugOn='Y' then
do
if DefRexxVar<> '?JustExec?';then
EndCmt='@Finished@ (Executing rexx from macro "' || DefRexxVar || '")'
else
EndCmt="@Finished@"
call DefRexxAddLine "call RexxTrace '" || EndCmt || "','?'"
DefRexxNumTrace=DefRexxNumTrace+1
end
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'
DefRexxCode=PerformReplacementsInCmdsParameters(DefRexxCode)
call ExecRexxCmd DefRexxCode
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
DefRexxVar='?JustExec?';
if Rest<> '' then
do
Rest=translate(Rest)
do until Rest=''
DefSpec=GetQuotedText(Rest, "Rest")
select
when DefSpec='NOPACK' then
DefRexxPack='N'
when DefSpec='$TRACE' then
DefRexxTraceAll='Y'
when DefSpec='$TRACE_OFF' then
DefRexxTraceAll='N'
otherwise
CryAndDie('Invalid option of "' || DefSpec || '" used')
end
end
end
if OptionDebugOn='Y' then
do
if DefRexxPack='Y' then
call DBG_DEFINING "AllowPack option is currently " ||YorN2OnorOff(AllowPack)
if DefRexxTraceAll='Y' then
call DBG_DEFINING '$Trace statements for each line are being inserted!'
else
call DBG_DEFINING '$Trace statements for each line are NOT being inserted!'
if DefRexxVar<> '?JustExec?';then
StrCmt='@Starting@ (Executing rexx from macro "' || DefRexxVar || '")'
else
StrCmt="@Starting@"
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'
if translate(word(NewRexxLine,1))="$TRACE" then
do
Rest=translate(subword(NewRexxLine,2))
select
when Rest="ON" then
do
DefRexxTraceAllowed='Y'
DropLine='Y'
end
when Rest="OFF" then
do
DefRexxTraceAllowed='N'
DropLine='Y'
end
otherwise
do
DropLine='Y'
if OptionDebugOn='Y' then
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
if DropLine='Y' then
DropLine='N'
else
do
if DefRexxTraceNext="Y" then
TraceThis='Y'
else
do
if DefRexxTraceAll='N' 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 OptionDebugOn='Y' then
do
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
end
call DefRexxAddLine NewRexxLine
end
return

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

Def_Rexx_24:
NameOfOs2ReginaRexxInterpreter=""
signal Rexx_25

_GetNameOfMacroSpaceExe:
if Symbol('MacroSpaceExe') <> 'VAR' then
do
MacroSpaceExeBase='MacroSpc.EXE'
MacroSpaceExe=_filespec('drive', PpWizardPgmName) || _filespec('Path',PpWizardPgmName)||MacroSpaceExeBase
if QueryExists(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 QueryExists(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 Char1 ErrorColor
call Line1 FailMsg
call Line1 copies('~',length(FailMsg))
do while lines(TmpFile)<>0
call Line1 linein(TmpFile)
end
call Char1 Reset|| ''
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_25:
InfiniteLoopDetected='N'
InfiniteLoopWhen=0
InfiniteIncludeLoopWhen=0
RexxSkipCounter=0
ArePositionalChars='"' || "'="
MarksPhpXml='<' || '?'
signal Define_26

InitCondNlCount:
CondNlCount=0
return

_RXQuote:
parse arg t_Right,t_Quote,t_OpQuote
t_Break=t_Quote|| '||,' ||DefRexxSpecialSepTag||t_Quote
t_DQuote=t_Quote||t_Quote
t_Left=''
do while length(t_Right)>100
if t_Left=='' then
t_Left=ReplaceString(left(t_Right,100),t_Quote,t_DQuote)
else
t_Left=t_Left||t_Break||ReplaceString(left(t_Right,100),t_Quote,t_DQuote)
t_Right=substr(t_Right,100+1)
end
return(t_Left||ReplaceString(t_Right,t_Quote,t_DQuote))

_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
u_D="SOME"
else
u_D=YorN2OnorOff(OptionParmVal)
call OptionDebugShow 'PARMVAL', 'Currently set to "' || u_D || '"'
end
return

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

PARMVAL_GET:
call PARMVAL_DEBUG
if OptionParmVal="S" then
w_Value="SOME"
else
w_Value=YorN2OnorOff(OptionParmVal)
return(w_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
w_L=length(Tags)
if w_L<>4&w_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 w_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
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")
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 verify(arg(1),EndsVar, 'M') <> 0 then CryAndDie('The macro name "' || arg(1) || '" is invalid (Any of "' || EndsVar || '" are invalid)')
s_MacName=arg(1)
s_MacNameO=s_MacName
s_RbPos=pos(MacroIndRight,s_MacName)
if s_RbPos<>0 then
do
if OptionDebugOn='Y' then
do
call DBG_DEFINING '[indirection]: ' ||DebugRightArrow||s_MacName||DebugLeftArrow
call DBGIND 1
end
do while s_RbPos<>0
s_LbPos=lastpos(MacroIndLeft,s_MacName,s_RbPos)
if s_LbPos=0 then
CryAndDie('Could not find a matching "' || MacroIndLeft || '" character for "' || MacroIndRight || '"', 'The invalid macro is:', '  ' ||s_MacName)
s_L=left(s_MacName,s_LbPos-1)
s_M=substr(s_MacName,s_LbPos+1,s_RbPos-s_LbPos-1)
s_R=substr(s_MacName,s_RbPos+1)
if OptionDebugOn='Y' then
do
call DBG_DEFINING 'Looking for: ' ||s_M
call DBGIND 1
end
s_RepType=''
if symbol(s_M)='VAR' then
do
s_RepType='REXX'
s_RepWith=value(s_M)
end
else
do
if CsReplacement='N' then
s_SavedAs='MACRO?.M?'||c2x(translate(s_M))
else
s_SavedAs='MACRO?.M?'||c2x(s_M)
if symbol(s_SavedAs)='VAR' then
do
s_RepType='PPWIZARD'
s_RepWith=value(s_SavedAs)
end
end
if OptionDebugOn='Y' then
do
if s_RepType='' then
call DBG_DEFINING 'No such REXX or PPWIZARD symbol!'
else
call DBG_DEFINING s_RepType|| ' symbol contained: ' ||s_RepWith
call DBGIND-1
end
if s_RepType='' then
do
if s_MacName=s_MacNameO then
s_Show=s_MacName
else
s_Show=s_MacName|| ' <= "' ||s_MacNameO
CryAndDie("Could not find a REXX variable or PPWIZARD macro matching:", '  ' || s_M, 'In the macro reference:', '  ' ||s_Show)
end
s_MacName=s_L||s_RepWith||s_R
if OptionDebugOn='Y' then
call DBG_DEFINING 'New macro reference is "' ||DebugRightArrow||s_MacName||DebugLeftArrow
s_RbPos=pos(MacroIndRight,s_MacName)
end
if OptionDebugOn='Y' then
call DBGIND-1
end
if pos(MacroIndLeft,s_MacName)<>0 then
CryAndDie('Could not find a matching "' || MacroIndRight || '" character for "' || MacroIndLeft || '"', 'The invalid macro is:', '  ' ||s_MacName)
x_Dummy=s_MacName
if CsReplacement='N' then
x_As='MACRO?.M?'||c2x(translate(s_MacName))
else
x_As='MACRO?.M?'||c2x(s_MacName)
if symbol(x_As)='VAR' then
return('Y')
else
return('N')

HandleUndefCommand:
y_Ud=PerformReplacementsInCmdsParameters(arg(1))
if verify(y_Ud,EndsVar, 'M') <> 0 then CryAndDie('The macro name "' || y_Ud || '" is invalid (Any of "' || EndsVar || '" are invalid)')
s_MacName=y_Ud
s_MacNameO=s_MacName
s_RbPos=pos(MacroIndRight,s_MacName)
if s_RbPos<>0 then
do
if OptionDebugOn='Y' then
do
call DBG_DEFINING '[indirection]: ' ||DebugRightArrow||s_MacName||DebugLeftArrow
call DBGIND 1
end
do while s_RbPos<>0
s_LbPos=lastpos(MacroIndLeft,s_MacName,s_RbPos)
if s_LbPos=0 then
CryAndDie('Could not find a matching "' || MacroIndLeft || '" character for "' || MacroIndRight || '"', 'The invalid macro is:', '  ' ||s_MacName)
s_L=left(s_MacName,s_LbPos-1)
s_M=substr(s_MacName,s_LbPos+1,s_RbPos-s_LbPos-1)
s_R=substr(s_MacName,s_RbPos+1)
if OptionDebugOn='Y' then
do
call DBG_DEFINING 'Looking for: ' ||s_M
call DBGIND 1
end
s_RepType=''
if symbol(s_M)='VAR' then
do
s_RepType='REXX'
s_RepWith=value(s_M)
end
else
do
if CsReplacement='N' then
s_SavedAs='MACRO?.M?'||c2x(translate(s_M))
else
s_SavedAs='MACRO?.M?'||c2x(s_M)
if symbol(s_SavedAs)='VAR' then
do
s_RepType='PPWIZARD'
s_RepWith=value(s_SavedAs)
end
end
if OptionDebugOn='Y' then
do
if s_RepType='' then
call DBG_DEFINING 'No such REXX or PPWIZARD symbol!'
else
call DBG_DEFINING s_RepType|| ' symbol contained: ' ||s_RepWith
call DBGIND-1
end
if s_RepType='' then
do
if s_MacName=s_MacNameO then
s_Show=s_MacName
else
s_Show=s_MacName|| ' <= "' ||s_MacNameO
CryAndDie("Could not find a REXX variable or PPWIZARD macro matching:", '  ' || s_M, 'In the macro reference:', '  ' ||s_Show)
end
s_MacName=s_L||s_RepWith||s_R
if OptionDebugOn='Y' then
call DBG_DEFINING 'New macro reference is "' ||DebugRightArrow||s_MacName||DebugLeftArrow
s_RbPos=pos(MacroIndRight,s_MacName)
end
if OptionDebugOn='Y' then
call DBGIND-1
end
if pos(MacroIndLeft,s_MacName)<>0 then
CryAndDie('Could not find a matching "' || MacroIndRight || '" character for "' || MacroIndLeft || '"', 'The invalid macro is:', '  ' ||s_MacName)
y_Dummy=s_MacName
if CsReplacement='N' then
SavedAs='MACRO?.M?'||c2x(translate(s_MacName))
else
SavedAs='MACRO?.M?'||c2x(s_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)')
s_MacName=HashDefineU
s_MacNameO=s_MacName
s_RbPos=pos(MacroIndRight,s_MacName)
if s_RbPos<>0 then
do
if OptionDebugOn='Y' then
do
call DBG_DEFINING '[indirection]: ' ||DebugRightArrow||s_MacName||DebugLeftArrow
call DBGIND 1
end
do while s_RbPos<>0
s_LbPos=lastpos(MacroIndLeft,s_MacName,s_RbPos)
if s_LbPos=0 then
CryAndDie('Could not find a matching "' || MacroIndLeft || '" character for "' || MacroIndRight || '"', 'The invalid macro is:', '  ' ||s_MacName)
s_L=left(s_MacName,s_LbPos-1)
s_M=substr(s_MacName,s_LbPos+1,s_RbPos-s_LbPos-1)
s_R=substr(s_MacName,s_RbPos+1)
if OptionDebugOn='Y' then
do
call DBG_DEFINING 'Looking for: ' ||s_M
call DBGIND 1
end
s_RepType=''
if symbol(s_M)='VAR' then
do
s_RepType='REXX'
s_RepWith=value(s_M)
end
else
do
if CsReplacement='N' then
s_SavedAs='MACRO?.M?'||c2x(translate(s_M))
else
s_SavedAs='MACRO?.M?'||c2x(s_M)
if symbol(s_SavedAs)='VAR' then
do
s_RepType='PPWIZARD'
s_RepWith=value(s_SavedAs)
end
end
if OptionDebugOn='Y' then
do
if s_RepType='' then
call DBG_DEFINING 'No such REXX or PPWIZARD symbol!'
else
call DBG_DEFINING s_RepType|| ' symbol contained: ' ||s_RepWith
call DBGIND-1
end
if s_RepType='' then
do
if s_MacName=s_MacNameO then
s_Show=s_MacName
else
s_Show=s_MacName|| ' <= "' ||s_MacNameO
CryAndDie("Could not find a REXX variable or PPWIZARD macro matching:", '  ' || s_M, 'In the macro reference:', '  ' ||s_Show)
end
s_MacName=s_L||s_RepWith||s_R
if OptionDebugOn='Y' then
call DBG_DEFINING 'New macro reference is "' ||DebugRightArrow||s_MacName||DebugLeftArrow
s_RbPos=pos(MacroIndRight,s_MacName)
end
if OptionDebugOn='Y' then
call DBGIND-1
end
if pos(MacroIndLeft,s_MacName)<>0 then
CryAndDie('Could not find a matching "' || MacroIndRight || '" character for "' || MacroIndLeft || '"', 'The invalid macro is:', '  ' ||s_MacName)
y_Dummy=s_MacName
if CsReplacement='N' then
SavedAs='MACRO?.M?'||c2x(translate(s_MacName))
else
SavedAs='MACRO?.M?'||c2x(s_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:
cpParms=ReplaceHashAndStandardDefines(arg(1), "PRM")
if ExpandXCmd='Y' then
do
if pos(StartsStdSymbolReplacement_x,cpParms)<>0 then
cpParms=ReplaceTheXCodesWeKnowExist(cpParms)
end
if pos(MarksNewLine,cpParms)<>0 then
do
Line1='The commands parameters expanded a macro that generated multiple lines!'
Line2='The parameters are now:'
Line3=copies(' ',8)||translate(cpParms,DebugNewline,MarksNewLine)
CryAndDie(Line1,Line2,Line3)
end
return(cpParms)

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=translate(SymbolNameC)
Left1=left(SymbolName,1)
if Left1='=' then
DdCodes=''
else
do
SpcPos=pos(' ',SymbolName)
if SpcPos=0 then
DdCodes=''
else
do
DdCodes=substr(SymbolName,SpcPos+1)
SymbolName=left(SymbolName,SpcPos-1)
end
end
select
when Left1='?' then
do
SymbolName=substr(SymbolName,2)
if symbol(SymbolName)<> 'VAR' then
do
call DumpVarsIfCompoundVariable SymbolName
call CryAndDie 'The rexx variable "' || SymbolName || '" is unknown!'
end
SymbolValue=_valueG(SymbolName)
end
when Left1='I' then
do
select
when SymbolName="INPUTFILE" then
SymbolValue=InputFileFull
when SymbolName="INPUTCOMPONENT" then
SymbolValue=IncludeFileName
when SymbolName="INPUTCOMPONENTLINE" then
SymbolValue=IncludeLineNumber
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
otherwise
call _UnknownStandardSymbol
end
end
when Left1='O' then
do
select
when SymbolName="OUTPUTLINE" then
SymbolValue=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=QueryExists(CurrentOutFile)
if SymbolValue='' then
CryAndDie('Could not obtain file name information for the "' || StartsStdSymbolReplacement || 'OutputFile>" variable!')
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=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='COMPILETIME' then
do
z_Fmt=CfgMacro("PPWIZARD_FORMAT_COMPILETIME", '%c')
SymbolValue=FormatTime(z_Fmt,PpwCompTs, "PPWIZARD")
end
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=GeneratedLines+1
when SymbolName='NEWESTFILEDATETIME' then
SymbolValue=NewestSourcefile
when SymbolName='LESSTHAN' then
SymbolValue=CodexHexLessThan
when SymbolName='QUESTIONMARK' then
SymbolValue=CodexHexQuestionMark
when SymbolName='BASEDIR' then
SymbolValue=BaseDir4CurrentInputFile
when SymbolName='UNIQUE' then
do
PPwizardUnique=PPwizardUnique+1
SymbolValue=PPwizardUnique
end
when SymbolName='TEMPLATEDATAFILE' then
SymbolValue=TemplateDataFile
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 Left1='=' then
do
if OptionDebugOn='Y' then
call DBGIND 1
call ExecRexxCmd 'SymbolValue = ' ||substr(SymbolNameC,2)
if OptionDebugOn='Y' then
call DBGIND-1
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
do
QChar=QuoteIt(SymbolValue,TryQuoteListDs)
SymbolValue=QChar||SymbolValue||QChar
end

when DdCode='$$SDQ' then
do
QChar=QuoteIt(SymbolValue,TryQuoteListSd)
SymbolValue=QChar||SymbolValue||QChar
end

when DdCode='$$AQ' then
do
QChar=QuoteIt(SymbolValue,TryQuoteListAny)
SymbolValue=QChar||SymbolValue||QChar
end

when DdCode='$$UPPER' then
SymbolValue=translate(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 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='$$RXEXEC' then
do
RxExec=''
call ExecRexxCmd SymbolValue
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
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 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)

GetDefineContents:
if verify(arg(1),EndsVar, 'M') <> 0 then CryAndDie('The macro name "' || arg(1) || '" is invalid (Any of "' || EndsVar || '" are invalid)')
s_MacName=arg(1)
s_MacNameO=s_MacName
s_RbPos=pos(MacroIndRight,s_MacName)
if s_RbPos<>0 then
do
if OptionDebugOn='Y' then
do
call DBG_DEFINING '[indirection]: ' ||DebugRightArrow||s_MacName||DebugLeftArrow
call DBGIND 1
end
do while s_RbPos<>0
s_LbPos=lastpos(MacroIndLeft,s_MacName,s_RbPos)
if s_LbPos=0 then
CryAndDie('Could not find a matching "' || MacroIndLeft || '" character for "' || MacroIndRight || '"', 'The invalid macro is:', '  ' ||s_MacName)
s_L=left(s_MacName,s_LbPos-1)
s_M=substr(s_MacName,s_LbPos+1,s_RbPos-s_LbPos-1)
s_R=substr(s_MacName,s_RbPos+1)
if OptionDebugOn='Y' then
do
call DBG_DEFINING 'Looking for: ' ||s_M
call DBGIND 1
end
s_RepType=''
if symbol(s_M)='VAR' then
do
s_RepType='REXX'
s_RepWith=value(s_M)
end
else
do
if CsReplacement='N' then
s_SavedAs='MACRO?.M?'||c2x(translate(s_M))
else
s_SavedAs='MACRO?.M?'||c2x(s_M)
if symbol(s_SavedAs)='VAR' then
do
s_RepType='PPWIZARD'
s_RepWith=value(s_SavedAs)
end
end
if OptionDebugOn='Y' then
do
if s_RepType='' then
call DBG_DEFINING 'No such REXX or PPWIZARD symbol!'
else
call DBG_DEFINING s_RepType|| ' symbol contained: ' ||s_RepWith
call DBGIND-1
end
if s_RepType='' then
do
if s_MacName=s_MacNameO then
s_Show=s_MacName
else
s_Show=s_MacName|| ' <= "' ||s_MacNameO
CryAndDie("Could not find a REXX variable or PPWIZARD macro matching:", '  ' || s_M, 'In the macro reference:', '  ' ||s_Show)
end
s_MacName=s_L||s_RepWith||s_R
if OptionDebugOn='Y' then
call DBG_DEFINING 'New macro reference is "' ||DebugRightArrow||s_MacName||DebugLeftArrow
s_RbPos=pos(MacroIndRight,s_MacName)
end
if OptionDebugOn='Y' then
call DBGIND-1
end
if pos(MacroIndLeft,s_MacName)<>0 then
CryAndDie('Could not find a matching "' || MacroIndRight || '" character for "' || MacroIndLeft || '"', 'The invalid macro is:', '  ' ||s_MacName)
ba_MN=s_MacName
if CsReplacement='N' then
ba_SA='MACRO?.M?'||c2x(translate(s_MacName))
else
ba_SA='MACRO?.M?'||c2x(s_MacName)
if symbol(ba_SA)='VAR' then
return(_valueG(ba_SA))
if arg(1)=ba_MN then
ba_New=''
else
ba_New=' ("' || ba_MN || '")'
CryAndDie('Macro named "' || arg(1) || '"' || ba_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
bb_DieIfNotUsed='N'
bb_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)
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
ReplaceParmWith=ParmValue.FndVarIndex
else
do
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
bb_ReginaBugWorkAround='N'
select
when ThisParmName='?' then
do
bb_ValPointless='Y'
bb_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
bb_ValPointless='Y'
bb_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
MpTmp=ParmValue.ParmIndex
if length(MpTmp)<=200 then
do
MpRepVW=QuoteAsRexxLit(MpTmp)
end
else
do
MpRepVW='MpTmpV'
MpTmpF='Y'
do while length(MpTmp)>200
RepWith=RepWith|| 'MpTmpV='
if MpTmpF='Y' then
MpTmpF='N'
else
RepWith=RepWith|| 'MpTmpV||'
RepWith=RepWith||QuoteAsRexxLit(left(MpTmp,200))||DefRexxSpecialSepTag
MpTmp=substr(MpTmp,200+1)
end
if MpTmp\=='' then
RepWith=RepWith|| 'MpTmpV=MpTmpV||' ||QuoteAsRexxLit(MpTmp)||DefRexxSpecialSepTag
end
ArrayCnt=ArrayCnt+1
RepWith=RepWith|| 'MP.' || ArrayCnt || ".MPNAME  = " ||QuoteAsRexxLit(ParmNameC.ParmIndex)||DefRexxSpecialSepTag
RepWith=RepWith|| 'MP.' || ArrayCnt || ".MPVALUE = " ||MpRepVW||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
bb_ReginaBugWorkAround='Y'
if OptionDebugOn='Y' then
call _SpecialPrm 'name of macro being expanded'
ReplaceParmWith=VariableName
end
when translate(ThisParmName)='?RESETUSED' then
do
bb_ReginaBugWorkAround='Y'
if OptionDebugOn='Y' then
call _SpecialPrm 'All parms now marked unused'
do ParmIndex=1 to ParmCount
ParmUsed.ParmIndex='N'
end
bb_ValPointless='Y'
ReplaceParmWith=''
ParmCmds=''
end
when ThisParmName='!' then
do
bb_DieIfNotUsed="Y"
bb_ReginaBugWorkAround='Y'
if OptionDebugOn='Y' then
call _SpecialPrm 'Empty - It is a parameter validation command'
ReplaceParmWith=''
ParmCmds=''
end
otherwise
do
if bb_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,TryQuoteListAny)
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='$$DSQ' then
do
QChar=QuoteIt(ReplaceParmWith,TryQuoteListDs)
ReplaceParmWith=QChar||ReplaceParmWith||QChar
end

when ParmCmd='$$SDQ' then
do
QChar=QuoteIt(ReplaceParmWith,TryQuoteListSd)
ReplaceParmWith=QChar||ReplaceParmWith||QChar
end

when ParmCmd='$$AQ' then
do
QChar=QuoteIt(ReplaceParmWith,TryQuoteListAny)
ReplaceParmWith=QChar||ReplaceParmWith||QChar
end

when ParmCmd='$$UPPER' then
ReplaceParmWith=translate(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 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='$$RXEXEC' then
do
RxExec=''
call ExecRexxCmd ReplaceParmWith
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
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 bb_ValPointless='N' then
do
if OptionParmVal<> "S" then
do
bb_DieIfNotUsed=OptionParmVal
end
if bb_DieIfNotUsed='Y' | OptionDebugOn = 'Y' then
do
bb_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 bb_UnUsed='' then
bb_UnUsed=ParmName.ParmIndex
else
bb_UnUsed=bb_UnUsed|| ', ' ||ParmName.ParmIndex
end
end
if bb_DieIfNotUsed='Y' then
do
if bb_UnUsed<> '' then
do
bb_UnUsed='    ' ||bb_UnUsed
if DefaultCnt=0 then
bb_Def='No macro parameters used default values'
else
do
bb_Def=''
do DefaultIndex=1 to DefaultCnt
if bb_Def='' then
bb_Def=PrmDefaultName.DefaultIndex
else
bb_Def=bb_Def|| ', ' ||PrmDefaultName.DefaultIndex
end
end
bb_Def='    ' ||bb_Def
CryAndDie('The "' || VariableName || '" macro was supplied parameters it', 'does not require! These are:', bb_UnUsed, '', 'These macro parameters used default values:',bb_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)
else
ThisParmVal=GetQuotedText(RightBit, "RightBit",EndsMacroReplacement)
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)
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
do
QChar=QuoteIt(VariableCont,TryQuoteListDs)
VariableCont=QChar||VariableCont||QChar
end

when ThisDdCmd='$$SDQ' then
do
QChar=QuoteIt(VariableCont,TryQuoteListSd)
VariableCont=QChar||VariableCont||QChar
end

when ThisDdCmd='$$AQ' then
do
QChar=QuoteIt(VariableCont,TryQuoteListAny)
VariableCont=QChar||VariableCont||QChar
end

when ThisDdCmd='$$UPPER' then
VariableCont=translate(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 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='$$RXEXEC' then
do
RxExec=''
call ExecRexxCmd VariableCont
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
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:
DefVar=arg(1)
if MacroExists(DefVar)='N' then
do
DefValue=arg(2)
DefDbgWrd='not'
end
else
do
DefValue=GetDefineContents(DefVar)
DefDbgWrd='was'
end
if OptionDebugOn='Y' then
call DBG_MACROVALORDEF 'Option(Macro) "' || DefVar || '" ' || DefDbgWrd || ' found. Using ' ||DebugRightArrow||DefValue||DebugLeftArrow
return(DefValue)

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

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 DirectToOutputFile 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

DirectToOutputFile:
if 0=charout(CurrentOutFile,arg(1))then
return
IoReason=FileDescription(CurrentOutFile)
CryAndDie('Write to "' || CurrentOutFile || '" failed (' || IoReason || ')!')

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_27:
call InitializeOneLine
signal OneLine_28

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 "PPWIZARD's #( Command"
if OneLineLevel<>0 then
return('')
else
do
_OneLineBit=OneLineBuffer
call InitializeOneLine
return(_OneLineBit)
end

ProcessOneLine:
OneLineLevel=OneLineLevel+1
call StackPush "PPWIZARD's #( Command",,"#( command - level " ||OneLineLevel
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_28:
UserHashCmds=''
signal CMDNFND_29

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

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

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

InitCommandLineOptions:
OptChar1='/'
OptChar2='-'
OptionsCmdLine=strip(arg(1))
OptionDebugOn='N'
OptionMaxCol=500
DepDelPrev='N'
OptionBaseDirectory=''
InputMasksAllowed='Y'
OptionPrjExtn='DEF_*'
CgiOutputFile=''
OptionCgiModeOn='N'
ProcessingMode=''
call MakingText "HTML"
call MakingText "OTHER"
call MakingText "REXX"
call MakingText "COPY"
PpwOnOK=''
PpwOnERROR=''
OptionUncUsed='N'
OptionValidation=''
OptionValidationRc=''
OptionOutput=''
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
Option0FilesPerMaskOk='N'
Option0FilesTotalOk='N'
Option0FilesTotalAfterExcludeOk='N'
OptionXSlash=''
OptionDeleteOnError='Y'
bc_Line=copies('*+',20)
call StoreOutHeader "|VBS|'" || bc_Line || "|' |'" || bc_Line || "|"
return

QuickCheckForDebugSwitch:
OptionsEnvironment=GetEnv('PPWIZARD_OPTIONS')
UpperTheCmdLine=translate(OptionsEnvironment|| ' ' ||OptionsCmdLine)
if pos(OptChar1|| 'DEBUG ', UpperTheCmdLine || ' ') <> 0 | pos(OptChar2 || 'DEBUG ', UpperTheCmdLine || ' ')<>0 then
do
OptionDebugOn='Y'
OptionWantInfoMsgs='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:
bd_ForDep=arg(1)
bd_ThisParm=ReplaceString(ThisParm, ' ', '{x20}')
if CmdLineTotal='' then
CmdLineTotal=bd_ThisParm
else
CmdLineTotal=CmdLineTotal|| ' ' ||bd_ThisParm
if bd_ForDep='Y' then
do
if PpwClDep='' then
PpwClDep=bd_ThisParm
else
PpwClDep=PpwClDep|| ' ' ||bd_ThisParm
end
return

ProcessCommandLineBit:
parse arg be_What,be_CmdLine
call DBGIND 1
call DBG 'Processing switches - ' ||be_What
call DBGIND 1
do while be_CmdLine<> ''
be_CmdLine=strip(be_CmdLine)
be_QPos=pos(left(be_CmdLine,1),CmdLineQL)
if be_QPos<>0 then
do
be_SQ=substr(CmdLineQL,be_QPos,1)
be_EQ=substr(CmdLineQR,be_QPos,1)
call DBG 'Item quoted. Left Quote = ' || be_SQ || ', Looking for end quote of ' ||be_EQ
be_Start=be_CmdLine
be_CmdLine=substr(be_CmdLine,2)
be_QPos=pos(be_EQ,be_CmdLine)
if be_QPos=0 then
UserSyntaxError('Could not find the ending quote of ' || be_EQ || ' at ==> ' ||be_Start)
ThisParm=left(be_CmdLine,be_QPos-1)
be_CmdLine=substr(be_CmdLine,be_QPos+1)
if be_CmdLine<> '' then
do
if left(be_CmdLine,1)\==' ' then
UserSyntaxError('Invalid quoted parameter (space must follow quoted item) at ==> ' ||be_Start)
end
end
else
do
parse var be_CmdLine ThisParm be_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}')
be_CmdLine=ThisParm|| ' ' ||be_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:', '    ' ||be_What)
call AddToSwitchList 'N'
be_FM=MakeAbsolute(ThisParm)
be_FF='?' ||RexDirChar
if left(be_FM,2)=be_FF then
do
be_Find=substr(be_FM,3)
be_FM=FindFile(be_Find)
if be_FM='' then
CryAndDie('Could not locate the file "' || be_Find || '"!')
end
be_Marker='{ENDBASE}'
if pos(be_Marker,be_FM)<>0 then
do
parse var be_FM be_BD (be_Marker) be_FM
be_FM=be_BD||be_FM
call DBG 'Without base dir marker = "' || be_FM || '"'
if left(be_BD,1)='+' then
be_BD=substr(be_BD,2)
end
else
do
if OptionBaseDirectory<> '' then
do
be_BD=OptionBaseDirectory
end
else
do
if left(be_FM,1)='+' then
be_BD=substr(be_FM,2)
else
be_BD=be_FM
be_BD=_filespec('Location',be_BD)
end
end
call ValidateBaseDirUse be_BD,be_FM, 'Y'
be_PM=ProcessingMode
be_OM=OptionOutput
be_DM=OptionDependsOn
InputMaskCount=InputMaskCount+1
InputMaskBDir.InputMaskCount=be_BD
InputMaskPMode.InputMaskCount=be_PM
InputMaskOutMask.InputMaskCount=be_OM
InputMaskDepMask.InputMaskCount=be_DM
InputMask0FilesOk.InputMaskCount=Option0FilesPerMaskOk
be_U="<Unknown at this time>"
if be_PM='' then
be_PM=be_U
if be_OM='' then
be_OM=be_U
if be_DM='' then
be_DM=be_U
call DBG 'Base Directory  = "' || be_BD || '"'
call DBG 'Processing Mode = "' || be_PM || '"'
call DBG 'Output Mask     = "' || be_OM || '"'
call DBG 'Depends On Mask = "' || be_DM || '"'
call DBG '0 Files OK      = ' ||Option0FilesPerMaskOk
InputMask.InputMaskCount=be_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='COPY' then
call PModeSwitch ThisCmd,ThisCmdOptions
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='OUTPUT' then
OptionOutput=SwitchMustHaveOptions(ThisCmd,ThisCmdOptions)
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 be_P1 ',' be_P2 ',' be_P3
if be_P1<> '' then
Option0FilesPerMaskOk=SwitchWantsYesOrNo(ThisCmd,be_P1, 'Y')
if be_P2<> '' then
Option0FilesTotalOk=SwitchWantsYesOrNo(ThisCmd,be_P2, 'Y')
if be_P3<> '' then
Option0FilesTotalAfterExcludeOk=SwitchWantsYesOrNo(ThisCmd,be_P3, 'Y')
end
when ThisCmd='TEMPLATE' then
OptionTemplate=SwitchMustHaveOptions(ThisCmd,ThisCmdOptions)
when ThisCmd='COLOR' | ThisCmd = 'COLOUR' then
do
WantColor=SwitchWantsYesOrNo(ThisCmd,ThisCmdOptions, 'Y')
if WantColor='N' then
call RemoveColorCodes
else
do
call NotAvailableUnderNtYet ThisCmd
call SetColorCodes
end
end
when ThisCmd='BEEP' then
do
WantBeep=SwitchWantsYesOrNo(ThisCmd,ThisCmdOptions, 'Y')
if WantBeep='N' then
call RemoveBeepCode
else
call SetBeepCode
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='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
be_P=SwitchMustHaveOptions(ThisCmd,ThisCmdOptions)
call ProcessRequireCommon translate(be_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
if ThisCmdOptions='' then
OptionIncludePathCnt=0
else
do
OptionIncludePathCnt=OptionIncludePathCnt+1
OptionIncludePath.OptionIncludePathCnt=ThisCmdOptions
end
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 GetListOfFiles 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='$TRACE' then
call SetDollarTraceState SwitchWantsYesOrNo(ThisCmd,ThisCmdOptions, 'Y')
when ThisCmd='DEBUGTIME' then
OptionDebugTime=left(SwitchOptionsValidateAgainstList(ThisCmd,ThisCmdOptions, "N,NO,L,LONG,S,SHORT"),1)
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 RemoveBeepCode
call RemoveColorCodes
call SwitchMustNotHaveOptions ThisCmd,ThisCmdOptions
DebugSwitchUsed='Y'
OptionDebugOn='Y'
OptionWantInfoMsgs='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
be_CmdLine=FromEnv|| ' ' ||be_CmdLine
end
when ThisCmd='INPUT' then
be_CmdLine='"' || SwitchMustHaveOptions(ThisCmd, ThisCmdOptions) || '" ' ||be_CmdLine
when ThisCmd='LIST' then
do
RecordSwitch='N'
ListFile=QueryExists(ThisCmdOptions)
if ListFile='' then
CryAndDie('The list file "' || ThisCmdOptions || '" does not exist')
call DBG 'Processing: "' || ListFile || '"'
call DBGIND 1
call FileClose ListFile
LCmt=';' || ';'
LineNum=0
SpecList=''
do while lines(ListFile)<>0
OneSpec=strip(linein(ListFile))
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
be_CmdLine=strip(SpecList)|| ' ' ||be_CmdLine
call DieIfIoErrorOccurred ListFile
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='MAKING' then
do
call SwitchMustHaveOptions ThisCmd,ThisCmdOptions
parse var ThisCmdOptions '/' be_M '/' be_T
call MakingText be_M,be_T
end
when ThisCmd='UNC' then
OptionUncUsed=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 Line1 ErrorColor|| "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 || ' InputMask1 [-Option1 InputMask2 /Option2 ...]'
call Line1 ''
call Line1 'SOME COMMON OPTIONS'
call Line1 '~~~~~~~~~~~~~~~~~~~'
call Line1 OptChar|| 'Output:Mask     = Call output what?  Place it where? (example "out\*.html")'
call Line1 OptChar|| 'Rexx ' || OptChar || 'Other     = Not HTML mode (rexx preprocessor or "OTHER")'
call Line1 OptChar|| 'DependsOn:Mask  = Generate/Check dependencies (makefile type functionality)'
call Line1 OptChar|| 'Debug           = Show debug information (diagnose problems or learning)'
call Line1 ''
call Line1 "Please see PPWIZARD's documentation for more details (and more options)." ||Beep||Beep||Reset
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:
bf_PrjFile=arg(1)
if pos('.',bf_PrjFile)=0 then
bf_PrjFile=bf_PrjFile|| '.ppw'
if OptionDebugOn='Y' then
do
call DBGIND 1
call DBG 'Looking for the project file "' || bf_PrjFile || '"'
call DBGIND 1
end
bf_Full=FindFile(bf_PrjFile)
if OptionDebugOn='Y' then
do
call DBGIND 1
if bf_Full='' then
call DBG 'Project file not found.'
else
call DBG 'Found project file "' || bf_Full || '"'
call DBGIND-3
end
return(bf_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 bg_Switch,bg_CmdRc,bg_Cmd
if OptionDebugOn='Y' then
call DBG 'Performing ' || OptChar || bg_Switch || ' command'
bg_Exec=ReplaceString(bg_Cmd, "{?}",CurrentOutFile)
if left(bg_Exec,1)<> '!' then
bg_Redirect='Y'
else
do
bg_Redirect='N'
bg_Exec=substr(bg_Exec,2)
end
if bg_Redirect='N' then
do
call AddressCmd bg_Exec
CmdRc=Rc
end
else
do
TmpFile=RexGetTmpFileName()
call AddressCmd bg_Exec||RedirectStdOutAndErr2(TmpFile),TmpFile
CmdRc=Rc
call _SysFileDelete TmpFile
end
if bg_CmdRc<> '' then
do
call DBGIND 1
bg_ExecOk=0
bg_ExecThis='bg_ExecOk = ' || '(' || bg_CmdRc || ')'
if ProcessedCmdLine='Y' then
call ExecRexxCmd bg_ExecThis
else
do
call DBG 'Interpreting: ' ||bg_ExecThis
interpret bg_ExecThis
end
call DBGIND-1
if\bg_ExecOk then
CryAndDie('User command failed (CmdRc was ' || CmdRc || '):', '     ' || bg_Exec, 'Test was:', '     ' ||bg_CmdRc)
end
return

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

ValidateBaseDirUse:
parse arg bi_BD,bi_FM,bi_MayHavePlus
call DBG 'Validating base directory "' || bi_BD || '" against "' || bi_FM || '"'
if bi_MayHavePlus='Y' then
do
if left(bi_FM,1)='+' then
bi_FM=substr(bi_FM,2)
end
if RexSystemOpSys="UNIX" then
do
bi_BdU=bi_BD
bi_FmU=bi_FM
end
else
do
bi_BdU=translate(bi_BD)
bi_FmU=translate(bi_FM)
end
if bi_BdU\==left(bi_FmU,length(bi_BdU))then
CryAndDie('The file mask       "' || bi_FmU ||  '"', 'does not begin with "' || bi_BdU || '"')
return

PModeSwitch:
parse arg bj_PM,bj_Prm
call SwitchMustNotHaveOptions bj_PM,bj_Prm
ProcessingMode=bj_PM
return

MakingText:
parse arg bk_M,bk_T
if bk_T='' then
do
if translate(bk_M)='COPY' then
bk_T='Coping: "{IS}" -> "{OL}"'
else
bk_T='Making ({PM}) - {OL}'
end
call value 'PPWMAKING_' ||bk_M,bk_T
call DBG '/Making Text for ' || bk_M || ' mode is: ' ||bk_T
return

CmdLine_30:
DependsOnFmtVer="FORMAT 00.157"
call ClearCollectedDependancyInfo
call ClearDependancyTimeStampCache
signal DEPENDON_31

_CheckedLineout:
bl_File=arg(1)
bl_Line=arg(2)
if 0<>lineout(bl_File,bl_Line)then
CryAndDie('Write to "' || bl_File || '" failed!')
return

NeedToRemake:
DepFile4=arg(1)
if OptionDependsOn='' then
do
call DBG 'No Dependancy file to check - 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
bm_Line=linein(DepFileName)
if bm_Line='' then
iterate
parse var bm_Line bm_Type bm_Line
if bm_Type='output' then
do
bm_LastTime=GetQuotedText(bm_Line, "bm_Line")
call MustDeleteFile bm_LastTime
end
end
call FileClose DepFileName
call DBGIND-1
end
call MustDeleteFile DepFileName
return('Y')

ClearCollectedDependancyInfo:
DepTmpCnt=0
DepInCnt=0
DepOutCnt=0
return

ClearDependancyTimeStampCache:
TimeStampCount=0
return

GetFileDateTimeButDontWarnOnError:
tsFile=arg(1)
if QueryExists(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 Line1 TitleColor||TitleText
call Line1 copies('~',length(TitleText))||Reset
end
if QueryExists(DepFileName)='' then
do
call _ShowDependancyCheckProgress DepFileName|| ' does not exist.'
return('Y')
end
call FileClose DepFileName
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:
bn_File=translate(arg(1))
do bn_I=1 to DepTmpCnt
if bn_File=DepTmp.bn_I then
return(bn_I)
end
return(0)

AddTempFileToDependancyList:call TRACE "OFF"
bo_TFile=arg(1)
if RexSystemOpSys<> "UNIX" then
bo_TFile=translate(bo_TFile)
if IsTempFile(bo_TFile)<>0 then
return('N')
DepTmpCnt=DepTmpCnt+1
DepTmp.DepTmpCnt=bo_TFile
return('Y')

AddInputFileToDependancyList:call TRACE "OFF"
parse arg bp_IFile,bp_TS
if RexSystemOpSys<> "UNIX" then
bp_IFile=translate(bp_IFile)
if IsTempFile(bp_IFile)<>0 then
return('N')
if bp_TS='' then
bp_TS=GetDependsStamp("bp_IFile")
do bp_I=1 to DepInCnt
if bp_IFile=DepIn.bp_I then
return('N')
end
DepInCnt=DepInCnt+1
DepIn.DepInCnt=bp_IFile
DepInTs.DepInCnt=bp_TS
return('Y')

AddOutputFileToDependancyList:call TRACE "OFF"
bq_OFile=arg(1)
if RexSystemOpSys<> "UNIX" then
bq_OFile=translate(bq_OFile)
if IsTempFile(bq_OFile)<>0 then
return('N')
do bq_I=1 to DepOutCnt
if bq_OFile=DepOut.bq_I then
return('N')
end
DepOutCnt=DepOutCnt+1
DepOut.DepOutCnt=bq_OFile
return('Y')

DeletingOnError:
if symbol('DepOutCnt') <> 'VAR' then
return
if OptionDeleteOnError='N' then
return
call DBG 'Deleting any files we created for this build'
call DBGIND 1
do br_I=1 to DepOutCnt
br_File=DepOut.br_I
call FileClose br_File
if QueryExists(br_File)<> "" then
do
DeleteRc=_SysFileDelete(br_File)
if QueryExists(br_File)<> "" then
call DBG 'Could not delete "' || br_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
DepDrop=''
DepHook=CfgMacro("HOOK_DEPENDSON", '')
if DepHook<> '' then
do
DepIn.0=DepInCnt
DepOut.0=DepOutCnt
call ExecRexxCmd DepHook
DepInCnt=DepIn.0
DepOutCnt=DepOut.0
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 _CheckedLineout DepFileName,DependsOnFmtVer
call _CheckedLineout DepFileName, ''
DepWhatPad=0
do br_I=1 to DepOutCnt
if DepOut.br_I<> '' then
do
call DBG 'Add OUTPUT dependancy : ' ||DepOut.br_I
OutputFileTs=GetFileDateTimeButDontWarnOnError(DepOut.br_I)
call _CheckedLineout DepFileName, 'output   ' || _OutputDepWhatToFile(DepOut.br_I) || '   ~' || OutputFileTs || '~'
end
end
call _CheckedLineout DepFileName, ''
do br_I=1 to DepInCnt
if DepIn.br_I<> '' then
do
call DBG 'Add INPUT  dependancy : ' ||DepIn.br_I
call _CheckedLineout DepFileName, 'input    ' || _OutputDepWhatToFile(DepIn.br_I) || '   ~' || DepInTs.br_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 bs_Type,bs_Which
bs_Type=translate(bs_Type)
if bs_Which='' then
do
select
when bs_Type='INPUT' then
return(DepInCnt)
when bs_Type='OUTPUT' then
return(DepOutCnt)
otherwise
_GetDependancyInfoErr(bs_Type)
end
end
else
do
select
when bs_Type='INPUT' then
return(DepIn.bs_Which)
when bs_Type='OUTPUT' then
return(DepOut.bs_Which)
otherwise
_GetDependancyInfoErr(bs_Type)
end
end

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

GetDependsStamp:
bt_4WhatVar=arg(1)
bt_4What=value(bt_4WhatVar)
if left(bt_4What,1)<> '*' then
do
bt_Ret=GetFileDateTimeButDontWarnOnError(bt_4What)
end
else
do
Stamp4U=translate(bt_4What)
select
when abbrev(Stamp4U, "*TODAY")then
do
bt_Ret=date('S')
end
when Stamp4U="*CMDLINE" then
do
bt_Ret=PpwClDep
end
when Stamp4U="*PPWPGM" then
do
bt_Ret=PgmVersion||' '||FileQuerySize(PpWizardPgmName)||' '||GetFileDateTimeButDontWarnOnError(PpWizardPgmName)
end
when abbrev(Stamp4U, "*REXX=")then
do
bt_RexxExp=translate(substr(bt_4What,7))
if pos('DEPVALUE',translate(bt_RexxExp))=0 then
bt_RexxExp='DepValue = ' ||bt_RexxExp
DepValue=time('L')
call ExecRexxCmd bt_RexxExp
bt_Ret=DepValue
end
when abbrev(Stamp4U, "*EXPIRES=")then
do
bt_ExpWhen=translate(substr(bt_4What,10))
parse var bt_ExpWhen bt_ExpCmd ';' bt_ExpTs
if bt_ExpWhen='NOW' then
bt_ExpWhen=0
bt_CurrTs=TimeSTamp()
if bt_ExpTs='' then
do
bt_ExpTs=TimeSTamp(bt_ExpWhen)
bt_4What=bt_4What|| ';' ||bt_ExpTs
call value bt_4WhatVar,bt_4What
end
if bt_CurrTs<=bt_ExpTs then
bt_Ret='Tick Tock...'
else
bt_Ret='Expired!'
end
when abbrev(Stamp4U, "*EXEC=")then
do
TheCmd=substr(bt_4What,7)
TmpFile=RexGetTmpFileName("DEPON???.???")
call AddressCmd TheCmd|| ' >' || TmpFile || ' 2>&1'
ExecRc=Rc
call DBG 'Depend value is result of (Rc=' || ExecRc || '): ' ||TheCmd
call FileClose TmpFile
TheCmdVal=charin(TmpFile,,999999)
call FileClose TmpFile
TheCmdVal=translate(TheCmdVal,, '0D0A1A'x, ' ')
TheCmdVal='RC=' || ExecRc || '->' ||TheCmdVal
bt_Ret=TheCmdVal
end
when abbrev(Stamp4U, "*FILES=")then
do
TheMask=substr(bt_4What,8)
if left(TheMask,1)<> '+' then
sdDo='N'
else
do
sdDo='Y'
TheMask=substr(TheMask,2)
end
call GetListOfFiles TheMask, 'DepDirList',sdDo
DirStamp=DepDirList.0|| ' files'
do DepIndex=1 to DepDirList.0
DirStamp=DirStamp|| '; ' || DepDirList.DepIndex || '=' ||GetFileDateTimeButDontWarnOnError(DepDirList.DepIndex)
end
bt_Ret=DirStamp
end
otherwise
CryAndDie('An incorrectly formatted "special" input dependancy was specified', 'You used "' || bt_4What || '"')
end
end
call DBG 'Stamp: ' ||bt_Ret
return(bt_Ret)

DEPENDON_31:
DoingImport=''
signal IMPORT_32

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
FullImportName=FileQueryExists(ImportFileName)
if FullImportName='' then
CryAndDie('The #import file "' || ImportFileName || '" does not exist!')
call OutputProcessingFileStringToScreen FullImportName
call AddInputFileToDependancyList FullImportName
end
ToInclude=RexGetTmpFileName('I_' || left(TmpFilePart, 4, '_') || '??.???')
call MustDeleteFile ToInclude
if ImportParms='' then
CryAndDie('#import is missing macro name (parm #3)!')
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 AsIsPrepare ''
if OptionDebugOn='Y' then
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
call ImportTablePreparation
select
when ImportFileType='ML' then
ImpLinCnt=HandleMultiLineImport()
when CustomDelimiter<> 'NO' then
ImpLinCnt=HandleSimpleCharDelimitedFile(CustomDelimiter)
when ImportFileType='TAB' then
ImpLinCnt=HandleSimpleCharDelimitedFile(TabChar)
when ImportFileType='CMA' then
ImpLinCnt=HandleSimpleCharDelimitedFile(',')
when ImportFileType='FIX' then
ImpLinCnt=HandleFixedFieldFile()
when ImportFileType='SQL' then
ImpLinCnt=HandleSQLDataBase()
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 OutputProcessingFileStringToScreen
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:
ImportVar=MacroName|| '_' ||arg(1)
iveAnswer=MacroExists(ImportVar)
if OptionDebugOn='Y' then
call DBG_MACROVALORDEF 'Option(Macro) "' || ImportVar || '" Exists? : ' ||iveAnswer
return(iveAnswer)

GetImportValue:
ImportVar=MacroName|| '_' ||arg(1)
if MacroExists(ImportVar)='N' then
do
ImportMask=arg(2)
DebugWord='not'
end
else
do
ImportMask=GetDefineContents(ImportVar)
DebugWord='was'
end
if OptionDebugOn='Y' then
call DBG_MACROVALORDEF 'Option(Macro) "' || ImportVar || '" ' || DebugWord || ' found. Using ' ||DebugRightArrow||ImportMask||DebugLeftArrow
if ImportFileType<> "WRAP" & ImportFileType <> "T2H" then
ImportMask=ReplaceString(ImportMask,StartsMacroParm|| 'Columns' ||EndsMacroParm,DisplayingFields)
return(ImportMask)

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

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

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

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:
if arg(1)='Y' then
FileLine=CrLflinein(FullImportName)
else
FileLine=linein(FullImportName)
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
ilcPos=pos(ImportInlineCmtChars,FileLine)
if ilcPos<>0 then
FileLine=strip(left(FileLine,ilcPos-1), 'Trailing')
end
if arg(2)='Y' then
FileLine=AsIs(translate(FileLine, '',EofChar))
else
FileLine=translate(FileLine, '',EofChar)
if ReplaceNewLineChar\=='' then
FileLine=ReplaceString(FileLine,MarksNewLine,ReplaceNewLineChar)
if ReplaceTabChar\=='' then
FileLine=ReplaceString(FileLine,TabChar,ReplaceTabChar)
return(FileLine)

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

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_32:
signal IMPORTT_33

ImportTablePreparation:
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 '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
call _ImportValueSpacer 'What happens to blank fields?'
call DBGIND 1
ReplaceBlankFields=GetImportValue('BLANK_FIELD',  '')
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=5 CELLSPACING=5')
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('N', '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)

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
UseCrLfRoutines=GetImportValue('HANDLE_IMBEDDED_NEWLINES', 'N')
if UseCrLfRoutines='N' then
call DBG_IMPORT 'Special imbedded newline detecting code is not being used'
else
do
UseCrLfRoutines='Y'
call DBG_IMPORT 'We are using special imbedded newline detecting code'
end
call DBG_IMPORT 'Reading "' || FullImportName || '"...'
if UseCrLfRoutines='Y' then
OpenRc=CrlfOpen(FullImportName,10000)
ImportFileLine=0
do forever
if UseCrLfRoutines='Y' then
EofIf0=CrLflines(FullImportName)
else
EofIf0=lines(FullImportName)
if EofIf0=0 then
leave
CurrentRecord=ImportOneLine(UseCrLfRoutines, '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
bv_L=CurrentRecord
bv_Del=FieldDelimiter
bv_MinF=NumberOfFields
bv_MaxF=NumberOfFields
bv_FC=0
bv_Q='"'
bv_Q2='""'
do while bv_L<> ''
bv_Fc=bv_Fc+1
if left(bv_L,1)<>bv_Q then
do
bv_DelPos=pos(bv_Del,bv_L)
if bv_DelPos<>0 then
do
bv_F=left(bv_L,bv_DelPos-1)
bv_L=substr(bv_L,bv_DelPos+1)
end
else
do
bv_F=bv_L
bv_L=''
end
end
else
do
bv_LookFrom=2
do forever
bv_QPos=pos(bv_Q,bv_L,bv_LookFrom)
if bv_QPos=0 then
do
CryAndDie('Import of line ' || ImportFileLine || ' failed','No ending quote on field #' || bv_Fc,, 'RECORD', '~~~~~~', CurrentRecord, 'DETECTED AT', '~~~~~~~~~~~',bv_L)
end
if substr(bv_L,bv_QPos+1,1)=bv_Q then
bv_LookFrom=bv_QPos+2
else
leave
end
bv_F=ReplaceString(substr(bv_L,2,bv_QPos-2),bv_Q2,bv_Q)
bv_L=substr(bv_L,bv_QPos+1)
if bv_L<> '' then
do
if left(bv_L,1)<>bv_Del then
do
CryAndDie('Import of line ' || ImportFileLine || ' failed','Expected delimiter after field #' || bv_Fc,, 'RECORD', '~~~~~~', CurrentRecord, 'DETECTED AT', '~~~~~~~~~~~',bv_L)
end
bv_L=substr(bv_L,2)
end
end
bw_Fld.bv_Fc=bv_F
if bv_MaxF<>0 then
do
if bv_Fc>=bv_MaxF then
leave
end
end
if bv_Fc<bv_MinF then
do
do while bv_Fc<bv_MinF
bv_Fc=bv_Fc+1
bw_Fld.bv_Fc=''
end
end
bw_Fld.0=bv_Fc
do bw_i=1 to bw_Fld.0
call _AddField2Record bw_Fld.bw_i
end
if GenerateRecordFromFields()then
leave
end
if UseCrLfRoutines='Y' then
CloseRc=CrlfClose(FullImportName)
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)

IMPORTT_33:
signal REXXSQL_34

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

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

RexxSqlEmFailed:
CryAndDie(by_Em, 'REASON:',by_Reason)

by_Line:
by_Count=by_Count+1
by_L.by_Count=arg(1)
return

ErrorSql:
do by_I=1 to 10
by_L.by_I=''
end
by_Count=0
do by_I=1 to arg()
call by_Line arg(by_I)
end
if by_Count>6 then
by_Count=6
if by_L.1='' then
do
by_Count=1
by_L.1='REXXSQL ' || SQLCA.FUNCTION || '() call failed'
end
call by_Line ''
if sqlca.intcode=-1 Then
do
call by_Line 'SQLCODE:' sqlca.sqlcode
call by_Line 'SQLERRM:' sqlca.sqlerrm
call by_Line 'SQLTEXT:' sqlca.sqltext
end
else
do
call by_Line 'INTCODE:' sqlca.intcode
call by_Line 'INTERRM:' sqlca.interrm
end
CryAndDie(by_L.1,by_L.2,by_L.3,by_L.4,by_L.5,by_L.6,by_L.7,by_L.8,by_L.9,by_L.10)

HandleSqlDataBase:
if OptionDebugOn='Y' then
do
call DBG_IMPORT "Importing SQL via Mark Hessling's REXXSQL interface"
call DBGIND 1
end
call LoadRexxSql
bz_Imported=0
call DBG_IMPORT "REXXSQL VERSION: " || SqlVariable("VERSION")
do FieldIndex=1 to NumberOfFields
bz_FNAME=FieldExtra.FieldIndex
if bz_FNAME='' then
bz_FNAME=FieldHeading.FieldIndex
FieldName.FieldIndex=bz_FNAME
end
if OptionDebugOn='Y' then
do
call SqlVariable "DEBUG", GetImportValue('SQL_DEBUG', '3')
end
bz_Id="SQL"
bz_UserId=GetImportValue('SQL_USERID',   "")
bz_Password=GetImportValue('SQL_USERPW',   "")
bz_DataSourceId=GetImportValue('SQL_DATABASE', "")
if bz_DataSourceId='' then
CryAndDie('An SQL database was not specified')
bz_Server=GetImportValue('SQL_SERVER',   "")
call DBG_IMPORT "Connecting to the database"
if SQLConnect(bz_Id,bz_UserId,bz_Password,bz_DataSourceId,bz_Server)<0 then
ErrorSql('Connection failed to "' || bz_DataSourceId || '", have you set up ODBC datasource (control panel)?')
call DBG_IMPORT "DATABASE INFO: " || SqlGetInfo(bz_Id, 'DBMSNAME')
bz_Cmds=GetImportValue('SQL_COMMANDS', "")
if bz_Cmds<> '' then
do
call DBGIND 1
do bz_I=1 to words(bz_Cmds)
bz_Mac=word(bz_Cmds,bz_I)
bz_Cmd=GetDefineContents(bz_Mac)
if left(bz_Cmd,1)<> '-' then
bz_Doe='Y'
else
do
bz_Doe='N'
bz_Cmd=substr(bz_Cmd,2)
end
call DBG_IMPORT "Executing: " ||bz_Cmd
bz_Rc=SQLCommand(bz_Mac,bz_Cmd)
call DBGIND 1
if bz_Rc>=0 then
call DBG_IMPORT "OK, RC=" ||bz_Rc
else
do
if bz_Doe='Y' then
ErrorSql('User command from "' || bz_Mac || '" failed!')
if sqlca.intcode=-1 Then
do
bz_1='SQLCODE:' sqlca.sqlcode
bz_2='SQLERRM:' sqlca.sqlerrm
bz_3='SQLTEXT:' sqlca.sqltext
end
else
do
bz_1='INTCODE:' sqlca.intcode
bz_2='INTERRM:' sqlca.interrm
bz_3=''
end
call DBG_IMPORT "Command failed"
call DBG_IMPORT bz_1
call DBG_IMPORT bz_2
call DBG_IMPORT bz_3
end
call DBGIND-1
end
call DBGIND-1
end
bz_Query=GetImportValue('SQL_QUERY', "")
if bz_Query='' then
CryAndDie('An SQL query was not specified')
if SqlPrepare('SQLQUERY',bz_Query)<0 then
ErrorSql()
if OptionDebugOn='Y' then
do
call DBG_IMPORT "Returned Column information"
call DBGIND 1
bz_Attribs=SqlGetInfo(bz_Id, 'DESCRIBECOLUMNS')
if sqlca.intcode<0 then
bz_Attribs='NAME TYPE SIZE SCALE NULLABLE PRECISION'
bz_Pad2=0
do bz_I=1 to words(bz_Attribs)
bz_This=word(bz_Attribs,bz_I)
if length(bz_This)>bz_Pad2 then
bz_Pad2=length(bz_This)
end
bz_NumCols=SqlDescribe('SQLQUERY', 'bz_Det')
if bz_NumCols<0 then
ErrorSql()
do bz_ColIndex=1 to bz_NumCols
call DBG_IMPORT "Query Field " ||bz_ColIndex
call DBGIND 1
do bz_I=1 to words(bz_Attribs)
bz_Attrib=word(bz_Attribs,bz_I)
bz_Value=value('bz_Det.COLUMN.' || bz_Attrib || '.bz_ColIndex')
if left(bz_Value,1)='' | right(bz_Value, 1) = '' then
bz_Value='""'
call DBG_IMPORT right(bz_Attrib,bz_Pad2)|| ' = ' ||bz_Value
end
call DBGIND-1
end
call DBGIND-1
end
if SqlOpen('SQLQUERY')<0 then
ErrorSql()
bz_Rc=SqlFetch('SQLQUERY')
do while bz_Rc>0
call _NewRecord
do FieldIndex=1 to NumberOfFields
bz_ColVar='SQLQUERY.' ||FieldName.FieldIndex
if bz_Imported=0 then
do
if symbol(bz_ColVar)<> 'VAR' then
CryAndDie('The query did not return a field called "' || FieldName.FieldIndex || '"')
end
call _AddField2Record value(bz_ColVar)
end
bz_Imported=bz_Imported+1
if GenerateRecordFromFields()then
leave
bz_Rc=SqlFetch('SQLQUERY')
end
if bz_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(bz_Id)<0 then
ErrorSql()
if OptionDebugOn='Y' then
call DBGIND-1
return(bz_Imported)

REXXSQL_34:
signal IMPORTTX_35

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('N', '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_35:
signal IMPORTWR_36

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('N', '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_36:
MultiLineImportInProgress='N'
signal I_ML_37

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=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', 'N'))
ImportFileLine=ImportFileLine+1
if MultiLine='' then
do
if MlFieldCnt<>0 then
do
ca_Eof=_MlGenerateRecord()
call _MlNewRecord
if ca_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
cb_Eof=GenerateRecordFromFields()
LastMlStoredAs=''
return(cb_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_37:
call LoopInit
signal LOOP_38

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)")
InLoop='Y'
LoopID=LoopID+1
LoopCnt=0
LoopLine=1
cc_A=arg(1)
if cc_A="" then
cc_LoopType=''
else
do
cc_A=PerformReplacementsInCmdsParameters(cc_A)
parse var cc_A cc_LoopType cc_A
cc_LoopType=translate(cc_LoopType)
select
when cc_LoopType='FOR' then
do
parse value translate(cc_A)with cc_Var "=" cc_Strt " TO " cc_End
if cc_End="" then
CryAndDie("Incorrect FOR spec ==> " ||cc_A)
cc_Var=strip(cc_Var)
cc_Strt=strip(cc_Strt)
call _valueS cc_Var,cc_Strt
end
when cc_LoopType='SET' then
do
if translate(word(cc_A,1))<> 'COUNTER' then
cc_Var='SetLoopVar' ||LoopID
else
do
cc_Var=word(cc_A,2)
cc_A=subword(cc_A,3)
end
cc_SetCnt=0
cc_InitSet=''
cc_LoopSetCnt=0
cc_IndexList=''
cc_NewArray='SETITEMS' ||LoopID
do while cc_A<> ''
cc_SetName=GetQuotedText(cc_A, "cc_A")
if pos('=',cc_SetName)<>0 then
do
parse var cc_SetName cc_SetName '=' cc_Rest
parse var cc_Rest '{' cc_Del '}' cc_2Split
if cc_2Split=='' then
do
cc_Del=' '
cc_2Split=cc_Rest
end
call ArraySplit cc_SetName,cc_2Split,cc_Del
end
cc_SetVAR="SET_" ||cc_SetName
cc_SetStem=cc_SetName|| '.'
cc_SetCnt=cc_SetCnt+1
cc_IndexVar='cc_' ||cc_SetCnt
cc_InitSet=cc_InitSet|| 'do ' || cc_IndexVar || ' = 1 to ' || cc_SetStem || '0; '
if cc_SetCnt<>1 then
cc_IndexList=cc_IndexList|| ' || '
cc_IndexList=cc_IndexList|| '"' || cc_SetVar || '=' || cc_SetStem || '" || ' || cc_IndexVar || ' || ";"'
end
cc_InitSet=cc_InitSet|| 'cc_LoopSetCnt=cc_LoopSetCnt+1; '
cc_InitSet=cc_InitSet||cc_NewArray|| '.cc_LoopSetCnt=strip(' || cc_IndexList || '); '
do cc_I=1 to cc_SetCnt
cc_InitSet=cc_InitSet|| 'end; '
end
call ExecRexxCmd cc_InitSet
call _valueS cc_NewArray|| '.0',cc_LoopSetCnt
cc_End=cc_LoopSetCnt
call _valueS cc_Var,1
end
otherwise
CryAndDie('Invalid loop specification (command "' || cc_LoopType || '" unknown)')
end
end
if cc_LoopType='FOR' | cc_LoopType = 'SET' then
do
call DBG 'Adding FOR/SET loop lines'
LoopCnt=LoopCnt+1
PpwLoop.LoopCnt='#if [' || cc_Var || ' > ' || cc_End || ']'
LoopCnt=LoopCnt+1
PpwLoop.LoopCnt='#break'
LoopCnt=LoopCnt+1
PpwLoop.LoopCnt='#endif'
if cc_LoopType='SET' then
do
call DBG 'Adding SET loop lines for ' || cc_LoopSetCnt || ' loops'
LoopCnt=LoopCnt+1
PpwLoop.LoopCnt='#evaluate ^^ ^<' || '??' || cc_NewArray || '.' || cc_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
MaybeEndCmd=left(strip(PpwLoop.LoopCnt, 'L'),LengthEndCmd)
if MaybeEndCmd=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 cc_LoopType='FOR' | cc_LoopType = 'SET' then
do
call DBG 'Adding FOR/SET loop lines'
LoopCnt=LoopCnt+1
PpwLoop.LoopCnt='#RexxVar ^' || cc_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_38:
_RestrictKeyMinimum=CharsLUN
_giCounter=0
signal GetId_39

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_39:
call GetIdPrepare "IMAGEHW"
Add2Stem=''
_ValCharsHttp=UpperCase||LowerCase||DecimalDigits|| "./?%+:~_-,"
_ValCharsFtp=_ValCharsHttp
signal Evaluate_40

_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 QueryExists(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)

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

EnsureFileHasCorrectCase:call TRACE "OFF"
cFileI=arg(1)
if OptionTranslateFileNames='N' then
return(cFileI)
if OptionTranslateFileNames='UPPER' then
cFileO=translate(cFileI)
else
cFileO=ToLowerCase(cFileI)
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"
if OptionDebugOn='Y' then
call DBG_EVALUATE 'GetAmPmTime()'
return(GetAmPmTimeFromHhMmSs(time('N'),arg(1),arg(2)))

GetAmPmTimeFromHhMmSs:call TRACE "OFF"
parse arg cd_PT,cd_AddSS,cd_AmPm
if cd_AmPm='' then
cd_AmPm='am;pm'
parse var cd_AmPm cd_AmTxt ';' cd_PmTxt
if pos(':',cd_PT)=0 then
parse var cd_PT cd_HH 3 cd_MM 5 cd_SS
else
parse var cd_PT cd_HH ':' cd_MM ':' cd_SS
if cd_HH>=12 then
cd_AmPm=cd_PmTxt
else
cd_AmPm=cd_AmTxt
if cd_HH>12 then
cd_HH=cd_HH-12
cd_HH=cd_HH+0
cd_MM=right(cd_MM,2, '0')
if cd_AddSS='' then
do
if cd_SS='' then
cd_AddSS='N'
else
cd_AddSS='Y'
end
if cd_AddSS='N' then
cd_SS=''
else
cd_SS=':' || right(cd_SS, 2, '0')
cd_T=cd_HH|| ':' ||cd_MM||cd_SS||cd_AmPm
if OptionDebugOn='Y' then
call DBG_EVALUATE 'GetAmPmTimeFromHhMmSs(' || cd_PT || ') = ' ||cd_T
return(cd_T)

AddCommasToDecimalNumber:procedure;call TRACE "OFF"
NoComma=strip(arg(1))
if pos(',',NoComma)<>0 then
return(NoComma)
DotPos=pos('.',NoComma)
if DotPos=0 then
AfterDecimal=''
else
do
if DotPos=1 then
return("0" ||NoComma)
AfterDecimal=substr(NoComma,DotPos+1)
NoComma=left(NoComma,DotPos-1)
end
NoComma=reverse(NoComma)
ResultWithCommas=""
do while length(NoComma)>3
ResultWithCommas=ResultWithCommas||left(NoComma,3)|| ','
NoComma=substr(NoComma,4)
end
ResultWithCommas=ResultWithCommas||NoComma
ResultWithCommas=reverse(ResultWithCommas)
if AfterDecimal<> '' then
ResultWithCommas=ResultWithCommas|| '.' ||AfterDecimal
return(ResultWithCommas)

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"
if OptionDebugOn='Y' then
call DBG_EVALUATE 'BreakAt()'
parse arg baMaxSize,baString,baChars,baBreakWith
if baChars=='' then
baChars='./:#'
if baBreakWith='' then
baBreakWith='<BR>'
baPos=pos('-',baMaxSize)
if baPos=0 then
baMinSize=baMaxSize%3
else
parse var baMaxSize baMinSize'-'baMaxSize
baReturn=''
do while length(baString)>baMaxSize
baLeftBit=left(baString,baMaxSize)
baString=substr(baString,baMaxSize+1)
baBestPos=0
baCharList=baChars
do while baCharList\==''
baThisChar=left(baCharList,1)
baCharList=substr(baCharList,2)
baThisPos=lastpos(baThisChar,baLeftBit)
if baThisPos>baBestPos then
do
baBestPos=baThisPos
end
end
if baReturn<> '' then
baReturn=baReturn||baBreakWith
if baBestPos=0 then
baReturn=baReturn||baLeftBit
else
do
baReturn=baReturn||left(baLeftBit,baBestPos)
baString=substr(baLeftBit,baBestPos+1)||baString
end
end
if baReturn<> '' then
return(baReturn||baBreakWith||baString)
else
return(baReturn||baString)

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='Y' then
call DBG_EVALUATE 'Defined()'
DefinedAnswer=MacroExists(arg(1))
if OptionDebugOn='Y' then
call DBG_EVALUATE 'Defined("' || arg(1) || '") = "' || DefinedAnswer || '"'
return(DefinedAnswer)

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)

GetFileTimeStamp:call TRACE "OFF"
parse arg ce_FN,ce_OnErr
ce_OnErr=translate(ce_OnErr)
if OptionDebugOn='Y' then
do
call DBG_EVALUATE 'GetFileTimeStamp("' || ce_FN || '")'
call DBGIND 1
end
ce_ST=FileInMemoryTimeStamp(ce_FN)
if ce_ST='' then
do
ce_FT=FileQueryDateTime(ce_FN)
if OptionDebugOn='Y' then
call DBG_EVALUATE 'Is time stamped : "' || ce_FT || '"'
if ce_FT='' then
do
ce_M='The file "' || ce_FN || '" does not exist.'
select
when ce_OnErr='Q' then
call DBG ce_M
when ce_OnErr='D' then
CryAndDie(ce_M)
otherwise
call OutputWarningToScreen 'TS00',ce_M
end
if OptionDebugOn='Y' then
call DBGIND-1
return(-1)
end
ce_FT=space(ce_FT)
parse var ce_FT Month'-'Day'-'Year' 'Hour':'Minute':'Second
if Year<80 then
Year=100+Year
Year=1900+Year
ce_ST=Year||Month||Day||Hour||Minute||Second
end
if OptionDebugOn='Y' then
do
call DBG_EVALUATE 'Returning       : "' || ce_ST || '"'
call DBGIND-1
end
return(ce_ST)

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"
if OptionDebugOn='Y' then
call DBG_EVALUATE 'DieIfIoErrorOccurred("' || arg(1) || '")'
FileState=FileState(arg(1))
if FileState='READY' then
return
IoReason=FileDescription(arg(1))
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 "' || arg(1) || '" (' || IoReason || ').'
call DBGIND-1
end
return
end
call CryAndDie 'I/O failure on "' || arg(1) || '" (' || IoReason || ').'
end
return

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

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

InputComponentLineLevel:call TRACE "OFF"
if OptionDebugOn='Y' then
call DBG_EVALUATE 'InputComponentLineLevel()'
icLevel=_ValidateIcLevel(arg(1))
if icLevel=0 then
return('')
else
do
if icLevel=IncludeLevel then
return(IncludeLineNumber)
else
return(_IncludeLineNumber.icLevel)
end

GenerateFileName:call TRACE "OFF"
parse arg cf_SrcFile,cf_EdtMsk
if OptionDebugOn='Y' then
do
call DBG 'GenerateFileName(' || cf_SrcFile || ') using "' || cf_EdtMsk || '"'
call DBGIND 1
call DBG 'Current directory is "' || GetCurrentDirectory() || '"'
end
ShortName=_filespec('name',cf_SrcFile)
ShortNameNE=_filespec('withoutextn',ShortName)
InputPath=_filespec('location',cf_SrcFile)
cf_Full=ReplaceString(cf_EdtMsk, "?",InputPath)
cf_Full=ReplaceString(cf_Full, "*.*",ShortName)
cf_Full=ReplaceString(cf_Full, "*",ShortNameNE)
cf_Full=ReplaceString(cf_Full, "{$PATH}",InputPath)
cf_Full=ReplaceString(cf_Full, "{$BASE}",ShortNameNE)
cf_Full=ReplaceString(cf_Full, "{$SHORT}",ShortName)
cf_Full=ReplaceString(cf_Full, "{$FULL}",cf_SrcFile)
if pos('{$path}',cf_Full)<>0 then
do
call DBGIND 1
cf_Bd=BaseDir4CurrentInputFile
call DBG '{$path} found, base directory is "' || cf_Bd || '"'
call ValidateBaseDirUse cf_BD,cf_SrcFile
cf_SrcDir=_filespec('Location',cf_SrcFile)
cf_RelDir=substr(cf_SrcDir,length(cf_Bd)+1)
call DBG '{$path} = "' || cf_RelDir || '"'
cf_Full=ReplaceString(cf_Full, "{$path}",cf_RelDir)
call DBGIND-1
end
if OptionUncUsed='N' then
cf_Full=ReplaceString(cf_Full,RexDirChar||RexDirChar,RexDirChar)
cf_Full=EnsureFileHasCorrectCase(cf_Full)
if OptionDebugOn='Y' then
call DBG 'Generated Name = "' || cf_Full || '"'
if OptionDebugOn='Y' then
call DBGIND 1
call MakeDirectoryTree _filespec('drive', cf_Full) || _filespec('path',cf_Full)
if OptionDebugOn='Y' then
call DBGIND-2
return(cf_Full)

ProcessNext:call TRACE "OFF"
if OptionDebugOn='Y' then
call DBG_EVALUATE 'ProcessNext()'
if IncludeMemBufferNextLine=='' then
IncludeMemBufferNextLine=arg(1)
else
IncludeMemBufferNextLine=arg(1)||MarksNewLine||IncludeMemBufferNextLine
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 cg_Look4,cg_PathList
call DBGIND 1
if OptionDebugOn='Y' then
call DBG_EVALUATE 'Searching for "' || cg_Look4 || '" in "' || cg_PathList || '"'
if RexSystemOpSys="UNIX" then
cg_SepChar=':'
else
cg_SepChar=';'
cg_Found=''
do while cg_PathList<> ''
parse var cg_PathList cg_Path (cg_SepChar) cg_PathList
if right(cg_Path,1)<>RexDirChar then
cg_Path=cg_Path||RexDirChar
cg_Found=FileQueryExists(cg_Path||cg_Look4)
if cg_Found<> '' then
leave
end
if OptionDebugOn='Y' then
call DBG_EVALUATE 'Found "' || cg_Found || '"'
call DBGIND-1
return(cg_Found)

FindFileInPath:call TRACE "OFF"
parse arg ch_Look4,ch_LookIn
if RexSystemOpSys="UNIX" then
ch_SepChar=':'
else
ch_SepChar=';'
if OptionDebugOn='Y' then
call DBG_EVALUATE 'FindFileInPath(): Looking for "' || ch_Look4 || '" in "' || ch_LookIn || '"'
call DBGIND 1
ch_Searched=''
do while ch_LookIn<> ''
parse var ch_LookIn ch_ThisBit (ch_SepChar) ch_LookIn
if ch_ThisBit='' then
iterate
ch_Left1=left(ch_ThisBit,1)
select
when ch_Left1='*' then
do
ch_LookIn=GetEnv(substr(ch_ThisBit,2))||ch_SepChar||ch_LookIn
end
when ch_Left1='+' then
do
ch_List.0=0
ch_Mask=substr(ch_ThisBit,2)||RexDirChar|| '*.*'
call _SysFileTree ch_Mask, 'ch_List', 'DOS'
ch_Comb=''
do ch_Index=1 to ch_List.0
if ch_Index=1 then
ch_Comb=ch_List.ch_Index
else
ch_Comb=ch_Comb||ch_SepChar||ch_List.ch_Index
end
ch_LookIn=ch_Comb||ch_SepChar||ch_LookIn
end
otherwise
do
if ch_Searched='' then
ch_Searched=ch_ThisBit
else
ch_Searched=ch_Searched||ch_SepChar||ch_ThisBit
end
end
end
ch_Found=_FindFileInPathList(ch_Look4,ch_Searched)
if ch_Found<> '' then
ch_Found=FileQueryExists(ch_Found)
if OptionDebugOn='Y' then
call DBG_EVALUATE 'Result: "' || ch_Found || '"'
call DBGIND-1
return(ch_Found)

FindFile:call TRACE "OFF"
ci_Look4=arg(1)
ci_Found=''
if OptionDebugOn='Y' then
call DBG_EVALUATE 'FindFile(): Looking for "' || ci_Look4 || '"'
call DBGIND 1
if ci_Found='' then
do
call DBG_EVALUATE 'Looking in current directory'
ci_Found=QueryExists(ci_Look4)
end
if ci_Found='' then
do
do ci_Index=1 to OptionIncludePathCnt until ci_Found<> ''
ci_Found=FindFileInPath(ci_Look4,OptionIncludePath.ci_Index)
end
end
if ci_Found='' then
ci_Found=FindFileInPath(ci_Look4, '*PPWIZARD_INCLUDE')
if ci_Found='' then
ci_Found=FindFileInPath(ci_Look4, '*INCLUDE')
if ci_Found='' then
do
call DBG_EVALUATE 'Looking in same directory as PPWIZARD'
parse source . . ci_Found
ci_Found=_filespec('Location',ci_Found)||ci_Look4
if QueryExists(ci_Found)='' then
ci_Found=''
end
if ci_Found<> '' then
ci_Found=FileQueryExists(ci_Found)
if OptionDebugOn='Y' then
call DBG_EVALUATE 'Result: "' || ci_Found || '"'
call DBGIND-1
return(ci_Found)

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

SSTRIP:call TRACE "OFF"
parse arg cj_S,cj_M,cj_C
if cj_M=='' then
cj_M='B'
if cj_C=='' then
cj_C='00'x
cj_S=translate(cj_S, '', cj_C, ' ')
return(strip(cj_S,cj_M))

Add2:call TRACE "OFF"
parse arg ck_V,ck_S
if ck_S<> '' then
Add2Stem=ck_S|| '.'
if Add2Stem='' then
CryAndDie("Add to which array?")
ck_CV=Add2Stem|| '0'
if symbol(ck_CV)<> 'VAR' then
ck_C=0
else
ck_C=value(ck_CV)
ck_C=ck_C+1
call value Add2Stem||ck_C,ck_V
call value ck_CV,ck_C
return(ck_C)

QueryExists:call TRACE "OFF"
parse arg cl_File,cl_MustExist
if cl_File='' then
CryAndDie('The filename "" is invalid!')
else
do
cl_Rc=FileQueryExists(cl_File)
if cl_Rc='' & cl_MustExist = 'Y' then
CryAndDie('The filename "' || cl_File || '" does not exist!')
return(cl_Rc)
end

MustDeleteFile:call TRACE "OFF"
cm_File=arg(1)
if OptionDebugOn='Y' then
do
call DBG_EVALUATE 'MustDeleteFile(' || cm_File || ')'
call DBGIND 1
end
call FileClose cm_File
if QueryExists(cm_File)='' then
do
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 cm_File
if OptionDebugOn='Y' then
call DBGIND 1
DeleteRc=_SysFileDelete(cm_File)
if OptionDebugOn='Y' then
call DBGIND-1
if QueryExists(cm_File)<> "" then
CryAndDie('Could not delete "' || cm_File || '", it must be in use (DosRc=' || DeleteRc || ')...')
end
if OptionDebugOn='Y' then
call DBGIND-1
return

OptionGet:call TRACE "OFF"
if OptionDebugOn='Y' then
call DBG_EVALUATE 'OptionGet()'
call DBGIND 1
cn_Ans=OptionGetValue(arg(1))
call DBGIND-1
return(cn_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 co_R,co_ProtU,co_T
co_Prot=co_ProtU|| '://'
co_Pos=pos(co_Prot,co_R)
if co_Pos=0 then
return(co_R)
if co_ProtU='ftp' then
co_Valid=_ValCharsFtp
else
co_Valid=_ValCharsHttp
co_ProtL=length(co_Prot)
if co_T='' then
co_T='<a href="{URL}">{URL}</a>'
co_L=''
do until co_Pos=0
co_L=co_L||left(co_R,co_Pos-1)
co_R=substr(co_R,co_Pos)
co_Pos=verify(co_R,co_Valid, 'N')
if co_Pos=0 then
do
co_Url=co_R
co_R=''
end
else
do
co_Url=left(co_R,co_Pos-1)
co_R=substr(co_R,co_Pos)
end
co_Insert=ReplaceString(co_T, "{URL}",co_Url)
co_Insert=ReplaceString(co_Insert, "{URL-}",substr(co_Url,co_ProtL+1))
co_L=co_L||co_Insert
co_Pos=pos(co_Prot,co_R)
end
return(co_L||co_R)

TimeStamp:call TRACE "OFF"
parse arg cp_CmdList,cp_Ts
cp_AddSec=0
do while cp_CmdList<> ''
parse var cp_CmdList cp_Cmd cp_CmdList
cp_Unit=translate(right(cp_Cmd,1))
cp_Units=left(cp_Cmd,length(cp_Cmd)-1)
select
when cp_Unit='W' then
cp_CmdSec=cp_Units*604800
when cp_Unit='D' then
cp_CmdSec=cp_Units*86400
when cp_Unit='H' then
cp_CmdSec=cp_Units*3600
when cp_Unit='M' then
cp_CmdSec=cp_Units*60
when cp_Unit='S' then
cp_CmdSec=cp_Units
otherwise
cp_CmdSec=cp_Cmd
end
cp_AddSec=cp_AddSec+cp_CmdSec
end
if cp_Ts='' then
do
cp_Bd=basedate()
cp_Sec=time('S')
end
else
do
cp_Bd=basedate(left(cp_Ts,8))
parse value substr(cp_Ts,9)with cp_HH+2 cp_MM+2 cp_SS
cp_Sec=(cp_HH*3600)+(cp_MM*60)+cp_SS
end
cp_TotSec=cp_Sec+cp_AddSec
cp_PlusDay=cp_TotSec%86400
cp_Sec=cp_TotSec//86400
cp_Date=Bd2Date(cp_Bd+cp_PlusDay)
cp_HH=right(cp_Sec%3600,2, '0')
cp_Sec=cp_Sec//3600
cp_MM=right(cp_Sec%60,2, '0')
cp_Sec=cp_Sec//60
cp_SS=right(cp_Sec,2, '0')
return(cp_Date||cp_HH||cp_MM||cp_SS)

ArraySplit:call TRACE "OFF"
parse arg cq_Stem,cq_Value,cq_Del,cq_Spaces,cq_KeepBlank
cq_Stem=cq_Stem|| '.'
if cq_Del=='' then
cq_Del=' '
if cq_Spaces='' then
cq_Spaces='B'
cq_Cnt=0
do while cq_Value\==''
parse var cq_Value cq_Before (cq_Del) cq_Value
if cq_Spaces<> 'K' then
do
if cq_Spaces='BM' then
cq_Before=space(cq_Before)
else
cq_Before=strip(cq_Before,cq_Spaces)
end
if cq_Before='' then
do
if cq_KeepBlank<> 'Y' then
iterate
end
cq_Cnt=cq_Cnt+1
call _valueS cq_Stem||cq_Cnt,cq_Before
end
call _valueS cq_Stem|| '0',cq_Cnt
return(cq_Cnt)

ArrayRemoveDup:
parse arg cr_Stem,cr_MaxInRow
if cr_MaxInRow='' then
cr_MaxRpt=0
else
cr_MaxRpt=cr_MaxInRow-1
cr_Stem=cr_Stem|| '.'
cr_End=value(cr_Stem|| '0')
cr_DstI=0
cr_Last=''
cr_RepeatCnt=0
do cr_SrcI=1 to cr_End
cr_Value=value(cr_Stem||cr_SrcI)
if cr_Value\==cr_Last then
cr_RepeatCnt=0
else
do
if cr_SrcI<>1 then
do
cr_RepeatCnt=cr_RepeatCnt+1
if cr_RepeatCnt>cr_MaxRpt then
iterate
end
end
cr_Last=cr_Value
cr_DstI=cr_DstI+1
call value cr_Stem||cr_DstI,cr_Value
end
call value cr_Stem|| '0',cr_DstI
return(cr_DstI)

ArrayTranslate:
parse arg cs_Stem,cs_Spaces,cs_Case
cs_Stem=cs_Stem|| '.'
if cs_Spaces='' then
cs_Spaces='B'
cs_End=value(cs_Stem|| '0')
do cs_SrcI=1 to cs_End
cs_Value=value(cs_Stem||cs_SrcI)
if cs_Spaces<> 'K' then
do
if cs_Spaces='BM' then
cs_Value=space(cs_Value)
else
cs_Value=strip(cs_Value,cs_Spaces)
end
if cs_Case<> '' then
do
if cs_Case='L' then
cs_Value=ToLowerCase(cs_Value)
else
cs_Value=translate(cs_Value)
end
call value cs_Stem||cs_SrcI,cs_Value
end
return(cs_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)

SortArray:

ArraySort:call TRACE "OFF"
if OptionDebugOn='Y' then
call DBG_EVALUATE 'ArraySort()'
parse arg bsArray,bsStartCol,bsEndCol,bsStrict
bsArray=translate(bsArray)|| '.'
if bsStartCol='' then
bsStartCol=0
else
do
if bsEndCol='' then
bsLength=0
else
bsLength=bsEndCol-bsStartCol
end
bsM=1
bsCount=_valueG(bsArray||0)
do while(9*bsM+4)<bsCount
bsM=bsM*3+1
end
do while bsM>0
bsK=bsCount-bsM
do bsJ=1 to bsK
bsIndex1=bsJ
do while bsIndex1>0
bsIndex2=bsIndex1+bsM
if bsStartCol=0 then
do
bsVal1=_valueG(bsArray||BSINDEX1)
bsVal2=_valueG(bsArray||BSINDEX2)
end
else
do
if bsLength=0 then
do
bsVal1=substr(_valueG(bsArray||BSINDEX1),bsStartCol)
bsVal2=substr(_valueG(bsArray||BSINDEX2),bsStartCol)
end
else
do
bsVal1=substr(_valueG(bsArray||BSINDEX1),bsStartCol,bsLength)
bsVal2=substr(_valueG(bsArray||BSINDEX2),bsStartCol,bsLength)
end
end
if bsStrict='Y' then
bsGreater=bsVal1>>bsVal2
else
bsGreater=bsVal1>bsVal2
if bsGreater then
do
bsTemp=_valueG(bsArray||BSINDEX1)
call _valueS bsArray||BSINDEX1,_valueG(bsArray||BSINDEX2)
call _valueS bsArray||BSINDEX2,bsTemp
end
else
leave
bsIndex1=bsIndex1-bsM
end
end
bsM=bsM%3
end
return(bsCount)

MakeDirectoryTree:call TRACE "OFF"
WholeDirectory=arg(1)
if right(WholeDirectory,1)=RexDirChar then
WholeDirectory=left(WholeDirectory,length(WholeDirectory)-1)
if WholeDirectory='' then
return(0)
if OptionDebugOn='Y' then
do
call DBG 'MakeDirectoryTree("' || WholeDirectory || '")'
call DBGIND 1
end
if RexWhich='REGINA' then
do
if DirQueryExists(WholeDirectory)<> '' then
do
if OptionDebugOn='Y' then
do
call DBG 'Directory already exists (no need to make)'
call DBGIND-1
end
return(0)
end
end
else
do
if OptionDebugOn='Y' then
call DBG "Under OS/2 rexx we can't easily tell if directory already exists"
end
if RexSystemOpSys="DOS" then
ct_Dq=''
else
ct_Dq='"'
if RexSystemOpSys="UNIX" then
MakeDirCmd='mkdir '
else
MakeDirCmd='md '
SearchFromPosn=1
do until SlashPosn=0
SlashPosn=pos(RexDirChar,WholeDirectory,SearchFromPosn)
if SlashPosn<>1 then
do
if SlashPosn=0 then
MakeDir=WholeDirectory
else
MakeDir=left(WholeDirectory,SlashPosn-1)
DirBit=filespec('name',MakeDir)
if right(MakeDir,1)<> ':' & DirBit <> '.' & DirBit <> '..' then
do
if OptionDebugOn='N' then
call AddressCmd MakeDirCmd||ct_Dq||MakeDir||ct_Dq||AllCmdOutput2Nul()
else
do
TmpMkDirFile=RexGetTmpFileName()
call AddressCmd MakeDirCmd||ct_Dq||MakeDir||ct_Dq||RedirectStdOutAndErr2(TmpMkDirFile),TmpMkDirFile
if Rc=0 then
call DBG 'Made Directory "' || MakeDir || '"'
call _SysFileDelete TmpMkDirFile
end
end
end
SearchFromPosn=SlashPosn+1
end
if OptionDebugOn='Y' then
call DBGIND-1
return(0)

FileCopy:call TRACE "OFF"
parse arg cu_Src,cu_Dst,cu_When,cu_ContOnError
call DBG 'Copy "' || cu_Src || '" to "' || cu_Dst || '"?'
call DBGIND 1
if FileQueryExists(cu_Src)='' then
do
if cu_ContOnError<> 'Y' then
CryAndDie('The FileCopy() source file "' || cu_Src || '" does not exist...')
return(2)
end
cu_When=translate(cu_When)
cu_Do=''
select
when cu_When='' then
cu_Do='we always copy'
when cu_When='EQUAL' then
do
cu_Ss=stream(cu_Src, 'c', 'query size') || ' - ' || stream(cu_Src, 'c', 'query datetime')
if FileQueryExists(cu_Dst)='' then
cu_Ds='Destination does not exist'
else
cu_Ds=stream(cu_Dst, 'c', 'query size') || ' - ' || stream(cu_Dst, 'c', 'query datetime')
call DBG 'Want files EQUAL...'
call DBGIND 1
call DBG 'SRC: ' ||cu_Ss
call DBG 'DST: ' ||cu_Ds
call DBGIND-1
if cu_Ss<>cu_Ds then
cu_Do='files unequal'
end
otherwise
CryAndDie('Unknown FileCopy() mode of "' || cu_When || '"')
end
if cu_Do<> '' then
call DBG 'Source will be copied as ' ||cu_Do
else
do
call DBG 'The source does not need copying'
call DBGIND-1
return(0)
end
call AddInputFileToDependancyList cu_Src
call AddOutputFileToDependancyList cu_Dst
cu_QSD='"' || cu_Src || '" "' || cu_Dst || '"'
select
when RexSystemOpSys="UNIX" then
cu_CpyS='cp --force --verbose'
when RexSystemOpSys="WIN32" then
cu_CpyS='copy /Y /B'
when RexSystemOpSys="OS/2" then
cu_CpyS='copy'
otherwise
cu_CpyS='copy'
end
CopyCmd=cu_CpyS|| ' ' ||cu_QSD
TmpMkDirFile=RexGetTmpFileName()
cu_CpyRc=AddressCmd(CopyCmd||RedirectStdOutAndErr2(TmpMkDirFile),TmpMkDirFile)
call _SysFileDelete TmpMkDirFile
if cu_CpyRc=0 then
call DBG 'File successfully copied'
else
do
call DBG 'Copy failed'
if cu_ContOnError<> 'Y' then
CryAndDie('File copy failed (Rc=' || cu_CpyRc || ')!', 'From: "' || cu_Src || '"', 'To  : "' || cu_Dst || '"')
end
call DBGIND-1
return(cu_CpyRc)

QuoteIt:call TRACE "OFF"
if OptionDebugOn='Y' then
call DBG_EVALUATE 'QuoteIt()'
parse arg cv_Q4,cv_TryQ,cv_RetQuotedStr
if cv_RetQuotedStr='' then
cv_RetQuotedStr='N'
if cv_TryQ='' then
cv_TryQ='"' || "'"
else
do
if translate(cv_TryQ)='ANY' then
cv_TryQ=TryQuoteListAny
end
TryQuoteLng=length(cv_TryQ)
do cv_I=1 to TryQuoteLng
cv_PosQ=substr(cv_TryQ,cv_I,1)
if pos(cv_PosQ,cv_Q4)=0 then
do
if cv_RetQuotedStr='N' then
return(cv_PosQ)
else
return(cv_PosQ||cv_Q4||cv_PosQ)
end
end
CryAndDie('QuoteIt(): Could not find safe quote for ' ||DebugRightArrow||cv_Q4||DebugLeftArrow)

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

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

Evaluate_40:
TraceBpListsLoaded=''
TraceAutoAliasCnt=0
TraceAutoAliasMax=0
signal ExecCmd_41

ExecRexxCmd:
InterpretThisAsPassed=arg(1)
if RexWhich='REGINA' then
UseEos=MarksNewLine
else
UseEos=';'
InterpretThisC=ReplaceEos(InterpretThisAsPassed)
InterpretThis=InterpretThisC
TraceBreakPoint=''
PrevTracedLine=''
if OptionDebugOn='Y' then
do
call DBG_INTERPRET 'Interpreting ' ||DebugRightArrow||InterpretThisC||DebugLeftArrow
call DBG_INTERPRET 'Rexx code is ' || AddCommasToDecimalNumber(length(InterpretThisC)) || ' bytes long'
if bitand(DebugLevel,SeeRexxTrace)==SeeRexxTrace then
do
if RexWhich='REGINA' then
TrcDef='OFF'
else
TrcDef='INTERMEDIATES'
TraceLevel4Rexx=translate(CfgMacro('REXXTRACE',TrcDef))
if TraceLevel4Rexx<> 'OFF' then
InterpretThis='TRACE ' || TraceLevel4Rexx || ';' || InterpretThisC || ';call TRACE "OFF";'
TraceBreakPoint=strip(CfgMacro('REXX_BP', ''))
if TraceBreakPoint='' then
TraceBpList=''
else
do
if length(TraceBreakPoint)>1&left(TraceBreakPoint,1)='=' then
do
TraceBreakPoint='=' ||MacroGet(strip(substr(TraceBreakPoint,2)))
TraceBreakPoint=ReplaceEos(PerformReplacementsInCmdsParameters(TraceBreakPoint))
end
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
TraceBpList=CfgMacro('REXX_BP_ALIAS', '')
if TraceBpList<>TraceBpListsLoaded then
TraceBpListsLoaded=''
end
call Line1 ''
call Line1 '---------- REXX TRACE - START(' || TraceLevel4Rexx || ') ----------'
end
end
signal ON SYNTAX NAME _SyntaxErrorDuringInterpret
signal ON NOVALUE NAME _UnknownVariableDuringInterpret
interpret InterpretThis
TraceBreakPoint=''
if OptionDebugOn='Y' then
do
if bitand(DebugLevel,SeeRexxTrace)==SeeRexxTrace then
do
call Line1 '---------- REXX TRACE - END(' || TraceLevel4Rexx || ') ----------'
call Line1 ''
end
end
return

_UnknownVariableDuringInterpret:
TrappingLine=SIGL
call TRACE "OFF"
call CommonTrapHandler TrappingLine, 'NoValue Abort!', 'Unknown Variable', condition('D'),space(InterpretThisAsPassed),TraceBreakPoint

_SyntaxErrorDuringInterpret:
TrappingLine=SIGL
call TRACE "OFF"
call CommonTrapHandler TrappingLine, 'Syntax Error!', 'Reason',errortext(Rc),space(InterpretThisAsPassed),TraceBreakPoint

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

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

RexxTrace:call TRACE "OFF"
if OptionDebugOn='N' then
return
if bitand(DebugLevel,SeeRexxTrace)\==SeeRexxTrace then
return
signal on NOVALUE name RexxTrapUninitializedVariable
signal on SYNTAX name RexxTrapSyntaxError
parse arg rtText,rtDumpList,rtDbgCmd,rtDbgTrapped
rtSay='$TRACE: ' ||rtText
call Line1 PpwRexxTraceColor||rtSay||Reset
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 InterpretThisC, '', '', 'TraceVarSay'
end
end
end
call Line1 ''
if 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'
call ExecuteUsersTraceCmd substr(TraceBreakPoint,2)
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
do forever
call charout,InfoColor|| '<' || '$TRACE, ' || BpAliasCnt || ' aliases> ' ||Reset
rtCmd=strip(linein())
if rtCmd='' then
return
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 Line1 HighlightColor||STxt||Reset
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 Line1 ErrorColor|| '#Alias "#' || rtAliasI || '" does not exist!' ||Reset||Beep
iterate
end
rtAliasI=(TraceAutoAliasCnt-rtAliasI)+1
rtCmd=Aalias.rtAliasI
end
else
do
rtCmd=FindBpAlias(rtAlias)
if rtCmd='' then
do
call Line1 ErrorColor|| 'Alias "' || rtAlias || '" not found!' ||Reset||Beep
iterate
end
end
call Line1 HighlightColor||rtCmd||Reset
call ExecuteUsersTraceCmd rtCmd
end
end
when left(rtCmd,1)='?' then
do
rtCmdU=substr(rtCmdU,2)
call Char1 PpwRexxTraceColor
select
when rtCmdU='' then
do
call Line1 PpwRexxTraceColor||rtText||Reset
end
when abbrev('VARIABLES',rtCmdU)then
do
call Line1 'ALL KNOWN VARIABLES'
call Line1 '~~~~~~~~~~~~~~~~~~~'
call DumpVarsInExpression InterpretThisC, '', '', 'TraceVarSay'
end
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
call Line1 ErrorColor|| 'No commands have been remembered yet!' ||Reset||Beep
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
otherwise
call Line1 ErrorColor|| 'Unknown ? command of "' || rtCmd || '"!' ||Reset||Beep
end
call Char1 Reset
end
when rtCmdU='BP' then
do
call charout,InfoColor|| "New Breakpoint (blank = none) => " ||Reset
TraceBreakPoint=strip(linein())
end
otherwise
do
if ExecuteUsersTraceCmd(rtCmd)=0 then
do
if AddAutoAlias(rtCmd)<>0 then
call SaveBpAliasFile
end
end
end
end
return

TraceVarSay:
call Line1 PpwRexxTraceColor|| "      | " ||arg(1)||Reset
call AddToBpSearch arg(1)
return

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

_SyntaxErrorDuringExecuteUsersTraceCmd:
call Line1 ErrorColor|| 'SYNTAX ERROR: ' ||errortext(Rc)||Reset
call Line1 Beep
return(1)

_UnknownVariableDuringExecuteUsersTraceCmd:
call Line1 ErrorColor|| 'NOVALUE ERROR: VAR=' || condition('D')||Reset
call Line1 Beep
return(1)

LoadBpLists:
if TraceBpListsLoaded<> '' then
return
BpSaveTo=''
BpList=TraceBpList
BpAliasCnt=0
BpFileNumb=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
BpListLine=0
BpLongestAlias=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_41:
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 cx_N,cx_V
cx_XN='XVAR?.X?' ||c2x(translate(cx_N))
call _valueS cx_XN,cx_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")),RexEOL
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"

ReplaceXCodesIfNotDisabled:
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_42

InitOnExitProcessing:
OnExitCnt=0
LinesFromOnExit='N'
do cy_I=1 to 100
OnExitLst.cy_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
cy_All=''
do cy_I=1 to 100
cy_Txt=OnExitLst.cy_I
if cy_Txt\=='' then
do
call DBG 'FROM: ' ||OnExitLoc.cy_I
call DBGIND 1
call DBG 'SLOT #' || cy_I || ': ' ||cy_Txt
call DBGIND-1
if cy_All='' then
cy_All=cy_Txt
else
cy_All=cy_All||MarksNewLine||cy_Txt
end
end
call DBGIND-1
IncludeMemBufferNextLine=cy_All
LinesFromOnExit='Y'
OnExitCnt=0
return('Y')
end
end
return('N')

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

OnExit_42:
IncludeIntoMemory=''
signal Include_43

RecursiveIncludeSave:
call LoopPush IncludeLevel
_DebugCurrentFileNumber.IncludeLevel=DebugCurrentFileNumber
_IncludeMemHandle.IncludeLevel=IncludeMemHandle
_IncludeEofLine.IncludeLevel=IncludeEofLine
_IncludeFragmentText.IncludeLevel=IncludeFragmentText
_IncludeLineNumber.IncludeLevel=IncludeLineNumber
_IncludeMemBufferNextLine.IncludeLevel=IncludeMemBufferNextLine
_EofForced.IncludeLevel=EofForced
EofForced=''
return

RecursiveIncludeRestore:
DebugCurrentFileNumber=_DebugCurrentFileNumber.IncludeLevel
IncludeMemHandle=_IncludeMemHandle.IncludeLevel
IncludeEofLine=_IncludeEofLine.IncludeLevel
IncludeFragmentText=_IncludeFragmentText.IncludeLevel
IncludeLineNumber=_IncludeLineNumber.IncludeLevel
IncludeMemBufferNextLine=_IncludeMemBufferNextLine.IncludeLevel
EofForced=_EofForced.IncludeLevel
IncludeFileName=IncludeFileName.IncludeLevel
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
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 DieIfIoErrorOccurred ifFullFileName, 'Y'
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 DieIfIoErrorOccurred IncludeFileName, 'Y'
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_43:
SummaryUserAllBldCount=0
SummaryUserOverallCount=0
SummaryUserThisBldCount=0
signal Summary_44

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 Line1 TitleColor
call Line1 TitleText
call Line1 copies('~',length(TitleText))||Reset
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:
do SummLine=1 to SummaryLines
call Line1 "   " || left(SummaryL.SummLine, MaxSummaryLeft) || ': ' ||SummaryR.SummLine
end
return

Summary_44:
PpwCompTime=NiceDateTime()
PpwCompTs=TimeStamp()
if RexSystemOpSys="OS/2" then
do
call SetColorCodes
call SetBeepCode
end
else
do
call RemoveColorCodes
call SetBeepCode
end
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 ProcessCommandLine
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
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 GetListOfFiles 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 RemoveBeepCode
call RemoveColorCodes
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 GetListOfFiles 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 InputMaskCount<>0&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 ProcessingMode='' then
do
call DBG 'User did not specify what mode we are processing with, will default'
select
when AllSameExtn='X' then
call PModeSwitch "REXX"
otherwise
call PModeSwitch "HTML"
end
call DBG 'Processing all input files in "' || ProcessingMode || '" mode'
end
if NewLineChars==CrLf then
LinesEndWith="CR followed by LF"
else
LinesEndWith="LF only"
call DBG 'Output lines are terminated with ' ||LinesEndWith
if ProcessingMode='HTML' then
OptionDefaultInputName="DEFAULT.IT"
else
OptionDefaultInputName=""
if OptionDependsOn<> '' & OptionCgiModeOn = 'Y' then
UserSyntaxError("Can't do dependancy checking in CGI mode!")
if ProcessingMode<> 'HTML' & OptionCgiModeOn = 'Y' then
UserSyntaxError("Must stay in HTML mode when /CGI switch used!")
if ProcessingMode='HTML' then
call DBG 'HTML Generator Tags are ' ||DebugRightArrow||OptionHtmlGeneratorTags||DebugLeftArrow
else
OptionHtmlGeneratorTags=''
if OptionOutput='' then
do
if ProcessingMode='REXX' then
do
if RexSystemOpSys="OS/2" then
da_O='*.cmd'
else
da_O='*.rex'
end
else
do
da_O='*.htm'
end
OptionOutput=da_O
end
if OptionWantCopyright='Y' then
do
if OptionQuietDependsOn='N' then
call DisplayCopyright
end
call DebugStateChanged
if InputMaskCount=0 then
do
call DBG 'No input masks were specified (or no files matched)...'
if OptionDefaultInputName='' then
UserSyntaxError('No input files were specified!')
if FileQueryExists(OptionDefaultInputName)='' then
UserSyntaxError('No input files were specified and "' || OptionDefaultInputName || '" not found!')
InputMask.1=OptionDefaultInputName
InpFileCount=1
InpFile.InpFileCount=OptionDefaultInputName
InpFileMaskIndex.InpFileCount=1
end
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
da_Pm=InputMaskPMode.SpecIndex
if da_Pm='' then
da_Pm=LastProcessingMode
ProcessingMode=da_Pm
da_Om=InputMaskOutMask.SpecIndex
if da_Om='' then
da_Om=LastOptionOutput
OptionOutput=da_Om
da_Dm=InputMaskDepMask.SpecIndex
if da_Dm='' then
da_Dm=LastOptionDependsOn
OptionDependsOn=da_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)

SetColorCodes:
EscapeChar=d2c(27)
Reset=EscapeChar|| '[0m'
HighlightColor=EscapeChar|| '[1;35m'
TitleColor=EscapeChar|| '[0;32m'
PpwRexxTraceColor=EscapeChar|| '[0;32m'
ErrorColor=EscapeChar|| '[1;31m'
WarningColor=EscapeChar|| '[0;33m'
InfoColor=EscapeChar|| '[0;1m'
return

RemoveColorCodes:
Reset=''
HighlightColor=''
TitleColor=''
ErrorColor=''
WarningColor=''
InfoColor=''
PpwRexxTraceColor=''
return

SetBeepCode:
Beep=''
return

RemoveBeepCode:
Beep=''
return

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

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
if NeedToRemake(InFile)='N' then
return(0)
InpFileCountActuallyMade=InpFileCountActuallyMade+1
if OptionWantCopyright='Y' then
do
if OptionQuietDependsOn='Y' then
call DisplayCopyright
end
InputFileFull=QueryExists(InputFile)
db_T=value('PPWMAKING_' ||ProcessingMode)
db_T=ReplaceString(db_T, '{IS}', _filespec('N',InputFileFull))
db_T=ReplaceString(db_T, '{OS}', _filespec('N',CurrentOutFile))
db_T=ReplaceString(db_T, '{ID}', _filespec('L',InputFileFull))
db_T=ReplaceString(db_T, '{OD}', _filespec('L',CurrentOutFile))
db_T=ReplaceString(db_T, '{IL}',InputFileFull)
db_T=ReplaceString(db_T, '{OL}',CurrentOutFile)
db_T=ReplaceString(db_T, '{PM}',ProcessingMode)
call Line1 TitleColor||db_T
if ProcessingMode<> 'COPY' then
call Line1 copies('~',length(db_T))||Reset
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 StackInitForBuild
call CompletelyInitializeAutoTagState
call InitTransformationCode
call InitOutputHold
call InitializeCharCodes
call InitializeDefineRexx
call InitializeOneLine
call InitCondNlCount
call InitOnExitProcessing
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
NewestSourcefile=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
db_Rc=FileCopy(InputFileFull,CurrentOutFile, 'EQUAL')
call CreateDependancyFileFromLists
return(0)
end
OutputLevel=0
Ok2OutputHeader='Y'
call HaveNewOutputFile CurrentOutFile,,'N',ProcessingMode
do db_HI=1 to OptionHashIncludeCnt
db_This=OptionHashInclude.db_HI
call DBG '/#Include "' ||db_This
GenerateRc=GenerateRc+ProcessInputFile(db_This)
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 TransformCode<> '' then
CryAndDie('Missing #transform (end) at EOF', 'Block started at ' ||TransformStartLoc)
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')
if ProcessingMode='REXX' then
call CheckRexxModuleForSyntaxErrors
else
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)

ProcessInputFile:
RequestedFile=arg(1)
IncludeFragmentText=arg(2)
AddToDepFile=arg(3)
ForceLoadingIntoMemory=arg(4)
IncludeLineNumber=0
IncludeMemBufferNextLine=''
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
ForceLoadingIntoMemory='Y'
end
leave
end
end
if AddToDepFile<> 'N' then
call AddInputFileToDependancyList(IncludeFileName)
call OutputProcessingFileStringToScreen '',IncludeFragmentText
ThisDateTime=GetSourceFileDateTimeDieOnError(IncludeFileName)
if ThisDateTime>NewestSourcefile then
NewestSourcefile=ThisDateTime
parse value IncludeFileOpen(IncludeFileName,ForceLoadingIntoMemory)with IncludeEofLine ';' IncludeMemHandle
if MemUpdateIndex<>0 then
do
_IncludeMemHandle.MemUpdateIndex=IncludeMemHandle
_IncludeEofLine.MemUpdateIndex=IncludeEofLine
end
if IncludeFragmentText<> '' then
do
call DBG 'Looking for the start of the fragment'
do while IncludeFileLines()<>0
InputLines=InputLines+1
FileLine=IncludeFileLineIn()
if pos(IncludeFragmentText,FileLine)<>0 then
leave
end
if IncludeFileLines()=0 then
do
FT=IncludeFragmentText
LP=IncludeLineNumber
IncludeLevel=IncludeLevel-1
if IncludeLevel<>0 then
call RecursiveIncludeRestore
CryAndDie('Did not find the START of the code fragment "' || FT || '" (processed ' || AddCommasToDecimalNumber(LP) || ' lines)')
end
end
do forever
LastLineAfterMacroRep=''
select
when IncludeMemBufferNextLine\=='' then
do
if InLoop='Y' &LoopLinesFromFile=0 then
do
db_LC='{'
FileLine=GetLoopLineIntoFileLine()
end
else
do
db_LC='#'
parse var IncludeMemBufferNextLine FileLine (MarksNewLine) IncludeMemBufferNextLine
end
LastLine=FileLine
LineSrc='M'
if LinesFromOnExit='Y' then
LastFileLine=FileLine
if OptionDebugOn='Y' then
call DebugShowCurrentLineWithLineNumber FileLine,db_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
FileLine=GetLoopLineIntoFileLine()
else
do
InputLines=InputLines+1
FileLine=IncludeFileLineIn()
end
LastFileLine=FileLine
LastLine=FileLine
LineSrc='F'
if OptionDebugOn='Y' then
call DebugShowCurrentLineWithLineNumber FileLine
if IncludeFragmentText<> '' then
do
if pos(IncludeFragmentText,FileLine)<>0 then
do
call DBG 'Found the end of the fragment'
IncludeFragmentText=''
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
if IncludeMemBufferNextLine=='' then
IncludeMemBufferNextLine=FileLine
else
IncludeMemBufferNextLine=FileLine||MarksNewLine||IncludeMemBufferNextLine
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
if IncludeMemBufferNextLine=='' then
IncludeMemBufferNextLine=PartialLine
else
IncludeMemBufferNextLine=PartialLine||MarksNewLine||IncludeMemBufferNextLine
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'
if IncludeMemBufferNextLine=='' then
IncludeMemBufferNextLine=PartialLine
else
IncludeMemBufferNextLine=PartialLine||MarksNewLine||IncludeMemBufferNextLine
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
if IncludeMemBufferNextLine=='' then
IncludeMemBufferNextLine=PartialLine
else
IncludeMemBufferNextLine=PartialLine||MarksNewLine||IncludeMemBufferNextLine
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
if IncludeMemBufferNextLine=='' then
IncludeMemBufferNextLine=FileLine
else
IncludeMemBufferNextLine=FileLine||MarksNewLine||IncludeMemBufferNextLine
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 HtmlGeneratorTags<> '' then
do
FileLineU=translate(FileLine)
InsertTags=''
LookFor="<HEAD>"
TagPos=pos(LookFor,FileLineU)
if TagPos<>0 then
do
InsertTags=TagSvNewLine||HtmlGeneratorTags||TagSvNewLine
InsertAt=TagPos+length(LookFor)
end
else
do
LookFor="<BODY"
TagPos=pos(LookFor,FileLineU)
if TagPos<>0 then
do
InsertTags='<head>' || TagSvNewLine || '  ' || HtmlGeneratorTags || TagSvNewLine || '</head>' ||TagSvNewLine
InsertAt=TagPos
end
end
if InsertTags\=='' then
do
call DBG 'Found "' || LookFor || '" so inserted HTML generator tags'
FileLine=insert(InsertTags,FileLine,InsertAt-1)
FileLine=ReplaceHashAndStandardDefines(FileLine,, 'Y')
HtmlGeneratorTags=''
end
end
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
if IncludeMemBufferNextLine=='' then
IncludeMemBufferNextLine=FileLine
else
IncludeMemBufferNextLine=FileLine||MarksNewLine||IncludeMemBufferNextLine
iterate
end
end
if ExpandXLate='Y' then
do
if pos(StartsStdSymbolReplacement_x,FileLine)<>0 then
FileLine=ReplaceTheXCodesWeKnowExist(FileLine)
end
end
if TransformCode<> '' then
do
BeforeLine=FileLine
FileRest=FileLine
FileAfter=''
AppendWith=''
do until FileRest==''
parse var FileRest FileLine (MarksNewLine) FileRest
call ExecRexxCmd TransformCode
FileAfter=FileAfter||AppendWith||FileLine
AppendWith=MarksNewLine
end
FileLine=FileAfter
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
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; call GenerateOneLine This1; end; end; end
end
end
EofForced=''
call IncludeFileClose
if IncludeFragmentText<> '' then
CryAndDie('Did not find the END of the code fragment "' || IncludeFragmentText || '"!')
IncludeLevel=IncludeLevel-1
if OptionDebugOn='Y' then
call DBG 'Finished processing the input file'
return(0)

OutputProcessingFileStringToScreen:
parse arg ProcessingWhat,ProcessingFrag
if ProcessingWhat='' then
ProcessingWhat=IncludeFileName
if ProcessingFrag<> '' then
ProcessingFrag='(' || ProcessingFrag || ')'
call Line1 copies("  ", IncludeLevel) || ' * Processing: ' ||ProcessingWhat||ProcessingFrag
return

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; 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 Line1 copies("  ", IncludeLevel) || InfoColor || '   ' || LineText || 'INFO: ' ||InfoText||Reset
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 OutputProcessingFileStringToScreen '',IncludeFragmentText
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 QueryExists(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 Char1 HighlightColor
call Line1 '[]---------------------------------------------------------[]'
call Line1 '| ' || WizName || ': Version ' || PgmVersion || ' (' || PgmAuthorEmail || ')   |'
call Line1 '| ' || PgmAuthorHomePage || '            |'
call Line1 '| (C)opyright ' || PgmAuthor || ' 1997-2001. ALL RIGHTS RESERVED. |'
call Line1 '[]---------------------------------------------------------[]'
call Line1 Reset
CopyrightDisplayed='Y'
end
return

CheckRexxInterpreter:
if RexWhich='REGINA' then
do
if pos(RexVerRegina,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)

GetCurrentDirectory:
if RexWhich='STANDARD_OS/2' then
cwDir=directory()
else
do
cwDir=FileQueryExists('.')
cwDirRegina=cwDir
cwLength=length(cwDir)
if lastpos(RexDirChar,cwDir)=cwLength then
do
if RexSystemOpSys="UNIX" then
do
if cwDir<>RexDirChar then
cwDir=left(cwDir,cwLength-1)
end
else
do
cwColonPos=pos(':',cwDir)
if cwColonPos+1<>cwLength then
cwDir=left(cwDir,cwLength-1)
end
end
if cwDirRegina<>cwDir then
call DBG 'Regina returned "' || cwDirRegina || '" for current directory'
end
if OptionDebugOn='Y' then
call DBG 'Current Directory = "' || cwDir || '"'
return(cwDir)

GetListOfFiles:
parse arg glfMask,glfStem,glfFollowDirs
call DBG 'GetListOfFiles("' || glfMask || '"): Follow Directories = "' || glfFollowDirs || '"'
call DBGIND 1
call _valueS glfStem|| '.0',0
if RexxHookGetFileList='' then
do
if glfFollowDirs='N' then
glfFollowDirs=''
else
glfFollowDirs='S'
call DBG 'Using "_SysFileTree()" as "GetFileList" hook not used'
call _SysFileTree glfMask,glfStem, 'FO' ||glfFollowDirs
end
else
do
call DBG 'Not using "_SysFileTree()" as user specified use of "' || RexxHookGetFileList || '"'
glfTmpFile=RexGetTmpFileName()
call MustDeleteFile glfTmpFile
glfLocn=_filespec('Location',glfMask)
glfName=_filespec('Name',glfMask)
call CallHook "GETFILELIST",,glfLocn,glfName,glfFollowDirs,glfTmpFile
if QueryExists(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=QueryExists(CurrentLine)
if FullFile='' then
CryAndDie('"' || RexxHookGetFileList || '" specified an invalid file of "' || CurrentLine || '" on line #' ||glfLine)
glfCount=glfCount+1
call _valueS glfStem|| '.' ||glfCount,CurrentLine
end
end
call FileClose glfTmpFile
call _valueS glfStem|| '.0',glfCount
if OptionDebugOn='N' then
call MustDeleteFile glfTmpFile
end
call DBGIND-1
return

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 Char1 ErrorColor
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()
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 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 Char1 Beep||Reset
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:
dc_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 ' ||dc_Rc
if OptionCgiModeOn='N' then
do
if dc_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(dc_Rc)

ExitNowCallingAnyHandlers:
dd_Rc=arg(1)
if dd_Rc=0|dd_Rc=1 then
call _CallExitHandler PpwOnOK, "success"
else
do
call DeletingOnError
call _CallExitHandler PpwOnERROR, "failure"
end
exit(dd_Rc)

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

_ReplaceConsoleHandlers:
parse arg de_Val,de_Bef,de_Aft
de_Before='{' || de_Bef || '}'
if pos(de_Before,de_Val)<>0 then
do
if de_Aft='' then
do
call Line1 'No value known for "' || de_Before || '"' ||d2c(7)
call Sleep 3
return('')
end
de_Val=ReplaceString(de_Val,de_Before,de_Aft)
end
return(de_Val)
signal INDENT_45

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_45:

_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')

_ReportCurrentOutputFile:
call DBG 'Current Output file = "' || CurrentOutFile || '" (level ' || OutputLevel || ')'
return

HaveNewOutputFile:
df_Append=arg(3)
df_Mode=arg(4)
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 arg(2)<> '' then
CurrentOutFile=GenerateFileName(arg(1),arg(2))
else
do
CurrentOutFile=arg(1)
call MakeDirectoryTree _filespec('drive', CurrentOutFile) || _filespec('path',CurrentOutFile)
end
end
CurrentOutLine=0
do ChkIndex=1 to OutputLevel
if Output.ChkIndex.File=CurrentOutFile then
do
if df_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=CurrentOutLine
Output.OutputLevel.!Locn=CurrentSourceLocation('')
Output.OutputLevel.!PMODE=ProcessingMode
if ProcessingMode<>df_Mode then
do
call DBG 'Processing mode for "' || CurrentOutFile || '" is "' || df_Mode || '" (changed from "' || ProcessingMode || '")'
ProcessingMode=df_Mode
end
df_Hdr='Y'
if OptionCgiModeOn='N' then
do
if QueryExists(CurrentOutFile)<> "" then
do
if df_Append='Y' then
do
call DBG 'Appending to "' || CurrentOutFile || '"'
df_Hdr='N'
end
else
do
call DBG 'Deleting "' || CurrentOutFile || '"'
call MustDeleteFile CurrentOutFile
end
end
end
call AddOutputFileToDependancyList CurrentOutFile
call charout CurrentOutFile, ""
call FileClose CurrentOutFile
call _ReportCurrentOutputFile
if df_Hdr='Y' then
do
if Ok2OutputHeader='Y' then
call OutputHeaderIfWantedOrRequired
end
call OutputSyntaxCheckingHeaderIfWantedOrRequired
Output.OutputLevel.!SYNRC=OutSyntaxRc
Output.OutputLevel.!SYNCMD=OutSyntaxCmd
Output.OutputLevel.!SYNMSG=OutSyntaxMsg
return

_BackToPreviousOutput:
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
OutputLevel=OutputLevel-1
CurrentOutFile=Output.OutputLevel.File
CurrentOutLine=Output.OutputLevel.Line
OutSyntaxRc=Output.OutputLevel.!SYNRC
OutSyntaxCmd=Output.OutputLevel.!SYNCMD
OutSyntaxMsg=Output.OutputLevel.!SYNMSG
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 _ReportCurrentOutputFile
return

StoreOutHeader:
dg_Spec=arg(1)
dg_Del=left(dg_Spec,1)
parse var dg_Spec (dg_Del) dg_Extn (dg_Del) dg_S (dg_Del) dg_M (dg_Del) dg_E (dg_Del) .
dg_Key='OUTHDR_' ||c2x(dg_Extn)
call value dg_Key,dg_S|| '00'x || dg_M || '00'x||dg_E
return

StoreSyntaxCheckCode4Header:
dh_Spec=arg(1)
dh_Del=left(dh_Spec,1)
parse var dh_Spec (dh_Del) dh_Extn (dh_Del) dh_Cmd (dh_Del) dh_Rc (dh_Del) dh_Lines
dh_Key='OUTHDRSYN_' ||c2x(dh_Extn)
if dh_Cmd='' then
drop(dh_Key)
else
do
ReplaceCount=0
dh_Lines=ReplaceString(dh_Lines,dh_Del, 'FF'x)
call value dh_Key,dh_Cmd|| '00'x || dh_Rc || '00'x||dh_Lines
end
return

OutputHeaderIfWantedOrRequired:
di_CmtS=''
di_CmtM=''
di_CmtE=''
if ProcessingMode='REXX' then
do
di_CmtS=RexxCmtStart
di_CmtM=' * '
di_CmtE=' ' ||RexxCmtEnd
end
di_Extn=_filespec('EXTN',CurrentOutFile)
di_ExtnU=translate(di_Extn)
di_Key='OUTHDR_' ||c2x(di_Extn)
di_KeyU='OUTHDR_' ||c2x(di_ExtnU)
di_KeyA='OUTHDR_' || c2x('*')
if symbol(di_Key)='VAR' then
di_UseKey=di_Key
else
do
if symbol(di_KeyU)='VAR' then
di_UseKey=di_KeyU
else
do
if symbol(di_KeyA)='VAR' then
di_UseKey=di_KeyA
else
di_UseKey=''
end
end
if di_UseKey<> '' then
do
call DBG 'Output Header definition was found'
parse value value(di_UseKey)with di_CmtS '00'x di_CmtM '00'x di_CmtE
end
if di_CmtS||di_CmtM||di_CmtE\=='' then
do
if left(di_CmtS,1)='@' & di_CmtM||di_CmtE = '' then
do
di_Inc=substr(di_CmtS,2)
call DBG 'Include output header - "' ||di_Inc
if IncludeLevel=0 then
GenerateRc=GenerateRc+ProcessInputFile(di_Inc)
else
do
call RecursiveIncludeSave
GenerateRc=GenerateRc+ProcessInputFile(di_Inc)
call RecursiveIncludeRestore
end
end
else
do
call GenerateOneLine di_CmtS
call GenerateOneLine di_CmtM|| 'Generator   : PPWIZARD version ' ||PgmVersion
call GenerateOneLine di_CmtM|| '            : FREE tool for Windows, OS/2, DOS and UNIX by ' || PgmAuthor  || ' (' || PgmAuthorEmail || ')'
call GenerateOneLine di_CmtM|| '            : ' ||PgmHomePage
call GenerateOneLine di_CmtM|| "Time        : " ||space(PpwCompTime)
call GenerateOneLine di_CmtM|| "Input File  : " ||InputFile
call GenerateOneLine di_CmtM|| "Output File : " ||FileQueryExists(Output.OutputLevel.File)
call GenerateOneLine di_CmtE
call GenerateOneLine ''
end
end
if ProcessingMode='REXX' then
do
call GenerateOneLine 'if arg(1)="' || SyntaxOkText || '" then exit(' || SyntaxOkRc || ')'
call GenerateOneLine ''
end
return

OutputSyntaxCheckingHeaderIfWantedOrRequired:
OutSyntaxRc=''
OutSyntaxCmd=''
OutSyntaxMsg=''
di_Lines=''
di_Key='OUTHDRSYN_' ||c2x(di_Extn)
di_KeyU='OUTHDRSYN_' ||c2x(di_ExtnU)
di_KeyA='OUTHDRSYN_' || c2x('*')
if symbol(di_Key)='VAR' then
di_UseKey=di_Key
else
do
if symbol(di_KeyU)='VAR' then
di_UseKey=di_KeyU
else
do
if symbol(di_KeyA)='VAR' then
di_UseKey=di_KeyA
else
di_UseKey=''
end
end
if di_UseKey<> '' then
do
call DBG 'Output syntax checking header code definition was found'
parse value value(di_UseKey)with OutSyntaxCmd '00'x OutSyntaxRc '00'x di_Lines
end
if OutSyntaxCmd<> '' then
do
if left(OutSyntaxCmd,1)='@' & (OutSyntaxRc || di_Lines) = '' then
do
di_Inc=substr(OutSyntaxCmd,2)
call DBG 'Include output header - "' ||di_Inc
OutSyntaxRc=''
OutSyntaxCmd=''
OutSyntaxMsg=''
if IncludeLevel=0 then
GenerateRc=GenerateRc+ProcessInputFile(di_Inc)
else
do
call RecursiveIncludeSave
GenerateRc=GenerateRc+ProcessInputFile(di_Inc)
call RecursiveIncludeRestore
if OutSyntaxCmd='' | OutSyntaxRc = '' then
CryAndDie('You must set the rexx variables:', ' * OutSyntaxCmd', ' * OutSyntaxRc')
end
end
else
do
do while di_Lines<> ''
parse var di_Lines di_This 'FF'x di_Lines
call GenerateOneLine di_This
end
call GenerateOneLine ''
end
end
return

DoSyntaxCheckingOnFileIfEnabled:
if OutSyntaxRc='' then
return
dj_File=FileQueryExists(arg(1))
dj_Cmd=ReplaceString(OutSyntaxCmd, '{?}',dj_File)
call DBGIND 1
call DBG 'Calling stub in generated code ("' || dj_File || '")'
CheckRc='*?*'
CheckRc=AddressCmd(dj_Cmd)
if CheckRc<>OutSyntaxRc then
do
if left(OutSyntaxMsg,1)<> '-' then
CryAndDie('Probable Syntax Error detected while checking generated file', 'Got unexpected RC of "' || CheckRc || '" (expected RC of ' || OutSyntaxRc || ')', 'Error message probably visible above...', 'Error checking "' || dj_File || '"',OutSyntaxMsg)
else
do
CryAndDie(substr(OutSyntaxMsg,2))
end
end
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
dk_Parms=PerformReplacementsInCmdsParameters(arg(1))
if dk_Parms='' then
call _BackToPreviousOutput
else
do
dk_NewFile=GetQuotedText(dk_Parms, "dk_Parms")
dk_Parms=translate(dk_Parms)
dk_AsIs='N'
dk_Append='N'
Ok2OutputHeader='Y'
dk_Mode=ProcessingMode
do while dk_Parms<> ''
ThisParm=GetQuotedText(dk_Parms, "dk_Parms")
select
when ThisParm="ASIS" then
dk_AsIs='Y'
when ThisParm="NOHEADER" then
Ok2OutputHeader='N'
when ThisParm="APPEND" then
dk_Append='Y'
when ThisParm="HTML" | ThisParm = "REXX" | ThisParm = "OTHER" then
dk_Mode=ThisParm
otherwise
CryAndDie('The parameter "' || ThisParm || '" is unknown!')
end
end
call OutputHoldPushAndClear
if dk_AsIs='N' then
call HaveNewOutputFile dk_NewFile,OptionOutput,dk_Append,dk_Mode
else
call HaveNewOutputFile dk_NewFile,,dk_Append,dk_Mode
end
return(0)

GetQuotedText:
parse arg TheString,RestVarName,QuoteDel
TheString=strip(TheString, 'L')
QuoteDel=' ' ||QuoteDel
if OptionDebugOn='Y' then
do
call DBG_QUOTING 'GetQuotedText(): ' ||DebugRightArrow||TheString||DebugLeftArrow
call DBGIND 1
end
if TheString='' then
call _ErrorNoQuotedParm
QuoteChar=left(TheString,1)
if datatype(QuoteChar, 'Alphanumeric')then
do
if OptionDebugOn='Y' then
call DBG_QUOTING 'Text is unquoted'
DelPos=verify(TheString,QuoteDel, 'M')
if DelPos=0 then
do
QuotedString=TheString
TheRest=''
end
else
do
QuotedString=substr(TheString,1,DelPos-1)
TheRest=substr(TheString,DelPos)
end
end
else
do
if OptionDebugOn='Y' then
call DBG_QUOTING 'Text is quoted with ' ||DebugRightArrow||QuoteChar||DebugLeftArrow
SecondQuotePosn=pos(QuoteChar,TheString,2)
if SecondQuotePosn=0 then
call _ErrorNoEndQuote
QuotedString=substr(TheString,2,SecondQuotePosn-2)
TheRest=substr(TheString,SecondQuotePosn+1)
end
if TheRest<> '' then
do
if QuoteDel<> 'Y' then
do
if pos(left(TheRest,1),QuoteDel)=0 then
do
Line1='There is no whitespace after the 2nd quote char of "' || QuoteChar || '" (did not expect to find "' || left(TheRest, 1) || '")'
Line2='The rest of the line:'
Line3=copies(' ',8)||DebugRightArrow||TheRest||DebugLeftArrow
CryAndDie(Line1,Line2,Line3)
end
end
end
TheRest=strip(TheRest, 'L')
if RestVarName<> '' then
call _valueS RestVarName,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:
TheString=strip(arg(1))
if OptionDebugOn='Y' then
do
call DBG_QUOTING 'GetQuotedRest(): ' ||DebugRightArrow||TheString||DebugLeftArrow
call DBGIND 1
end
if TheString='' then
call _ErrorNoQuotedParm
QuoteChar=left(TheString,1)
if datatype(QuoteChar, 'Alphanumeric')then
do
QuotedString=TheString
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(TheString)
if SecondQuotePosn<2|substr(TheString,SecondQuotePosn,1)<>QuoteChar then
call _ErrorNoEndQuote
QuotedString=substr(TheString,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:
CryAndDie('Expect a quoted string, not enough parameters available!')

_ErrorNoEndQuote:
Line1='Could not find a matching end quote character of "' || QuoteChar || '"!'
Line2='Processing:'
Line3=copies(' ',8)||DebugRightArrow||TheString||DebugLeftArrow
CryAndDie(Line1,Line2,Line3)

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='=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 || ')')

_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:
dl_MinVer=_EnsureVersionY2KSafe(GetQuotedText(arg(1), 'dl_Rest'))
if dl_Rest='' then
dl_MaxVer='9999.99'
else
do
dl_MaxVer=_EnsureVersionY2KSafe(GetQuotedText(dl_Rest))
dl_Rest='"' || dl_MaxVer || '"'
end
dl_ThisVer=_EnsureVersionY2KSafe(PgmVersion)
if OptionDebugOn='Y' then
do
call DBG 'You require "' || dl_MinVer || '" - ' ||dl_Rest
call DBG 'You have    "' || dl_ThisVer || '"'
end
dl_U='You are using version "' || dl_ThisVer || '"'
if dl_ThisVer<dl_MinVer then
CryAndDie('You required at least PPWIZARD version "' || dl_MinVer || '"',dl_U)
if dl_ThisVer>dl_MaxVer then
CryAndDie('You need a PPWIZARD version EARLIER than "' || dl_MaxVer || '"',dl_U)
return(0)

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

RexxCtrlC:
LineCtrlC=SIGL
TRACE OFF
call AllFollowingOutputGoesToErrorFile
call Line1 ''
call Line1 HighlightColor||copies('=+',39)||ErrorColor
call CgiStartFatalError
call Line1 "Come on, you pressed Ctrl+C or Break didn't you!"
call CgiEndFatalError
call Line1 HighlightColor||copies('=+',39)||Reset
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('')

CommonTrapHandler:
signal on NOVALUE name SimpleRexxTrapUninitializedVariable
signal on SYNTAX name SimpleRexxTrapSyntaxError
FailingLine=arg(1)
TrapHeading=arg(2)
TextDescription=arg(3)
Text=arg(4)
CmdBeingEvaluated=arg(5)
UserBreakPoint=arg(6)
HaveCapturedTrapDetails='Y'
call AllFollowingOutputGoesToErrorFile
call Line1 ''
call Line1 HighlightColor||copies('=+',39)||ErrorColor
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()
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
CmdBeingEvaluated=ReplaceString(CmdBeingEvaluated,DefRexxSpecialSepTag, ";")
EvPrefix='Evaluating This : '
ShowThisS=CmdBeingEvaluated
if length(ShowThisS)>300 then
ShowThisS=left(ShowThisS,300)|| ' ...(Too much to show all)'
CmdSepL=RexEOL||copies(' ',length(EvPrefix))
ShowThisL=EvPrefix||ReplaceString(CmdBeingEvaluated, ";",CmdSepL)
ShowThisL=ReplaceString(ShowThisL, '0D'x, '')
call Line1 ShowThisS,ShowThisL
end
if RexWhich='REGINA' then
ReginaUname=' (' || uname() || ')'
else
ReginaUname=''
FailingLineText=AddCommasToDecimalNumber(FailingLine)
call Line1 'Operating System: ' ||RexSystemOpSys||ReginaUname
call Line1 'Rexx Version    : ' ||RexVersionInfo
if CmdBeingEvaluated='' then
DumpSource='Y'
else
do
DumpSource='N'
call DumpVarsInExpression CmdBeingEvaluated,, 'KNOWN VARIABLES', 'Line1'
end
if DumpSource='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 Line1 HighlightColor||copies('=+',39)||Reset
call Line1 ''
if UserBreakPoint<> '' then
do
call RexxTrace HookText,,,'Y'
end
AbnormalExit(FailingLine,HookText)

RexxTrapUninitializedVariable:
TrappingLine=SIGL
call CommonTrapHandler TrappingLine, 'NoValue Abort!', 'Unknown Variable', condition('D')

RexxTrapSyntaxError:
TrappingLine=SIGL
call CommonTrapHandler TrappingLine, 'Syntax Error!', 'Reason',errortext(Rc)

SimpleCommonTrapHandler:
if HaveCapturedTrapDetails='N' then
do
FailingLine=arg(1)
TrapHeading=arg(2)
TextDescription=arg(3)
Text=arg(4)
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, 'NoValue Abort!', 'Unknown Variable', condition('D')

SimpleRexxTrapSyntaxError:
TrappingLine=SIGL
call SimpleCommonTrapHandler TrappingLine, 'Syntax Error!', 'Reason',errortext(Rc)