home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 5 Edit / 05-Edit.zip / ppw99329.zip / ppwizard.cmd < prev    next >
OS/2 REXX Batch file  |  1999-11-25  |  246KB  |  9,074 lines

  1. /*
  2.  * Generator   : PPWIZARD version 99.325
  3.  *             : FREE tool for OS/2, Windows, DOS and UNIX by Dennis Bareis (dbareis@labyrinth.net.au)
  4.  *             : http://www.labyrinth.net.au/~dbareis/ppwizard.htm
  5.  * Time        : Thursday, 25 Nov 1999 6:06:02pm
  6.  * Input File  : E:\DB\PROJECTS\OS2\ppwizard\PPWIZARD.X
  7.  * Output File : .\OUT\ppwizard.cmd
  8.  */
  9.  
  10. if arg(1)="!CheckSyntax!" then exit(21924)
  11.  
  12. PgmVersion="99.329"
  13. SupportedReginaVersions='0.08F, 0.08G or 0.08H'
  14. PpwStartSec=(time('S') || substr(time('L'),9,3))
  15. TrapHandler=''
  16. Dummy=time('Reset')
  17. b2rNewSingleQuote="' || " || '"' || "'" || '" || ' || "'"
  18. b2rAllHexCodes=''
  19. b2rAllAsciiCodes=''
  20. do b2rCharCode=0 to 31
  21. b2rAllHexCodes=b2rAllHexCodes||d2c(b2rCharCode)
  22. end
  23. do b2rCharCode=32 to 126
  24. b2rAllAsciiCodes=b2rAllAsciiCodes||d2c(b2rCharCode)
  25. end
  26. do b2rCharCode=127 to 255
  27. b2rAllHexCodes=b2rAllHexCodes||d2c(b2rCharCode)
  28. end
  29. signal EndBIN2REXPXh
  30.  
  31. _QuoteAscii:
  32. b2rAscii2Quote=arg(1)
  33. if pos("'",b2rAscii2Quote)=0 then
  34. return("'" || b2rAscii2Quote || "'")
  35. else
  36. do
  37. if pos('"',b2rAscii2Quote)=0 then
  38. return('"' || b2rAscii2Quote || '"')
  39. else
  40. do
  41. return("'" || ReplaceString(b2rAscii2Quote, "'", b2rNewSingleQuote) || "'")
  42. end
  43. end
  44.  
  45. _FormatHex:
  46. b2rHexString=arg(1)
  47. b2rLengthHex=length(b2rHexString)
  48. b2rFormattedHex="'"
  49. if b2rLengthHex>7 then
  50. do
  51. b2rLeft1=left(b2rHexString,1)
  52. b2rLeft1Pos=verify(b2rHexString,b2rLeft1)
  53. if b2rLeft1Pos=0 then
  54. return( "copies('" || c2x(b2rLeft1) || "'x, " || b2rLengthHex || ")" )
  55. else
  56. do
  57. if b2rLeft1Pos>7 then
  58. do
  59. b2rFormattedHex="copies('" || c2x(b2rLeft1) || "'x, " || b2rLeft1Pos-1 || ") || '"
  60. b2rHexString=substr(b2rHexString,b2rLeft1Pos)
  61. b2rLengthHex=b2rLengthHex-(b2rLeft1Pos-1)
  62. end
  63. end
  64. end
  65. do b2rCharPosn=1 to b2rLengthHex
  66. if(b2rCharPosn//8)=1 then
  67. do
  68. if b2rCharPosn<>1 then
  69. b2rFormattedHex=b2rFormattedHex|| ' '
  70. end
  71. b2rFormattedHex=b2rFormattedHex||c2x(substr(b2rHexString,b2rCharPosn,1))
  72. end
  73. b2rFormattedHex=b2rFormattedHex|| "'x"
  74. return(b2rFormattedHex)
  75.  
  76. _QuoteAsciiBreakIfRequired:
  77. qabAscii=arg(1)
  78. qabLength=length(qabAscii)
  79. qabReturn=''
  80. do while qabLength>256
  81. qabLeft=left(qabAscii,256)
  82. qabAscii=substr(qabAscii,256+1)
  83. qabLength=qabLength-256
  84. if qabReturn='' then
  85. qabReturn=_QuoteAscii(qabLeft)
  86. else
  87. qabReturn=qabReturn|| " || " ||_QuoteAscii(qabLeft)
  88. end
  89. if qabLength=0 then
  90. return(qabReturn)
  91. else
  92. do
  93. if qabReturn='' then
  94. return(_QuoteAscii(qabAscii))
  95. else
  96. return(qabReturn|| " || " ||_QuoteAscii(qabAscii))
  97. end
  98.  
  99. _FormatHexBreakIfRequired:
  100. fhbHex=arg(1)
  101. fhbLength=length(fhbHex)
  102. fhbReturn=''
  103. do while fhbLength>80
  104. fhbLeft=left(fhbHex,80)
  105. fhbHex=substr(fhbHex,80+1)
  106. fhbLength=fhbLength-80
  107. if fhbReturn='' then
  108. fhbReturn=_FormatHex(fhbLeft)
  109. else
  110. fhbReturn=fhbReturn|| " || " ||_FormatHex(fhbLeft)
  111. end
  112. if fhbLength=0 then
  113. return(fhbReturn)
  114. else
  115. do
  116. if fhbReturn='' then
  117. return(_FormatHex(fhbHex))
  118. else
  119. return(fhbReturn|| " || " ||_FormatHex(fhbHex))
  120. end
  121.  
  122. BIN2REXP:
  123. call BIN2REXP_START
  124. b2rValue=arg(1)
  125. b2rValueLength=length(b2rValue)
  126. if b2rValueLength=0 then
  127. call BIN2REXP_ONEBIT '""'
  128. else
  129. do
  130. do while b2rValue\==''
  131. b2rEndAsciiPos=verify(b2rValue,b2rAllAsciiCodes)
  132. if b2rEndAsciiPos=0 then
  133. do
  134. call BIN2REXP_ONEBIT _QuoteAsciiBreakIfRequired(b2rValue)
  135. b2rValue=''
  136. end
  137. else
  138. do
  139. if b2rEndAsciiPos<>1 then
  140. do
  141. call BIN2REXP_ONEBIT _QuoteAsciiBreakIfRequired(left(b2rValue,b2rEndAsciiPos-1))
  142. b2rValue=substr(b2rValue,b2rEndAsciiPos)
  143. end
  144. else
  145. do
  146. b2rEndBinaryPos=verify(b2rValue,b2rAllHexCodes)
  147. if b2rEndBinaryPos=0 then
  148. do
  149. call BIN2REXP_ONEBIT _FormatHexBreakIfRequired(b2rValue)
  150. b2rValue=''
  151. end
  152. else
  153. do
  154. call BIN2REXP_ONEBIT _FormatHexBreakIfRequired(left(b2rValue,b2rEndBinaryPos-1))
  155. b2rValue=substr(b2rValue,b2rEndBinaryPos)
  156. end
  157. end
  158. end
  159. end
  160. end
  161. call BIN2REXP_END
  162. return
  163.  
  164. EndBIN2REXPXh:
  165. signal EndDUMPVARXh
  166.  
  167. DumpVarsInExpression:
  168. dv_RexxExp=arg(1)
  169. dv_Stem=translate(arg(2))
  170. dv_VarHeading=arg(3)
  171. dv_LineRoutine=arg(4)
  172. if dv_Stem<> '' then
  173. do
  174. dv_AutoDump='N'
  175. dv_StemDot=dv_Stem|| '.'
  176. if symbol(dv_StemDot|| '0') = 'VAR' then
  177. dv_VarCount=value(dv_StemDot|| '0')
  178. else
  179. do
  180. call _DumpVarsLineOutput 'DumpVar: Could not find "' || dv_StemDot || '0' || '"'
  181. return(0)
  182. end
  183. end
  184. else
  185. do
  186. dv_AutoDump='Y'
  187. dv_Stem='DV_VARLIST'
  188. dv_StemDot=dv_Stem|| '.'
  189. dv_VarCount=0
  190. end
  191. if dv_VarCount=0 then
  192. dv_MaxVarLng=0
  193. do while dv_RexxExp<> ''
  194. parse value strip(dv_RexxExp, 'L')with dv_1stChar+1 dv_RexxExp
  195. select
  196. when datatype(dv_1stChar, 'S')then
  197. do
  198. dv_OneVar=dv_1stChar
  199. do while dv_RexxExp<> ''
  200. parse value Strip(dv_RexxExp, 'L')with dv_1stChar+1 dv_RexxExp
  201. if datatype(dv_1stChar, 'S')then
  202. dv_OneVar=dv_OneVar||dv_1stChar
  203. else
  204. do
  205. dv_RexxExp=dv_1stChar||dv_RexxExp
  206. leave
  207. end
  208. end
  209. call _RememberDumpedVar dv_OneVar
  210. if pos('.',dv_OneVar)<>0 then
  211. do
  212. do while dv_OneVar<> ''
  213. parse var dv_OneVar dv_ThisBit '.' dv_OneVar
  214. call _RememberDumpedVar dv_ThisBit
  215. end
  216. end
  217. end
  218. when dv_1stChar='"' | dv_1stChar = "'" then
  219. do
  220. dv_EndQuotePos=pos(dv_1stChar,dv_RexxExp)
  221. if dv_EndQuotePos=0 then
  222. dv_RexxExp=''
  223. else
  224. dv_RexxExp=substr(dv_RexxExp,dv_EndQuotePos+1)
  225. end
  226. otherwise
  227. nop
  228. end
  229. end
  230. call value dv_StemDot|| '0',dv_VarCount
  231. if dv_AutoDump='Y' then
  232. call DumpVarsInExpressionNow dv_Stem,dv_VarHeading,dv_LineRoutine
  233. return(dv_VarCount)
  234.  
  235. DumpVarsInExpressionNow:
  236. dv_StemDot=arg(1)|| '.'
  237. dv_VarHeading=arg(2)
  238. dv_LineRoutine=arg(3)
  239. if symbol(dv_StemDot|| '0') = 'VAR' then
  240. dv_VarCount=value(dv_StemDot|| '0')
  241. else
  242. do
  243. call _DumpVarsLineOutput 'DumpVar: could not find "' || dv_StemDot || '0' || '"'
  244. return(0)
  245. end
  246. if dv_VarCount<>0&dv_VarHeading<> '' then
  247. do
  248. call _DumpVarsLineOutput ''
  249. call _DumpVarsLineOutput dv_VarHeading
  250. call _DumpVarsLineOutput copies('~',length(dv_VarHeading))
  251. end
  252. dv_ShowVarLng=dv_MaxVarLng
  253. if dv_MaxVarLng>30 then
  254. dv_ShowVarLng=30
  255. do dv_Index=1 to dv_VarCount
  256. dv_OneVar=value(dv_StemDot||dv_Index)
  257. if length(dv_OneVar)>=dv_ShowVarLng then
  258. ShowVar=dv_OneVar
  259. else
  260. ShowVar=right(dv_OneVar,dv_ShowVarLng)
  261. dv_OneVarValue=value(translate(dv_OneVar))
  262. if datatype(dv_OneVarValue, 'N')=0 then
  263. do
  264. call BIN2REXP dv_OneVarValue
  265. dv_OneVarValue=dv_Value
  266. end
  267. call _DumpVarsLineOutput ShowVar|| ' = ' ||dv_OneVarValue
  268. end
  269. return
  270.  
  271. _RememberDumpedVar:
  272. dv_ThisVar=arg(1)
  273. if symbol(dv_ThisVar)='VAR' then
  274. do
  275. dv_AlreadyHave='N'
  276. dv_ThisVarUpper=translate(dv_ThisVar)
  277. do dv_Index=1 to dv_VarCount
  278. if dv_ThisVarUpper=translate(value(dv_StemDot||dv_Index))then
  279. do
  280. dv_AlreadyHave='Y'
  281. leave
  282. end
  283. end
  284. if dv_AlreadyHave='N' then
  285. do
  286. dv_VarCount=dv_VarCount+1
  287. call value dv_StemDot||dv_VarCount,dv_ThisVar
  288. if length(dv_ThisVar)>dv_MaxVarLng then
  289. dv_MaxVarLng=length(dv_ThisVar)
  290. end
  291. end
  292. return
  293.  
  294. _DumpVarsLineOutput:
  295. if dv_LineRoutine='' then
  296. say arg(1)
  297. else
  298. interpret 'call ' || dv_LineRoutine || ' arg(1)'
  299. return
  300.  
  301. BIN2REXP_START:
  302. dv_Value=''
  303. return
  304.  
  305. BIN2REXP_ONEBIT:
  306. if dv_Value<> '' then
  307. dv_Value=dv_Value|| ' || '
  308. dv_Value=dv_Value||arg(1)
  309. return
  310.  
  311. BIN2REXP_END:
  312. return
  313.  
  314. EndDUMPVARXh:
  315. HaveCapturedTrapDetails='N'
  316. MacroBeingExpanded=''
  317. LastLineAfterMacroRep=''
  318. LastFileLine=''
  319. LastLine=''
  320. signal on NOVALUE name SimpleRexxTrapUninitializedVariable
  321. signal on SYNTAX name SimpleRexxTrapSyntaxError
  322. TrapHandler='SIMPLE'
  323. MyBaseHomeDir="http://www.labyrinth.net.au/~dbareis/"
  324. PgmHomePage=MyBaseHomeDir|| "ppwizard.htm"
  325. PgmAuthorHomePage=MyBaseHomeDir|| "index.htm"
  326. PgmAuthor="Dennis Bareis"
  327. PgmAuthorEmail="dbareis@labyrinth.net.au"
  328. ExpressionKilledUs=''
  329. SyntaxOkRc=21924
  330. SyntaxOkText='!CheckSyntax!'
  331. CopyrightDisplayed='N'
  332. CurrentOutFile=''
  333. IncludeLevel=0
  334. CgiOutputFile=''
  335. OptionCgiModeOn='N'
  336. DoOnExit=''
  337. TryQuoteListAny='"' || "'" || '^~!@#$%&*-+=?./\|`:' || xrange('DB'x, 'FE'x) || xrange('80'x, 'DA'x)
  338. TryQuoteListSd="'" || '"'
  339. TryQuoteListDs='"' || "'"
  340. OnExitSleepFor=0
  341. call RemoveColorCodes
  342. call RemoveBeepCode
  343. if translate(strip(arg(1)))='DEBUG' then
  344. call DisplayCopyright
  345. /*
  346. *REXSYSTM.XH Version 99.275 By Dennis Bareis
  347. *http://www.labyrinth.net.au/~dbareis/index.htm(db0@anz.com)
  348. */
  349. parse version RexVersionInfo
  350. if pos('REGINA',translate(RexVersionInfo))<>0 then
  351. do
  352. RexWhich='REGINA'
  353. parse value translate(RexVersionInfo)with . 'REGINA_' RexVerRegina ' '
  354. RexVerRegina=translate(RexVerRegina, '.', '_')
  355. end
  356. else
  357. do
  358. RexVerRegina=''
  359. RexWhich='STANDARD_OS/2'
  360. end
  361. parse source RexSystemOpSys .
  362. if RexSystemOpSys="WIN32" then
  363. do
  364. parse value uname()with RexSystemOpSys .
  365. if RexSystemOpSys<> "WIN95" & RexSystemOpSys <> "WIN98" & RexSystemOpSys <> "WINNT" then
  366. do
  367. call RexSystemFailure 'Regina uname() returned "' || uname() || '" (expected WIN95, WIN98 or WINNT)'
  368. end
  369. end
  370. RexSystmRexxPgmName='?';RexSystmRexxPgmName=RexGetFullSourceName()
  371. if arg(2)<> '' then
  372. call RexSystemFailure 'ARG(2) contains unexpected data of ' || arg(2) || '.'
  373. if translate(strip(arg(1)))='DEBUG' then
  374. do
  375. call RexDumpSystemInfo
  376. exit(0)
  377. end
  378. if RexWhich='STANDARD_OS/2' then
  379. do
  380. call RxFuncAdd 'SysSleep',        'RexxUtil', 'SysSleep'
  381. call RxFuncAdd 'SysFileDelete',   'RexxUtil', 'SysFileDelete'
  382. call RxFuncAdd 'SysSearchPath',   'RexxUtil', 'SysSearchPath'
  383. call RxFuncAdd 'SysFileTree',     'RexxUtil', 'SysFileTree'
  384. call RxFuncAdd 'SysTempFileName', 'RexxUtil', 'SysTempFileName'
  385. call SetLocal
  386. RexEnvVarPool='OS2ENVIRONMENT'
  387. RexStdoutStream='STDOUT'
  388. RexStderrStream='STDERR'
  389. RexTmpFileCntr=random(90000)
  390. end
  391. else
  392. do
  393. OPTIONS 'NOEXT_COMMANDS_AS_FUNCS'
  394. numeric digits 11
  395. RexEnvVarPool='SYSTEM'
  396. RexStdoutStream='<stdout>'
  397. RexStderrStream='<stderr>'
  398. end
  399. if RexSystemOpSys<> "UNIX" then
  400. do
  401. RexDirChar='\'
  402. RexOptionChar='/'
  403. end
  404. else
  405. do
  406. RexDirChar='/'
  407. RexOptionChar='-'
  408. end
  409. signal REXSYSTM_1;
  410.  
  411. RexDumpSystemInfo:
  412. say 'Program Name  : ' ||RexSystmRexxPgmName
  413. say 'Op System     : ' ||RexSystemOpSys
  414. say 'Rexx Ver      : ' ||RexVersionInfo
  415. say 'Which System  : ' ||RexWhich
  416. if RexWhich='REGINA' then
  417. say 'regina uname(): ' ||uname()
  418. return
  419.  
  420. RexNeedReginaWorkAround:
  421. if RexWhich='STANDARD_OS/2' then
  422. return('N')
  423. else
  424. return('Y')
  425.  
  426. RexGetFullSourceName:
  427. parse source . . TmpRexxSrc
  428. if RexWhich='REGINA' then
  429. TmpRexxSrc=stream(strip(TmpRexxSrc), 'c', 'query exists')
  430. if TmpRexxSrc='' then
  431. call RexSystemFailure 'Could not determine the name of the rexx program!'
  432. return(TmpRexxSrc)
  433.  
  434. RexQueryExists:
  435. if arg(1)='' then
  436. return('')
  437. else
  438. return(stream(arg(1), 'c', 'query exists'))
  439.  
  440. RexGetNameOfTmpDir:call TRACE "OFF"
  441. TmpDir=strip(GetEnv('TMP'))
  442. if TmpDir='' then
  443. TmpDir=strip(GetEnv('TEMP'))
  444. if TmpDir='' then
  445. do
  446. if RexSystemOpSys="UNIX" then
  447. TmpDir='/tmp'
  448. end
  449. if right(TmpDir,1)==RexDirChar then
  450. TmpDir=left(TmpDir,length(TmpDir)-1)
  451. return(TmpDir)
  452.  
  453. Stderr2:
  454. if RexSystemOpSys="DOS" | RexSystemOpSys = "WIN95" | RexSystemOpSys = "WIN98" then
  455. return('')
  456. else
  457. return(' 2>' ||arg(1))
  458.  
  459. AddressCmd:call TRACE "OFF"
  460. SysCmd2Exec=arg(1)
  461. if RexWhich='STANDARD_OS/2' then
  462. SysCmd2Exec='@' ||SysCmd2Exec
  463. call DebugAddressCmdBefore SysCmd2Exec
  464. SysCmd2Exec
  465. SysCmdRc=Rc
  466. FileIndex=2
  467. SysCmdFile=arg(FileIndex)
  468. do while SysCmdFile<> ''
  469. call DebugAddressCmdOutput SysCmdFile, 'H1'
  470. call DebugAddressCmdOutput copies('~', length(SysCmdFile)), 'H2'
  471. if stream(SysCmdFile, 'c', 'query exists') = '' then
  472. call DebugAddressCmdOutput '*File does not exist*',     '!'
  473. else
  474. do
  475. SysCmdLine=0
  476. CloseRc=stream(SysCmdFile, 'c', 'close')
  477. do while lines(SysCmdFile)<>0
  478. SysCmdLine=SysCmdLine+1
  479. call DebugAddressCmdOutput linein(SysCmdFile),SysCmdLine
  480. end
  481. CloseRc=stream(SysCmdFile, 'c', 'close')
  482. end
  483. FileIndex=FileIndex+1
  484. SysCmdFile=arg(FileIndex)
  485. end
  486. call DebugAddressCmdAfter SysCmdRc
  487. Rc=SysCmdRc
  488. return(SysCmdRc)
  489.  
  490. _filespec:call TRACE "OFF"
  491. fsCmd=translate(arg(1))
  492. select
  493. when fsCmd='D' | fsCmd = 'DRIVE' then
  494. do
  495. if RexSystemOpSys="UNIX" then
  496. return('')
  497. fsPos=pos(':',arg(2))
  498. if fsPos=0 then
  499. return('')
  500. else
  501. return(left(arg(2),fsPos))
  502. end
  503. when fsCmd='P' | fsCmd = 'PATH' then
  504. do
  505. fsStartWith=substr(arg(2),length(_filespec('D',arg(2)))+1)
  506. fsPos=lastpos(RexDirChar,fsStartWith)
  507. if fsPos=0 then
  508. return('')
  509. else
  510. return(left(fsStartWith,fsPos))
  511. end
  512. when fsCmd='N' | fsCmd = 'NAME' then
  513. do
  514. return(substr(arg(2),length(_filespec('L',arg(2)))+1))
  515. end
  516. when fsCmd='L' | fsCmd = 'LOCATION' then
  517. do
  518. return(_filespec('D', arg(2)) || _filespec('P',arg(2)))
  519. end
  520. when fsCmd='E' | fsCmd = 'EXTN' then
  521. do
  522. fsDotPos=lastpos('.',arg(2))
  523. if fsDotPos=0 then
  524. return('')
  525. else
  526. return(substr(arg(2),fsDotPos+1))
  527. end
  528. when fsCmd='W' | fsCmd = 'WITHOUTEXTN' then
  529. do
  530. fsDotPos=lastpos('.',arg(2))
  531. if fsDotPos=0 then
  532. return(arg(2))
  533. else
  534. return(left(arg(2),fsDotPos-1))
  535. end
  536. otherwise
  537. call RexSystemFailure 'Unknown _filespec() command of "' || arg(1) || '"'
  538. end
  539. return
  540.  
  541. _SysSleep:call TRACE "OFF"
  542. if RexWhich='STANDARD_OS/2' then
  543. do
  544. call SysSleep arg(1)
  545. return
  546. end
  547. call sleep arg(1)
  548. return
  549.  
  550. _SysSearchPath:call TRACE "OFF"
  551. if RexWhich='STANDARD_OS/2' then
  552. return(SysSearchPath(arg(1),arg(2)))
  553. SspPath=GetEnv(arg(1))
  554. if SspPath='' then
  555. return('')
  556. if RexSystemOpSys="UNIX" then
  557. SspChar=':'
  558. else
  559. SspChar=';'
  560. do while SspPath<> ''
  561. parse var SspPath SspThisFile (SspChar) SspPath
  562. if right(SspThisFile,1)<>RexDirChar then
  563. SspThisFile=SspThisFile||RexDirChar
  564. SspThisFile=RexQueryExists(SspThisFile||arg(2))
  565. if SspThisFile<> '' then
  566. return(SspThisFile)
  567. end
  568. return('')
  569.  
  570. _SysFileTree:call TRACE "OFF"
  571. if RexWhich='STANDARD_OS/2' then
  572. return(SysFileTree(arg(1),arg(2),arg(3),arg(4),arg(5)))
  573. if pos('D',arg(3))<>0 then
  574. stfType='D'
  575. else
  576. stfType='F'
  577. TmpDirFile=RexGetTmpFileName()
  578. if RexSystemOpSys<> "UNIX" then
  579. do
  580. DirCmd='dir /B '
  581. if pos('S',arg(3))<>0 then
  582. DirCmd=DirCmd|| "/S "
  583. if stfType='F' then
  584. DirCmd=DirCmd|| "/A-D "
  585. else
  586. DirCmd=DirCmd|| "/AD "
  587. DirCmd=DirCmd||arg(1)|| ' > ' || TmpDirFile || Stderr2('&1')
  588. end
  589. else
  590. do
  591. DirCmd='find ' || _filespec('L', arg(1)) || ' -noleaf '
  592. if pos('S',arg(3))=0 then
  593. DirCmd=DirCmd|| '-maxdepth 1 '
  594. if stfType='F' then
  595. DirCmd=DirCmd|| "-type f "
  596. else
  597. DirCmd=DirCmd|| "-type d "
  598. stfSName=_filespec('N',arg(1))
  599. if stfSName<> '' then
  600. DirCmd=DirCmd|| '-name "' || stfSName || '"'
  601. DirCmd=DirCmd|| ' >& ' ||TmpDirFile
  602. end
  603. Rc=AddressCmd(DirCmd,TmpDirFile)
  604. LastSlash=lastpos(RexDirChar,arg(1))
  605. CloseRc=stream(TmpDirFile, 'c', 'close')
  606. TmpLine=0
  607. do while lines(TmpDirFile)<>0
  608. AFile=linein(TmpDirFile)
  609. if AFile='' | AFile = '.' | AFile = '..' then
  610. iterate
  611. if RexSystemOpSys="UNIX" & stfType = 'D' then
  612. do
  613. if AFile=_filespec('L',arg(1))then
  614. iterate
  615. end
  616. if LastSlash<>0 then
  617. do
  618. if pos(RexDirChar,AFile)==0 then
  619. AFile=left(arg(1),LastSlash)||AFile
  620. end
  621. if stfType='F' then
  622. do
  623. AFile=stream(AFile, 'c', 'query exists')
  624. if AFile='' then
  625. iterate
  626. end
  627. else
  628. do
  629. if pos(' ',AFile)<>0 then
  630. iterate
  631. end
  632. TmpLine=TmpLine+1
  633. call _valueS arg(2)|| '.' ||TmpLine,strip(AFile)
  634. end
  635. CloseRc=stream(TmpDirFile, 'c', 'close')
  636. DeleteRc=_SysFileDelete(TmpDirFile)
  637. call _valueS arg(2)|| '.0',TmpLine
  638. return(0)
  639.  
  640. _SysFileDelete:call TRACE "OFF"
  641. if RexWhich='STANDARD_OS/2' then
  642. return(SysFileDelete(arg(1)))
  643. if RexSystemOpSys="DOS" | RexSystemOpSys = "WIN95" | RexSystemOpSys = "WIN98" then
  644. return(AddressCmd('if exist ' || arg(1) || ' del ' || arg(1) || ' >nul'))
  645. else
  646. do
  647. if RexSystemOpSys="UNIX" then
  648. return(AddressCmd('rm -f '  || arg(1) || ' >& /dev/null'))
  649. else
  650. return(AddressCmd('del ' || arg(1) || ' >nul' || Stderr2('&1')))
  651. end
  652.  
  653. RexGetTmpFileName:call TRACE "OFF"
  654. if arg(1)<> '' then
  655. TmpFileM=arg(1)
  656. else
  657. do
  658. if RexSystemOpSys<> "UNIX" then
  659. TmpFileM='RSTM????.TMP'
  660. else
  661. do
  662. TmpFileM=GetEnv('USER')
  663. if TmpFileM='' then
  664. TmpFileM=GetEnv('user')
  665. if TmpFileM='' then
  666. TmpFileM='?????.rstm'
  667. else
  668. TmpFileM=TmpFileM|| '_?????.rstm'
  669. end
  670. end
  671. TmpFileM=RexGetNameOfTmpDir()||RexDirChar||TmpFileM
  672. if RexWhich='STANDARD_OS/2' then
  673. do
  674. TmpFileF=SysTempFileName(TmpFileM)
  675. if TmpFileF='' then
  676. do
  677. RexTmpFileCntr=RexTmpFileCntr+1
  678. TmpFileF='C_' || right(RexTmpFileCntr, 6, '0') || '.TMP'
  679. end
  680. return(TmpFileF)
  681. end
  682. TmpRandom=right(time('S'),3)||random(99999)
  683. TmpRandomAdd=0
  684. do until stream(TmpFileA, 'c', 'query exists') = ''
  685. TmpRandomS=d2x(TmpRandom+TmpRandomAdd)
  686. TmpFileA=changestr("?????", TmpFileM, right(TmpRandom, 5, '_'))
  687. TmpFileA=changestr("????",  TmpFileA, right(TmpRandom, 4, '_'))
  688. TmpFileA=changestr("???",   TmpFileA, right(TmpRandom, 3, '_'))
  689. TmpFileA=changestr("??",    TmpFileA, right(TmpRandom, 2, '_'))
  690. TmpFileA=changestr("?",     TmpFileA, right(TmpRandom, 1, '_'))
  691. TmpRandomAdd=TmpRandomAdd+1
  692. end
  693. return(TmpFileA)
  694.  
  695. GetEnv:call TRACE "OFF"
  696. rsGetEnv=value(arg(1),,RexEnvVarPool)
  697. if rsGetEnv=='' & arg(2) = 'Y' then
  698. call RexSystemFailure 'Could not find the environment variable "' || arg(1) || '"'
  699. return(rsGetEnv)
  700.  
  701. SetEnv:call TRACE "OFF"
  702. return(value(arg(1),arg(2),RexEnvVarPool))
  703.  
  704. _valueS:call TRACE "OFF"
  705. if RexWhich='STANDARD_OS/2' then
  706. return(value(arg(1),arg(2)))
  707. return(value(translate(arg(1)),arg(2)))
  708.  
  709. _valueG:call TRACE "OFF"
  710. if RexWhich='STANDARD_OS/2' then
  711. return(value(arg(1)))
  712. return(value(arg(1)))
  713.  
  714. REXSYSTM_1:
  715. PpWizardPgmName=RexSystmRexxPgmName
  716. PpWizardOpSys=RexSystemOpSys
  717. PpwUserDescription='PPWIZARD version ' || PgmVersion || ' on ' || PpWizardOpSys ||  ', FREE tool for OS/2, Windows, DOS and UNIX by ' || PgmAuthor || ' (' || PgmHomePage || ')'
  718. PgmDefaultHtmlMetaTags='<META NAME="GENERATOR" CONTENT="' || PpwUserDescription || '">'
  719. if RexSystemOpSys<> "UNIX" then
  720. do
  721. DebugNewline=d2c(25)
  722. DebugLeftArrow=d2c(174)
  723. DebugRightArrow=d2c(175)
  724. end
  725. else
  726. do
  727. DebugNewline=d2c(165)
  728. DebugLeftArrow='<'
  729. DebugRightArrow='>'
  730. end
  731. OptionCodeType=''
  732. WarningsToIgnore=''
  733. signal Warning_2;
  734.  
  735. OutputWarningToScreen:
  736. WarningPrefix=strip( 'WARNING ' ||strip(arg(1)))
  737. WarningText=arg(2)
  738. if IncludeLevel=0 then
  739. LineText=''
  740. else
  741. LineText='(@' || AddCommasToDecimalNumber(IncludeLineNumber) || ')'
  742. WarningText=LineText||WarningPrefix|| ': ' ||WarningText
  743. WarningTextU=translate(WarningText)
  744. IgnoreList=WarningsToIgnore
  745. do while IgnoreList<> ''
  746. parse var IgnoreList IgnoreThis (PathDelimiterChar) IgnoreList
  747. if IgnoreThis<> '' then
  748. do
  749. if pos(IgnoreThis,WarningTextU)<>0 then
  750. do
  751. if OptionDebugOn='Y' then
  752. do
  753. call DebugLine 'Ignoring => ' ||WarningText
  754. call DebugIncrement 1
  755. call DebugLine 'Warning contained ==> ' ||IgnoreThis
  756. call DebugIncrement-1
  757. end
  758. return
  759. end
  760. end
  761. end
  762. call Line1 copies("  ", IncludeLevel) || WarningColor || '   ' ||WarningText||Reset
  763. Warnings=Warnings+1
  764. return
  765.  
  766. WarnAboutDepreciatedFeature:
  767. call OutputWarningToScreen 'DEP0', 'Replace OBSOLETE Feature ASAP -> ' ||arg(1)
  768. return
  769.  
  770. ProcessHashWarning:
  771. Rest=PerformReplacementsInCmdsParameters(arg(1))
  772. WarningCde=GetQuotedText(Rest, "Rest")
  773. WarningMsg=GetQuotedRest(Rest)
  774. call OutputWarningToScreen WarningCde,WarningMsg
  775. return(0)
  776.  
  777. Warning_2:
  778. SrTypePre=d2c(254)||d2c(174)
  779. SrTypeSuf=d2c(175)
  780. call SrInit
  781. signal SR_TYPE_3;
  782.  
  783. SrInit:
  784. SrCaseIns=SrTypePre|| 'CI' ||SrTypeSuf
  785. SrCaseIns_P=length(SrCaseIns)+1
  786. SrFixed=SrTypePre|| 'FiX' ||SrTypeSuf
  787. SrFixed_P=length(SrFixed)+1
  788. return
  789.  
  790. CompareReplaceFixed:call TRACE "OFF"
  791.  
  792. CompareReplaceFixed2:
  793. sr_FromOrig=arg(1)
  794. sr_SSpec=arg(2)
  795. sr_CaseInSens='N'
  796. sr_From=sr_FromOrig
  797. sr_From_L=length(sr_From)
  798. if arg(3, 'E')=1 then
  799. sr_NoMatch=sr_From
  800. else
  801. sr_NoMatch=0
  802. do while sr_SSpec<> ''
  803. parse var sr_SSpec sr_CmdChar +1 sr_SSpec
  804. select
  805. when sr_CmdChar='@' then
  806. do
  807. parse var sr_SSpec sr_Operator ',' sr_Posn '=' +1 sr_Delim +1 sr_CompWith (sr_Delim) sr_SSpec
  808. sr_Length=length(sr_CompWith)
  809. if datatype(sr_Posn, 'W')=0 then
  810. CryAndDie("CompareReplaceFixed()", "The position must be a whole number, '" || sr_Posn || "' is invalid")
  811. if sr_Posn<0 then
  812. do
  813. sr_Posn=sr_From_L+sr_Posn+1
  814. if sr_Posn<1 then
  815. return(sr_NoMatch)
  816. end
  817. if sr_CaseInSens='N' then
  818. sr_bit=substr(sr_From,sr_Posn,sr_Length)
  819. else
  820. sr_bit=translate(substr(sr_From,sr_Posn,sr_Length))
  821. select
  822. when sr_Operator='=' then
  823. srCompRc=sr_bit=sr_CompWith;
  824. when sr_Operator='<>' then
  825. srCompRc=sr_bit<>sr_CompWith;
  826. when sr_Operator='==' then
  827. srCompRc=sr_bit==sr_CompWith;
  828. when sr_Operator='\==' then
  829. srCompRc=sr_bit\==sr_CompWith;
  830. when sr_Operator='<' then
  831. srCompRc=sr_bit<sr_CompWith;
  832. when sr_Operator='>' then
  833. srCompRc=sr_bit>sr_CompWith;
  834. when sr_Operator='<=' then
  835. srCompRc=sr_bit<=sr_CompWith;
  836. when sr_Operator='>=' then
  837. srCompRc=sr_bit>=sr_CompWith;
  838. otherwise
  839. CryAndDie("CompareReplaceFixed()", "Unsupported operator of '" || sr_Operator || "' used", '', 'ONLY "=, <>, ==, \==, <, >, <=, >=" are supported!')
  840. end
  841. if srCompRc=0 then
  842. return(sr_NoMatch)
  843. end
  844. when sr_CmdChar='!' then
  845. do
  846. parse var sr_SSpec sr_CmdChar2 +1 sr_SSpec
  847. select
  848. when sr_CmdChar2='B' | sr_CmdChar2 = 'L' | sr_CmdChar2 = 'T' then
  849. do
  850. sr_From=strip(sr_From,sr_CmdChar2)
  851. sr_From_L=length(sr_From)
  852. end
  853. when sr_CmdChar2='I' then
  854. do
  855. sr_From=space(sr_From)
  856. sr_From_L=length(sr_From)
  857. end
  858. when sr_CmdChar2='S' then
  859. sr_CaseInSens='N'
  860. when sr_CmdChar2='i' then
  861. sr_CaseInSens='Y'
  862. otherwise
  863. CryAndDie("CompareReplaceFixed()", 'Invalid "!" command of "' || sr_CmdChar2 || '"')
  864. end
  865. end
  866. when sr_CmdChar='?' then
  867. do
  868. parse var sr_SSpec sr_Operator +1 sr_Delim +1 sr_LookFor (sr_Delim) sr_SSpec
  869. if sr_CaseInSens='N' then
  870. sr_Pos=pos(sr_LookFor,sr_From)
  871. else
  872. sr_Pos=pos(sr_LookFor,translate(sr_From))
  873. if sr_Operator='=' then
  874. do
  875. if sr_Pos=0 then
  876. return(sr_NoMatch)
  877. end
  878. else
  879. do
  880. if sr_Pos<>0 then
  881. return(sr_NoMatch)
  882. end
  883. end
  884. otherwise
  885. CryAndDie("CompareReplaceFixed()", 'Invalid compare command of "' || sr_CmdChar || '"')
  886. end
  887. end
  888. if arg(3, 'O')=1 then
  889. return(1)
  890. sr_RSpec=arg(3)
  891. ReplaceCount=ReplaceCount+1
  892. sr_From=sr_FromOrig
  893. sr_From_L=length(sr_From)
  894. sr_output=''
  895. do forever
  896. parse var sr_RSpec sr_Before '@' sr_RSpec
  897. sr_Output = sr_Output || sr_Before
  898. if sr_RSpec=='' then
  899. return(sr_Output)
  900. parse var sr_RSpec sr_CmdChar +1 sr_RSpec
  901. select
  902. when sr_CmdChar='$' then
  903. do
  904. parse var sr_RSpec sr_Posn ',' sr_Length ';' sr_RSpec
  905. if sr_Posn<0 then
  906. do
  907. sr_Posn=sr_From_L+sr_Posn+1
  908. if sr_Posn<1 then
  909. return(sr_From)
  910. end
  911. if sr_Length='*' then
  912. sr_Output=sr_Output||substr(sr_From,sr_Posn)
  913. else
  914. sr_Output=sr_Output||substr(sr_From,sr_Posn,sr_Length)
  915. end
  916. when sr_CmdChar='=' then
  917. do
  918. parse var sr_RSpec sr_Delim +1 sr_Exec (sr_Delim) sr_RSpec
  919. CompareString=sr_From
  920. call ExecRexxCmd('sr_Output = sr_Output || ' ||sr_Exec)
  921. end
  922. when sr_CmdChar='@' then
  923. sr_Output=sr_Output|| '@'
  924. otherwise
  925. CryAndDie("CompareReplaceFixed()", 'Invalid replace command of "' || sr_CmdChar || '"')
  926. end
  927. end
  928.  
  929. SR_TYPE_3:
  930. DependsOnFmtVer="FORMAT 99.289"
  931. call ClearDependancyTimeStampCache
  932. signal DEPENDON_4;
  933.  
  934. _CheckedLineout:
  935. Lineout.FileName=arg(1)
  936. Lineout.TheLine=arg(2)
  937. if 0<>lineout(Lineout.FileName,Lineout.TheLine)then
  938. CryAndDie('Write to "' || Lineout.FileName || '" failed!')
  939. return
  940.  
  941. NeedToRemake:
  942. DepFile4=arg(1)
  943. if OptionDependsOn='' then
  944. do
  945. call DebugLine 'No Dependancy file to check - Need to make'
  946. DepFileName=''
  947. return("Y")
  948. end
  949. DepFileName=GenerateFileName(DepFile4,OptionDependsOn, 'Y')
  950. if _NeedToRemakeCheckDependencies()='N' then
  951. do
  952. if OptionSeeDependsProgress='Y' then
  953. call Line1 ''
  954. return('N')
  955. end
  956. call Stream DepFileName, 'c', 'Close'
  957. DeleteRc=_SysFileDelete(DepFileName)
  958. if SafeQueryExists(DepFileName)<> "" then
  959. CryAndDie('Could not delete "' || DepFileName || '", it must be in use (DosRc=' || DeleteRc || ')...')
  960. InputDepCount=0
  961. OutputDepCount=0
  962. return('Y')
  963.  
  964. ClearDependancyTimeStampCache:
  965. TimeStampCount=0
  966. return
  967.  
  968. GetFileDateTimeButDontWarnOnError:
  969. tsFile=arg(1)
  970. do TimeIndex=1 to TimeStampCount
  971. if tsFile==TimeStamp.TimeIndex.TSNAME then
  972. return(TimeStamp.TimeIndex.TSTIME)
  973. end
  974. if SafeQueryExists(tsFile)=='' then
  975. Ts=-1
  976. else
  977. Ts=GetFileTimeStamp(tsFile)
  978. TimeStampCount=TimeStampCount+1
  979. TimeStamp.TimeStampCount.TSNAME=tsFile
  980. TimeStamp.TimeStampCount.TSTIME=Ts
  981. return(Ts)
  982.  
  983. _ShowDependancyCheckProgress:
  984. if OptionSeeDependsProgress='Y' then
  985. call Line1 '  ?> ' ||arg(1)
  986. else
  987. call DebugLine arg(1)
  988. return
  989.  
  990. _NeedToRemakeCheckDependencies:
  991. TitleText='Checking Dependencies - "' || _filespec('name', CurrentOutFile) || '"'
  992. if OptionSeeDependsProgress='N' then
  993. call DebugLine TitleText
  994. else
  995. do
  996. call Line1 TitleColor||TitleText
  997. call Line1 copies('~',length(TitleText))||Reset
  998. end
  999. OutputTime=GetFileDateTimeButDontWarnOnError(CurrentOutFile)
  1000. if OutputTime=-1 then
  1001. do
  1002. call _ShowDependancyCheckProgress CurrentOutFile|| ' does not exist.'
  1003. return('Y')
  1004. end
  1005. if SafeQueryExists(DepFileName)='' then
  1006. do
  1007. call _ShowDependancyCheckProgress DepFileName|| ' does not exist.'
  1008. return('Y')
  1009. end
  1010. CloseRc=stream(DepFileName, 'c', 'close')
  1011. OpenRc=stream(DepFileName, 'c', 'open read')
  1012. DependLine=linein(DepFileName)
  1013. if DependLine<>DependsOnFmtVer then
  1014. do
  1015. call _ShowDependancyCheckProgress 'Dependency formatting is not at current level'
  1016. CloseRc=stream(DepFileName, 'c', 'close')
  1017. return('Y')
  1018. end
  1019. ReMake='N'
  1020. do while lines(DepFileName)<>0
  1021. DependLine=linein(DepFileName)
  1022. if DependLine='' then
  1023. iterate
  1024. if left(DependLine,1)='' then
  1025. DepType='output'
  1026. else
  1027. DepType='input'
  1028. DependLine=substr(DependLine,2)
  1029. WhatStamped=GetQuotedText(DependLine, "DependLine")
  1030. LineStamp=GetQuotedRest(DependLine)
  1031. call _ShowDependancyCheckProgress 'Checking: "' || WhatStamped || '"'
  1032. ThisInputDepFile=WhatStamped
  1033. DependantTime=GetDependsStamp(WhatStamped)
  1034. if DependantTime=-1 then
  1035. do
  1036. call _ShowDependancyCheckProgress "Can't locate the dependant file (" || DepType || ")!"
  1037. ReMake='Y'
  1038. leave
  1039. end
  1040. if DependantTime<>LineStamp then
  1041. do
  1042. call _ShowDependancyCheckProgress "The stamp of " || DepType || " differs from last make."
  1043. ReMake='Y'
  1044. leave
  1045. end
  1046. end
  1047. CloseRc=stream(DepFileName, 'c', 'close')
  1048. if ReMake='N' then
  1049. call _ShowDependancyCheckProgress 'No need to remake...'
  1050. return(ReMake)
  1051.  
  1052. GetDependsStamp:
  1053. if left(ThisInputDepFile,1)='*' then
  1054. do
  1055. Stamp4U=translate(ThisInputDepFile)
  1056. select
  1057. when abbrev(Stamp4U, "*EXEC=")then
  1058. do
  1059. TheCmd=substr(ThisInputDepFile,7)
  1060. TmpFile=RexGetTmpFileName("DEPON???.???")
  1061. call AddressCmd TheCmd|| ' >' || TmpFile || ' 2>&1'
  1062. ExecRc=Rc
  1063. call DebugLine 'Depend value is result of (Rc=' || ExecRc || '): ' ||TheCmd
  1064. CloseRc=stream(TmpFile, 'c', 'close')
  1065. TheCmdVal=charin(TmpFile,,999999)
  1066. CloseRc=stream(TmpFile, 'c', 'close')
  1067. TheCmdVal=translate(TheCmdVal,, '0D0A1A'x, ' ')
  1068. TheCmdVal='RC=' || ExecRc || '->' ||TheCmdVal
  1069. return(TheCmdVal)
  1070. end
  1071. when abbrev(Stamp4U, "*FILES=")then
  1072. do
  1073. TheMask=substr(ThisInputDepFile,8)
  1074. if left(TheMask,1)<> '+' then
  1075. sdDo=''
  1076. else
  1077. do
  1078. sdDo='S'
  1079. TheMask=substr(TheMask,2)
  1080. end
  1081. call _SysFileTree TheMask, 'DepDirList', 'FO' ||sdDo
  1082. DirStamp=DepDirList.0|| ' files'
  1083. do DepIndex=1 to DepDirList.0
  1084. DirStamp=DirStamp|| '; ' || DepDirList.DepIndex || '=' ||GetFileDateTimeButDontWarnOnError(DepDirList.DepIndex)
  1085. end
  1086. return(DirStamp)
  1087. end
  1088. otherwise
  1089. nop
  1090. end
  1091. end
  1092. if RexSystemOpSys<> "UNIX" then
  1093. ThisInputDepFile=translate(ThisInputDepFile)
  1094. return(GetFileDateTimeButDontWarnOnError(ThisInputDepFile))
  1095.  
  1096. AddInputFileToDependancyList:call TRACE "OFF"
  1097. if DepFileName='' then
  1098. return('N')
  1099. ThisInputDepFile=arg(1)
  1100. InputFileStamp=arg(2)
  1101. if InputFileStamp='' then
  1102. InputFileStamp=GetDependsStamp()
  1103. do LookIndex=1 to InputDepCount
  1104. if ThisInputDepFile=InputDepFile.LookIndex then
  1105. return('N')
  1106. end
  1107. InputDepCount=InputDepCount+1
  1108. InputDepFile.InputDepCount=ThisInputDepFile
  1109. InputDepStamp.InputDepCount=InputFileStamp
  1110. return('Y')
  1111.  
  1112. AddOutputFileToDependancyList:call TRACE "OFF"
  1113. if DepFileName='' then
  1114. return('N')
  1115. ThisOutputDepFile=arg(1)
  1116. do LookIndex=1 to OutputDepCount
  1117. if ThisOutputDepFile=OutputDepFile.LookIndex then
  1118. return('N')
  1119. end
  1120. OutputDepCount=OutputDepCount+1
  1121. OutputDepFile.OutputDepCount=ThisOutputDepFile
  1122. return('Y')
  1123.  
  1124. _OutputDepWhatToFile:
  1125. DepWhat=arg(1)
  1126. DepWhatQ=QuoteIt(DepWhat)
  1127. DepWhat=DepWhatQ||DepWhat||DepWhatQ
  1128. return(DepWhat)
  1129.  
  1130. CreateDependancyFileFromLists:
  1131. if DepFileName='' then
  1132. return
  1133. call DebugLine 'Making the dependancy file (' || DepFileName || ')'
  1134. call DebugIncrement 1
  1135. call MakeDirectoryTree _filespec('drive', DepFileName) || _filespec('path',DepFileName)
  1136. call ClearDependancyTimeStampCache
  1137. call _CheckedLineout DepFileName,DependsOnFmtVer
  1138. call _CheckedLineout DepFileName, ''
  1139. DepWhatPad=0
  1140. do LookIndex=1 to OutputDepCount
  1141. call DebugLine 'Add OUTPUT dependancy : ' ||OutputDepFile.LookIndex
  1142. OutputFileTs=GetFileDateTimeButDontWarnOnError(OutputDepFile.LookIndex)
  1143. call _CheckedLineout DepFileName, ' ' || _OutputDepWhatToFile(OutputDepFile.LookIndex) || '   ~' || OutputFileTs || '~'
  1144. end
  1145. call _CheckedLineout DepFileName, ''
  1146. do LookIndex=1 to InputDepCount
  1147. call DebugLine 'Add INPUT  dependancy : ' ||InputDepFile.LookIndex
  1148. call _CheckedLineout DepFileName, ' ' || _OutputDepWhatToFile(InputDepFile.LookIndex) || '   ~' || InputDepStamp.LookIndex || '~'
  1149. end
  1150. CloseRc=stream(DepFileName, 'c', 'close')
  1151. call DebugIncrement-1
  1152. return
  1153.  
  1154. ProcessDependsOn:
  1155. Rest=PerformReplacementsInCmdsParameters(arg(1))
  1156. DepType=translate(GetQuotedText(Rest, "DependsOnList"))
  1157. if DepType<> 'INPUT' & DepType <> 'OUTPUT' then
  1158. CryAndDie('Expected either "INPUT" or "OUTPUT" for dependancy type (not "' || DepType || '")!')
  1159. if DependsOnList='' then
  1160. CryAndDie('No files supplied on "#DependsOn ' || DepType || '" command!')
  1161. do while DependsOnList<> ''
  1162. ThisOne=GetQuotedText(DependsOnList, "DependsOnList")
  1163. if DepType='OUTPUT' then
  1164. Added=AddOutputFileToDependancyList(ThisOne)
  1165. else
  1166. Added=AddInputFileToDependancyList(ThisOne)
  1167. if Added='Y' then
  1168. call DebugLine DepType|| ' dependancy : ' ||ThisOne
  1169. end
  1170. return(0)
  1171.  
  1172. DEPENDON_4:
  1173. SpellDelChars=d2c(9)|| ',.=:;<>&-%()!/~' || '?#${}[]"'
  1174. SpellDictFileCount=0
  1175. SpellDelChangeCount=0
  1176. SpellingPrompts='N'
  1177. SpellShowEachError='N'
  1178. SpellingAddFile=''
  1179. SpellWordCount=0
  1180. SpellMistakeCount=0
  1181. SpellingAddCount=0
  1182. BadlySpellWordCount=0
  1183. CheckSpelling='N'
  1184. signal SPELLING_5;
  1185.  
  1186. PrepareSpellingForThisBuild:
  1187. if OptionCompleteAddToToDepFile='Y' then
  1188. do
  1189. do DictIndex=1 to SpellDictFileCount
  1190. call AddInputFileToDependancyList SpellDictFile.DictIndex,SpellDictTime.DictIndex
  1191. end
  1192. end
  1193. Drop ?BADWORDEB.
  1194. return
  1195.  
  1196. LoadSpellingDictionary:
  1197. DictFileS=arg(1)
  1198. call DebugLine_SPELLING 'User wants the dictionary "' || DictFileS || '"'
  1199. DictFile=stream(DictFileS, 'c', 'query exists')
  1200. if DictFile='' then
  1201. DictFile=FindIncludeFile(DictFileS)
  1202. if DictFile='' then
  1203. CryAndDie('The dictionary file "' || DictFileS || '" does not exist!')
  1204. call DebugLine_SPELLING 'Loading "' || DictFile || '"'
  1205. SpellDictFileCount=SpellDictFileCount+1
  1206. SpellDictFile.SpellDictFileCount=DictFile
  1207. SpellDictTime.SpellDictFileCount=GetFileDateTimeButDontWarnOnError(DictFile)
  1208. CloseRc=stream(DictFile, 'c', 'close')
  1209. do while lines(DictFile)<>0
  1210. ThisWord=translate(strip(linein(DictFile)))
  1211. if ThisWord='' then
  1212. iterate
  1213. if left(ThisWord,1)=';' then
  1214. iterate
  1215. if left(ThisWord,1)<> '$' then
  1216. do
  1217. SpellWordCount=SpellWordCount+1
  1218. call _valueS '?SPELLDICT.?' || c2x(ThisWord), ''
  1219. end
  1220. else
  1221. do
  1222. parse var ThisWord DictCmd Rest
  1223. select
  1224. when DictCmd='$MISTAKE' then
  1225. do
  1226. parse var Rest SpeltWrong SpeltCorrectly .
  1227. SpellMistakeCount=SpellMistakeCount+1
  1228. call _valueS '?SPELLERR.?' ||c2x(SpeltWrong),SpeltCorrectly
  1229. end
  1230. when DictCmd='$DELIMITERS' then
  1231. do
  1232. call DebugLine_SPELLING 'Dictionary is changing spelling delimiters'
  1233. SpellDelChangeCount=SpellDelChangeCount+1
  1234. if SpellDelChangeCount>1 then
  1235. call OutputWarningToScreen 'SPL9', 'Spell check delimiters already modified!'
  1236. call ExecRexxCmd "SpellDelChars = " ||strip(Rest)
  1237. end
  1238. otherwise
  1239. do
  1240. SpellWordCount=SpellWordCount+1
  1241. call _valueS '?SPELLDICT.?' || c2x(ThisWord), ''
  1242. end
  1243. end
  1244. end
  1245. end
  1246. CloseRc=stream(DictFile, 'c', 'close')
  1247. call DebugLine_SPELLING 'Now have ' || AddCommasToDecimalNumber(SpellWordCount) || ' word(s) in dictionary and ' || AddCommasToDecimalNumber(SpellMistakeCount) || ' common mistakes noted!'
  1248. CheckSpelling='Y'
  1249. return
  1250.  
  1251. SpellCheckOneLine:
  1252. SpellLine=space(arg(1))
  1253. if 1=1 then
  1254. do
  1255. RightBit=SpellLine
  1256. SpellLine=''
  1257. StartPos=pos('<',RightBit)
  1258. do while StartPos<>0
  1259. EndPos=pos('>',RightBit,StartPos+1)
  1260. if EndPos=0 then
  1261. EndPos=StartPos
  1262. SpellLine=SpellLine||left(RightBit,StartPos-1)|| ' '
  1263. RightBit=substr(RightBit,EndPos+1)
  1264. StartPos=pos('<',RightBit)
  1265. end
  1266. SpellLine=SpellLine||RightBit
  1267. if SpellLine='' then
  1268. return
  1269. end
  1270. SpellLine=translate(translate(SpellLine), '', SpellDelChars, ' ')
  1271. do WordIndex=1 to words(SpellLine)
  1272. ThisWord=Word(SpellLine,WordIndex)
  1273. if left(ThisWord,1)="'" then
  1274. ThisWord=substr(ThisWord,2)
  1275. if right(ThisWord,1)="'" then
  1276. ThisWord=left(ThisWord,length(ThisWord)-1)
  1277. if length(ThisWord)>100 then
  1278. do
  1279. if OptionDebugOn='Y' then
  1280. call DebugLine_SPELLING 'Word too big to safely handle "' || ThisWord || '"'
  1281. iterate
  1282. end
  1283. ThisWordC2X=c2x(ThisWord)
  1284. if SpellMistakeCount<>0 then
  1285. do
  1286. MistakeId='?SPELLERR.?' ||ThisWordC2X
  1287. if symbol(MistakeId)='VAR' then
  1288. do
  1289. if SpellShowEachError='Y' then
  1290. ShowThisError='Y'
  1291. else
  1292. do
  1293. DuplicatedId='?BADWORDEB.?' ||ThisWordC2X
  1294. if symbol(DuplicatedId)='VAR' then
  1295. ShowThisError='N'
  1296. else
  1297. do
  1298. ShowThisError='Y'
  1299. call _valueS DuplicatedId, ''
  1300. end
  1301. end
  1302. if ShowThisError='Y' then
  1303. do
  1304. CorrectWord=_valueG(MistakeId)
  1305. if CorrectWord='' then
  1306. call OutputWarningToScreen 'SPL0', 'Common Mistake: ' ||ThisWord
  1307. else
  1308. call OutputWarningToScreen 'SPL0', 'Common Mistake: ' || ThisWord || ' (use "' || CorrectWord || '" instead)'
  1309. end
  1310. iterate
  1311. end
  1312. end
  1313. if SpellWordCount=0&SpellingPrompts='N' then
  1314. iterate
  1315. ValidId='?SPELLDICT.?' ||ThisWordC2X
  1316. if symbol(ValidId)<> 'VAR' then
  1317. do
  1318. if datatype(ThisWord)<> 'NUM' then
  1319. do
  1320. WordWarningId=''
  1321. WordWarningMsg=''
  1322. if SpellingPrompts<> 'N' then
  1323. do
  1324. DuplicatedId='?BADWORDPI.?' ||ThisWordC2X
  1325. if symbol(DuplicatedId)='VAR' then
  1326. do
  1327. BadIndex=_valueG(DuplicatedId)
  1328. if BadIndex<> '' then
  1329. do
  1330. WordWarningId='SPL1'
  1331. WordWarningMsg='Added "' || ThisWord || '" to "' || SpellingAddFile || '"'
  1332. SpellingAddOccurs.BadIndex=SpellingAddOccurs.BadIndex+1
  1333. end
  1334. end
  1335. else
  1336. do
  1337. DuplicatedIdValue=''
  1338. if SpellingAddFile<> '' & SpellingPrompts <> 'N' then
  1339. do
  1340. if SpellingPrompts='OK' then
  1341. UserResp='Y'
  1342. else
  1343. do
  1344. do until UserResp='Y' | UserResp = 'N' | UserResp = 'Q' | UserResp = 'A'
  1345. call charout,ThisWord|| ' <- OK (Yes/yes All/No/Quit asking)?'
  1346. UserResp=translate(left(linein(),1))
  1347. end
  1348. end
  1349. if UserResp='A' then
  1350. do
  1351. SpellingPrompts='OK'
  1352. UserResp='Y'
  1353. end
  1354. if UserResp='Y' then
  1355. do
  1356. SpellingAddCount=SpellingAddCount+1
  1357. DuplicatedIdValue=SpellingAddCount
  1358. SpellingAddWord.SpellingAddCount=ThisWord
  1359. SpellingAddOccurs.SpellingAddCount=1
  1360. if SpellingPrompts='OK' then
  1361. do
  1362. WordWarningId='SPL1'
  1363. WordWarningMsg='Added "' || ThisWord || '" to "' || SpellingAddFile || '"'
  1364. end
  1365. end
  1366. else
  1367. do
  1368. if UserResp='Q' then
  1369. SpellingPrompts='N'
  1370. end
  1371. end
  1372. BadlySpellWordCount=BadlySpellWordCount+1
  1373. call _valueS DuplicatedId,DuplicatedIdValue
  1374. end
  1375. end
  1376. if SpellShowEachError='Y' then
  1377. ShowThisError='Y'
  1378. else
  1379. do
  1380. DuplicatedId='?BADWORDEB.?' ||ThisWordC2X
  1381. if symbol(DuplicatedId)='VAR' then
  1382. ShowThisError='N'
  1383. else
  1384. do
  1385. ShowThisError='Y'
  1386. call _valueS DuplicatedId, ''
  1387. end
  1388. end
  1389. if ShowThisError='Y' then
  1390. do
  1391. if WordWarningId='' then
  1392. do
  1393. WordWarningId='SPL1'
  1394. WordWarningMsg='Spelling? : ' ||ThisWord
  1395. end
  1396. call OutputWarningToScreen WordWarningId,WordWarningMsg
  1397. end
  1398. end
  1399. end
  1400. end
  1401. return
  1402.  
  1403. OutputAnySpellingAdditions:
  1404. if SpellingAddCount=0 then
  1405. return
  1406. call DebugLine_SPELLING 'Adding spelling words to file "' || SpellingAddFile || '"'
  1407. call DebugIncrement 1
  1408. if VariableExists("PPWIZARD_DONT_SORT_ADD_WORDS") = 'N' then
  1409. do
  1410. call DebugLine_SPELLING 'Sorting ' || SpellingAddCount || ' "bad" word(s) by number of occurences!'
  1411. SpellingAddWord.0=SpellingAddCount
  1412. SpellingAddOccurs.0=SpellingAddCount
  1413. SrtM=1
  1414. SrtCount=SpellingAddOccurs.0
  1415. do while(9*SrtM+4)<SrtCount
  1416. SrtM=SrtM*3+1
  1417. end
  1418. do while SrtM>0
  1419. SrtK=SrtCount-SrtM
  1420. do SrtJ=1 to SrtK
  1421. SrtIndex1=SrtJ
  1422. do while SrtIndex1>0
  1423. SrtIndex2=SrtIndex1+SrtM
  1424. SrtGreater=SpellingAddOccurs.SrtIndex1>SpellingAddOccurs.SrtIndex2
  1425. if SrtGreater then
  1426. do
  1427. SrtTemp=SpellingAddOccurs.SrtIndex1;SpellingAddOccurs.SrtIndex1=SpellingAddOccurs.SrtIndex2;SpellingAddOccurs.SrtIndex2=SrtTemp;SrtTemp=SpellingAddWord.SrtIndex1;SpellingAddWord.SrtIndex1=SpellingAddWord.SrtIndex2;SpellingAddWord.SrtIndex2=SrtTemp
  1428. end
  1429. else
  1430. leave
  1431. SrtIndex1=SrtIndex1-SrtM
  1432. end
  1433. end
  1434. SrtM=SrtM%3
  1435. end
  1436. call ReverseArray "SpellingAddWord"
  1437. call ReverseArray "SpellingAddOccurs"
  1438. end
  1439. call DebugLine_SPELLING 'Deleting "' || SpellingAddFile || '"'
  1440. call Stream SpellingAddFile, 'c', 'Close'
  1441. DeleteRc=_SysFileDelete(SpellingAddFile)
  1442. if SafeQueryExists(SpellingAddFile)<> "" then
  1443. CryAndDie('Could not delete "' || SpellingAddFile || '", it must be in use (DosRc=' || DeleteRc || ')...')
  1444. call DebugLine_SPELLING 'Writing words to file'
  1445. call DebugIncrement 1
  1446. do WordIndex=1 to SpellingAddCount
  1447. call lineout SpellingAddFile,SpellingAddWord.WordIndex
  1448. if OptionDebugOn='Y' then
  1449. call DebugLine_SPELLING 'The word "' || SpellingAddWord.WordIndex || '" occured ' || SpellingAddOccurs.WordIndex || ' time(s).'
  1450. end
  1451. call DebugIncrement-1
  1452. call DieIfIoErrorOccurred SpellingAddFile
  1453. call Stream SpellingAddFile, 'c', 'Close'
  1454. call OutputInformationToScreen AddCommasToDecimalNumber(SpellingAddCount)|| ' word(s) added to "' || SpellingAddFile || '"'
  1455. call DebugIncrement-1
  1456. return
  1457.  
  1458. SPELLING_5:
  1459. OptionDebugOn='N'
  1460. if RexWhich='REGINA' then
  1461. OptionDebugTime='L'
  1462. else
  1463. OptionDebugTime='S'
  1464. call DebugIncrementInit
  1465. signal Debug_6;
  1466.  
  1467. Debug:call TRACE "OFF"
  1468.  
  1469. DebugLine:
  1470. if OptionDebugOn='N' then
  1471. return
  1472.  
  1473. DebugLine2:
  1474. call Line1 _DebugPrefix()|| '         >' ||translate(arg(1),DebugNewline,MarksNewLine)
  1475. return
  1476.  
  1477. _DebugPrefix:
  1478. if OptionDebugTime='N' then
  1479. return(copies("  ",IncludeLevel+DebugIndent))
  1480. else
  1481. do
  1482. if OptionDebugTime='L' then
  1483. return( '[' || left(time('L'),11)               || ']' || copies("  ",IncludeLevel+DebugIndent))
  1484. else
  1485. return( '[' || (time('S') || substr(time('L'), 9, 3)) - PpwStartSec || ']' || copies("  ",IncludeLevel+DebugIndent))
  1486. end
  1487.  
  1488. YorN2OnorOff:
  1489. if arg(1)='Y' then
  1490. return('ON')
  1491. else
  1492. return('OFF')
  1493.  
  1494. OutputInfoIfDebugOn:
  1495. if OptionDebugOn='Y' then
  1496. do
  1497. if DebugOnStuffOutputted='N' then
  1498. do
  1499. SourceTime=stream(PpWizardPgmName, 'c', 'query datetime')
  1500. call DebugLine 'Debug Header'
  1501. call DebugLine '~~~~~~~~~~~~'
  1502. call DebugIncrement 1
  1503. call DebugLine 'Program : "' || PpWizardPgmName    || '" (' || SourceTime || ')'
  1504. call DebugLine 'OptionE : "' || OptionsEnvironment || '"'
  1505. call DebugLine 'OptionC : "' || OptionsCmdLine     || '"'
  1506. call DebugLine 'Src Type: "' || OptionCodeType     || '"'
  1507. call DebugLine 'OpSystem: "' || PpWizardOpSys      || '"'
  1508. call DebugLine 'Rexx Ver: "' || RexVersionInfo     || '"'
  1509. call DebugLine 'Mode    : "' || RexWhich           || '"'
  1510. if RexWhich='REGINA' then
  1511. call DebugLine 'uname() : "' || uname()        || '"'
  1512. if OptionFilterIn<> '' then
  1513. call DebugLine 'Filter I: ' || FunctionFilterIn || '(' || InputInterfaceVer || ')'
  1514. if OptionFilterOut<> '' then
  1515. call DebugLine 'Filter O: "' || OptionFilterOut   || '" (interface version ' || OutputInterfaceVer || ')'
  1516. call Line1 ''
  1517. DebugOnStuffOutputted='Y'
  1518. call DebugIncrement-1
  1519. end
  1520. end
  1521. call SetEnv "PPWIZARD_DEBUG",OptionDebugOn
  1522. return
  1523.  
  1524. DebugShowCurrentLineWithLineNumber:
  1525. if OptionDebugOn='Y' then
  1526. do
  1527. FmtLineNum=IncludeLineNumber
  1528. if length(FmtLineNum)<4 then
  1529. FmtLineNum=right(FmtLineNum,4, '0')
  1530. if arg(2)<> '' then
  1531. FmtLineNum=copies(arg(2),length(FmtLineNum))
  1532. if IncludeMemHandle='' then
  1533. FmtLineNum='{' || DebugCurrentFileNumber || '}' ||FmtLineNum
  1534. else
  1535. FmtLineNum='[' || DebugCurrentFileNumber || ']' ||FmtLineNum
  1536. select
  1537. when AsIsModeOn='Y' & AutoTagOn = 'Y' then
  1538. DebugSym='> '
  1539. when AsIsModeOn='Y' then
  1540. DebugSym='} '
  1541. when AutoTagOn='Y' then
  1542. DebugSym=') '
  1543. otherwise
  1544. DebugSym=': '
  1545. end
  1546. if arg(1)=='' then
  1547. call Line1 _DebugPrefix()||FmtLineNum||DebugSym
  1548. else
  1549. call Line1 _DebugPrefix()||FmtLineNum||DebugSym||DebugRightArrow||translate(arg(1),DebugNewline,MarksNewLine)||DebugLeftArrow
  1550. end
  1551. return
  1552.  
  1553. DebugShowLineDropped:
  1554. if OptionDebugOn='Y' then
  1555. do
  1556. call Line1 _DebugPrefix()||left(arg(1),length(FmtLineNum), ' ') || '-'
  1557. end
  1558. return
  1559.  
  1560. DebugWarning:
  1561. if OptionDebugOn='N' then
  1562. return
  1563. DbgWarning='!!! ' || arg(1) || ' !!!'
  1564. DbgLine=copies('!',length(DbgWarning))
  1565. call DebugLine2 ''
  1566. call DebugLine2 left('!!!![ DEBUG WARNING ]', length(DbgWarning), '!')
  1567. call DebugLine2 DbgWarning
  1568. call DebugLine2 left('', length(DbgWarning), '!')
  1569. call DebugLine2 ''
  1570. return
  1571.  
  1572. DebugOutputVariableInfo:
  1573. if OptionDebugOn='Y' then
  1574. call DebugLine2 '? ' ||translate(arg(1),DebugNewline,MarksNewLine)
  1575. return
  1576.  
  1577. DebugIndent:call TRACE "OFF"
  1578.  
  1579. DebugIncrement:
  1580. DebugIndent=DebugIndent+(arg(1)*2)
  1581. if DebugIndent<0 then
  1582. DebugIndent=0
  1583. return
  1584.  
  1585. DebugIncrementInit:
  1586. DebugIndent=0
  1587. return
  1588.  
  1589. ProcessHashDebug:
  1590. DebugParms=arg(1)
  1591. DebugCmd=translate(GetQuotedText(DebugParms, "Rest"))
  1592. select
  1593. when DebugCmd="RIGHT" then
  1594. call DebugIncrement 1
  1595. when DebugCmd="LEFT" then
  1596. call DebugIncrement-1
  1597. when DebugCmd="SHOW" then
  1598. do
  1599. if OptionDebugOn='Y' then
  1600. do
  1601. Rest=PerformReplacementsInCmdsParameters(Rest)
  1602. Rest=ReplaceXCodesIfNotDisabled(Rest)
  1603. call Line1 _DebugPrefix()|| '         }' ||translate(GetQuotedRest(Rest),DebugNewline,MarksNewLine)
  1604. end
  1605. end
  1606. otherwise
  1607. do
  1608. if DebugSwitchUsed='Y' then
  1609. call DebugLine 'Command ignored as "/debug" used'
  1610. else
  1611. do
  1612. ReturnRc=SetOnorOffVariable(DebugParms, 'OptionDebugOn')
  1613. call OutputInfoIfDebugOn
  1614. end
  1615. end
  1616. end
  1617. return(0)
  1618.  
  1619. Debug_6:
  1620. AllBitsOff='000000'x
  1621. AllBitsOn='FFFFFF'x
  1622. UserBitsOn='000003'x
  1623. AllBitsOnExceptUser=bitxor(AllBitsOn,UserBitsOn)
  1624. DebugLevel=AllBitsOnExceptUser
  1625. DebugLevelCnt=0
  1626. SeeLevelAll=_SaveDebugLevel("ALL",           "FFFFFF")
  1627. DummyUser1=_SaveDebugLevel("USER1",         "000001")
  1628. DummyUser2=_SaveDebugLevel("USER2",         "000002")
  1629. SeeLevelConditional=_SaveDebugLevel("CONDITIONAL",   "000004")
  1630. SeeFoundVar=_SaveDebugLevel("FOUNDVAR",      "000008")
  1631. SeeFoundVarParms=_SaveDebugLevel("FOUNDVARPARMS", "000010")
  1632. SeeFoundStdVar=_SaveDebugLevel("FOUNDSTDVAR",   "000020")
  1633. SeeAfterReplace=_SaveDebugLevel("AFTERREPLACE",  "000040")
  1634. SeeOptions=_SaveDebugLevel("OPTIONS",       "000080")
  1635. SeeOpSys=_SaveDebugLevel("OPSYS",         "000100")
  1636. SeeDefining=_SaveDebugLevel("DEFINING",      "000200")
  1637. SeeDefaultOrMacroValue=_SaveDebugLevel("MACROVALORDEF", "000400")
  1638. SeeAsIs=_SaveDebugLevel("ASIS",          "000800")
  1639. SeeAutoTag=_SaveDebugLevel("AUTOTAG",       "001000")
  1640. SeeRexxVar=_SaveDebugLevel("REXXVAR",       "002000")
  1641. SeeRexxTrace=_SaveDebugLevel("REXXTRACE",     "004000")
  1642. SeeInterpret=_SaveDebugLevel("INTERPRET",     "008000")
  1643. SeeEvaluate=_SaveDebugLevel("EVALUATE",      "010000")
  1644. SeeImport=_SaveDebugLevel("IMPORT",        "020000")
  1645. SeeSpelling=_SaveDebugLevel("SPELLING",      "040000")
  1646. SeeImport=bitand(SeeImport,SeeDefaultOrMacroValue)
  1647. signal DebugOpt_7;
  1648.  
  1649. IsDebugOn:call TRACE "OFF"
  1650. ido1=arg(1)
  1651. if ido1='' then
  1652. return(OptionDebugOn)
  1653. else
  1654. do
  1655. if OptionDebugOn='N' then
  1656. return(0)
  1657. else
  1658. do
  1659. idoUBits=bitand(DebugLevel,UserBitsOn)
  1660. idoUBits=bitand(idoUBits,x2c(right(ido1,6, '0')))
  1661. return(c2d(idoUBits))
  1662. end
  1663. end
  1664.  
  1665. DebugAddressCmdBefore:
  1666. if OptionDebugOn='Y' then
  1667. do
  1668. if bitand(DebugLevel,SeeOpSys)==SeeOpSys then
  1669. do
  1670. call DebugIncrement 1
  1671. call DebugLine 'Executing: ' ||arg(1)
  1672. call DebugIncrement-1
  1673. end
  1674. end
  1675. return
  1676.  
  1677. DebugAddressCmdOutput:
  1678. if OptionDebugOn='Y' then
  1679. do
  1680. if bitand(DebugLevel,SeeOpSys)==SeeOpSys then
  1681. do
  1682. call DebugIncrement 2
  1683. DbgLineNumber=arg(2)
  1684. if datatype(DbgLineNumber, 'W')=0 then
  1685. call DebugLine '> ' ||arg(1)
  1686. else
  1687. do
  1688. if DbgLineNumber<999 then
  1689. DbgLineNumber=right(DbgLineNumber,3, '0')
  1690. call DebugLine '> ' || DbgLineNumber || ': ' ||arg(1)
  1691. end
  1692. call DebugIncrement-2
  1693. end
  1694. end
  1695. return
  1696.  
  1697. DebugAddressCmdAfter:
  1698. if OptionDebugOn='Y' then
  1699. do
  1700. if bitand(DebugLevel,SeeOpSys)==SeeOpSys then
  1701. do
  1702. call DebugIncrement 2
  1703. call DebugLine '  Rc = ' ||arg(1)
  1704. call DebugIncrement-2
  1705. end
  1706. end
  1707. return
  1708.  
  1709. DebugOutputAfterReplacement:
  1710. if OptionDebugOn='N' then
  1711. return
  1712. if bitand(DebugLevel,SeeAfterReplace)==SeeAfterReplace then
  1713. call DebugLine2 arg(2)||DebugRightArrow||translate(arg(1),DebugNewline,MarksNewLine)||DebugLeftArrow
  1714. return
  1715.  
  1716. DebugLine_DEFINING:
  1717. if bitand(DebugLevel,SeeDefining)==SeeDefining then
  1718. call DebugLine arg(1)
  1719. return
  1720.  
  1721. DebugLine_ASIS:
  1722. if bitand(DebugLevel,SeeAsIs)==SeeAsIs then
  1723. call DebugLine arg(1)
  1724. return
  1725.  
  1726. DebugLine_REXXVAR:
  1727. if bitand(DebugLevel,SeeRexxVar)==SeeRexxVar then
  1728. call DebugLine arg(1)
  1729. return
  1730.  
  1731. DebugLine_INTERPRET:
  1732. if bitand(DebugLevel,SeeInterpret)==SeeInterpret then
  1733. call DebugLine arg(1)
  1734. return
  1735.  
  1736. DebugLine_EVALUATE:
  1737. if bitand(DebugLevel,SeeEvaluate)==SeeEvaluate then
  1738. call DebugLine arg(1)
  1739. return
  1740.  
  1741. DebugLine_SPELLING:
  1742. if bitand(DebugLevel,SeeSpelling)==SeeSpelling then
  1743. call DebugLine arg(1)
  1744. return
  1745.  
  1746. DebugLine_IMPORT:
  1747. if bitand(DebugLevel,SeeImport)==SeeImport then
  1748. call DebugLine arg(1)
  1749. return
  1750.  
  1751. DebugLine_AUTOTAG:
  1752. if bitand(DebugLevel,SeeAutoTag)==SeeAutoTag then
  1753. call DebugLine arg(1)
  1754. return
  1755.  
  1756. DebugLine_MACROVALORDEF:
  1757. if bitand(DebugLevel,SeeDefaultOrMacroValue)==SeeDefaultOrMacroValue then
  1758. call DebugLine arg(1)
  1759. return
  1760.  
  1761. DebugLine_OPTIONS:
  1762. if bitand(DebugLevel,SeeOptions)==SeeOptions then
  1763. call DebugLine arg(1)
  1764. return
  1765.  
  1766. DebugLine_CONDITIONAL:
  1767. if bitand(DebugLevel,SeeLevelConditional)==SeeLevelConditional then
  1768. call DebugLine arg(1)
  1769. return
  1770.  
  1771. DebugOutputVariableInfo_FOUNDSTDVAR:
  1772. if bitand(DebugLevel,SeeFoundStdVar)==SeeFoundStdVar then
  1773. call DebugOutputVariableInfo arg(1)
  1774. return
  1775.  
  1776. DebugOutputVariableInfo_FOUNDVAR:
  1777. if bitand(DebugLevel,SeeFoundVar)==SeeFoundVar then
  1778. call DebugOutputVariableInfo arg(1)
  1779. return
  1780.  
  1781. DebugOutputVariableInfo_FOUNDVARPARMS:
  1782. if bitand(DebugLevel,SeeFoundVarParms)==SeeFoundVarParms then
  1783. call DebugOutputVariableInfo arg(1)
  1784. return
  1785.  
  1786. DebugOutputVariableInfo_FOUNDSTDVAR:
  1787. if bitand(DebugLevel,SeeFoundVar)==SeeFoundVar then
  1788. call DebugOutputVariableInfo arg(1)
  1789. return
  1790.  
  1791. _SaveDebugLevel:
  1792. DebugLevelCnt=DebugLevelCnt+1
  1793. DebugLevelNme.DebugLevelCnt=translate(arg(1))
  1794. DebugLevelVal.DebugLevelCnt=arg(2)
  1795. return(x2c(arg(2)))
  1796.  
  1797. GetDebugLevel:
  1798. WantedName=translate(arg(1))
  1799. do DbgIndex=1 to DebugLevelCnt
  1800. if WantedName=DebugLevelNme.DbgIndex then
  1801. return(DebugLevelVal.DbgIndex)
  1802. end
  1803. return('')
  1804.  
  1805. _WorkOutDebugLevelText:
  1806. DbgLvlTxt="ALL"
  1807. do DbgIndex=1 to DebugLevelCnt
  1808. if bitand(DebugLevel,x2c(DebugLevelVal.DbgIndex))=AllBitsOff then
  1809. DbgLvlTxt=DbgLvlTxt|| ',-' ||DebugLevelNme.DbgIndex
  1810. end
  1811. return(DbgLvlTxt)
  1812.  
  1813. DEBUGLEVEL_DEBUG:
  1814. if OptionDebugOn='Y' then
  1815. call OptionDebugShow 'DEBUGLEVEL', 'Debug level (when on) is ' ||_WorkOutDebugLevelText()
  1816. return
  1817.  
  1818. DEBUGLEVEL_GET:
  1819. call DEBUGLEVEL_DEBUG
  1820. return(_WorkOutDebugLevelText())
  1821.  
  1822. DEBUGLEVEL_SET:
  1823. DebugCmdsIn=arg(1)
  1824. DebugCmds=DebugCmdsIn
  1825. do while DebugCmds<> ''
  1826. parse var DebugCmds OneDebugOpt','DebugCmds
  1827. OptionAction=left(OneDebugOpt,1)
  1828. if OptionAction='+' then
  1829. OneDebugOpt=substr(OneDebugOpt,2)
  1830. else
  1831. do
  1832. if OptionAction='-' then
  1833. OneDebugOpt=substr(OneDebugOpt,2)
  1834. else
  1835. OptionAction='+'
  1836. end
  1837. OptionBinary=x2c(GetDebugLevel(OneDebugOpt))
  1838. if OptionBinary='' then
  1839. CryAndDie('Invalid debug option of "' || OneDebugOpt || '"')
  1840. if OptionAction='+' then
  1841. DebugLevel=bitor(DebugLevel,OptionBinary)
  1842. else
  1843. DebugLevel=bitxor(DebugLevel,OptionBinary)
  1844. end
  1845. if ProcessedCmdLine='N' then
  1846. do
  1847. call OptionDebugShow 'DEBUGLEVEL', 'Setting default value of debug level to "' || _WorkOutDebugLevelText() || '"'
  1848. Default4_DebugLevel=DebugLevel
  1849. return(0)
  1850. end
  1851. if DebugCmdsIn='' then
  1852. DebugLevel=Default4_DebugLevel
  1853. call DEBUGLEVEL_DEBUG
  1854. return
  1855.  
  1856. DebugOpt_7:
  1857. OptionCgiModeOn='N'
  1858. CgiOutputFile=''
  1859. CgiFatalError='N'
  1860. signal CGI_8;
  1861.  
  1862. Line1:
  1863. if OptionCgiModeOn='N' then
  1864. say arg(1)
  1865. else
  1866. do
  1867. if CgiOutputFile<> '' then
  1868. call lineout CgiOutputFile,arg(1)
  1869. if CgiFatalError='Y' then
  1870. say _MustSeeAsIsInHtmlViewer(arg(1))
  1871. end
  1872. return
  1873.  
  1874. Char1:
  1875. if OptionCgiModeOn='N' then
  1876. call charout,arg(1)
  1877. else
  1878. do
  1879. if CgiOutputFile<> '' then
  1880. call charout CgiOutputFile,arg(1)
  1881. if CgiFatalError='Y' then
  1882. call charout,_MustSeeAsIsInHtmlViewer(arg(1))
  1883. end
  1884. return
  1885.  
  1886. DieIfCgiModeOn:
  1887. if OptionCgiModeOn='Y' then
  1888. call CryAndDie "This feature is not allowed in CGI mode"
  1889. return
  1890.  
  1891. TurnCgiModeOn:
  1892. OptionCgiModeOn='Y'
  1893. CgiOutputFile=ThisCmdOptions
  1894. if pos('?',CgiOutputFile)<>0 then
  1895. do
  1896. PartSecond=time('Long')
  1897. parse var PartSecond .'.'PartSecond
  1898. RandomBit=right(time('Seconds'), 5, '0')
  1899. RandomBit=RandomBit||left(strip(PartSecond),3)
  1900. RandomBit=RandomBit|| '.' || right( date('Days'), 3, '0')
  1901. CgiOutputFile=ReplaceString(CgiOutputFile, '?',RandomBit)
  1902. end
  1903. if CgiOutputFile<> '' then
  1904. do
  1905. if stream(CgiOutputFile, 'c', 'query exists') <> '' then
  1906. do
  1907. call Stream CgiOutputFile, 'c', 'Close'
  1908. DeleteRc=_SysFileDelete(CgiOutputFile)
  1909. if DeleteRc<>0 then
  1910. call DebugLine 'Could not delete "' || CgiOutputFile || '" (Rc = ' || DeleteRc || ')'
  1911. end
  1912. end
  1913. call RemoveColorCodes
  1914. call RemoveBeepCode
  1915. return
  1916.  
  1917. CloseCgiFileIfOpen:
  1918. if CgiOutputFile<> '' then
  1919. CloseRc=stream(CgiOutputFile, 'c', 'close')
  1920. return
  1921.  
  1922. CgiStartFatalError:
  1923. if OptionCgiModeOn='N' then
  1924. return
  1925. CgiDoVar='CGI_FATAL_MY_MESSAGE_ONLY'
  1926. if VariableExists(CgiDoVar)='Y' then
  1927. do
  1928. CgiErrorCodes=GetDefineValueOrUseDefault(CgiDoVar, '')
  1929. if CgiErrorCodes='' then
  1930. call DebugLine 'We do not want any error indication in user output'
  1931. else
  1932. call DebugLine 'Displaying user message only (no error details)'
  1933. say CgiErrorCodes
  1934. return
  1935. end
  1936. call DebugLine 'Will show user error output as "' || CgiDoVar || '" was not defined'
  1937. CgiErrDefault='<P><HR><FONT SIZE=+1 COLOR=RED><CENTER><H1>FATAL ERROR</H1></CENTER><P><PRE>'
  1938. CgiErrorCodes=GetDefineValueOrUseDefault("CGI_FATAL_HEADER",CgiErrDefault)
  1939. say CgiErrorCodes
  1940. CgiErrDefault='</PRE><HR></FONT>'
  1941. CgiErrorCodes=GetDefineValueOrUseDefault("CGI_FATAL_TRAILER",CgiErrDefault)
  1942. CgiFatalError='Y'
  1943. return
  1944.  
  1945. CgiEndFatalError:
  1946. if OptionCgiModeOn='N' then
  1947. return
  1948. if CgiFatalError='N' then
  1949. return
  1950. say CgiErrorCodes
  1951. CgiFatalError='N'
  1952. return
  1953.  
  1954. _MustSeeAsIsInHtmlViewer:
  1955. BrowserOk=ReplaceString(arg(1), "<",          "<")
  1956. BrowserOk=ReplaceString(BrowserOk, ">",          ">")
  1957. return(BrowserOk)
  1958.  
  1959. CGI_8:
  1960. signal EndLineCrLfXH
  1961.  
  1962. CrLfClose:
  1963. _CrlfBuffer=''
  1964. return(stream(arg(1), 'c', 'close'))
  1965.  
  1966. CrLfOpen:
  1967. call CrLfClose arg(1)
  1968. _CrLfEOL=d2c(13)||d2c(10)
  1969. _CrLfEOLLng=2
  1970. if arg(2)<> '' then
  1971. do
  1972. if chars(arg(1))<>0 then
  1973. do
  1974. _CrLf2Read=arg(2)
  1975. if _CrLf2Read<5000 then
  1976. _CrLf2Read=5000
  1977. _CrlfBuffer=charin(arg(1),,_CrLf2Read)
  1978. if pos(_CrLfEOL,_CrlfBuffer)=0 then
  1979. do
  1980. if pos(d2c(10),_CrlfBuffer)<>0 then
  1981. do
  1982. _CrLfEOL=d2c(10)
  1983. _CrLfEOLLng=1
  1984. end
  1985. end
  1986. end
  1987. end
  1988. return(0)
  1989.  
  1990. CrLfLines:
  1991. if _CrlfBuffer<> '' then
  1992. return(1)
  1993. else
  1994. do
  1995. if chars(arg(1))=0 then
  1996. return(0)
  1997. else
  1998. return(1)
  1999. end
  2000.  
  2001. CrLfLineIn:
  2002. _CrLfPos=pos(_CrLfEOL,_CrlfBuffer)
  2003. do while _CrLfPos=0
  2004. if chars(arg(1))=0 then
  2005. leave
  2006. _CrlfBuffer=_CrlfBuffer||charin(arg(1),,5000)
  2007. _CrLfPos=pos(_CrLfEOL,_CrlfBuffer)
  2008. end
  2009. if _CrLfPos=0 then
  2010. do
  2011. _CrLfReturn=_CrlfBuffer
  2012. _CrlfBuffer=''
  2013. end
  2014. else
  2015. do
  2016. _CrLfReturn=left(_CrlfBuffer,_CrLfPos-1)
  2017. _CrlfBuffer=substr(_CrlfBuffer,_CrLfPos+_CrLfEOLLng)
  2018. end
  2019. return(_CrLfReturn)
  2020.  
  2021. EndLineCrLfXH:
  2022. ReplaceCount=0
  2023. CiSelfRef="{*}"
  2024. signal EndREPLSTR
  2025.  
  2026. ReplaceString:call TRACE "OFF"
  2027. parse arg rs?TheString,rs?ChangeFrom
  2028. rs?FoundPosn=pos(rs?ChangeFrom,rs?TheString)
  2029. if rs?FoundPosn=0 then
  2030. return(rs?TheString)
  2031. rs?ChangeTo=arg(3)
  2032. rs?ChangeFromLength=length(rs?ChangeFrom)
  2033. rs?LeftPart=''
  2034. do until rs?FoundPosn=0
  2035. rs?LeftPart=rs?LeftPart||left(rs?TheString,rs?FoundPosn-1)||rs?ChangeTo
  2036. rs?TheString=substr(rs?TheString,rs?FoundPosn+rs?ChangeFromLength)
  2037. ReplaceCount=ReplaceCount+1
  2038. rs?FoundPosn=pos(rs?ChangeFrom,rs?TheString)
  2039. end
  2040. return(rs?LeftPart||rs?TheString)
  2041.  
  2042. ReplaceStringCi:call TRACE "OFF"
  2043. rsi?TheString=arg(1)
  2044. rsi?TheStringU=translate(rsi?TheString)
  2045. rsi?ChangeFrom=translate(arg(2))
  2046. rsi?FoundPosn=pos(rsi?ChangeFrom,rsi?TheStringU)
  2047. if rsi?FoundPosn=0 then
  2048. return(rsi?TheString)
  2049. rsi?ChangeTo=arg(3)
  2050. if pos(CiSelfRef,rsi?ChangeTo)=0 then
  2051. rsi?Ref='N'
  2052. else
  2053. rsi?Ref='Y'
  2054. rsi?ChangeFromLength=length(rsi?ChangeFrom)
  2055. rsi?LeftPart=''
  2056. do until rsi?FoundPosn=0
  2057. if rsi?Ref='N' then
  2058. rsi?SubWith=rsi?ChangeTo
  2059. else
  2060. do
  2061. rsi?SaveCount=ReplaceCount
  2062. rsi?SubWith=ReplaceString(rsi?ChangeTo,CiSelfRef,substr(rsi?TheString,rsi?FoundPosn,rsi?ChangeFromLength))
  2063. ReplaceCount=rsi?SaveCount
  2064. end
  2065. rsi?LeftPart=rsi?LeftPart||left(rsi?TheString,rsi?FoundPosn-1)||rsi?SubWith
  2066. rsi?TheString=substr(rsi?TheString,rsi?FoundPosn+rsi?ChangeFromLength)
  2067. rsi?TheStringU=substr(rsi?TheStringU,rsi?FoundPosn+rsi?ChangeFromLength)
  2068. ReplaceCount=ReplaceCount+1
  2069. rsi?FoundPosn=pos(rsi?ChangeFrom,rsi?TheStringU)
  2070. end
  2071. return(rsi?LeftPart||rsi?TheString)
  2072.  
  2073. EndREPLSTR:
  2074. ReplaceCount=0
  2075. signal EndBULK_C2S
  2076.  
  2077. BulkChar2String:call TRACE "OFF"
  2078. parse arg brRightBit,brArray
  2079. brModifyThese=value(brArray)
  2080. brPos=verify(brRightBit,brModifyThese, 'M')
  2081. if brPos=0 then
  2082. return(brRightBit)
  2083. brLeftBit=''
  2084. brArray=brArray|| '.'
  2085. do until brPos=0
  2086. brLeftBit=brLeftBit||left(brRightBit,brPos-1)||value(brArray||pos(substr(brRightBit,brPos,1),brModifyThese))
  2087. brRightBit=substr(brRightBit,brPos+1)
  2088. ReplaceCount=ReplaceCount+1
  2089. brPos=verify(brRightBit,brModifyThese, 'M')
  2090. end
  2091. return(brLeftBit||brRightBit)
  2092.  
  2093. BulkChangePrepare:call TRACE "OFF"
  2094. parse arg brArray,brChar,brString
  2095. if brChar=='' then
  2096. call value brArray, ''
  2097. else
  2098. do
  2099. brValue=value(brArray)||BrChar
  2100. call value brArray,brValue
  2101. call value brArray|| '.' ||length(brValue),brString
  2102. end
  2103. return
  2104.  
  2105. EndBULK_C2S:
  2106. signal PREFIX_9;
  2107.  
  2108. HASHPREFIX_DEBUG:
  2109. if OptionDebugOn='Y' then
  2110. call OptionDebugShow 'HASHPREFIX', 'Hash prefix is now "' || HashPrefix || '" (' || HashPrefix || 'define etc)'
  2111. return
  2112.  
  2113. HASHPREFIX_GET:
  2114. call HASHPREFIX_DEBUG
  2115. return(HashPrefix)
  2116.  
  2117. HASHPREFIX_SET:
  2118. HashPrefix=arg(1)
  2119. if ProcessedCmdLine='N' then
  2120. do
  2121. call OptionDebugShow 'HASHPREFIX', 'Setting default value of hash Prefix to "' || HashPrefix || '"'
  2122. Default4_HashPrefix=HashPrefix
  2123. return(0)
  2124. end
  2125. if HashPrefix=='' then
  2126. HashPrefix=Default4_HashPrefix
  2127. AfterPrefix=translate(HashPrefix, '',LowerCase)
  2128. if AfterPrefix<>HashPrefix then
  2129. CryAndDie('A hash prefix should not include lower case characters!')
  2130. HashPrefixLng=length(HashPrefix)
  2131. call HASHPREFIX_DEBUG
  2132. CmdHashAsIs=HashPrefix|| 'ASIS'
  2133. CmdHashAutoTag=HashPrefix|| 'AUTOTAG'
  2134. CmdHashAutoTagClear=HashPrefix|| 'AUTOTAGCLEAR'
  2135. CmdHashAutoTagState=HashPrefix|| 'AUTOTAGSTATE'
  2136. CmdHashLoopBreak=HashPrefix|| 'BREAK'
  2137. CmdHashLoopContinue=HashPrefix|| 'CONTINUE'
  2138. CmdHashDebug=HashPrefix|| 'DEBUG'
  2139. CmdHashDefine=HashPrefix|| 'DEFINE'
  2140. CmdHashDefinePlus=HashPrefix|| 'DEFINE+'
  2141. CmdHashDefineRexx=HashPrefix|| 'DEFINEREXX'
  2142. CmdHashDefineRexxPlus=HashPrefix|| 'DEFINEREXX+'
  2143. CmdHashDependsOn=HashPrefix|| 'DEPENDSON'
  2144. CmdHashElseifL=HashPrefix|| 'ELSEIF'
  2145. CmdHashEndifL=HashPrefix|| 'ENDIF'
  2146. CmdHashEof=HashPrefix|| 'EOF'
  2147. CmdHashErrorL=HashPrefix|| 'ERROR'
  2148. CmdHashEvaluateL=HashPrefix|| 'EVALUATE'
  2149. CmdHashEvaluatePlusL=HashPrefix|| 'EVALUATE+'
  2150. CmdHashIf=HashPrefix|| 'IF'
  2151. CmdHashIfdef=HashPrefix|| 'IFDEF'
  2152. CmdHashIfndef=HashPrefix|| 'IFNDEF'
  2153. CmdHashImport=HashPrefix|| 'IMPORT'
  2154. CmdHashInclude=HashPrefix|| 'INCLUDE'
  2155. CmdHashInfo=HashPrefix|| 'INFO'
  2156. CmdHashMacroSpace=HashPrefix|| 'MACROSPACE'
  2157. CmdHashOneLine=HashPrefix|| 'ONELINE'
  2158. CmdHashOnExit=HashPrefix|| 'ONEXIT'
  2159. CmdHashOption=HashPrefix|| 'OPTION'
  2160. CmdHashOutput=HashPrefix|| 'OUTPUT'
  2161. CmdHashRequire=HashPrefix|| 'REQUIRE'
  2162. CmdHashRexxVar=HashPrefix|| 'REXXVAR'
  2163. CmdHashUndefL=HashPrefix|| 'UNDEF'
  2164. CmdHashWarningL=HashPrefix|| 'WARNING'
  2165. CmdHashLoopS=HashPrefix|| '{'
  2166. CmdHashLoopE=HashPrefix|| '}'
  2167. CmdHashEvaluateS=HashPrefix|| 'E'
  2168. CmdHashEvaluatePlusS=HashPrefix|| 'E+'
  2169. CmdHashUndefS=HashPrefix|| 'U'
  2170. CmdHashElseifS=HashPrefix|| 'ELSE'
  2171. CmdHashEndifS=HashPrefix|| 'END'
  2172. CmdHashErrorS=HashPrefix|| '!'
  2173. CmdHashWarningS=HashPrefix|| 'W'
  2174. return
  2175.  
  2176. PREFIX_9:
  2177. signal LineCmt_10;
  2178.  
  2179. LINECOMMENT_DEBUG:
  2180. if OptionDebugOn='Y' then
  2181. do
  2182. if LineComment<>NullChar then
  2183. call OptionDebugShow 'LINECOMMENT', 'Lines starting with "' || LineComment || '" are comments ("' || InLineComment || '" for inline comments)'
  2184. else
  2185. call OptionDebugShow 'LINECOMMENT', 'Comment removal has been turned off'
  2186. end
  2187. return
  2188.  
  2189. LINECOMMENT_GET:
  2190. call LINECOMMENT_DEBUG
  2191. return(LineCommentSet2)
  2192.  
  2193. LINECOMMENT_SET:
  2194. LineComment=arg(1)
  2195. LineCommentSet2=LineComment
  2196. if ProcessedCmdLine='N' then
  2197. do
  2198. call OptionDebugShow 'LINECOMMENT', 'Setting default value of line comment to "' || LineComment || '"'
  2199. Default4_LineComment=LineComment
  2200. return(0)
  2201. end
  2202. if LineComment=='' then
  2203. LineComment=Default4_LineComment
  2204. if translate(LineComment)='NULL' then
  2205. LineComment=NullChar
  2206. else
  2207. do
  2208. if length(LineComment)<>1 then
  2209. CryAndDie('A comment char should be one character long')
  2210. end
  2211. InLineComment=LineComment||LineComment
  2212. call LINECOMMENT_DEBUG
  2213. return
  2214.  
  2215. LineCmt_10:
  2216. signal WhiteSpc_11;
  2217.  
  2218. _WsFmt:
  2219. dbgExtra=''
  2220. do CharIndex=1 to length(ExtraWhiteSpace)
  2221. if CharIndex<>1 then
  2222. dbgExtra=dbgExtra|| ', '
  2223. dbgExtra=dbgExtra||c2x(substr(ExtraWhiteSpace,CharIndex,1))
  2224. end
  2225. return(dbgExtra)
  2226.  
  2227. WHITESPACE_DEBUG:
  2228. if OptionDebugOn='Y' then
  2229. do
  2230. if ExtraWhiteSpace=='' then
  2231. call OptionDebugShow 'WHITESPACE', 'No extra whitespace characters defined'
  2232. else
  2233. call OptionDebugShow 'WHITESPACE', 'Extra whitespace characters are hexadecimal ' ||_WsFmt()
  2234. end
  2235. return
  2236.  
  2237. WHITESPACE_GET:
  2238. call WHITESPACE_DEBUG
  2239. return(ExtraWhiteSpace)
  2240.  
  2241. WHITESPACE_SET:
  2242. ExtraWhiteSpace=arg(1)
  2243. if ProcessedCmdLine='N' then
  2244. do
  2245. Default4_ExtraWhiteSpace=ExtraWhiteSpace
  2246. if ExtraWhiteSpace=='' then
  2247. call OptionDebugShow 'WHITESPACE', 'Setting default to no extra whitespace'
  2248. else
  2249. call OptionDebugShow 'WHITESPACE', 'Setting default to extra whitespace characters are hexadecimal ' ||_WsFmt()
  2250. return(0)
  2251. end
  2252. if ExtraWhiteSpace=='NULL' then
  2253. ExtraWhiteSpace=Default4_ExtraWhiteSpace
  2254. call WHITESPACE_DEBUG
  2255. return
  2256.  
  2257. WhiteSpc_11:
  2258. signal LineCont_12;
  2259.  
  2260. LINECONTINUATION_DEBUG:
  2261. if OptionDebugOn='Y' then
  2262. do
  2263. if LineContChar=NullChar then
  2264. call OptionDebugShow 'LINECONTINUATION', 'Line continuation handling has been turned off'
  2265. else
  2266. do
  2267. call OptionDebugShow 'LINECONTINUATION', 'The line continuation character is now "' || LineContChar || '"'
  2268. if symbol('CodexNewLine') = 'VAR' then
  2269. DbgText='"' CodexNewLine || '"'
  2270. else
  2271. DbgText="'X' code for newline"
  2272. call DebugIncrement 1
  2273. call DebugLine '"' || LineContAddNewLine   || '" = Join with    ' ||DbgText
  2274. call DebugLine '"' || LineContWithoutSpace || '" = Join without space'
  2275. call DebugLine '"' || LineContWithSpace    || '" = Join with    space'
  2276. call DebugLine '"' || LineContDefault      || '" = Join with    space'
  2277. call DebugIncrement-1
  2278. end
  2279. end
  2280. return
  2281.  
  2282. LINECONTINUATION_GET:
  2283. call LINECONTINUATION_DEBUG
  2284. return(LineContCharList)
  2285.  
  2286. LINECONTINUATION_SET:
  2287. LineContParm=arg(1)
  2288. LineContParmSet2=LineContParm
  2289. if ProcessedCmdLine='N' then
  2290. do
  2291. call OptionDebugShow 'LINECONTINUATION', 'Setting default value of line continuation chars to "' || LineContParm || '"'
  2292. Default4_LineContParm=LineContParm
  2293. LineContCharList=LineContParm
  2294. return(0)
  2295. end
  2296. if LineContParm=='' then
  2297. LineContParm=Default4_LineContParm
  2298. if translate(LineContParm)='NULL' then
  2299. LineContParm=NullChar
  2300. else
  2301. do
  2302. if length(LineContParm)<>1&length(LineContParm)<>5 then
  2303. CryAndDie('Invalid line continuation spec of "' || LineContParm || '"')
  2304. end
  2305. LineContCharList=overlay(LineContParm,LineContCharList)
  2306. LineContChar=substr(LineContCharList,1,1)
  2307. LineContAddNewLine=substr(LineContCharList,2,1)||LineContChar
  2308. LineContAddNewLineObs=d2c(25)||LineContChar
  2309. LineContWithoutSpace=substr(LineContCharList,3,1)||LineContChar
  2310. LineContWithSpace=substr(LineContCharList,4,1)||LineContChar
  2311. LineContDefault=substr(LineContCharList,5,1)||LineContChar
  2312. call LINECONTINUATION_DEBUG
  2313. return
  2314.  
  2315. LineCont_12:
  2316. RexxTokens='|=+-/%*<>\,;:()&'
  2317. signal LineOut_13;
  2318.  
  2319. GenerateOneLine:
  2320. Line2Gen=arg(1)
  2321. if CheckSpelling='Y' then
  2322. do
  2323. if AllowSpell='Y' & Line2Gen <> '' then
  2324. call SpellCheckOneLine Line2Gen
  2325. end
  2326. if OptionFilterOut='' then
  2327. do
  2328. if 0<>charout(CurrentOutFile,Line2Gen||NewLineChars)then
  2329. do
  2330. IoReason=stream(CurrentOutFile, 'Description')
  2331. CryAndDie('Write to "' || CurrentOutFile || '" failed (' || IoReason || ')!')
  2332. end
  2333. GeneratedLines=GeneratedLines+1
  2334. CurrentOutLine=CurrentOutLine+1
  2335. end
  2336. else
  2337. do
  2338. FilterRc=HtmlFilterOut("O",Line2Gen,CurrentOutFile,CurrentOutLine,GeneratedLines,NewLineChars)
  2339. if Left(FilterRc,3)<> "OK:" then
  2340. CryAndDie(FilterRc)
  2341. else
  2342. do
  2343. NumWritten=substr(FilterRc,4)
  2344. GeneratedLines=GeneratedLines+NumWritten
  2345. CurrentOutLine=CurrentOutLine+NumWritten
  2346. end
  2347. end
  2348. return
  2349.  
  2350. OutputRexxLine:
  2351. RexxLine=arg(1)
  2352. if OptionPack='Y' & KeepIndent = 'N' then
  2353. do
  2354. if AllowPack='Y' then
  2355. RexxLine=CompressRexxLine(RexxLine)
  2356. else
  2357. do
  2358. if OptionDebugOn='Y' then
  2359. call DebugLine 'Not allowed to pack this line'
  2360. end
  2361. end
  2362. ElPos=pos(':',RexxLine)
  2363. if ElPos<>0 then
  2364. do
  2365. PossLabel=strip(left(RexxLine,ElPos-1))
  2366. if datatype(PossLabel, 'S')=1 then
  2367. call GenerateOneLine ''
  2368. end
  2369. if pos(NotEqualInC,RexxLine)<>0 then
  2370. call OutputInformationToScreen '"' || NotEqualInC || '" found.  Did you mean to use "<>" or "\="?'
  2371. call GenerateOneLine RexxLine
  2372. return
  2373.  
  2374. CompressRexxLine:
  2375. RexxLine=arg(1)
  2376. Spos=lastpos("'",RexxLine)
  2377. Dpos=lastpos('"',RexxLine)
  2378. EndPos=max(Spos,Dpos)
  2379. if EndPos=0 then
  2380. return(_CompressRexx(RexxLine))
  2381. else
  2382. do
  2383. Spos=pos("'",RexxLine)
  2384. Dpos=pos('"',RexxLine)
  2385. StartPos=min(Spos,Dpos)
  2386. if StartPos=0 then
  2387. StartPos=max(Spos,Dpos)
  2388. LeftBit=left(RexxLine,StartPos-1)
  2389. RightBit=substr(RexxLine,EndPos+1)
  2390. if right(LeftBit,1, "*") == ' ' then
  2391. LeftSpace=' '
  2392. else
  2393. LeftSpace=''
  2394. if left(RightBit,1, "*") == ' ' then
  2395. RightSpace=' '
  2396. else
  2397. RightSpace=''
  2398. LeftBit=_CompressRexx(LeftBit)
  2399. RightBit=_CompressRexx(RightBit)
  2400. if LeftSpace==' ' then
  2401. do
  2402. if right(LeftBit,1)='=' then
  2403. LeftSpace=''
  2404. end
  2405. LeftBit=_CompressRexx(LeftBit)
  2406. RightBit=_CompressRexx(RightBit)
  2407. return(LeftBit||LeftSpace||substr(RexxLine,StartPos,(EndPos-StartPos)+1)||RightSpace||RightBit)
  2408. end
  2409.  
  2410. _CompressRexx:
  2411. ToCompress=space(arg(1))
  2412. Compressed=''
  2413. TokenPos=verify(ToCompress,RexxTokens, 'M')
  2414. do while TokenPos<>0
  2415. Compressed=Compressed||strip(left(ToCompress,TokenPos-1), 'T')||substr(ToCompress,TokenPos,1)
  2416. ToCompress=strip(substr(ToCompress,TokenPos+1), 'L')
  2417. TokenPos=verify(ToCompress,RexxTokens, 'M')
  2418. end
  2419. return(Compressed||ToCompress)
  2420.  
  2421. LineOut_13:
  2422. AsIsCount=0
  2423. AsIsUsing=''
  2424. signal AsIs_14;
  2425.  
  2426. AsIsPrepare:call TRACE "OFF"
  2427. AsIsParms=space(arg(1))
  2428. AsIsUsing=AsIsParms
  2429. AsIsCount=0
  2430. AsIsIndex=0
  2431. AsIsCollecting=''
  2432. call DebugLine_ASIS 'AsIsPrepare(): Cleared memory. Processing "' || AsIsUsing || '"'
  2433. call DebugIncrement 1
  2434. aiOptCnt=0
  2435. do while AsIsParms<> ''
  2436. call _SetUpAsIsTagging translate(GetQuotedText(AsIsParms, "AsIsParms"))
  2437. end
  2438. if AsIsCount<>0 then
  2439. do
  2440. if aiOptCnt=0 then
  2441. aiMsg='none'
  2442. else
  2443. do
  2444. if aiOptCnt=AsIsCount then
  2445. aiMsg='all'
  2446. else
  2447. aiMsg=aiOptCnt
  2448. end
  2449. call DebugLine_ASIS 'Have ' || AsIsCount || ' "as is" tags (' || aiMsg || ' optimised)'
  2450. end
  2451. call DebugIncrement-1
  2452. return(AsIsCount)
  2453.  
  2454. ExpandAsIsTags:
  2455. if AsIsModeOn='N' then
  2456. return(arg(1))
  2457.  
  2458. AsIs:call TRACE "OFF"
  2459. if AsIsCount=0 then
  2460. return(arg(1))
  2461. EaiString=arg(1)
  2462. AsIsCnt=ReplaceCount
  2463. do Tag=1 to AsIsIndex
  2464. if AsIsBef.Tag=='' then
  2465. EaiString=BulkChar2String(EaiString,AsIsAft.Tag)
  2466. else
  2467. do
  2468. if left(AsIsBef.Tag,2)<>SrTypePre then
  2469. EaiString=ReplaceString(EaiString,AsIsBef.Tag,AsIsAft.Tag);
  2470. else
  2471. do
  2472. select
  2473. when abbrev(AsIsBef.Tag,SrCaseIns)then
  2474. EaiString=ReplaceStringCI(EaiString,substr(AsIsBef.Tag,SrCaseIns_P),AsIsAft.Tag);
  2475. when abbrev(AsIsBef.Tag,SrFixed)then
  2476. EaiString=CompareReplaceFixed2(EaiString,substr(AsIsBef.Tag,SrFixed_P),AsIsAft.Tag);
  2477. otherwise
  2478. EaiString=ReplaceString(EaiString,AsIsBef.Tag,AsIsAft.Tag);
  2479. end;
  2480. end
  2481. end
  2482. end
  2483. if OptionDebugOn='Y' then
  2484. do
  2485. if AsIsCnt<>ReplaceCount then
  2486. call DebugOutputAfterReplacement EaiString, 'ASIS'
  2487. end
  2488. return(EaiString)
  2489.  
  2490. ProcessAsIs:
  2491. HashCmdParms=PerformReplacementsInCmdsParameters(arg(1))
  2492. AsIsCmd=translate(GetQuotedText(HashCmdParms, "AsIsParms"))
  2493. if AsIsCmd='SETUP' then
  2494. do
  2495. AsIsPrepCache='?'
  2496. call SetupNamedAsIsStorage GetQuotedText(AsIsParms)
  2497. return(0)
  2498. end
  2499. call SetOnorOffVariable AsIsCmd, 'AsIsModeOn'
  2500. if AsIsModeOn='N' then
  2501. do
  2502. AsIsCount=0
  2503. if AsIsParms<> '' then
  2504. CryAndDie('Did not expect more than the "OFF" parameter')
  2505. call OptionsPop
  2506. end
  2507. else
  2508. do
  2509. call OptionsPush
  2510. call OptionOnOrOff_SET "KEEPINDENT",      "KeepIndent",      "ON"
  2511. call OptionOnOrOff_SET "LEAVEBLANKLINES", "LeaveBlankLines", "ON"
  2512. call LINECOMMENT_SET "NULL"
  2513. call LINECONTINUATION_SET "NULL"
  2514. call AsIsPrepare AsIsParms
  2515. end
  2516. if OptionDebugOn='Y' then
  2517. do
  2518. if AsIsCount=0 then
  2519. call DebugLine_ASIS 'AsIs mode is ' || YorN2OnorOff(AsIsModeOn) || '.  No tags prepared.'
  2520. else
  2521. call DebugLine_ASIS 'AsIs mode is ' || YorN2OnorOff(AsIsModeOn) || '.  Have ' || AsIsCount || ' tags from "' || AsIsUsing || '"'
  2522. end
  2523. return(0)
  2524.  
  2525. SetupNamedAsIsStorage:
  2526. AsIsNameU=translate(arg(1))
  2527. AsIsName='AI_' ||c2x(AsIsNameU)
  2528. AsIsAltCnt=arg(2)
  2529. AsIsCounter=0
  2530. if AsIsAltCnt='' then
  2531. do
  2532. TagFrom=AutoTagFirst
  2533. TagTo=AutoTagLast
  2534. end
  2535. else
  2536. do
  2537. TagFrom=1
  2538. TagTo=AsIsAltCnt
  2539. end
  2540. do Tag=TagFrom to TagTo
  2541. AsIsCounter=AsIsCounter+1
  2542. if AsIsAltCnt='' then
  2543. do
  2544. AsIsBef.AsIsCounter.AsIsName=AutoTagOnB.Tag
  2545. AsIsAft.AsIsCounter.AsIsName=AutoTagOnA.Tag
  2546. end
  2547. else
  2548. do
  2549. AsIsBef.AsIsCounter.AsIsName=ImportB.Tag
  2550. AsIsAft.AsIsCounter.AsIsName=ImportA.Tag
  2551. end
  2552. end
  2553. call _valueS AsIsName,AsIsCounter
  2554. if AsIsAltCnt='' then
  2555. call ClearAutoTags 'N'
  2556. call DebugLine_ASIS 'Captured ' || AsIsCounter || ' tags as "' || AsIsNameU || '"'
  2557. return
  2558.  
  2559. _SetUpAsIsTagging:
  2560. AsIsNameU=translate(arg(1))
  2561. AsIsName='AI_' ||c2x(AsIsNameU)
  2562. call DebugLine_ASIS 'Getting tags from storage named "' || AsIsNameU || '"'
  2563. call DebugIncrement 1
  2564. if symbol(AsIsName)<> 'VAR' then
  2565. CryAndDie('#AsIs "SETUP" has not been run for "' || AsIsNameU || '"')
  2566. AsIsCopyCount=_valueG(AsIsName)
  2567. do Index=1 to AsIsCopyCount
  2568. ThisBefore=AsIsBef.Index.AsIsName
  2569. ThisAfter=AsIsAft.Index.AsIsName
  2570. AsIsCount=AsIsCount+1
  2571. call DebugLine_ASIS 'AsIs #' || AsIsCount || ': From=' || DebugRightArrow || ThisBefore || DebugLeftArrow || ',  To=' ||DebugRightArrow||ThisAfter||DebugLeftArrow
  2572. if length(ThisBefore)<>1 then
  2573. do
  2574. AsIsCollecting=''
  2575. AsIsIndex=AsIsIndex+1
  2576. AsIsBef.AsIsIndex=ThisBefore
  2577. AsIsAft.AsIsIndex=ThisAfter
  2578. end
  2579. else
  2580. do
  2581. if AsIsCollecting=='' then
  2582. do
  2583. AsIsCollecting='OptAsIs' ||AsIsIndex
  2584. call _valueS AsIsCollecting, ''
  2585. AsIsIndex=AsIsIndex+1
  2586. AsIsBef.AsIsIndex=''
  2587. AsIsAft.AsIsIndex=AsIsCollecting
  2588. end
  2589. aiOptCnt=aiOptCnt+1
  2590. aiOptList=_valueG(AsIsCollecting)||ThisBefore
  2591. aiIndex=length(aiOptList)
  2592. call _valueS AsIsCollecting,aiOptList
  2593. call _valueS AsIsCollecting|| '.' ||aiIndex,ThisAfter
  2594. end
  2595. end
  2596. call DebugLine_ASIS 'Copied ' || AsIsCopyCount || ' tags'
  2597. call DebugIncrement-1
  2598. return
  2599.  
  2600. AsIs_14:
  2601. AtChangeType=''
  2602. AtChangeTypeDesc="CASESENSITIVE"
  2603. signal AutoTag_15;
  2604.  
  2605. ShowAutoTagStateWhenDebugOn:
  2606. if OptionDebugOn='Y' then
  2607. do
  2608. if AutoTagName='' then
  2609. DbgText1=''
  2610. else
  2611. DbgText1=' (named "' || AutoTagName || '")'
  2612. call DebugLine_AUTOTAG 'AutoTagging is ' || YorN2OnorOff(AutoTagOn) || '.  Have ' || ((AutoTagLast - AutoTagFirst) + 1) || ' tags available in state #' ||AutoTagStateCnt||DbgText1
  2613. if arg(1)='Y' then
  2614. do
  2615. call DebugIncrement 1
  2616. do Tag=AutoTagFirst to AutoTagLast
  2617. call DebugLine_AUTOTAG 'AutoTag #' || Tag || ': From=' || DebugRightArrow || AutoTagOnB.Tag || DebugLeftArrow || ',  To=' ||DebugRightArrow||AutoTagOnA.Tag||DebugLeftArrow
  2618. end
  2619. call DebugIncrement-1
  2620. end
  2621. end
  2622. return
  2623.  
  2624. CompletelyInitializeAutoTagState:
  2625. AutoTagOn='N'
  2626. call ClearAutoTags 'Y'
  2627. return
  2628.  
  2629. ClearAutoTags:
  2630. if arg(1)='N' then
  2631. do
  2632. if AutoTagStateCnt=0 then
  2633. AutoTagLast=0
  2634. else
  2635. AutoTagLast=AutoTagState.AutoTagStateCnt.Last
  2636. end
  2637. else
  2638. do
  2639. AutoTagLast=0
  2640. AutoTagStateCnt=0
  2641. AutoTagFirst=1
  2642. AutoTagName=''
  2643. end
  2644. if OptionDebugOn='Y' then
  2645. do
  2646. if AutoTagStateCnt=0 then
  2647. call DebugLine_AUTOTAG 'Cleared ALL autotags (no state information saved - State #0).'
  2648. else
  2649. call ShowAutoTagStateWhenDebugOn
  2650. end
  2651. return
  2652.  
  2653. AutoTag:call TRACE "OFF"
  2654. EatString=arg(1)
  2655. if AutoTagFirst>AutoTagLast then
  2656. return(EatString)
  2657. AtCnt=ReplaceCount
  2658. do Tag=AutoTagFirst to AutoTagLast
  2659. if left(AutoTagOnB.Tag,2)<>SrTypePre then
  2660. EatString=ReplaceString(EatString,AutoTagOnB.Tag,AutoTagOnA.Tag);
  2661. else
  2662. do
  2663. select
  2664. when abbrev(AutoTagOnB.Tag,SrCaseIns)then
  2665. EatString=ReplaceStringCI(EatString,substr(AutoTagOnB.Tag,SrCaseIns_P),AutoTagOnA.Tag);
  2666. when abbrev(AutoTagOnB.Tag,SrFixed)then
  2667. EatString=CompareReplaceFixed2(EatString,substr(AutoTagOnB.Tag,SrFixed_P),AutoTagOnA.Tag);
  2668. otherwise
  2669. EatString=ReplaceString(EatString,AutoTagOnB.Tag,AutoTagOnA.Tag);
  2670. end;
  2671. end
  2672. end
  2673. if OptionDebugOn='Y' then
  2674. do
  2675. if AtCnt<>ReplaceCount then
  2676. call DebugOutputAfterReplacement EatString, 'ATAG'
  2677. end
  2678. return(EatString)
  2679.  
  2680. ProcessAutoTagClear:
  2681. if arg(1)='' then
  2682. AtClearAll='N'
  2683. else
  2684. do
  2685. AtParm=GetQuotedText(arg(1))
  2686. if translate(AtParm)<> 'ALL' then
  2687. CryAndDie('Invalid parameter of "' || AtParm || '" specified!')
  2688. AtClearAll='Y'
  2689. end
  2690. call ClearAutoTags AtClearAll
  2691. return(0)
  2692.  
  2693. _GetStateIndexForNameOrDie:
  2694. gsiName=arg(1)
  2695. do NameIndex=1 to AutoTagStateCnt
  2696. if gsiName=AutoTagState.NameIndex.Name then
  2697. return(NameIndex)
  2698. end
  2699. CryAndDie('There is no state known as "' || gsiName(1) || '"')
  2700.  
  2701. MatchesAutoTagStateIncDebugText:
  2702. MatchIndex=arg(1)
  2703. if MatchIndex<=0 then
  2704. return('')
  2705. else
  2706. return(' (matches "#AutoTagState +" at ' || AutoTagState.MatchIndex.AtLine || ')')
  2707.  
  2708. ProcessAutoTagState:
  2709. Rest=strip(arg(1))
  2710. Ats1stParm=left(Rest,1)
  2711. if Ats1stParm='+' | Ats1stParm = '-' then
  2712. Rest=substr(Rest,2)
  2713. else
  2714. Ats1stParm=GetQuotedText(arg(1), "Rest")
  2715. select
  2716. when Ats1stParm='+' then
  2717. do
  2718. AutoTagStateCnt=AutoTagStateCnt+1
  2719. AutoTagState.AutoTagStateCnt.First=AutoTagFirst
  2720. AutoTagState.AutoTagStateCnt.Last=AutoTagLast
  2721. AutoTagState.AutoTagStateCnt.Name=AutoTagName
  2722. AutoTagState.AutoTagStateCnt.AtOnOff=AutoTagOn
  2723. AutoTagState.AutoTagStateCnt.AtLine=CurrentSourceLocation()
  2724. BeforeFirst=AutoTagFirst
  2725. BeforeLast=AutoTagLast
  2726. AutoTagFirst=AutoTagLast+1
  2727. AutoTagName=''
  2728. do while Rest<> ''
  2729. StateAlias=translate(GetQuotedText(Rest, "Rest"))
  2730. if StateAlias="REMEMBER" then
  2731. do
  2732. CopyFrom=BeforeFirst
  2733. Copyto=BeforeLast
  2734. end
  2735. else
  2736. do
  2737. NameIndex=_GetStateIndexForNameOrDie(StateAlias)
  2738. CopyFrom=AutoTagState.NameIndex.First
  2739. Copyto=AutoTagState.NameIndex.Last
  2740. end
  2741. do AddTagIndex=CopyFrom to CopyTo
  2742. call _AddAutoTag AutoTagOnB.AddTagIndex,AutoTagOnA.AddTagIndex
  2743. end
  2744. end
  2745. if OptionDebugOn='Y' then
  2746. call DebugLine_AUTOTAG 'Remembering current #AutoTag state, now in state #' ||AutoTagStateCnt
  2747. end
  2748. when Ats1stParm='-' then
  2749. do
  2750. if AutoTagStateCnt<=0 then
  2751. CryAndDie('No #autotag states memorised!')
  2752. if OptionDebugOn='Y' then
  2753. call DebugLine_AUTOTAG 'This restore matches the setup at ' ||AutoTagState.AutoTagStateCnt.AtLine
  2754. BeforeFirst=AutoTagFirst
  2755. BeforeLast=AutoTagLast
  2756. AutoTagFirst=AutoTagState.AutoTagStateCnt.First
  2757. AutoTagLast=AutoTagState.AutoTagStateCnt.Last
  2758. AutoTagOn=AutoTagState.AutoTagStateCnt.AtOnOff
  2759. AutoTagName=AutoTagState.AutoTagStateCnt.Name
  2760. AutoTagStateCnt=AutoTagStateCnt-1
  2761. if Rest='' then
  2762. Remember='N'
  2763. else
  2764. do
  2765. Rest=translate(GetQuotedText(Rest, "Rest"))
  2766. if Rest="REMEMBER" then
  2767. Remember='Y'
  2768. else
  2769. CryAndDie('Invalid parameter of "' || Rest || '" specified (expected "REMEMBER")')
  2770. end
  2771. if Rest='' then
  2772. DbgWord='dropping'
  2773. else
  2774. do
  2775. Rest=translate(GetQuotedText(Rest))
  2776. if Rest<> "REMEMBER" then
  2777. CryAndDie('Invalid parameter of "' || Rest || '" specified (expected "REMEMBER")')
  2778. DbgWord='remembering'
  2779. AutoTagLast=AutoTagFirst-1
  2780. do AddTagIndex=BeforeFirst to BeforeLast
  2781. call _AddAutoTag AutoTagOnB.AddTagIndex,AutoTagOnA.AddTagIndex
  2782. end
  2783. end
  2784. if OptionDebugOn='Y' then
  2785. call DebugLine_AUTOTAG 'Restoring #AutoTag state #' || AutoTagStateCnt || ', we are ' || DbgWord || ' any new tags you may have defined'
  2786. end
  2787. otherwise
  2788. AutoTagName=translate(Ats1stParm)
  2789. if Rest<> '' then
  2790. call DieIfExtraUnexpectedParms Rest
  2791. if OptionDebugOn='Y' then
  2792. call DebugLine_AUTOTAG 'This state is now named "' || AutoTagName || '"'
  2793. end
  2794. call ShowAutoTagStateWhenDebugOn AutoTagOn
  2795. return(0)
  2796.  
  2797. _AddAutoTag:
  2798. TheTagB=arg(1)
  2799. TheTagA=arg(2)
  2800. ThePosn=arg(3)
  2801. if ThePosn='' then
  2802. ThePosn='999999'
  2803. ThePosn=(ThePosn+AutoTagFirst)-1
  2804. if ThePosn>AutoTagLast then
  2805. do
  2806. AutoTagLast=AutoTagLast+1
  2807. SlotIndex=AutoTagLast
  2808. end
  2809. else
  2810. do
  2811. ToIndex=AutoTagLast+2
  2812. do MoveIndex=ThePosn to AutoTagLast
  2813. ToIndex=ToIndex-1
  2814. FromIndex=ToIndex-1
  2815. AutoTagOnB.ToIndex=AutoTagOnB.FromIndex
  2816. AutoTagOnA.ToIndex=AutoTagOnA.FromIndex
  2817. end
  2818. SlotIndex=ThePosn
  2819. AutoTagLast=AutoTagLast+1
  2820. end
  2821. AutoTagOnB.SlotIndex=TheTagB
  2822. AutoTagOnA.SlotIndex=TheTagA
  2823. return
  2824.  
  2825. _DeleteAutoTag:
  2826. TheTagB=arg(1)
  2827. do Tag=AutoTagFirst to AutoTagLast
  2828. if TheTagB=AutoTagOnB.Tag then
  2829. do
  2830. AutoTagLast=AutoTagLast-1
  2831. do ToIndex=Tag to AutoTagLast
  2832. FromIndex=ToIndex+1
  2833. AutoTagOnB.ToIndex=AutoTagOnB.FromIndex
  2834. AutoTagOnA.ToIndex=AutoTagOnA.FromIndex
  2835. end
  2836. return('Y')
  2837. end
  2838. end
  2839. if OptionDebugOn='Y' then
  2840. call DebugLine_AUTOTAG 'No need to delete the tag (it does not exist)'
  2841. return('N')
  2842.  
  2843. ProcessAutoTag:
  2844. AtBefore=GetQuotedText(arg(1), "Rest")
  2845. if AtBefore='' then
  2846. CryAndDie("You did not supply text to be replaced (can't replace empty string)!")
  2847. AtDumpList='N'
  2848. OnOrOff=IsStringOnOrOffCmd(AtBefore)
  2849. if OnOrOff<> '' & Rest = '' then
  2850. do
  2851. AutoTagOn=OnOrOff
  2852. if AutoTagOn='Y' then
  2853. AtDumpList='Y'
  2854. end
  2855. else
  2856. do
  2857. AtBefore_NoCT=AtBefore
  2858. AtBefore=AtChangeType||AtBefore
  2859. if Rest='' then
  2860. call _DeleteAutoTag AtBefore
  2861. else
  2862. do
  2863. AtAfter=ReplaceString(GetQuotedText(Rest, "Rest"),AutoTagSelf,AtBefore_NoCT)
  2864. if ReplacementsAllowed='Y' then
  2865. do
  2866. do while pos(StartsMacroReplacement,AtAfter)<>0
  2867. BeforeCount=ReplaceCount
  2868. AtAfterR=_ReplaceAllHashDefinedVariables(AtAfter)
  2869. if pos(MarksNewLine,AtAfterR)<>0 then
  2870. leave
  2871. AtAfter=AtAfterR
  2872. if OptionDebugOn='Y' then
  2873. do
  2874. if BeforeCount<>ReplaceCount then
  2875. call DebugOutputAfterReplacement AtAfter, 'VP2O'
  2876. end
  2877. end
  2878. if pos(StartsStdSymbolReplacement,AtAfter)<>0 then
  2879. do
  2880. if pos(MarksNewLine,AtAfter)=0 then
  2881. do
  2882. BeforeCount=ReplaceCount
  2883. AtAfterR=ReplaceStandardDefinitions(AtAfter)
  2884. if BeforeCount<>ReplaceCount then
  2885. do
  2886. if pos(MarksNewLine,AtAfterR)=0 then
  2887. do
  2888. AtAfter=AtAfterR
  2889. if OptionDebugOn='Y' then
  2890. call DebugOutputAfterReplacement AtAfter, 'SP2O'
  2891. end
  2892. end
  2893. end
  2894. end
  2895. end
  2896. AtSlot=''
  2897. if Rest<> '' then
  2898. do
  2899. SlotSpec=word(rest,1)
  2900. Rest=subword(rest,2)
  2901. if left(SlotSpec,1)<> '#' then
  2902. CryAndDie('Invalid slot specification of "' || SlotSpec || '" supplied, must begin with a "#"!')
  2903. AtSlot=substr(SlotSpec,2)
  2904. end
  2905. if OptionDebugOn='Y' then
  2906. call DebugLine_AUTOTAG 'Assigning ' || DebugRightArrow || AtBefore_NoCT || DebugLeftArrow || ' = ' || DebugRightArrow || AtAfter || DebugLeftArrow || ' (TYPE=' || AtChangeTypeDesc || ')'
  2907. call _AddAutoTag AtBefore,AtAfter,AtSlot
  2908. end
  2909. end
  2910. call ShowAutoTagStateWhenDebugOn AtDumpList
  2911. if Rest<> '' then
  2912. CryAndDie('Too many parameters!')
  2913. return(0)
  2914.  
  2915. ATCHANGETYPE_DEBUG:
  2916. if OptionDebugOn='Y' then
  2917. call OptionDebugShow 'ATCHANGETYPE', 'AutoTag change type is "' || AtChangeTypeDesc || '"'
  2918. return
  2919.  
  2920. ATCHANGETYPE_GET:
  2921. call ATCHANGETYPE_DEBUG
  2922. return(AtChangeTypeDesc)
  2923.  
  2924. ATCHANGETYPE_SET:
  2925. AtChangeTypeDesc=translate(arg(1))
  2926. if ProcessedCmdLine='N' then
  2927. do
  2928. call OptionDebugShow 'ATCHANGETYPE', 'Setting default change type to "' || AtChangeTypeDesc || '"'
  2929. Default4_ATCHANGETYPEDESC=AtChangeTypeDesc
  2930. return(0)
  2931. end
  2932. if AtChangeTypeDesc=='' then
  2933. AtChangeTypeDesc=Default4_ATCHANGETYPEDESC
  2934. SelectOn=translate(AtChangeTypeDesc)
  2935. select
  2936. when SelectOn="CASESENSITIVE" then
  2937. AtChangeType=''
  2938. when SelectOn="CASEINSENSITIVE" then
  2939. AtChangeType=SrCaseIns
  2940. when SelectOn="FIXED" then
  2941. AtChangeType=SrFixed
  2942. otherwise
  2943. CryAndDie('Unknown ATCHANGETYPE option of "' || AtChangeTypeDesc || '"')
  2944. end
  2945. call ATCHANGETYPE_DEBUG
  2946. return
  2947.  
  2948. AutoTag_15:
  2949. OptionCount=0
  2950. LongestPpwOptionLng=0
  2951. call _OptionsAdd "ALLOWPACK"
  2952. call _OptionsAdd "ALLOWSPELL"
  2953. call _OptionsAdd "CSREPLACEMENT"
  2954. call _OptionsAdd "DEFINEMACROREPLACE"
  2955. call _OptionsAdd "KEEPINDENT"
  2956. call _OptionsAdd "LEAVEBLANKLINES"
  2957. call _OptionsAdd "REPLACE"
  2958. call _OptionsAdd "ATCHANGETYPE"
  2959. call _OptionsAdd "DEBUGLEVEL"
  2960. call _OptionsAdd "EXTRAINDENT"
  2961. call _OptionsAdd "EXPANDX"
  2962. call _OptionsAdd "HASHPREFIX"
  2963. call _OptionsAdd "LINECOMMENT"
  2964. call _OptionsAdd "LINECONTINUATION"
  2965. call _OptionsAdd "MACROPARMTAGS"
  2966. call _OptionsAdd "REPLACEMENTTAGS"
  2967. call _OptionsAdd "WHITESPACE"
  2968. signal OPTION_16;
  2969.  
  2970. _OptionsAdd:
  2971. OptionCount=OptionCount+1
  2972. OptionList.OptionCount=arg(1)
  2973. ThisLng=length(arg(1))
  2974. if ThisLng>LongestPpwOptionLng then
  2975. LongestPpwOptionLng=ThisLng
  2976. return
  2977.  
  2978. SetUpPpwizardOptionDefaults:
  2979. if RexSystemOpSys<> "UNIX" then
  2980. DefWhite=d2c(26)||d2c(27)
  2981. else
  2982. DefWhite=d2c(13)||d2c(26)||d2c(27)
  2983. ProcessedCmdLine='N'
  2984. call DebugLine_OPTIONS 'Setting PPWIZARD defaults (may be overriden with ' || RexOptionChar || 'option switch)'
  2985. call DebugIncrement 1
  2986. call OptionOnOrOff_SET "ALLOWPACK",          "AllowPack",           "ON"
  2987. call OptionOnOrOff_SET "ALLOWSPELL",         "AllowSpell",          "ON"
  2988. call ATCHANGETYPE_SET "CASESENSITIVE"
  2989. call OptionOnOrOff_SET "CSREPLACEMENT",      "CsReplacement",       "OFF"
  2990. call DEBUGLEVEL_SET 'ALL,-USER1,-USER2'
  2991. call OptionOnOrOff_SET "DEFINEMACROREPLACE", "DefineMacroReplace",  "OFF"
  2992. call EXPANDX_SET 'LATE'
  2993. call EXTRAINDENT_SET 'NULL'
  2994. call HASHPREFIX_SET '#'
  2995. call OptionOnOrOff_SET "KEEPINDENT",         "KeepIndent",          "OFF"
  2996. call OptionOnOrOff_SET "LEAVEBLANKLINES",    "LeaveBlankLines",     "OFF"
  2997. call LINECOMMENT_SET ';'
  2998. call LINECONTINUATION_SET '\%-+ '
  2999. call MACROPARMTAGS_SET '{}$'
  3000. call OptionOnOrOff_SET "REPLACE",            "ReplacementsAllowed", "ON"
  3001. call REPLACEMENTTAGS_SET '<>$?'
  3002. call WHITESPACE_SET DefWhite
  3003. call DebugIncrement-1
  3004. return
  3005.  
  3006. SetUpOptionsForThisBuild:
  3007. ProcessedCmdLine='Y'
  3008. call DebugLine_OPTIONS 'Initializing #options for this build of ' ||CurrentOutFile
  3009. call DebugIncrement 1
  3010. call OptionOnOrOff_SET "ALLOWPACK",          "AllowPack",           ""
  3011. call OptionOnOrOff_SET "ALLOWSPELL",         "AllowSpell",          ""
  3012. call ATCHANGETYPE_SET ''
  3013. call OptionOnOrOff_SET "CSREPLACEMENT",      "CsReplacement",       ""
  3014. call DEBUGLEVEL_SET ''
  3015. call OptionOnOrOff_SET "DEFINEMACROREPLACE", "DefineMacroReplace",  ""
  3016. call EXPANDX_SET ''
  3017. call EXTRAINDENT_SET ''
  3018. call HASHPREFIX_SET ''
  3019. call OptionOnOrOff_SET "KEEPINDENT",         "KeepIndent",          ""
  3020. call OptionOnOrOff_SET "LEAVEBLANKLINES",    "LeaveBlankLines",     ""
  3021. call LINECOMMENT_SET ''
  3022. call LINECONTINUATION_SET ''
  3023. call MACROPARMTAGS_SET ''
  3024. call OptionOnOrOff_SET "REPLACE",            "ReplacementsAllowed", ""
  3025. call REPLACEMENTTAGS_SET ''
  3026. call WHITESPACE_SET 'NULL'
  3027. call DebugIncrement-1
  3028. return
  3029.  
  3030. MatchesOptionStackPushDebugText:
  3031. MatchIndex=arg(1)
  3032. if MatchIndex<=0 then
  3033. return('')
  3034. else
  3035. return(' (matches "#option PUSH" at ' || OptPush.MatchIndex || ')')
  3036.  
  3037. OptionsPush:
  3038. OptionStackCnt=OptionStackCnt+1
  3039. OptPush.OptionStackCnt=CurrentSourceLocation()
  3040. PushName='OptPush' ||OptionStackCnt
  3041. if OptionDebugOn='Y' then
  3042. call DebugLine_OPTIONS 'Saving current options on stack as #' ||OptionStackCnt
  3043. call DebugIncrement 1
  3044. do OptionIndex=1 to OptionCount
  3045. call _valueS PushName|| '.' ||OptionIndex,OptionGetValue(OptionList.OptionIndex)
  3046. end
  3047. call DebugIncrement-1
  3048. return
  3049.  
  3050. OptionsPop:
  3051. if OptionStackCnt<=0 then
  3052. CryAndDie('There are no options on the stack to pop!')
  3053. if OptionDebugOn='Y' then
  3054. call DebugLine_OPTIONS 'Restoring current options from #' || OptionStackCnt || ' (pushed at ' || OptPush.OptionStackCnt || ')'
  3055. call DebugIncrement 1
  3056. PushName='OptPush' ||OptionStackCnt
  3057. do OptionIndex=1 to OptionCount
  3058. call OptionSetValue OptionList.OptionIndex,_valueG(PushName|| '.' ||OptionIndex)
  3059. end
  3060. call DebugIncrement-1
  3061. OptionStackCnt=OptionStackCnt-1
  3062. return
  3063.  
  3064. ProcessOption:
  3065. Options=arg(1)
  3066. if ProcessedCmdLine='Y' then
  3067. Options=PerformReplacementsInCmdsParameters(Options)
  3068. if Options='' then
  3069. CryAndDie('No options specified!')
  3070. do while Options<> ''
  3071. parse var Options Word1' 'RestOptions
  3072. Word1=translate(word1)
  3073. select
  3074. when Word1="PUSH" | Word1 = "+" then
  3075. do
  3076. Options=RestOptions
  3077. call OptionsPush
  3078. end
  3079. when Word1="POP" | Word1 = "-" then
  3080. do
  3081. Options=RestOptions
  3082. call OptionsPop
  3083. end
  3084. otherwise
  3085. do
  3086. if pos('=',Options)=0 then
  3087. CryAndDie('Could not find an "=" sign in "' || Options || '"')
  3088. parse var Options ThisOption'='Options
  3089. ThisOption=translate(strip(ThisOption))
  3090. ThisValue=GetQuotedText(Options, "Options")
  3091. call OptionSetValue ThisOption,ThisValue
  3092. end
  3093. end
  3094. end
  3095. return(0)
  3096.  
  3097. OptionDebugShow:
  3098. if OptionDebugOn='Y' then
  3099. call DebugLine_OPTIONS left(arg(1),LongestPpwOptionLng)|| ': ' ||arg(2)
  3100. return
  3101.  
  3102. OptionOnOrOff_DEBUG:
  3103. if OptionDebugOn='Y' then
  3104. call OptionDebugShow arg(1), 'Currently set to ' ||YorN2OnorOff(_valueG(arg(2)))
  3105. return
  3106.  
  3107. OptionOnOrOff_SET:
  3108. parse arg OptionName,OnOffVar2Set,OnOffValue
  3109. if ProcessedCmdLine='N' then
  3110. do
  3111. call OptionDebugShow OptionName, 'Setting default to "' || OnOffValue || '"'
  3112. call _valueS "Default4_" ||OnOffVar2Set,OnOffValue
  3113. return(0)
  3114. end
  3115. if OnOffValue=='' then
  3116. OnOffValue=_valueG("Default4_" ||OnOffVar2Set)
  3117. OnOrOff=IsStringOnOrOffCmd(OnOffValue)
  3118. if OnOrOff='' then
  3119. CryAndDie('Tried to set "' || OnOffVar2Set || '" to an invalid value of "' || OnOffValue || '"')
  3120. call _valueS OnOffVar2Set,OnOrOff
  3121. call OptionOnOrOff_DEBUG OptionName,OnOffVar2Set
  3122. return(0)
  3123.  
  3124. OptionOnOrOff_GET:
  3125. parse arg OptionName,OnOffVar2Get
  3126. VarState=YorN2OnorOff(_valueG(OnOffVar2Get))
  3127. call OptionOnOrOff_DEBUG OptionName,OnOffVar2Get
  3128. return(VarState)
  3129.  
  3130. OptionSetValue:
  3131. parse arg sOption,sValue
  3132. select
  3133. when sOption="ALLOWPACK" then
  3134. call OptionOnOrOff_SET "ALLOWPACK", "AllowPack",sValue
  3135. when sOption="ALLOWSPELL" then
  3136. call OptionOnOrOff_SET "ALLOWSPELL", "AllowSpell",sValue
  3137. when sOption="ATCHANGETYPE" then
  3138. call ATCHANGETYPE_SET sValue,sOption
  3139. when sOption="CSREPLACEMENT" then
  3140. call OptionOnOrOff_SET "CSREPLACEMENT", "CsReplacement",sValue
  3141. when sOption="DEBUGLEVEL" then
  3142. call DEBUGLEVEL_SET sValue,sOption
  3143. when sOption="DEFINEMACROREPLACE" then
  3144. call OptionOnOrOff_SET "DEFINEMACROREPLACE", "DefineMacroReplace",sValue
  3145. when sOption="EXPANDX" then
  3146. call EXPANDX_SET sValue,sOption
  3147. when sOption="EXTRAINDENT" then
  3148. call EXTRAINDENT_SET sValue,sOption
  3149. when sOption="HASHPREFIX" then
  3150. call HASHPREFIX_SET sValue,sOption
  3151. when sOption="KEEPINDENT" then
  3152. call OptionOnOrOff_SET "KEEPINDENT", "KeepIndent",sValue
  3153. when sOption="LEAVEBLANKLINES" then
  3154. call OptionOnOrOff_SET "LEAVEBLANKLINES", "LeaveBlankLines",sValue
  3155. when sOption="LINECOMMENT" then
  3156. call LINECOMMENT_SET sValue,sOption
  3157. when sOption="LINECONTINUATION" then
  3158. call LINECONTINUATION_SET sValue,sOption
  3159. when sOption="MACROPARMTAGS" then
  3160. call MACROPARMTAGS_SET sValue,sOption
  3161. when sOption="REPLACE" then
  3162. call OptionOnOrOff_SET "REPLACE", "ReplacementsAllowed",sValue
  3163. when sOption="REPLACEMENTTAGS" then
  3164. call REPLACEMENTTAGS_SET sValue,sOption
  3165. when sOption="WHITESPACE" then
  3166. call WHITESPACE_SET sValue,sOption
  3167. otherwise
  3168. CryAndDie("Can't set '" || sOption || "' as this option is unknown")
  3169. end
  3170. return
  3171.  
  3172. OptionGetValue:
  3173. parse arg gOption
  3174. select
  3175. when gOption="ALLOWPACK" then
  3176. return(OptionOnOrOff_GET("ALLOWPACK", "AllowPack"))
  3177. when gOption="ALLOWSPELL" then
  3178. return(OptionOnOrOff_GET("ALLOWSPELL", "AllowSpell"))
  3179. when gOption="ATCHANGETYPE" then
  3180. return(ATCHANGETYPE_GET(gOption))
  3181. when gOption="CSREPLACEMENT" then
  3182. return(OptionOnOrOff_GET("CSREPLACEMENT", "CsReplacement"))
  3183. when gOption="DEBUGLEVEL" then
  3184. return(DEBUGLEVEL_GET(gOption))
  3185. when gOption="DEFINEMACROREPLACE" then
  3186. return(OptionOnOrOff_GET("DEFINEMACROREPLACE", "DefineMacroReplace"))
  3187. when gOption="EXPANDX" then
  3188. return(EXPANDX_GET(gOption))
  3189. when gOption="EXTRAINDENT" then
  3190. return(EXTRAINDENT_GET(gOption))
  3191. when gOption="HASHPREFIX" then
  3192. return(HASHPREFIX_GET(gOption))
  3193. when gOption="KEEPINDENT" then
  3194. return(OptionOnOrOff_GET("KEEPINDENT", "KeepIndent"))
  3195. when gOption="LEAVEBLANKLINES" then
  3196. return(OptionOnOrOff_GET("LEAVEBLANKLINES", "LeaveBlankLines"))
  3197. when gOption="LINECOMMENT" then
  3198. return(LINECOMMENT_GET(gOption))
  3199. when gOption="LINECONTINUATION" then
  3200. return(LINECONTINUATION_GET(gOption))
  3201. when gOption="MACROPARMTAGS" then
  3202. return(MACROPARMTAGS_GET(gOption))
  3203. when gOption="REPLACE" then
  3204. return(OptionOnOrOff_GET("REPLACE", "ReplacementsAllowed"))
  3205. when gOption="REPLACEMENTTAGS" then
  3206. return(REPLACEMENTTAGS_GET(gOption))
  3207. when gOption="WHITESPACE" then
  3208. return(WHITESPACE_GET(gOption))
  3209. otherwise
  3210. CryAndDie("Can't get '" || gOption || "' as this option is unknown")
  3211. end
  3212. return
  3213.  
  3214. OPTION_16:
  3215. DefRexxSpecialSepTag='<' || '?xRexxEos>'
  3216. call InitializeDefineRexx
  3217. signal Def_Rexx_17;
  3218.  
  3219. InitializeDefineRexx:
  3220. DefRexxVar=''
  3221. DefRexxAddType=''
  3222. DefRexxCode=''
  3223. DefRexxStartLoc=''
  3224. DefRexxPack='Y'
  3225. return
  3226.  
  3227. ProcessDefineRexx:
  3228. if arg(1)='' then
  3229. do
  3230. if DefRexxVar='' then
  3231. CryAndDie("Not currently defining rexx code!", 'To execute you need to specify a parameter of ""')
  3232. if DefineMacroReplace='Y' then
  3233. DefRexxCode=PerformReplacementsInCmdsParameters(DefRexxCode)
  3234. if DefRexxVar<> '?JustExec?' then
  3235. do
  3236. call AddHashDefine DefRexxVar,DefRexxCode,DefRexxAddType
  3237. end
  3238. else
  3239. do
  3240. if OptionDebugOn='Y' then
  3241. call DebugLine_DEFINING 'Rexx code will be immediately executed but not saved'
  3242. DefRexxCode=PerformReplacementsInCmdsParameters(DefRexxCode)
  3243. call ExecRexxCmd DefRexxCode
  3244. end
  3245. call InitializeDefineRexx
  3246. end
  3247. else
  3248. do
  3249. if DefRexxVar<> '' then
  3250. CryAndDie("Already in rexx code block started at " ||DefRexxStartLoc)
  3251. DefRexxStartLoc=CurrentSourceLocation()
  3252. DefRexxAddType=arg(2)
  3253. DefRexxVar=GetQuotedText(PerformReplacementsInCmdsParameters(arg(1)), "Rest")
  3254. if DefRexxVar='' then
  3255. DefRexxVar='?JustExec?'
  3256. if Rest<> '' then
  3257. do
  3258. Rest=translate(Rest)
  3259. do until Rest=''
  3260. DefSpec=GetQuotedText(Rest, "Rest")
  3261. select
  3262. when DefSpec='NOPACK' then
  3263. DefRexxPack='N'
  3264. otherwise
  3265. CryAndDie('Invalid option of "' || DefSpec || '" used')
  3266. end
  3267. end
  3268. end
  3269. if OptionDebugOn='Y' then
  3270. do
  3271. if DefRexxPack='Y' then
  3272. call DebugLine_DEFINING "AllowPack option is currently " ||YorN2OnorOff(AllowPack)
  3273. end
  3274. end
  3275. return(0)
  3276.  
  3277. AddDefineRexxLine:
  3278. NewRexxLine=strip(arg(1))
  3279. if right(NewRexxLine,2)=RexxCmtEnd then
  3280. do
  3281. StartCmtPos=lastpos(RexxCmtStart,NewRexxLine)
  3282. if StartCmtPos<>0 then
  3283. do
  3284. if StartCmtPos=0 then
  3285. NewRexxLine=''
  3286. else
  3287. NewRexxLine=strip(left(NewRexxLine,StartCmtPos-1), 'T')
  3288. end
  3289. end
  3290. do while right(NewRexxLine,1)=';'
  3291. NewRexxLine=strip(left(NewRexxLine,length(NewRexxLine)-1), 'T')
  3292. end
  3293. if NewRexxLine='' then
  3294. return
  3295. if DefRexxPack='Y' then
  3296. do
  3297. if AllowPack='Y' then
  3298. NewRexxLine=CompressRexxLine(NewRexxLine)
  3299. end
  3300. if DefRexxCode='' then
  3301. DefRexxCode=NewRexxLine
  3302. else
  3303. DefRexxCode=DefRexxCode||DefRexxSpecialSepTag||NewRexxLine
  3304. return
  3305.  
  3306. Def_Rexx_17:
  3307. InfiniteLoopDetected='N'
  3308. InfiniteLoopWhen=0
  3309. InfiniteIncludeLoopWhen=0
  3310. RexxSkipCounter=0
  3311. ArePositionalChars='"' || "'="
  3312. signal Define_18;
  3313.  
  3314. _MacroBitNotFoundText:
  3315. if CsReplacement='N' then
  3316. return('')
  3317. else
  3318. return('Macro names & parameters are case sensitive (check case)')
  3319.  
  3320. InitializeHashDefinesForThisCompile:
  3321. call DebugLine_DEFINING 'Initializing all #defines, got ' || OptionDefineCount || ' /define definitions to load up.'
  3322. drop MACRO?.
  3323. call AddHashDefine '_PPWIZARD_', ''
  3324. if OptionDefineCount<>0 then
  3325. do
  3326. do Index=1 to OptionDefineCount
  3327. call AddHashDefine OptionDefine.Index.Var,OptionDefine.Index.Cont
  3328. end
  3329. end
  3330. call _GetUserOptionsViaDefineSwitch
  3331. return
  3332.  
  3333. _GetUserOptionsViaDefineSwitch:
  3334. call DebugLine_MACROVALORDEF 'Getting some lesser options (not worth specific commands)'
  3335. call DebugIncrement 1
  3336. if RexSystemOpSys="UNIX" then
  3337. PathDelimiterChar=':'
  3338. else
  3339. PathDelimiterChar=';'
  3340. PathDelimiterChar=GetDefineValueOrUseDefault("PATH_DELIMITER_CHAR",PathDelimiterChar)
  3341. if length(PathDelimiterChar)<>1 then
  3342. CryAndDie("Invalid path delimiter (expected 1 only character)")
  3343. RexxLocalVar=GetDefineValueOrUseDefault("REXX_MAKE_LOCAL_VAR", '@' || '@')
  3344. InfiniteLoopWhen=GetDefineValueOrUseDefault("INFINITE_MACRO_LOOP_WHEN",20)
  3345. InfiniteIncludeLoopWhen=GetDefineValueOrUseDefault("INFINITE_INCLUDE_LOOP_WHEN",20)
  3346. call DebugIncrement-1
  3347. return
  3348.  
  3349. REPLACEMENTTAGS_DEBUG:
  3350. if OptionDebugOn='Y' then
  3351. call OptionDebugShow 'REPLACEMENTTAGS', 'Replace tags now look like "' || StartsMacroReplacement || 'MacroVar' || EndsMacroReplacement || '" and "' || StartsStdSymbolReplacement || 'StandardMacroVar' || EndsMacroReplacement || '"'
  3352. return
  3353.  
  3354. REPLACEMENTTAGS_SET:
  3355. Tags=arg(1)
  3356. if ProcessedCmdLine='N' then
  3357. do
  3358. call OptionDebugShow 'REPLACEMENTTAGS', 'Setting default value of replacement tags to "' || Tags || '"'
  3359. Default4_ReplacementTags=Tags
  3360. return(0)
  3361. end
  3362. if Tags=='' then
  3363. Tags=Default4_ReplacementTags
  3364. if length(Tags)<>4 then
  3365. CryAndDie('Tried to set invalid replace tags of "' || Tags || '"')
  3366. StartsMacroReplacement=substr(Tags,1,1)||substr(Tags,3,1)
  3367. StdSymbolReplacementChar=substr(Tags,4,1)
  3368. StartsStdSymbolReplacement=substr(Tags,1,1)||StdSymbolReplacementChar
  3369. EndsMacroReplacement=substr(Tags,2,1)
  3370. EndsVar=' ' ||EndsMacroReplacement
  3371. StartsStdSymbolReplacement_x=StartsStdSymbolReplacement|| 'x'
  3372. CodexNewLine=StartsStdSymbolReplacement|| "NewLine" ||EndsMacroReplacement
  3373. CodexHexNewLine=StartsStdSymbolReplacement_x|| "0A" ||EndsMacroReplacement
  3374. CodexHexSpace=StartsStdSymbolReplacement_x|| "20" ||EndsMacroReplacement
  3375. CodexHexHash=StartsStdSymbolReplacement_x|| "23" ||EndsMacroReplacement
  3376. CodexHexDollar=StartsStdSymbolReplacement_x|| "24" ||EndsMacroReplacement
  3377. CodexHexLessThan=StartsStdSymbolReplacement_x|| "3C" ||EndsMacroReplacement
  3378. call REPLACEMENTTAGS_DEBUG
  3379. return
  3380.  
  3381. REPLACEMENTTAGS_GET:
  3382. call REPLACEMENTTAGS_DEBUG
  3383. return(substr(StartsMacroReplacement,1,1)||EndsMacroReplacement||substr(StartsMacroReplacement,2,1)||substr(StartsStdSymbolReplacement,2,1))
  3384.  
  3385. MACROPARMTAGS_DEBUG:
  3386. if OptionDebugOn='Y' then
  3387. call OptionDebugShow 'MACROPARMTAGS', 'Macro parameters now look like "' || StartsMacroParm || 'MacroParameter' || EndsMacroParm || '"'
  3388. return
  3389.  
  3390. MACROPARMTAGS_SET:
  3391. Tags=arg(1)
  3392. if ProcessedCmdLine='N' then
  3393. do
  3394. call OptionDebugShow 'MACROPARMTAGS', 'Setting default value of macro parameter tags to "' || Tags || '"'
  3395. Default4_MacroParameterTags=Tags
  3396. return(0)
  3397. end
  3398. if Tags=='' then
  3399. Tags=Default4_MacroParameterTags
  3400. if length(Tags)<>3 then
  3401. CryAndDie('Tried to set invalid macro parameter tags of "' || Tags || '"')
  3402. StartsMacroParm=substr(Tags,1,1)||substr(Tags,3,1)
  3403. EndsMacroParm=substr(Tags,2,1)
  3404. HidesMacroParm=substr(Tags,1,1)|| '_' ||substr(Tags,3,1)
  3405. AutoTagSelf=StartsMacroParm|| 'AT' ||EndsMacroParm
  3406. call MACROPARMTAGS_DEBUG
  3407. return
  3408.  
  3409. MACROPARMTAGS_GET:
  3410. call MACROPARMTAGS_DEBUG
  3411. return(substr(StartsMacroParm,1,1)||EndsMacroParm||substr(StartsMacroParm,2,1))
  3412.  
  3413. ProcessDefine:
  3414. Rest=arg(1)
  3415. if DefineMacroReplace='Y' then
  3416. Rest=PerformReplacementsInCmdsParameters(Rest)
  3417. if pos(MarksNewLineInHashDefine,Rest)<>0 then
  3418. do
  3419. Rest=ReplaceString(arg(1),MarksNewLineInHashDefine2,MarksNewLine)
  3420. Rest=ReplaceString(Rest,MarksNewLineInHashDefine,MarksNewLine)
  3421. end
  3422. parse var Rest HashDefineV HashDefineC
  3423. return(AddHashDefine(HashDefineV,strip(HashDefineC),arg(2)))
  3424.  
  3425. ProcessEvaluate:
  3426. Rest=PerformReplacementsInCmdsParameters(arg(1))
  3427. HashDefineAnswerName=GetQuotedText(Rest, "Rest")
  3428. if Rest='' then
  3429. CryAndDie('Evaluate what command?')
  3430. CmdToEvaluate=GetQuotedRest(Rest)
  3431. HashDefineRc=0
  3432. if HashDefineAnswerName='' then
  3433. call ExecRexxCmd CmdToEvaluate
  3434. else
  3435. do
  3436. CmdToEvaluate='EvaluateAnswer = ' ||CmdToEvaluate
  3437. call ExecRexxCmd CmdToEvaluate
  3438. HashDefineRc=AddHashDefine(HashDefineAnswerName,EvaluateAnswer,arg(2))
  3439. end
  3440. return(HashDefineRc)
  3441.  
  3442. VariableExists:
  3443. if CsReplacement='N' then
  3444. VarNme=c2x(translate(arg(1)))
  3445. else
  3446. VarNme=c2x(arg(1))
  3447. if symbol('MACRO?.M?' || VarNme) = 'VAR' then
  3448. return('Y')
  3449. else
  3450. return('N')
  3451.  
  3452. HandleUndefCommand:
  3453. UndefVar=arg(1)
  3454. if verify(UndefVar,EndsVar, 'M') <> 0 then CryAndDie('The macro name "' || UndefVar || '" is invalid (Any of "' || EndsVar || '" are invalid)')
  3455. if CsReplacement='N' then
  3456. UndefVar=c2x(translate(UndefVar))
  3457. else
  3458. UndefVar=c2x(UndefVar)
  3459. SavedAs='MACRO?.M?' ||UndefVar
  3460. if symbol(SavedAs)='VAR' then
  3461. drop(SavedAs)
  3462. return(0)
  3463.  
  3464. MacroSet:call TRACE "OFF"
  3465.  
  3466. AddHashDefine:
  3467. parse arg HashDefineU,HashDefineC,OkToRedefine
  3468. if verify(HashDefineU,EndsVar, 'M') <> 0 then CryAndDie('The macro name "' || HashDefineU || '" is invalid (Any of "' || EndsVar || '" are invalid)')
  3469. if CsReplacement='N' then
  3470. HashDefineV=c2x(translate(HashDefineU))
  3471. else
  3472. HashDefineV=c2x(HashDefineU)
  3473. if OptionDebugOn='Y' then
  3474. do
  3475. call DebugLine_DEFINING 'Defining "' || HashDefineU || '" as ' ||DebugRightArrow||HashDefineC||DebugLeftArrow
  3476. call DebugIncrement 1
  3477. end
  3478. SavedAs='MACRO?.M?' ||HashDefineV
  3479. if symbol(SavedAs)='VAR' then
  3480. do
  3481. if OkToRedefine='Y' then
  3482. do
  3483. if OptionDebugOn='Y' then
  3484. call DebugLine_DEFINING 'User said OK to redefine so no warning'
  3485. end
  3486. else
  3487. do
  3488. call OutputWarningToScreen 'R000', 'Redefine of "' || HashDefineU || '".'
  3489. end
  3490. end
  3491. call _valueS SavedAs,HashDefineC
  3492. if OptionDebugOn='Y' then
  3493. call DebugIncrement-1
  3494. return(0)
  3495.  
  3496. PerformReplacementsInCmdsParameters:
  3497. cpParms=ReplaceHashAndStandardDefines(arg(1), "PRM")
  3498. if ExpandXCmd='Y' then
  3499. do
  3500. if pos(StartsStdSymbolReplacement_x,cpParms)<>0 then
  3501. cpParms=ReplaceTheXCodesWeKnowExist(cpParms)
  3502. end
  3503. if pos(MarksNewLine,cpParms)<>0 then
  3504. do
  3505. Line1='The commands parameters expanded a macro that generated multiple lines!'
  3506. Line2='The parameters are now:'
  3507. Line3=copies(' ',8)||translate(cpParms,DebugNewline,MarksNewLine)
  3508. CryAndDie(Line1,Line2,Line3)
  3509. end
  3510. return(cpParms)
  3511.  
  3512. ReplaceMacros:call TRACE "OFF"
  3513. signal _ReplaceMacros
  3514.  
  3515. ReplaceHashAndStandardDefines:
  3516. if ReplacementsAllowed='N' then
  3517. return(arg(1))
  3518.  
  3519. _ReplaceMacros:
  3520. parse arg HashDefineString,HashDefPrefix,HashDefRecord
  3521. ReplLoop=0
  3522. do while pos(StartsMacroReplacement,HashDefineString)<>0
  3523. BeforeCount=ReplaceCount
  3524. HashDefineString=_ReplaceAllHashDefinedVariables(HashDefineString)
  3525. if HashDefRecord='Y' then
  3526. LastLineAfterMacroRep=HashDefineString
  3527. if OptionDebugOn='Y' then
  3528. do
  3529. if BeforeCount<>ReplaceCount then
  3530. do
  3531. if HashDefPrefix='' then
  3532. call DebugOutputAfterReplacement HashDefineString, 'VCMD'
  3533. else
  3534. call DebugOutputAfterReplacement HashDefineString, 'V' ||HashDefPrefix
  3535. end
  3536. end
  3537. if pos(MarksNewLine,HashDefineString)<>0 then
  3538. leave
  3539. if ReplLoop>=InfiniteLoopWhen then
  3540. do
  3541. if InfiniteLoopWhen<>0 then
  3542. do
  3543. InfiniteLoopDetected='Y'
  3544. if ReplLoop=InfiniteLoopWhen then
  3545. do
  3546. OptionDebugOn='Y'
  3547. call DebugLine 'Infinite loop detected, debug forced on for a few loops'
  3548. call DebugIncrement 1
  3549. call DebugLine InfiniteLoopWhen|| ' loops detected, possible actions:'
  3550. call DebugIncrement 1
  3551. call DebugLine 'Have have you forgotten to use "#option DefineMacroReplace=ON" somewhere?'
  3552. call DebugLine 'Use "/define:INFINITE_MACRO_LOOP_WHEN=0"    to turn off detection'
  3553. call DebugLine 'Use "/define:INFINITE_MACRO_LOOP_WHEN=1000" to increase detection threshold'
  3554. call DebugIncrement-2
  3555. say ''
  3556. call OutputInfoIfDebugOn
  3557. end
  3558. say ''
  3559. if ReplLoop>InfiniteLoopWhen+50 then
  3560. CryAndDie("Infinite loop detected (debug turned on above), current line now:", "",HashDefineString)
  3561. end
  3562. end
  3563. ReplLoop=ReplLoop+1
  3564. end
  3565. if InfiniteLoopDetected='Y' then
  3566. CryAndDie("Increase your loop detection value from " || InfiniteLoopWhen || ' with "/define:INFINITE_MACRO_LOOP_WHEN=Value"', "Increase to at least " || ReplLoop || '!')
  3567. if pos(StartsStdSymbolReplacement,HashDefineString)<>0 then
  3568. do
  3569. BeforeCount=ReplaceCount
  3570. HashDefineString=ReplaceStandardDefinitions(HashDefineString)
  3571. if HashDefRecord='Y' then
  3572. LastLineAfterMacroRep=HashDefineString
  3573. if OptionDebugOn='Y' then
  3574. do
  3575. if BeforeCount<>ReplaceCount then
  3576. do
  3577. if HashDefPrefix='' then
  3578. call DebugOutputAfterReplacement HashDefineString, 'SCMD'
  3579. else
  3580. call DebugOutputAfterReplacement HashDefineString, 'S' ||HashDefPrefix
  3581. end
  3582. end
  3583. end
  3584. return(HashDefineString)
  3585.  
  3586. _UnknownStandardSymbol:
  3587. call CryAndDie 'The standard symbol "' || StartsStdSymbolReplacement || SymbolName || EndsMacroReplacement || '" is unknown!'
  3588.  
  3589. ReplaceStandardDefinitions:
  3590. RightBit=arg(1)
  3591. if pos(MarksNewLine,RightBit)<>0 then
  3592. return(RightBit)
  3593. LeftBit=''
  3594. StartPos=pos(StartsStdSymbolReplacement,RightBit)
  3595. do while StartPos<>0
  3596. EndPos=pos(EndsMacroReplacement,RightBit,StartPos+1)
  3597. if EndPos=0 then
  3598. CryAndDie('Could not find the "' || EndsMacroReplacement || '" end of variable started at: ' ||substr(RightBit,StartPos))
  3599. LeftBit=LeftBit||left(RightBit,StartPos-1)
  3600. SymbolNameC=substr(RightBit,StartPos+2,(EndPos-StartPos)-2)
  3601. RightBit=substr(RightBit,EndPos+1)
  3602. if left(SymbolNameC,1)='x' then
  3603. do
  3604. ReplaceCount=ReplaceCount-1
  3605. SymbolValue=StartsStdSymbolReplacement||SymbolNameC||EndsMacroReplacement
  3606. end
  3607. else
  3608. do
  3609. if OptionDebugOn='Y' then
  3610. call DebugOutputVariableInfo_FOUNDSTDVAR 'Found : ' ||StartsStdSymbolReplacement||SymbolNameC||EndsMacroReplacement
  3611. SymbolName=translate(SymbolNameC)
  3612. Left1=left(SymbolName,1)
  3613. if Left1='=' then
  3614. DdCodes=''
  3615. else
  3616. do
  3617. SpcPos=pos(' ',SymbolName)
  3618. if SpcPos=0 then
  3619. DdCodes=''
  3620. else
  3621. do
  3622. DdCodes=substr(SymbolName,SpcPos+1)
  3623. SymbolName=left(SymbolName,SpcPos-1)
  3624. end
  3625. end
  3626. select
  3627. when Left1='?' then
  3628. do
  3629. SymbolName=substr(SymbolName,2)
  3630. if symbol(SymbolName)<> 'VAR' then
  3631. do
  3632. call DumpVarsIfCompoundVariable SymbolName
  3633. call CryAndDie 'The rexx variable "' || SymbolName || '" is unknown!'
  3634. end
  3635. SymbolValue=_valueG(SymbolName)
  3636. end
  3637. when Left1='I' then
  3638. do
  3639. select
  3640. when SymbolName="INPUTFILE" then
  3641. SymbolValue=InputFileFull
  3642. when SymbolName="INPUTCOMPONENT" then
  3643. SymbolValue=IncludeFileName
  3644. when SymbolName="INPUTCOMPONENTLINE" then
  3645. SymbolValue=IncludeLineNumber
  3646. when SymbolName="INCLUDELEVEL" then
  3647. SymbolValue=IncludeLevel
  3648. otherwise
  3649. call _UnknownStandardSymbol
  3650. end
  3651. end
  3652. when Left1='S' then
  3653. do
  3654. select
  3655. when SymbolName="SPACE" then
  3656. SymbolValue=CodexHexSpace
  3657. when SymbolName="SEMICOLON" then
  3658. SymbolValue=';'
  3659. otherwise
  3660. call _UnknownStandardSymbol
  3661. end
  3662. end
  3663. when Left1='O' then
  3664. do
  3665. select
  3666. when SymbolName="OUTPUTLINE" then
  3667. SymbolValue=CurrentOutLine+1
  3668. when SymbolName="OUTPUTLEVEL" then
  3669. SymbolValue=OutputLevel
  3670. when SymbolName="OPSYS" then
  3671. SymbolValue=PpWizardOpSys
  3672. when SymbolName="OUTPUTFILE" then
  3673. do
  3674. CloseRc=stream(CurrentOutFile, 'c', 'close')
  3675. SymbolValue=SafeQueryExists(CurrentOutFile)
  3676. if SymbolValue='' then
  3677. CryAndDie('Could not obtain file name information for the "' || StartsStdSymbolReplacement || 'OutputFile>" variable!')
  3678. end
  3679. otherwise
  3680. call _UnknownStandardSymbol
  3681. end
  3682. end
  3683. when Left1='P' then
  3684. do
  3685. select
  3686. when SymbolName='PROCESSINGMODE' then
  3687. SymbolValue=OptionCodeType
  3688. when SymbolName='PROTECTFROMPPWSTART' then
  3689. SymbolValue=MarksNewLine||HashPrefix||ProtectFromPpwS||MarksNewLine
  3690. when SymbolName='PROTECTFROMPPWEND' then
  3691. SymbolValue=MarksNewLine||ProtectFromPpwE||MarksNewLine
  3692. when SymbolName='PPWIZARDAUTHORHOMEPAGE' then
  3693. SymbolValue=PgmAuthorHomePage
  3694. when SymbolName='PPWIZARDAUTHOR' then
  3695. SymbolValue=PgmAuthor
  3696. when SymbolName='PPWIZARDAUTHOREMAIL' then
  3697. SymbolValue=PgmAuthorEmail
  3698. when SymbolName='PPWIZARDHOMEPAGE' then
  3699. SymbolValue=PgmHomePage
  3700. when SymbolName='PPWIZARDGENERATORMETATAGS' then
  3701. SymbolValue=PgmDefaultHtmlMetaTags
  3702. otherwise
  3703. call _UnknownStandardSymbol
  3704. end
  3705. end
  3706. when Left1='D' then
  3707. do
  3708. select
  3709. when SymbolName='DEBUGON' then
  3710. SymbolValue=OptionDebugOn
  3711. when SymbolName='DOLLAR' then
  3712. SymbolValue=CodexHexDollar
  3713. when SymbolName='DIRSLASH' then
  3714. SymbolValue=RexDirChar
  3715. otherwise
  3716. call _UnknownStandardSymbol
  3717. end
  3718. end
  3719. when SymbolName='NEWLINE' then
  3720. SymbolValue=CodexHexNewLine
  3721. when SymbolName='COMPILETIME' then
  3722. SymbolValue=CompileTime
  3723. when SymbolName='VERSION' then
  3724. SymbolValue=PgmVersion
  3725. when SymbolName='HASH' then
  3726. SymbolValue=CodexHexHash
  3727. when SymbolName='HASHPREFIX' then
  3728. SymbolValue=HashPrefix
  3729. when SymbolName='RESTARTLINE' then
  3730. SymbolValue=MarksNewLine
  3731. when SymbolName='TOTALOUTPUTLINES' then
  3732. SymbolValue=GeneratedLines+1
  3733. when SymbolName='NEWESTFILEDATETIME' then
  3734. SymbolValue=NewestSourcefile
  3735. when SymbolName='LESSTHAN' then
  3736. SymbolValue=CodexHexLessThan
  3737. when SymbolName='UNIQUE' then
  3738. do
  3739. PPwizardUnique=PPwizardUnique+1
  3740. SymbolValue=PPwizardUnique
  3741. end
  3742. when SymbolName='TEMPLATEDATAFILE' then
  3743. SymbolValue=TemplateDataFile
  3744. when SymbolName='CGISTART' then
  3745. SymbolValue='Content-type: text/html' ||CodexHexNewLine||CodexHexNewLine
  3746. when SymbolName='REXXSKIP' then
  3747. do
  3748. RexxSkipCounter=RexxSkipCounter+1
  3749. RexxLbl=_filespec("WITHOUTEXTN", _filespec("NAME", IncludeFileName)) || '_' ||RexxSkipCounter
  3750. SymbolValue=MarksNewLine||HashPrefix|| 'RexxVar "RexxSkipLbl" = "' || RexxLbl || '"' ||MarksNewLine
  3751. SymbolValue=SymbolValue|| 'signal ' || RexxLbl || ';' ||MarksNewLine
  3752. SymbolValue=SymbolValue||MarksNewLine||HashPrefix|| 'RexxVar "RexxSkipLbl" PUSH' ||MarksNewLine
  3753. end
  3754. when SymbolName='REXXSKIPTO' then
  3755. do
  3756. SymbolValue=MarksNewLine||HashPrefix|| 'RexxVar "RexxSkipLbl" POP' ||MarksNewLine
  3757. SymbolValue=SymbolValue||RexxSkipLbl|| ':' ||MarksNewLine
  3758. end
  3759. when Left1='=' then
  3760. do
  3761. if OptionDebugOn='Y' then
  3762. call DebugIncrement 1
  3763. call ExecRexxCmd 'SymbolValue = ' ||substr(SymbolName,2)
  3764. if OptionDebugOn='Y' then
  3765. call DebugIncrement-1
  3766. end
  3767. otherwise
  3768. call _UnknownStandardSymbol
  3769. end
  3770. if DdCodes<> '' then
  3771. do
  3772. do until DdCodes=''
  3773. parse var DdCodes DdCode DdCodes
  3774. if OptionDebugOn='Y' then
  3775. do
  3776. call DebugOutputVariableInfo_FOUNDSTDVAR '$$Bef : ' ||SymbolValue
  3777. call DebugOutputVariableInfo_FOUNDSTDVAR '$$Cmd : ' ||DdCode
  3778. end
  3779. select
  3780.  
  3781. when DdCode='$$DSQ' then
  3782. do
  3783. QChar=QuoteIt(SymbolValue,TryQuoteListDs)
  3784. SymbolValue=QChar||SymbolValue||QChar
  3785. end
  3786.  
  3787. when DdCode='$$SDQ' then
  3788. do
  3789. QChar=QuoteIt(SymbolValue,TryQuoteListSd)
  3790. SymbolValue=QChar||SymbolValue||QChar
  3791. end
  3792.  
  3793. when DdCode='$$AQ' then
  3794. do
  3795. QChar=QuoteIt(SymbolValue,TryQuoteListAny)
  3796. SymbolValue=QChar||SymbolValue||QChar
  3797. end
  3798.  
  3799. when DdCode='$$UPPER' then
  3800. SymbolValue=translate(SymbolValue)
  3801.  
  3802. when DdCode='$$LOWER' then
  3803. SymbolValue=ToLowerCase(SymbolValue)
  3804.  
  3805. when DdCode='$$ADDCOMMA' then
  3806. SymbolValue=AddCommasToDecimalNumber(SymbolValue)
  3807.  
  3808. when DdCode='$$HTMLQ' then
  3809. SymbolValue=ReplaceString(SymbolValue, '"', '"')
  3810.  
  3811. when DdCode='$$SQX2' then
  3812. SymbolValue=ReplaceString(SymbolValue, "'" , "''")
  3813.  
  3814. when DdCode='$$SPCPLUS' then
  3815. do
  3816. if SymbolValue\=='' then
  3817. SymbolValue=' ' ||SymbolValue
  3818. end
  3819.  
  3820. otherwise
  3821. do
  3822. UserRexx=GetDefineValueOrUseDefault("REXX_" || DdCode, '')
  3823. if UserRexx='' then
  3824. CryAndDie('The $$ replacement command of "' || DdCode || '" is unknown!')
  3825. TheMacro=""
  3826. TheName=SymbolName
  3827. TheValue=SymbolValue
  3828. call ExecRexxCmd UserRexx
  3829. if OptionDebugOn='Y' then
  3830. do
  3831. if SymbolValue=TheValue then
  3832. do
  3833. call DebugIncrement 1
  3834. call DebugOutputVariableInfo_FOUNDVARPARMS 'The user rexx code did not modify the "TheValue" variable'
  3835. call DebugIncrement-1
  3836. end
  3837. end
  3838. SymbolValue=TheValue
  3839. end
  3840. end
  3841. end
  3842. end
  3843. if OptionDebugOn='Y' then
  3844. call DebugOutputVariableInfo_FOUNDSTDVAR 'Value : ' ||DebugRightArrow||SymbolValue||DebugLeftArrow
  3845. end
  3846. LeftBit=LeftBit||SymbolValue
  3847. ReplaceCount=ReplaceCount+1
  3848. if pos(MarksNewLine,SymbolValue)<>0 then
  3849. leave
  3850. StartPos=pos(StartsStdSymbolReplacement,RightBit)
  3851. end
  3852. return(LeftBit||RightBit)
  3853.  
  3854. GetDefineContents:
  3855. if CsReplacement='N' then
  3856. VarNme=c2x(translate(arg(1)))
  3857. else
  3858. VarNme=c2x(arg(1))
  3859. SavedAs='MACRO?.M?' ||VarNme
  3860. if symbol(SavedAs)='VAR' then
  3861. return(_valueG(SavedAs))
  3862. call DebugLine 'The unknown symbols ALIAS is "' || VarNme || '"'
  3863. CryAndDie('Macro named "' || arg(1) || '" does not exist!',_MacroBitNotFoundText())
  3864.  
  3865. ReplaceDefinitionsParameters:
  3866. do ParmIndex=1 to ParmCount
  3867. ParmUsed.ParmIndex='N'
  3868. end
  3869. DefaultCnt=0
  3870. ParmLeftBit=''
  3871. ParmRightBit=VariableCont
  3872. ParmPos=pos(StartsMacroParm,ParmRightBit)
  3873. do while ParmPos<>0
  3874. ParmLeftBit=ParmLeftBit||left(ParmRightBit,ParmPos-1)
  3875. ParmRightBit=substr(ParmRightBit,ParmPos+2)
  3876. EqualPos=pos('=',ParmRightBit)
  3877. MaybeEndPos=pos(EndsMacroParm,ParmRightBit)
  3878. if MaybeEndPos=0 then
  3879. CryAndDie('Incorrect use of macro parameter, no matching "' || EndsMacroParm || '" for "' || StartsMacroParm || '"')
  3880. if EqualPos<>0&EqualPos<MaybeEndPos then
  3881. do
  3882. if CsReplacement='N' then
  3883. ThisParmName=translate(strip(left(ParmRightBit,EqualPos-1)))
  3884. else
  3885. ThisParmName=strip(left(ParmRightBit,EqualPos-1))
  3886. ParmRightBit=substr(ParmRightBit,EqualPos+1)
  3887. ParmDefault=GetQuotedText(ParmRightBit, "ParmRightBit",EndsMacroParm)
  3888. HaveDefault='Y'
  3889. CurlyPos=pos(EndsMacroParm,ParmRightBit)
  3890. if CurlyPos=0 then
  3891. CryAndDie("Expected to find '" || EndsMacroParm || "' " || 'after the parameter default of "' || ParmDefault || '"!')
  3892. ParmCmds=left(ParmRightBit,CurlyPos-1)
  3893. ParmRightBit=substr(ParmRightBit,CurlyPos+1)
  3894. FoundIndex=0
  3895. do DefaultIndex=1 to DefaultCnt
  3896. if ThisParmName=PrmDefaultName.DefaultIndex then
  3897. do
  3898. FoundIndex=DefaultIndex
  3899. leave
  3900. end
  3901. end
  3902. if FoundIndex=0 then
  3903. do
  3904. DefaultCnt=DefaultCnt+1
  3905. FoundIndex=DefaultCnt
  3906. end
  3907. PrmDefaultName.FoundIndex=ThisParmName
  3908. PrmDefaultValue.FoundIndex=ParmDefault
  3909. end
  3910. else
  3911. do
  3912. HaveDefault='N'
  3913. if CsReplacement='N' then
  3914. ThisParmName=translate(strip(left(ParmRightBit,MaybeEndPos-1)))
  3915. else
  3916. ThisParmName=strip(left(ParmRightBit,MaybeEndPos-1))
  3917. SpcPos=pos(' ',ThisParmName)
  3918. if SpcPos=0 then
  3919. ParmCmds=''
  3920. else
  3921. do
  3922. ParmCmds=substr(ThisParmName,SpcPos+1)
  3923. ThisParmName=left(ThisParmName,SpcPos-1)
  3924. end
  3925. ParmRightBit=substr(ParmRightBit,MaybeEndPos+1)
  3926. end
  3927. if OptionDebugOn='Y' then
  3928. call DebugOutputVariableInfo_FOUNDVARPARMS 'Parm : ' ||ThisParmName
  3929. FndVarIndex=0
  3930. do ParmIndex=1 to ParmCount
  3931. if ParmName.ParmIndex<> '' then
  3932. do
  3933. if ThisParmName=ParmName.ParmIndex then
  3934. do
  3935. ParmUsed.ParmIndex='Y'
  3936. FndVarIndex=ParmIndex
  3937. end
  3938. end
  3939. end
  3940. if FndVarIndex<>0 then
  3941. ReplaceParmWith=ParmValue.FndVarIndex
  3942. else
  3943. do
  3944. if HaveDefault='Y' then
  3945. ReplaceParmWith=ParmDefault
  3946. else
  3947. do
  3948. if OptionDebugOn='Y' then
  3949. do
  3950. call DebugIncrement 1
  3951. call DebugOutputVariableInfo_FOUNDVARPARMS 'A Default value not specified this time.  Do we have a default value stored?'
  3952. call DebugIncrement-1
  3953. end
  3954. do DefaultIndex=1 to DefaultCnt
  3955. if ThisParmName=PrmDefaultName.DefaultIndex then
  3956. do
  3957. ReplaceParmWith=PrmDefaultValue.DefaultIndex
  3958. HaveDefault='Y'
  3959. leave
  3960. end
  3961. end
  3962. if HaveDefault='N' then
  3963. do
  3964. if ThisParmName<> '?' then
  3965. 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())
  3966. call DebugOutputVariableInfo_FOUNDVARPARMS 'This is a special variable, value is all unused parms'
  3967. ReplaceParmWith=''
  3968. do ParmIndex=1 to ParmCount
  3969. if ParmName.ParmIndex<> '' then
  3970. do
  3971. if ParmUsed.ParmIndex='N' then
  3972. do
  3973. if ReplaceParmWith=='' then
  3974. LSPC=''
  3975. else
  3976. LSPC=' '
  3977. if ParmValueT.ParmIndex='nv' then
  3978. ReplaceParmWith=ReplaceParmWith||LSPC||ParmNameC.ParmIndex
  3979. else
  3980. do
  3981. if ParmCmds='' then
  3982. do
  3983. QChar=QuoteIt(ParmValue.ParmIndex)
  3984. ReplaceParmWith=ReplaceParmWith||LSPC||ParmNameC.ParmIndex|| '=' ||QChar||ParmValue.ParmIndex||QChar
  3985. end
  3986. else
  3987. do
  3988. ReplaceParmWith=ReplaceParmWith||LSPC||StartsMacroParm||ParmNameC.ParmIndex|| ' ' ||ParmCmds||EndsMacroParm
  3989. end
  3990. end
  3991. ParmUsed.ParmIndex='Y'
  3992. end
  3993. end
  3994. end
  3995. ParmCmds=''
  3996. end
  3997. end
  3998. end
  3999. if ParmCmds<> '' then
  4000. do
  4001. ParmCmds=translate(strip(ParmCmds))
  4002. do until ParmCmds=''
  4003. parse var ParmCmds ParmCmd ParmCmds
  4004. if OptionDebugOn='Y' then
  4005. do
  4006. call DebugIncrement 1
  4007. call DebugOutputVariableInfo_FOUNDVARPARMS '$Bef: ' ||ReplaceParmWith
  4008. call DebugOutputVariableInfo_FOUNDVARPARMS '$Cmd: ' ||ParmCmd
  4009. call DebugIncrement-1
  4010. end
  4011. select
  4012. when ParmCmd='$$PASSAQ' then
  4013. do
  4014. QChar=QuoteIt(ReplaceParmWith,TryQuoteListAny)
  4015. ReplaceParmWith=ThisParmName|| '=' ||QChar||ReplaceParmWith||QChar
  4016. end
  4017. when ParmCmd='$$PASSDSQ' then
  4018. do
  4019. QChar=QuoteIt(ReplaceParmWith,TryQuoteListDs)
  4020. ReplaceParmWith=ThisParmName|| '=' ||QChar||ReplaceParmWith||QChar
  4021. end
  4022. when ParmCmd='$$IGNORE' then
  4023. ReplaceParmWith=''
  4024.  
  4025. when ParmCmd='$$DSQ' then
  4026. do
  4027. QChar=QuoteIt(ReplaceParmWith,TryQuoteListDs)
  4028. ReplaceParmWith=QChar||ReplaceParmWith||QChar
  4029. end
  4030.  
  4031. when ParmCmd='$$SDQ' then
  4032. do
  4033. QChar=QuoteIt(ReplaceParmWith,TryQuoteListSd)
  4034. ReplaceParmWith=QChar||ReplaceParmWith||QChar
  4035. end
  4036.  
  4037. when ParmCmd='$$AQ' then
  4038. do
  4039. QChar=QuoteIt(ReplaceParmWith,TryQuoteListAny)
  4040. ReplaceParmWith=QChar||ReplaceParmWith||QChar
  4041. end
  4042.  
  4043. when ParmCmd='$$UPPER' then
  4044. ReplaceParmWith=translate(ReplaceParmWith)
  4045.  
  4046. when ParmCmd='$$LOWER' then
  4047. ReplaceParmWith=ToLowerCase(ReplaceParmWith)
  4048.  
  4049. when ParmCmd='$$ADDCOMMA' then
  4050. ReplaceParmWith=AddCommasToDecimalNumber(ReplaceParmWith)
  4051.  
  4052. when ParmCmd='$$HTMLQ' then
  4053. ReplaceParmWith=ReplaceString(ReplaceParmWith, '"', '"')
  4054.  
  4055. when ParmCmd='$$SQX2' then
  4056. ReplaceParmWith=ReplaceString(ReplaceParmWith, "'" , "''")
  4057.  
  4058. when ParmCmd='$$SPCPLUS' then
  4059. do
  4060. if ReplaceParmWith\=='' then
  4061. ReplaceParmWith=' ' ||ReplaceParmWith
  4062. end
  4063.  
  4064. otherwise
  4065. do
  4066. UserRexx=GetDefineValueOrUseDefault("REXX_" || ParmCmd, '')
  4067. if UserRexx='' then
  4068. CryAndDie('The $$ replacement command of "' || ParmCmd || '" is unknown!')
  4069. TheMacro=VariableName
  4070. TheName=ThisParmName
  4071. TheValue=ReplaceParmWith
  4072. call ExecRexxCmd UserRexx
  4073. if OptionDebugOn='Y' then
  4074. do
  4075. if ReplaceParmWith=TheValue then
  4076. do
  4077. call DebugIncrement 1
  4078. call DebugOutputVariableInfo_FOUNDVARPARMS 'The user rexx code did not modify the "TheValue" variable'
  4079. call DebugIncrement-1
  4080. end
  4081. end
  4082. ReplaceParmWith=TheValue
  4083. end
  4084. end
  4085. end
  4086. end
  4087. if OptionDebugOn='Y' then
  4088. do
  4089. call DebugIncrement 1
  4090. call DebugOutputVariableInfo_FOUNDVARPARMS 'Use : ' ||ReplaceParmWith
  4091. call DebugIncrement-1
  4092. end
  4093. ParmRightBit=ReplaceParmWith||ParmRightBit
  4094. ParmPos=pos(StartsMacroParm,ParmRightBit)
  4095. end
  4096. ParmLeftBit=ParmLeftBit||ParmRightBit
  4097. if OptionDebugOn='Y' then
  4098. do
  4099. do ParmIndex=1 to ParmCount
  4100. if ParmUsed.ParmIndex='N' then
  4101. 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).'
  4102. end
  4103. end
  4104. if pos('{',ParmLeftBit)<>0 then
  4105. do
  4106. if pos(StartsMacroParm,ParmLeftBit)<>0 then
  4107. CryAndDie('Not all "' || VariableName || '" parameters replaced!')
  4108. ParmLeftBit=ReplaceString(ParmLeftBit,HidesMacroParm,StartsMacroParm)
  4109. end
  4110. return(ParmLeftBit)
  4111.  
  4112. _ReplaceAllHashDefinedVariables:
  4113. RightBit=arg(1)
  4114. LeftBit=''
  4115. ChangesMade='N'
  4116. VarPos=pos(StartsMacroReplacement,RightBit)
  4117. do while VarPos<>0
  4118. LeftBit=LeftBit||left(RightBit,VarPos-1)
  4119. RightBit=substr(RightBit,VarPos+2)
  4120. DelPos=verify(RightBit,EndsVar, 'M')
  4121. if DelPos=0 then
  4122. CryAndDie("Can't find the end of the macro reference at " ||DebugRightArrow||StartsMacroReplacement||RightBit||DebugLeftArrow)
  4123. VariableName=left(RightBit,DelPos-1)
  4124. MacroBeingExpanded=VariableName
  4125. RightBit=strip(substr(RightBit,DelPos), 'L')
  4126. if OptionDebugOn='Y' then
  4127. do
  4128. call DebugOutputVariableInfo_FOUNDVAR 'Found : ' || StartsMacroReplacement || VariableName || ' ...' ||EndsMacroReplacement
  4129. call DebugIncrement 1
  4130. end
  4131. DefnAsIs='N'
  4132. VariableCont=GetDefineContents(VariableName)
  4133. if OptionDebugOn='Y' then
  4134. do
  4135. call DebugOutputVariableInfo_FOUNDVAR 'Value : ' ||DebugRightArrow||VariableCont||DebugLeftArrow
  4136. call DebugIncrement 1
  4137. end
  4138. ParmCount=0
  4139. PositionalParmCount=0
  4140. EndParmDelimiters=EndsMacroReplacement|| '= '
  4141. Left1=left(RightBit,1)
  4142. do while Left1<>EndsMacroReplacement
  4143. if pos(Left1,ArePositionalChars)<>0 then
  4144. do
  4145. PositionalParmCount=PositionalParmCount+1
  4146. ThisParmNameC='#' ||PositionalParmCount
  4147. if CsReplacement='N' then
  4148. ThisParmName=translate(ThisParmNameC)
  4149. else
  4150. ThisParmName=ThisParmNameC
  4151. ThisParmValType='v'
  4152. if Left1='=' then
  4153. ThisParmVal=GetQuotedText(substr(RightBit,2), "RightBit",EndsMacroReplacement)
  4154. else
  4155. ThisParmVal=GetQuotedText(RightBit, "RightBit",EndsMacroReplacement)
  4156. end
  4157. else
  4158. do
  4159. DelPos=verify(RightBit,EndParmDelimiters, 'M')
  4160. if DelPos=0 then
  4161. CryAndDie('Macro reference incorrectly formatted, missing "' || EndsMacroReplacement || '"?')
  4162. ThisParmNameC=strip(left(RightBit,DelPos-1))
  4163. if CsReplacement='N' then
  4164. ThisParmName=translate(ThisParmNameC)
  4165. else
  4166. ThisParmName=ThisParmNameC
  4167. DelChar=substr(RightBit,DelPos,1)
  4168. if DelChar='=' then
  4169. do
  4170. ThisParmVal=GetQuotedText(substr(RightBit,DelPos+1), "RightBit",EndsMacroReplacement)
  4171. ThisParmValType='v'
  4172. end
  4173. else
  4174. do
  4175. RightBit=strip(substr(RightBit,DelPos), 'L')
  4176. if left(ThisParmName,2)<> '$$' then
  4177. do
  4178. ThisParmVal=ThisParmName
  4179. ThisParmValType='nv'
  4180. end
  4181. else
  4182. do
  4183. if OptionDebugOn='Y' then
  4184. call DebugOutputVariableInfo_FOUNDVARPARMS '$$Cmd: ' ||ThisParmName
  4185. select
  4186. when ThisParmName='$$ASIS' then
  4187. DefnAsIs='Y'
  4188.  
  4189. when ThisParmName='$$DSQ' then
  4190. do
  4191. QChar=QuoteIt(VariableCont,TryQuoteListDs)
  4192. VariableCont=QChar||VariableCont||QChar
  4193. end
  4194.  
  4195. when ThisParmName='$$SDQ' then
  4196. do
  4197. QChar=QuoteIt(VariableCont,TryQuoteListSd)
  4198. VariableCont=QChar||VariableCont||QChar
  4199. end
  4200.  
  4201. when ThisParmName='$$AQ' then
  4202. do
  4203. QChar=QuoteIt(VariableCont,TryQuoteListAny)
  4204. VariableCont=QChar||VariableCont||QChar
  4205. end
  4206.  
  4207. when ThisParmName='$$UPPER' then
  4208. VariableCont=translate(VariableCont)
  4209.  
  4210. when ThisParmName='$$LOWER' then
  4211. VariableCont=ToLowerCase(VariableCont)
  4212.  
  4213. when ThisParmName='$$ADDCOMMA' then
  4214. VariableCont=AddCommasToDecimalNumber(VariableCont)
  4215.  
  4216. when ThisParmName='$$HTMLQ' then
  4217. VariableCont=ReplaceString(VariableCont, '"', '"')
  4218.  
  4219. when ThisParmName='$$SQX2' then
  4220. VariableCont=ReplaceString(VariableCont, "'" , "''")
  4221.  
  4222. when ThisParmName='$$SPCPLUS' then
  4223. do
  4224. if VariableCont\=='' then
  4225. VariableCont=' ' ||VariableCont
  4226. end
  4227.  
  4228. otherwise
  4229. do
  4230. UserRexx=GetDefineValueOrUseDefault("REXX_" || ThisParmName, '')
  4231. if UserRexx='' then
  4232. CryAndDie('The $$ replacement command of "' || ThisParmName || '" is unknown!')
  4233. TheMacro=""
  4234. TheName=VariableName
  4235. TheValue=VariableCont
  4236. call ExecRexxCmd UserRexx
  4237. if OptionDebugOn='Y' then
  4238. do
  4239. if VariableCont=TheValue then
  4240. do
  4241. call DebugIncrement 1
  4242. call DebugOutputVariableInfo_FOUNDVARPARMS 'The user rexx code did not modify the "TheValue" variable'
  4243. call DebugIncrement-1
  4244. end
  4245. end
  4246. VariableCont=TheValue
  4247. end
  4248. end
  4249. iterate
  4250. end
  4251. end
  4252. end
  4253. do ChkIndex=1 to ParmCount
  4254. if ThisParmName=ParmName.ChkIndex then
  4255. CryAndDie('The macro parameter "' || ThisParmName || '" was specified more than once!')
  4256. end
  4257. ParmCount=ParmCount+1
  4258. ParmName.ParmCount=ThisParmName
  4259. ParmNameC.ParmCount=ThisParmNameC
  4260. ParmValue.ParmCount=ThisParmVal
  4261. ParmValueT.ParmCount=ThisParmValType
  4262. Left1=left(RightBit,1)
  4263. end
  4264. if DefnAsIs='Y' then
  4265. do
  4266. if ParmCount<>0 then
  4267. CryAndDie('You wanted "' || VariableName || '" subsituted ASIS but then specified parameters!')
  4268. end
  4269. else
  4270. do
  4271. if ParmCount<>0 then
  4272. VariableCont=ReplaceDefinitionsParameters()
  4273. else
  4274. do
  4275. if pos(StartsMacroParm,VariableCont)<>0 then
  4276. VariableCont=ReplaceDefinitionsParameters()
  4277. else
  4278. VariableCont=ReplaceString(VariableCont,HidesMacroParm,StartsMacroParm)
  4279. end
  4280. end
  4281. if OptionDebugOn='Y' then
  4282. call DebugIncrement-2
  4283. RightBit=substr(RightBit,2)
  4284. LeftBit=LeftBit||VariableCont
  4285. ReplaceCount=ReplaceCount+1
  4286. if pos(MarksNewLine,LeftBit)<>0 then
  4287. leave
  4288. VarPos=pos(StartsMacroReplacement,RightBit)
  4289. end
  4290. MacroBeingExpanded=''
  4291. TheString=LeftBit||RightBit
  4292. return(TheString)
  4293.  
  4294. GetDefineValueOrUseDefault:
  4295. DefVar=arg(1)
  4296. if VariableExists(DefVar)='N' then
  4297. do
  4298. DefValue=arg(2)
  4299. DefDbgWrd='not'
  4300. end
  4301. else
  4302. do
  4303. DefValue=GetDefineContents(DefVar)
  4304. DefDbgWrd='was'
  4305. end
  4306. if OptionDebugOn='Y' then
  4307. call DebugLine_MACROVALORDEF 'Option(Macro) "' || DefVar || '" ' || DefDbgWrd || ' found. Using ' ||DebugRightArrow||DefValue||DebugLeftArrow
  4308. return(DefValue)
  4309.  
  4310. Define_18:
  4311. call InitializeOneLine
  4312. signal OneLine_19;
  4313.  
  4314. InitializeOneLine:
  4315. OneLineOn='N'
  4316. OneLineCount=0
  4317. OneLineBuffer=''
  4318. OneLineSeperator=''
  4319. OneLineStartLoc=''
  4320. OneLineStopper=''
  4321. OneLineStopperL=0
  4322. return
  4323.  
  4324. AddToOneLine:
  4325. _OneLineBit=arg(1)
  4326. _Word1=word(_OneLineBit,1)
  4327. if strip(_OneLineBit)<>OneLineStopper then
  4328. do
  4329. OneLineCount=OneLineCount+1
  4330. if OneLineCount=1 then
  4331. do
  4332. if translate(left(_Word1,length(CmdHashDefine)))=CmdHashDefine then
  4333. do
  4334. _OneLineBit=_OneLineBit|| ' '
  4335. PpwCmdDivider2=MarksNewLineInHashDefine
  4336. end
  4337. else
  4338. PpwCmdDivider2=MarksNewLine
  4339. OneLineBuffer=_OneLineBit
  4340. end
  4341. else
  4342. do
  4343. if left(_Word1,HashPrefixLng)<>HashPrefix then
  4344. OneLineBuffer=OneLineBuffer||OneLineSeperator||_OneLineBit
  4345. else
  4346. do
  4347. parse var _OneLineBit _ppwCmd _ppwCmdParm
  4348. _OneLineBit=_ppwCmd|| ' ' ||strip(_ppwCmdParm)
  4349. OneLineBuffer=OneLineBuffer||PpwCmdDivider2||_OneLineBit||PpwCmdDivider2
  4350. end
  4351. end
  4352. return('')
  4353. end
  4354. _OneLineBit=OneLineBuffer
  4355. if OptionDebugOn='Y' then
  4356. call DebugLine 'End of #OneLine block - ' || OneLineCount || ' line(s)'
  4357. call InitializeOneLine
  4358. return(_OneLineBit)
  4359.  
  4360. ProcessOneLine:
  4361. OneLineOn='Y'
  4362. OneLineStartLoc=CurrentSourceLocation()
  4363. Rest=PerformReplacementsInCmdsParameters(arg(1))
  4364. if Rest='' then
  4365. OneLineSeperator=' '
  4366. else
  4367. do
  4368. OneLineSeperator=GetQuotedText(Rest, "Rest")
  4369. end
  4370. if Rest='' then
  4371. OneLineStopper=HashPrefix|| 'OneLineEnd'
  4372. else
  4373. OneLineStopper=GetQuotedText(Rest)
  4374. OneLineStopperL=length(OneLineStopper)
  4375. if OptionDebugOn='Y' then
  4376. do
  4377. call DebugLine 'Line seperator      = ' ||DebugRightArrow||OneLineSeperator||DebugLeftArrow
  4378. call DebugLine 'End of block marker = ' || DebugRightArrow || OneLineStopper   || DebugLeftArrow || ' (case sensitive!)'
  4379. end
  4380. return(0)
  4381.  
  4382. OneLine_19:
  4383. signal Evaluate_20;
  4384.  
  4385. _ScaleSide:
  4386. parse arg SideBefore,SideScale
  4387. PercentPos=pos('%',SideScale)
  4388. if PercentPos=0 then
  4389. return(SideScale)
  4390. else
  4391. return((SideBefore*left(SideScale,PercentPos-1))%100)
  4392.  
  4393. _GetSizeTags:
  4394. if OptionDebugOn='Y' then
  4395. do
  4396. call DebugIncrement 1
  4397. call DebugLine_EVALUATE 'Real size = ' || ImageWidth || 'x' ||ImageHeight
  4398. call DebugIncrement-1
  4399. end
  4400. if ImgScaleW='?' | ImgScaleH = '?' then
  4401. do
  4402. if ImgScaleW='?' then
  4403. do
  4404. NewHeight=_ScaleSide(ImageHeight,ImgScaleH)
  4405. ImgScaleW=(NewHeight*100)%ImageHeight|| '%'
  4406. NewWidth=_ScaleSide(ImageWidth,ImgScaleW)
  4407. end
  4408. else
  4409. do
  4410. NewWidth=_ScaleSide(ImageWidth,ImgScaleW)
  4411. ImgScaleH=(NewWidth*100)%ImageWidth|| '%'
  4412. NewHeight=_ScaleSide(ImageHeight,ImgScaleH)
  4413. end
  4414. end
  4415. else
  4416. do
  4417. NewWidth=_ScaleSide(ImageWidth,ImgScaleW)
  4418. NewHeight=_ScaleSide(ImageHeight,ImgScaleH)
  4419. end
  4420. return('WIDTH=' || NewWidth || ' HEIGHT=' ||NewHeight)
  4421.  
  4422. _GetGifSize:
  4423. parse arg GifFile,ImgScaleW,ImgScaleH
  4424. GifFormatId=charin(GifFile,1,6)
  4425. if left(GifFormatId,3)<> "GIF" then
  4426. do
  4427. CloseRc=stream(GifFile, 'c', 'close')
  4428. CryAndDie('"' || GifFile || '" is not a ".GIF" file.')
  4429. end
  4430. WidthLow=charin(GifFile,,1)
  4431. WidthHigh=charin(GifFile,,1)
  4432. ImageWidth=c2d(WidthHigh||WidthLow)
  4433. HeightLow=charin(GifFile,,1)
  4434. HeightHigh=charin(GifFile,,1)
  4435. ImageHeight=c2d(HeightHigh||HeightLow)
  4436. CloseRc=stream(GifFile, 'c', 'close')
  4437. return(_GetSizeTags())
  4438.  
  4439. _GetJpgSize:
  4440. parse arg JpgFile,ImgScaleW,ImgScaleH
  4441. FileType=c2x(Charin(JpgFile,1,2))
  4442. if FileType<> "FFD8" then
  4443. do
  4444. CloseRc=stream(JpgFile, 'c', 'close')
  4445. CryAndDie('"' || ImageFile || '" is not a ".JPG" file.')
  4446. end
  4447. NxtSeg=3
  4448. ImageHeight="IMAGEHEIGHT"
  4449. Type=''
  4450. do while(Type<> "D9") & (NxtSeg <> -1) & (Imageheight = "IMAGEHEIGHT")
  4451. NxtSeg=_ReadJpgSegment(NxtSeg)
  4452. end
  4453. CloseRc=stream(JpgFile, 'c', 'close')
  4454. return(_GetSizeTags())
  4455.  
  4456. _ReadJpgSegment:
  4457. SegPos=arg(1)
  4458. Marker=c2x(charIn(JpgFile,SegPos))
  4459. if Marker<> "FF" then
  4460. return(-1)
  4461. Type=c2x(charIn(JpgFile))
  4462. Res=SegPos+2
  4463. select
  4464. when Type="01" | Type >= "D0" & Type <= "D9" then
  4465. SegmentLength=0
  4466. otherwise
  4467. SegmentLength=c2d(CharIn(JpgFile,,2))
  4468. End
  4469. Res=Res+SegmentLength
  4470. if Type="C0" | Type = "C2" then
  4471. do
  4472. Imagebps=c2d(CharIn(JpgFile))
  4473. ImageHeight=c2d(CharIn(JpgFile,,2))
  4474. ImageWidth=c2d(CharIn(JpgFile,,2))
  4475. end
  4476. return(Res)
  4477.  
  4478. GetImageHeightWidth:call TRACE "OFF"
  4479. parse arg ImageFile,ImageScaleW,ImageScaleH
  4480. if ImageScaleW='' then
  4481. ImageScaleW='100%'
  4482. if ImageScaleH='' then
  4483. ImageScaleH='?'
  4484. if OptionDebugOn='Y' then
  4485. call DebugLine_EVALUATE 'GetImageHeightWidth("' || ImageFile || '", "' || ImageScaleW || '", "' || ImageScaleH || '")'
  4486. DotPos=lastpos('.',ImageFile)
  4487. if DotPos=0 then
  4488. CryAndDie('Unknown graphic file type on "' || ImageFile || '".')
  4489. ImageExtn=translate(substr(ImageFile,DotPos+1))
  4490. if SafeQueryExists(ImageFile)='' then
  4491. do
  4492. CryAndDie('Graphic file "' || ImageFile || '" does not exist.')
  4493. return('')
  4494. end
  4495. call DebugIncrement 1
  4496. select
  4497. when ImageExtn='GIF' then
  4498. SizeString=_GetGifSize(ImageFile,ImageScaleW,ImageScaleH)
  4499. when ImageExtn='JPG' then
  4500. SizeString=_GetJpgSize(ImageFile,ImageScaleW,ImageScaleH)
  4501. otherwise
  4502. CryAndDie('Currently only support ".GIF" & ".JPG" files.')
  4503. end
  4504. if OptionDebugOn='Y' then
  4505. call DebugLine_EVALUATE 'Returning "' || SizeString || '"'
  4506. call DebugIncrement-1
  4507. return(SizeString)
  4508.  
  4509. ToLowerCase:call TRACE "OFF"
  4510. return(translate(arg(1),LowerCase,UpperCase))
  4511.  
  4512. EnsureFileHasCorrectCase:call TRACE "OFF"
  4513. cFileI=arg(1)
  4514. if OptionTranslateFileNames='N' then
  4515. return(cFileI)
  4516. if OptionTranslateFileNames='UPPER' then
  4517. cFileO=translate(cFileI)
  4518. else
  4519. cFileO=ToLowerCase(cFileI)
  4520. if OptionDebugOn='Y' then
  4521. do
  4522. if cFileI<>cFileO then
  4523. do
  4524. call DebugLine_EVALUATE 'A files case was adjusted'
  4525. call DebugIncrement 1
  4526. call DebugLine_EVALUATE 'FROM: "' || cFileI || '"'
  4527. call DebugLine_EVALUATE '  TO: "' || cFileO || '"'
  4528. call DebugIncrement-1
  4529. end
  4530. end
  4531. return(cFileO)
  4532.  
  4533. MakeDirectoryTree:call TRACE "OFF"
  4534. WholeDirectory=arg(1)
  4535. if right(WholeDirectory,1)=RexDirChar then
  4536. WholeDirectory=left(WholeDirectory,length(WholeDirectory)-1)
  4537. if WholeDirectory='' then
  4538. return(0)
  4539. if RexWhich='REGINA' then
  4540. do
  4541. if stream(WholeDirectory|| '\.', 'c', 'query exists') <> '' then
  4542. do
  4543. if OptionDebugOn='Y' then
  4544. call DebugLine 'Directory "' || WholeDirectory || '" already exists (no need to make)'
  4545. return(0)
  4546. end
  4547. end
  4548. SearchFromPosn=1
  4549. do until SlashPosn=0
  4550. SlashPosn=pos(RexDirChar,WholeDirectory,SearchFromPosn)
  4551. if SlashPosn<>1 then
  4552. do
  4553. if SlashPosn=0 then
  4554. MakeDir=WholeDirectory
  4555. else
  4556. MakeDir=left(WholeDirectory,SlashPosn-1)
  4557. if right(MakeDir,1)<> ':' then
  4558. do
  4559. if RexSystemOpSys="UNIX" then
  4560. MakeDirCmd='mkdir '
  4561. else
  4562. MakeDirCmd='md '
  4563. call AddressCmd MakeDirCmd||MakeDir|| ' >nul' || Stderr2('&1')
  4564. if OptionDebugOn='Y' then
  4565. do
  4566. if Rc=0 then
  4567. call DebugLine 'Made Directory "' || MakeDir || '"'
  4568. end
  4569. end
  4570. end
  4571. SearchFromPosn=SlashPosn+1
  4572. end
  4573. return(0)
  4574.  
  4575. GetAmPmTime:call TRACE "OFF"
  4576. CivilTime=time('C');  if length(CivilTime)  = 6 then CivilTime=' 'CivilTime
  4577. TheTime=time();NumSeconds=':'substr(TheTime,7,2)
  4578. return(insert(NumSeconds,CivilTime,5))
  4579.  
  4580. AddCommasToDecimalNumber:procedure;call TRACE "OFF"
  4581. NoComma=strip(arg(1))
  4582. if pos(',',NoComma)<>0 then
  4583. return(NoComma)
  4584. DotPos=pos('.',NoComma)
  4585. if DotPos=0 then
  4586. AfterDecimal=''
  4587. else
  4588. do
  4589. if DotPos=1 then
  4590. return("0" ||NoComma)
  4591. AfterDecimal=substr(NoComma,DotPos+1)
  4592. NoComma=left(NoComma,DotPos-1)
  4593. end
  4594. NoComma=reverse(NoComma)
  4595. ResultWithCommas=""
  4596. do while length(NoComma)>3
  4597. ResultWithCommas=ResultWithCommas||left(NoComma,3)|| ','
  4598. NoComma=substr(NoComma,4)
  4599. end
  4600. ResultWithCommas=ResultWithCommas||NoComma
  4601. ResultWithCommas=reverse(ResultWithCommas)
  4602. if AfterDecimal<> '' then
  4603. ResultWithCommas=ResultWithCommas|| '.' ||AfterDecimal
  4604. return(ResultWithCommas)
  4605.  
  4606. PadString:procedure;call TRACE "OFF"
  4607. parse arg TheString,TheMaxSize,PadType
  4608. StringSize=length(TheString)
  4609. if StringSize>=TheMaxSize then
  4610. return(TheString)
  4611. SpacesRequired=TheMaxSize-StringSize
  4612. if PadType='R' then
  4613. return(copies(' ',SpacesRequired)||TheString)
  4614. else
  4615. do
  4616. if PadType<> 'C' then
  4617. return(TheString||copies(' ',SpacesRequired))
  4618. else
  4619. do
  4620. SpacesOnLeft=SpacesRequired%2
  4621. return(copies(' ', SpacesOnLeft) || TheString || copies(' ',SpacesRequired-SpacesOnLeft))
  4622. end
  4623. end
  4624.  
  4625. BreakAt:call TRACE "OFF"
  4626. parse arg baMaxSize,baString,baChars,baBreakWith
  4627. if baChars='' then
  4628. baChars='./:#'
  4629. if baBreakWith='' then
  4630. baBreakWith='<BR>'
  4631. baPos=pos('-',baMaxSize)
  4632. if baPos=0 then
  4633. baMinSize=baMaxSize%3
  4634. else
  4635. parse var baMaxSize baMinSize'-'baMaxSize
  4636. baReturn=''
  4637. do while length(baString)>baMaxSize
  4638. baLeftBit=left(baString,baMaxSize)
  4639. baString=substr(baString,baMaxSize+1)
  4640. baBestPos=0
  4641. baCharList=baChars
  4642. do while baCharList<> ''
  4643. baThisChar=left(baCharList,1)
  4644. baCharList=substr(baCharList,2)
  4645. baThisPos=lastpos(baThisChar,baLeftBit)
  4646. if baThisPos>baBestPos then
  4647. do
  4648. baBestPos=baThisPos
  4649. end
  4650. end
  4651. if baReturn<> '' then
  4652. baReturn=baReturn||baBreakWith
  4653. if baBestPos=0 then
  4654. baReturn=baReturn||baLeftBit
  4655. else
  4656. do
  4657. baReturn=baReturn||left(baLeftBit,baBestPos)
  4658. baString=substr(baLeftBit,baBestPos+1)||baString
  4659. end
  4660. end
  4661. if baReturn<> '' then
  4662. return(baReturn||baBreakWith||baString)
  4663. else
  4664. return(baReturn||baString)
  4665.  
  4666. GetMacro:call TRACE "OFF"
  4667. call WarnAboutDepreciatedFeature 'GetMacro(). Replace with "MacroGet()"'
  4668.  
  4669. MacroGet:call TRACE "OFF"
  4670. GotValue=GetDefineContents(arg(1))
  4671. if OptionDebugOn='Y' then
  4672. call DebugLine_EVALUATE 'MacroGet("' || arg(1) || '") = ' ||DebugRightArrow||GotValue||DebugLeftArrow
  4673. return(GotValue)
  4674.  
  4675. Defined:call TRACE "OFF"
  4676. DefinedAnswer=VariableExists(arg(1))
  4677. if OptionDebugOn='Y' then
  4678. call DebugLine_EVALUATE 'Defined("' || arg(1) || '") = "' || DefinedAnswer || '"'
  4679. return(DefinedAnswer)
  4680.  
  4681. DataSave:call TRACE "OFF"
  4682. parse arg StoreApp,StoreKey,StoreData
  4683. call _valueS "AP?" || c2x(StoreApp) || '.KY?' ||c2x(StoreKey),StoreData
  4684. return
  4685.  
  4686. DataGet:call TRACE "OFF"
  4687. parse arg StoreApp,StoreKey,StoreDefault
  4688. DataVarName="AP?" || c2x(StoreApp) || '.KY' ||c2x(StoreKey)
  4689. if symbol(DataVarName)<> 'VAR' then
  4690. return(StoreDefault)
  4691. else
  4692. return(_valueG(DataVarName))
  4693.  
  4694. UrlEncode:call TRACE "OFF"
  4695. UrlIn=arg(1)
  4696. ueCmd=translate(arg(2))
  4697. SpaceToPlus='N'
  4698. select
  4699. when ueCmd='TO%' then
  4700. do
  4701. UrlBadChars=arg(3)
  4702. if UrlBadChars=='' then
  4703. UrlBadChars='+<>%"/?# '
  4704. end
  4705. when ueCmd='ENCODEALL' then
  4706. UrlBadChars=xrange('00'x, 'FF'x)
  4707. otherwise
  4708. CryAndDie('Invalid UrlEncode() command of "' || ueCmd || '"')
  4709. end
  4710. UrlOut=''
  4711. UrlCount=length(UrlIn)
  4712. do CharPosn=1 to UrlCount
  4713. ThisChar=substr(UrlIn,CharPosn,1)
  4714. if pos(ThisChar,UrlBadChars)=0 then
  4715. UrlOut=UrlOut||ThisChar
  4716. else
  4717. do
  4718. if ThisChar==' ' & SpaceToPlus = 'Y' then
  4719. UrlOut=UrlOut|| '+'
  4720. else
  4721. UrlOut=UrlOut|| '%' || right(c2x(ThisChar), 2, '0')
  4722. end
  4723. end
  4724. return(UrlOut)
  4725.  
  4726. UrlDecode:call TRACE "OFF"
  4727. parse arg UrlIn,udCmd
  4728. UrlPlusIsSpace='Y'
  4729. if udCmd<> '' then
  4730. do
  4731. if translate(udCmd)='LEAVE+' then
  4732. UrlPlusIsSpace='N'
  4733. else
  4734. CryAndDie('Invalid UrlDecode() command of "' || udCmd || '"')
  4735. end
  4736. UrlOut=''
  4737. CharPosn=1
  4738. UrlCount=length(UrlIn)
  4739. do while CharPosn<=UrlCount
  4740. ThisChar=substr(UrlIn,CharPosn,1)
  4741. CharPosn=CharPosn+1
  4742. if UrlPlusIsSpace<> 'N' & ThisChar = '+' then
  4743. ThisChar=' '
  4744. else
  4745. do
  4746. if ThisChar='%' then
  4747. do
  4748. ThisChar=substr(UrlIn,CharPosn,2)
  4749. CharPosn=CharPosn+2
  4750. if CharPosn>(UrlCount+1)then
  4751. CryAndDie('Invalid URL encoding of "%' || strip(ThisChar) || '" at end of URL')
  4752. ThisChar=x2c(ThisChar)
  4753. end
  4754. end
  4755. UrlOut=UrlOut||ThisChar
  4756. end
  4757. return(UrlOut)
  4758.  
  4759. QuoteIt:call TRACE "OFF"
  4760. parse arg Quote4,TryQuotes
  4761. if TryQuotes='' then
  4762. TryQuotes='"' || "'"
  4763. TryQuoteLng=length(TryQuotes)
  4764. do QuoteIndex=1 to TryQuoteLng
  4765. PossibleQuote=substr(TryQuotes,QuoteIndex,1)
  4766. if pos(PossibleQuote,Quote4)=0 then
  4767. return(PossibleQuote)
  4768. end
  4769. CryAndDie('QuoteIt(): Could not find safe quote for ' ||DebugRightArrow||Quote4||DebugLeftArrow)
  4770.  
  4771. GetFileTimeStamp:call TRACE "OFF"
  4772. FileName=arg(1)
  4773. if OptionDebugOn='Y' then
  4774. do
  4775. call DebugLine_EVALUATE 'GetFileTimeStamp("' || FileName || '")'
  4776. call DebugIncrement 1
  4777. end
  4778. FileTime=stream(FileName, 'c', 'query datetime')
  4779. if OptionDebugOn='Y' then
  4780. call DebugLine_EVALUATE 'Is time stamped : "' || FileTime || '"'
  4781. if FileTime='' then
  4782. do
  4783. call OutputWarningToScreen 'TS00', '"' || FileName || '" does not exist.'
  4784. if OptionDebugOn='Y' then
  4785. call DebugIncrement-1
  4786. return(-1)
  4787. end
  4788. FileName=arg(1)
  4789. FileTime=space(FileTime)
  4790. parse var FileTime Month'-'Day'-'Year' 'Hour':'Minute':'Second
  4791. if Year<80 then
  4792. Year=100+Year
  4793. Year=1900+Year
  4794. SortableTime=Year||Month||Day||Hour||Minute||Second
  4795. if OptionDebugOn='Y' then
  4796. call DebugLine_EVALUATE 'Returning       : "' || SortableTime || '"'
  4797. if OptionDebugOn='Y' then
  4798. call DebugIncrement-1
  4799. return(SortableTime)
  4800.  
  4801. BaseDate:Procedure;call TRACE "OFF"
  4802. TheDate=translate(arg(1), ' ', '/-')
  4803. if TheDate='' then
  4804. TheDate=date('Sorted')
  4805. parse var TheDate Year MM DD
  4806. if length(Year)>=8 then
  4807. do
  4808. DD=substr(Year,7,2)
  4809. MM=substr(Year,5,2)
  4810. Year=left(Year,4)
  4811. end
  4812. DaysInMonth='31  28  31  30  31  30  31  31  30  31  30  31'
  4813. if datatype(Year, 'WholeNumber')<>1 then
  4814. return(-10)
  4815. if datatype(MM, 'WholeNumber')<>1 then
  4816. return(-20)
  4817. if datatype(DD, 'WholeNumber')<>1 then
  4818. return(-30)
  4819. if MM<0|MM>12 then
  4820. return(-21)
  4821. DaysThisMonth=word(DaysInMonth,MM)
  4822. if MM=2 then
  4823. DaysThisMonth=DaysThisMonth+1
  4824. if DD<0|DD>DaysThisMonth then
  4825. return(-31)
  4826. if length(strip(Year))=2 then
  4827. do
  4828. if Year>=80 then
  4829. Year='19' ||Year
  4830. else
  4831. Year='20' ||Year
  4832. end
  4833. y=Year-0001
  4834. b=y*365
  4835. b=b+y%4
  4836. b=b-y%100
  4837. b=b+y%400
  4838. m=mm-01
  4839. do i=1 to m
  4840. b=b+word(DaysInMonth,i)
  4841. end
  4842. if mm>2 then
  4843. do
  4844. if 0=Year//4 then
  4845. do
  4846. if 0=Year//100 then
  4847. do
  4848. if 0=Year//400 then
  4849. b=b+1
  4850. end
  4851. else
  4852. b=b+1
  4853. end
  4854. end
  4855. d=dd-01
  4856. b=b+d
  4857. return(b)
  4858.  
  4859. ReverseArray:call TRACE "OFF"
  4860. riArray=translate(arg(1))|| '.'
  4861. riCount=_valueG(riArray||0)
  4862. riHalfWay=riCount%2
  4863. do riFrom=1 to riHalfWay
  4864. riTo=(riCount-riFrom)+1
  4865. riTemp=_valueG(riArray||riFrom)
  4866. call _valueS riArray||riFrom,_valueG(riArray||riTo)
  4867. call _valueS riArray||riTo,riTemp
  4868. end
  4869. return(riCount)
  4870.  
  4871. Warning:call TRACE "OFF"
  4872. call OutputWarningToScreen arg(1),arg(2)
  4873. return(0)
  4874.  
  4875. Error:call TRACE "OFF"
  4876. 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)
  4877. return(0)
  4878.  
  4879. Info:call TRACE "OFF"
  4880. call OutputInformationToScreen arg(1)
  4881. return(0)
  4882.  
  4883. DieIfIoErrorOccurred:call TRACE "OFF"
  4884. FileState=stream(arg(1), 'State')
  4885. if FileState='READY' then
  4886. return
  4887. IoReason=stream(arg(1), 'Description')
  4888. if IoReason\=='NOTREADY:EOF' then
  4889. do
  4890. if RexWhich='REGINA' & IoReason = '' then
  4891. do
  4892. if OptionDebugOn='Y' then
  4893. do
  4894. call DebugLine 'DieIfIoErrorOccurred(): Bug first reported to Mark Hessling 3/10/99 for 0.08h beta'
  4895. call DebugIncrement 1
  4896. call DebugLine 'I/O failure on "' || arg(1) || '" (' || IoReason || ').'
  4897. call DebugIncrement-1
  4898. end
  4899. return
  4900. end
  4901. call CryAndDie 'I/O failure on "' || arg(1) || '" (' || IoReason || ').'
  4902. end
  4903. return
  4904.  
  4905. _ValidateIcLevel:
  4906. icLevel=arg(1)
  4907. if icLevel='' then
  4908. icLevel=IncludeLevel
  4909. if datatype(icLevel, 'WholeNumber')<>1 then
  4910. return(0)
  4911. if icLevel<1|icLevel>IncludeLevel then
  4912. return(0)
  4913. return(icLevel)
  4914.  
  4915. InputComponentLevel:call TRACE "OFF"
  4916. icLevel=_ValidateIcLevel(arg(1))
  4917. if icLevel=0 then
  4918. return('')
  4919. else
  4920. return(IncludeFileName.icLevel)
  4921.  
  4922. InputComponentLineLevel:call TRACE "OFF"
  4923. icLevel=_ValidateIcLevel(arg(1))
  4924. if icLevel=0 then
  4925. return('')
  4926. else
  4927. do
  4928. if icLevel=IncludeLevel then
  4929. return(IncludeLineNumber)
  4930. else
  4931. return(_IncludeLineNumber.icLevel)
  4932. end
  4933.  
  4934. GenerateFileName:call TRACE "OFF"
  4935. parse arg SrcFile,ConversionSpec,RelPathAllowed
  4936. if OptionDebugOn='Y' then
  4937. do
  4938. call DebugLine 'GenerateFileName(' || SrcFile || ') using "' || ConversionSpec || '"'
  4939. call DebugLine 'Current directory is "' || GetCurrentDirectory() || '"'
  4940. call DebugIncrement 1
  4941. end
  4942. ShortName=_filespec('name',SrcFile)
  4943. InputPath=_filespec('drive', SrcFile) || _filespec('path',SrcFile)
  4944. ExtnPos=lastpos('.',ShortName)
  4945. if ExtnPos<>0 then
  4946. ShortName=left(ShortName,ExtnPos-1)
  4947. FullFileName=ReplaceString(ConversionSpec, "?",InputPath)
  4948. FullFileName=ReplaceString(FullFileName, "*",ShortName)
  4949. FullFileName=ReplaceString(FullFileName, "{$PATH}",InputPath)
  4950. FullFileName=ReplaceString(FullFileName, "{$BASE}",ShortName)
  4951. if pos('{$path}',FullFileName)<>0 then
  4952. do
  4953. if RelPathAllowed<> 'Y' then
  4954. CryAndDie('"{$path}" found, you are only allowed to use this on cmd line...')
  4955. call DebugLine '{$path} found, original mask was "' || MaskUsedForCurrentInputFile || '"'
  4956. MaskPath=_filespec('Location',MaskUsedForCurrentInputFile)
  4957. MaskPathLng=length(MaskPath)
  4958. InputFilePath=_filespec('Location',SrcFile)
  4959. StartInpPath=left(InputFilePath,MaskPathLng)
  4960. if translate(StartInpPath)<>translate(MaskPath)then
  4961. CryAndDie("Can't handle '{$path}' (maybe mask not absolute)")
  4962. DollarPath=substr(InputFilePath,MaskPathLng+1)
  4963. call DebugLine '{$path} = "' || DollarPath || '"'
  4964. FullFileName=ReplaceString(FullFileName, "{$path}",DollarPath)
  4965. end
  4966. FullFileName=EnsureFileHasCorrectCase(FullFileName)
  4967. if OptionDebugOn='Y' then
  4968. call DebugLine 'Generated Name = "' || FullFileName || '"'
  4969. call MakeDirectoryTree _filespec('drive', FullFileName) || _filespec('path',FullFileName)
  4970. if OptionDebugOn='Y' then
  4971. call DebugIncrement-1
  4972. return(FullFileName)
  4973.  
  4974. ProcessNext:call TRACE "OFF"
  4975. if IncludeMemBufferNextLine=='' then
  4976. IncludeMemBufferNextLine=arg(1)
  4977. else
  4978. IncludeMemBufferNextLine=arg(1)||MarksNewLine||IncludeMemBufferNextLine
  4979. return
  4980.  
  4981. SortArray:call TRACE "OFF"
  4982. parse arg bsArray,bsStartCol,bsEndCol,bsStrict
  4983. bsArray=translate(bsArray)|| '.'
  4984. if bsStartCol='' then
  4985. bsStartCol=0
  4986. else
  4987. do
  4988. if bsEndCol='' then
  4989. bsLength=0
  4990. else
  4991. bsLength=bsEndCol-bsStartCol
  4992. end
  4993. bsM=1
  4994. bsCount=_valueG(bsArray||0)
  4995. do while(9*bsM+4)<bsCount
  4996. bsM=bsM*3+1
  4997. end
  4998. do while bsM>0
  4999. bsK=bsCount-bsM
  5000. do bsJ=1 to bsK
  5001. bsIndex1=bsJ
  5002. do while bsIndex1>0
  5003. bsIndex2=bsIndex1+bsM
  5004. if bsStartCol=0 then
  5005. do
  5006. bsVal1=_valueG(bsArray||BSINDEX1)
  5007. bsVal2=_valueG(bsArray||BSINDEX2)
  5008. end
  5009. else
  5010. do
  5011. if bsLength=0 then
  5012. do
  5013. bsVal1=substr(_valueG(bsArray||BSINDEX1),bsStartCol)
  5014. bsVal2=substr(_valueG(bsArray||BSINDEX2),bsStartCol)
  5015. end
  5016. else
  5017. do
  5018. bsVal1=substr(_valueG(bsArray||BSINDEX1),bsStartCol,bsLength)
  5019. bsVal2=substr(_valueG(bsArray||BSINDEX2),bsStartCol,bsLength)
  5020. end
  5021. end
  5022. if bsStrict='Y' then
  5023. bsGreater=bsVal1>>bsVal2
  5024. else
  5025. bsGreater=bsVal1>bsVal2
  5026. if bsGreater then
  5027. do
  5028. bsTemp=_valueG(bsArray||BSINDEX1)
  5029. call _valueS bsArray||BSINDEX1,_valueG(bsArray||BSINDEX2)
  5030. call _valueS bsArray||BSINDEX2,bsTemp
  5031. end
  5032. else
  5033. leave
  5034. bsIndex1=bsIndex1-bsM
  5035. end
  5036. end
  5037. bsM=bsM%3
  5038. end
  5039. return(bsCount)
  5040.  
  5041. Evaluate_20:
  5042. DoingImport=''
  5043. signal IMPORT_21;
  5044.  
  5045. ProcessImport:
  5046. if DoingImport<> '' then
  5047. CryAndDie("Can't nest #import (started at " || DoingImport || ')')
  5048. else
  5049. DoingImport=CurrentSourceLocation()
  5050. ImportParms=PerformReplacementsInCmdsParameters(arg(1))
  5051. if AsIsModeOn='Y' then
  5052. CryAndDie("Please turn off #AsIs mode before importing.")
  5053. call _InitImportAsIsMemories
  5054. ImportFileName=GetQuotedText(ImportParms, "ImportParms")
  5055. if ImportFileName='' then
  5056. CryAndDie('#import has no parameters!')
  5057. CloseRc=stream(ImportFileName, 'c', 'close')
  5058. FullImportName=stream(ImportFileName, 'c', 'query exists')
  5059. if FullImportName='' then
  5060. CryAndDie('The #import file "' || ImportFileName || '" does not exist!')
  5061. call OutputProcessingFileStringToScreen FullImportName
  5062. call AddInputFileToDependancyList FullImportName
  5063. if ImportParms='' then
  5064. CryAndDie('#import is missing import type (parm #2)!')
  5065. ImportFileType=translate(GetQuotedText(ImportParms, "ImportParms"))
  5066. if substr(ImportFileType,4)<> '-' then
  5067. DropLine=0
  5068. else
  5069. do
  5070. ImportFileType=left(ImportFileType,3)
  5071. DropLine=1
  5072. end
  5073. FirstChar=left(ImportFileType,1)
  5074. DelimiterSpec=FirstChar||FirstChar||FirstChar
  5075. CustomDelimiter='NO'
  5076. if(ImportFileType==DelimiterSpec)|(ImportFileType==DelimiterSpec|| '-')then
  5077. do
  5078. CustomDelimiter=FirstChar
  5079. TmpFilePart=''
  5080. end
  5081. else
  5082. do
  5083. TmpFilePart=ImportFileType
  5084. if pos('*' || ImportFileType || '*', '*TAB*CMA*FIX*WRAP*T2H*ML*')=0 then
  5085. CryAndDie('Invalid #import type of "' || ImportFileType || '" specified!')
  5086. end
  5087. ToInclude=RexGetTmpFileName('IMP_' || left(TmpFilePart, 4, '_') || '.???')
  5088. DeleteRc=_SysFileDelete(ToInclude)
  5089. if SafeQueryExists(ToInclude)<> "" then
  5090. CryAndDie('Could not delete "' || ToInclude || '", it must be in use (DosRc=' || DeleteRc || ')...')
  5091. if ImportParms='' then
  5092. CryAndDie('#import is missing macro name (parm #3)!')
  5093. MacroName=GetQuotedText(ImportParms, "ImportParms")
  5094. if MacroName='' then
  5095. do
  5096. select
  5097. when ImportFileType='WRAP' then
  5098. MacroName='WRAP'
  5099. when ImportFileType='T2H' then
  5100. MacroName='T2H'
  5101. when ImportFileType='ML' then
  5102. MacroName='ML'
  5103. otherwise
  5104. MacroName='IMPORT'
  5105. end
  5106. end
  5107. call AsIsPrepare ''
  5108. if OptionDebugOn='Y' then
  5109. call DebugLine_IMPORT 'Generating "' || ToInclude || '" for later inclusion (#include).'
  5110. ReplaceNewLineChar=''
  5111. ReplaceTabChar=''
  5112. DisplayingFields=''
  5113. ReplaceNewLineChar=''
  5114. ReplaceTabChar=''
  5115. select
  5116. when ImportFileType='WRAP' then
  5117. ImpLinCnt=HandleLineWrapping()
  5118. when ImportFileType='T2H' then
  5119. ImpLinCnt=HandleTextToHtmlImport()
  5120. otherwise
  5121. do
  5122. call ImportTablePreparation
  5123. select
  5124. when ImportFileType='ML' then
  5125. ImpLinCnt=HandleMultiLineImport()
  5126. when CustomDelimiter<> 'NO' then
  5127. ImpLinCnt=HandleSimpleCharDelimitedFile(CustomDelimiter)
  5128. when ImportFileType='TAB' then
  5129. ImpLinCnt=HandleSimpleCharDelimitedFile(TabChar)
  5130. when ImportFileType='CMA' then
  5131. ImpLinCnt=HandleSimpleCharDelimitedFile(',')
  5132. when ImportFileType='FIX' then
  5133. ImpLinCnt=HandleFixedFieldFile()
  5134. otherwise
  5135. CryAndDie('Unknown import type of "' || ImportFileType || '"')
  5136. end
  5137. call ImportTableTermination
  5138. end
  5139. end
  5140. CloseRc=stream(FullImportName, 'c', 'close')
  5141. if OptionDebugOn='Y' then
  5142. call DebugLine_IMPORT 'Imported ' || AddCommasToDecimalNumber(ImpLinCnt) || ' line(s) in "' || ImportFileType || '" mode.'
  5143. CloseRc=stream(ToInclude, 'c', 'close')
  5144. call AsIsPrepare ''
  5145. if OptionDebugOn='Y' then
  5146. call DebugLine_IMPORT 'Now #include the generated temporary file ("' || ToInclude || '").'
  5147. call RecursiveIncludeSave
  5148. call ProcessInputFile ToInclude,, 'N', 'N'
  5149. call RecursiveIncludeRestore
  5150. call OutputProcessingFileStringToScreen
  5151. if OptionDebugOn='N' then
  5152. DeleteRc=_SysFileDelete(ToInclude)
  5153. DoingImport=''
  5154. return(0)
  5155.  
  5156. _ImportValueSpacer:
  5157. if OptionDebugOn='Y' then
  5158. do
  5159. call DebugLine_MACROVALORDEF ''
  5160. if arg(1)<> '' then
  5161. call DebugLine_MACROVALORDEF arg(1)
  5162. end
  5163. return
  5164.  
  5165. ImportValueExists:
  5166. ImportVar=MacroName|| '_' ||arg(1)
  5167. iveAnswer=VariableExists(ImportVar)
  5168. if OptionDebugOn='Y' then
  5169. call DebugLine_MACROVALORDEF 'Option(Macro) "' || ImportVar || '" Exists? : ' ||iveAnswer
  5170. return(iveAnswer)
  5171.  
  5172. GetImportValue:
  5173. ImportVar=MacroName|| '_' ||arg(1)
  5174. if VariableExists(ImportVar)='N' then
  5175. do
  5176. ImportMask=arg(2)
  5177. DebugWord='not'
  5178. end
  5179. else
  5180. do
  5181. ImportMask=GetDefineContents(ImportVar)
  5182. DebugWord='was'
  5183. end
  5184. if OptionDebugOn='Y' then
  5185. call DebugLine_MACROVALORDEF 'Option(Macro) "' || ImportVar || '" ' || DebugWord || ' found. Using ' ||DebugRightArrow||ImportMask||DebugLeftArrow
  5186. if ImportFileType<> "WRAP" & ImportFileType <> "T2H" then
  5187. ImportMask=ReplaceString(ImportMask,StartsMacroParm|| 'Columns' ||EndsMacroParm,DisplayingFields)
  5188. return(ImportMask)
  5189.  
  5190. GetImportValue_Tabs:
  5191. ReplaceTabChar=GetImportValue('TAB_CHAR', '')
  5192. return
  5193.  
  5194. GetImportValue_RecordFilter:
  5195. return(GetImportValue('RECORD_FILTER', ''))
  5196.  
  5197. GetImportValue_Comments:
  5198. call _ImportValueSpacer 'Get comment options'
  5199. call DebugIncrement 1
  5200. ImportLineCmtChars=GetImportValue( 'LINECMT_CHARS',arg(1))
  5201. ImportInlineCmtChars=GetImportValue('INLINECMT_CHARS',arg(2))
  5202. call DebugIncrement-1
  5203. return
  5204.  
  5205. IsCmtLine:
  5206. if ImportLineCmtChars='' then
  5207. return(0)
  5208. else
  5209. return(abbrev(arg(1),ImportLineCmtChars))
  5210.  
  5211. ImportOneLine:
  5212. if arg(1)='Y' then
  5213. FileLine=CrLflinein(FullImportName)
  5214. else
  5215. FileLine=linein(FullImportName)
  5216. if ImportInlineCmtChars<> '' then
  5217. do
  5218. ilcPos=pos(ImportInlineCmtChars,FileLine)
  5219. if ilcPos<>0 then
  5220. FileLine=strip(left(FileLine,ilcPos-1), 'Trailing')
  5221. end
  5222. if arg(2)='Y' then
  5223. FileLine=AsIs(translate(FileLine, '',EofChar))
  5224. else
  5225. FileLine=translate(FileLine, '',EofChar)
  5226. if ReplaceNewLineChar\=='' then
  5227. FileLine=ReplaceString(FileLine,MarksNewLine,ReplaceNewLineChar)
  5228. if ReplaceTabChar\=='' then
  5229. FileLine=ReplaceString(FileLine,TabChar,ReplaceTabChar)
  5230. return(FileLine)
  5231.  
  5232. PpwLineout:
  5233. parse arg gFile,gLine
  5234. do until gLine==''
  5235. parse var gLine This1 (MarksNewLine) gLine
  5236. if 0<>charout(gFile,This1||NewLineChars)then
  5237. do
  5238. IoReason=stream(gFile, 'Description')
  5239. CryAndDie('Write to "' || gFile || '" failed (' || IoReason || ')!')
  5240. end
  5241. end
  5242. return
  5243.  
  5244. GenerateTagsIfNonEmpty:
  5245. OptionalTags=GetImportValue(arg(1),arg(2))
  5246. if OptionalTags\=='' then
  5247. call PpwLineout ToInclude,OptionalTags
  5248. return
  5249.  
  5250. GenerateProtectStartTags:
  5251. call GenerateTagsIfNonEmpty 'PROTECT_START', StartsStdSymbolReplacement || 'ProtectFromPpwStart' ||EndsMacroReplacement
  5252. return
  5253.  
  5254. GenerateProtectEndTags:
  5255. call GenerateTagsIfNonEmpty 'PROTECT_END',   StartsStdSymbolReplacement || 'ProtectFromPpwEnd' ||EndsMacroReplacement
  5256. return
  5257.  
  5258. GenerateBeforeTags:
  5259. call GenerateTagsIfNonEmpty 'BEFORE',arg(1)
  5260. return
  5261.  
  5262. GenerateAfterTags:
  5263. call GenerateTagsIfNonEmpty 'AFTER',arg(1)
  5264. return
  5265.  
  5266. HandleImportAsIsOptions:
  5267. call _ImportValueSpacer 'Prepare "AS IS" tagging'
  5268. call DebugIncrement 1
  5269. ImportAsIsMemory=GetImportValue('ASIS_TAGGING',arg(1))
  5270. call DebugIncrement 1
  5271. call AsIsPrepare ImportAsIsMemory
  5272. call DebugIncrement-2
  5273. return
  5274.  
  5275. _InitImportAsIsMemories:
  5276. if symbol('ImpMemInit') = 'VAR' then
  5277. return
  5278. ImpMemInit='Y'
  5279. call DebugLine_IMPORT 'Initializing named #AsIs tags for HTML Importing'
  5280. call DebugIncrement 1
  5281. call _ClearTempMemory
  5282. call _AddToTempMemory '&', '&'
  5283. call _AddToTempMemory '<', '<'
  5284. call _AddToTempMemory '>', '>'
  5285. call SetupNamedAsIsStorage 'IMPORT_HTML_BASIC',TmpAtCount
  5286. call _ClearTempMemory
  5287. call _AddToTempMemory '╔', '+'
  5288. call _AddToTempMemory '═', '-'
  5289. call _AddToTempMemory '╗', '+'
  5290. call _AddToTempMemory '║', '|'
  5291. call _AddToTempMemory '╝', '+'
  5292. call _AddToTempMemory '╚', '+'
  5293. call _AddToTempMemory '┌', '+'
  5294. call _AddToTempMemory '─', '-'
  5295. call _AddToTempMemory '┐', '+'
  5296. call _AddToTempMemory '│', '|'
  5297. call _AddToTempMemory '┘', '+'
  5298. call _AddToTempMemory '└', '+'
  5299. call SetupNamedAsIsStorage 'IMPORT_HTML_BOXGRAPHIC_TO_BOXTEXT',TmpAtCount
  5300. call DebugIncrement-1
  5301. return
  5302.  
  5303. _ClearTempMemory:
  5304. TmpAtCount=0
  5305. return
  5306.  
  5307. _AddToTempMemory:
  5308. TmpAtCount=TmpAtCount+1
  5309. ImportB.TmpAtCount=arg(1)
  5310. ImportA.TmpAtCount=arg(2)
  5311. return
  5312.  
  5313. WriteLineToTmpImportFile:call TRACE "OFF"
  5314. call PpwLineout ToInclude,arg(1)
  5315. return
  5316.  
  5317. IMPORT_21:
  5318. signal IMPORTT_22;
  5319.  
  5320. ImportTablePreparation:
  5321. if ImportParms='' then
  5322. CryAndDie('#import is missing field names (parm #4 onwards)!')
  5323. NumberOfFields=0
  5324. DisplayingFields=0
  5325. do while ImportParms<> ''
  5326. NumberOfFields=NumberOfFields+1
  5327. HeadingInfo=GetQuotedText(ImportParms, "ImportParms")
  5328. ColumnNumber=DisplayingFields+1
  5329. ExtraInfo=''
  5330. if left(HeadingInfo,1)='{' then
  5331. do
  5332. EndPosn=pos('}',HeadingInfo)
  5333. if EndPosn=0 then
  5334. CryAndDie('Leading field codes on heading "' || HeadingInfo || '" invalid (expected "}")')
  5335. HeadingCodes=substr(HeadingInfo,2,EndPosn-2)
  5336. HeadingInfo=substr(HeadingInfo,EndPosn+1)
  5337. parse var HeadingCodes MaybeColumnNumber','ExtraInfo
  5338. if MaybeColumnNumber<> '' & MaybeColumnNumber <> '*' then
  5339. ColumnNumber=MaybeColumnNumber
  5340. end
  5341. FieldHeading.NumberOfFields=HeadingInfo
  5342. FieldExtra.NumberOfFields=ExtraInfo
  5343. if HeadingInfo<> '' then
  5344. do
  5345. FieldColumn.NumberOfFields=ColumnNumber
  5346. DisplayingFields=DisplayingFields+1
  5347. end
  5348. end
  5349. call _ImportValueSpacer 'Assorted options'
  5350. call DebugIncrement 1
  5351. DropBlankLines=translate(GetImportValue('DROP_BLANK_LINES',  'Y'))
  5352. DropLine=GetImportValue('DROP_LINE_COUNT',DropLine)
  5353. ReplaceNewLineChar=GetImportValue('NEWLINE_CHAR', '<BR>')
  5354. call GetImportValue_Tabs
  5355. RecordFilter=GetImportValue_RecordFilter()
  5356. call DebugIncrement-1
  5357. call _ImportValueSpacer 'What happens to blank fields?'
  5358. call DebugIncrement 1
  5359. ReplaceBlankFields=GetImportValue('BLANK_FIELD',  '')
  5360. do Index=1 to DisplayingFields
  5361. RepBlankCol.Index=GetImportValue('BLANK_COLUMN_' ||Index,ReplaceBlankFields)
  5362. end
  5363. call DebugIncrement-1
  5364. call _ImportValueSpacer 'What do we do with column titles?'
  5365. call DebugIncrement 1
  5366. if ImportValueExists('HEADER') = 'Y' then
  5367. ForHeader=GetImportValue('HEADER', '!BUG!')
  5368. else
  5369. do
  5370. DefaultColFormatting=GetImportValue('HEADING_COLUMNS',     'ALIGN=CENTER')
  5371. DefaultBeforeData=GetImportValue('HEADING_BEFORE_DATA', '')
  5372. DefaultAfterData=GetImportValue('HEADING_AFTER_DATA',  '')
  5373. ForHeader='<TR>'
  5374. do Index=1 to DisplayingFields
  5375. ThisColFormatting=GetImportValue('HEADING_COLUMN_' ||Index,DefaultColFormatting)
  5376. ThisBeforeData=GetImportValue('HEADING_BEFORE_DATA_' ||Index,DefaultBeforeData)
  5377. ThisAfterData=GetImportValue('HEADING_AFTER_DATA_' ||Index,DefaultAfterData)
  5378. ForHeader=ForHeader|| '<TH ' || ThisColFormatting || '>' || ThisBeforeData || StartsMacroParm || 'Column' || Index || EndsMacroParm || ThisAfterData || '</TH>'
  5379. end
  5380. ForHeader=ForHeader|| '</TR>'
  5381. end
  5382. call DebugIncrement-1
  5383. call _ImportValueSpacer 'Working out what table data row looks like'
  5384. call DebugIncrement 1
  5385. if ImportValueExists('RECORD') = 'Y' then
  5386. ForEachRecord=GetImportValue('RECORD', '!BUG!')
  5387. else
  5388. do
  5389. DefaultColFormatting=GetImportValue('RECORD_COLUMNS',     'ALIGN=CENTER')
  5390. DefaultBeforeData=GetImportValue('RECORD_BEFORE_DATA', '')
  5391. DefaultAfterData=GetImportValue('RECORD_AFTER_DATA',  '')
  5392. ForEachRecord='<TR>'
  5393. do Index=1 to DisplayingFields
  5394. ThisColFormatting=GetImportValue('RECORD_COLUMN_' ||Index,DefaultColFormatting)
  5395. ThisBeforeData=GetImportValue('RECORD_BEFORE_DATA_' ||Index,DefaultBeforeData)
  5396. ThisAfterData=GetImportValue('RECORD_AFTER_DATA_' ||Index,DefaultAfterData)
  5397. ForEachRecord=ForEachRecord|| '<TD ' || ThisColFormatting || '>' || ThisBeforeData || StartsMacroParm || 'Column' || Index || EndsMacroParm  || ThisAfterData || '</TD>'
  5398. end
  5399. ForEachRecord=ForEachRecord|| '</TR>'
  5400. end
  5401. call DebugIncrement-1
  5402. call _ImportValueSpacer 'Start output'
  5403. call DebugIncrement 1
  5404. call GenerateProtectStartTags
  5405. TableAttribs=GetImportValue('TABLE_ATTRIBS', 'BORDER=5 CELLSPACING=5')
  5406. if TableAttribs<> '' then
  5407. TableAttribs=' ' ||strip(TableAttribs)
  5408. BeforeRecordsDefault='<TABLE' || TableAttribs || '>'
  5409. call GenerateBeforeTags BeforeRecordsDefault
  5410. call DebugLine_IMPORT 'Outputting heading fields'
  5411. call DebugIncrement 1
  5412. call _NewRecord 'H'
  5413. do FieldIndex=1 to NumberOfFields
  5414. call _AddField2Record FieldHeading.FieldIndex
  5415. end
  5416. call GenerateRecordFromFields
  5417. call DebugIncrement-2
  5418. call GetImportValue_Comments ';', ';' || ';'
  5419. if OptionCodeType='HTML' then
  5420. call HandleImportAsIsOptions "IMPORT_HTML_BASIC"
  5421. return
  5422.  
  5423. ImportTableTermination:
  5424. call GenerateAfterTags '</TABLE>'
  5425. call GenerateProtectEndTags
  5426. return
  5427.  
  5428. HandleFixedFieldFile:
  5429. if OptionDebugOn='Y' then
  5430. call DebugLine_IMPORT 'Importing fixed field file'
  5431. do FieldIndex=1 to NumberOfFields
  5432. parse var FieldExtra.FieldIndex StartCol'-'EndCol
  5433. if EndCol='' | EndCol = '*' then
  5434. FieldLength=''
  5435. else
  5436. FieldLength=(EndCol-StartCol)+1
  5437. FieldStartCol.FieldIndex=StartCol
  5438. FieldLength.FieldIndex=FieldLength
  5439. end
  5440. ImportFileLine=0
  5441. call DebugLine_IMPORT 'Reading "' || FullImportName || '"...'
  5442. do while lines(FullImportName)<>0
  5443. CurrentRecord=ImportOneLine('Y', 'Y')
  5444. ImportFileLine=ImportFileLine+1
  5445. if CurrentRecord='' then
  5446. iterate
  5447. if ImportFileLine<=DropLine then
  5448. iterate
  5449. if IsCmtLine(ImportFileLine)then
  5450. iterate
  5451. call _NewRecord
  5452. do FieldIndex=1 to NumberOfFields
  5453. if FieldLength.FieldIndex='' then
  5454. ThisField=substr(CurrentRecord,FieldStartCol.FieldIndex)
  5455. else
  5456. ThisField=substr(CurrentRecord,FieldStartCol.FieldIndex,FieldLength.FieldIndex)
  5457. call _AddField2Record strip(ThisField)
  5458. end
  5459. if GenerateRecordFromFields()then
  5460. leave
  5461. end
  5462. return(ImportFileLine)
  5463.  
  5464. HandleSimpleCharDelimitedFile:
  5465. FieldDelimiter=arg(1)
  5466. FieldQuote='"'
  5467. FieldQuote2=FieldQuote||FieldQuote
  5468. if OptionDebugOn='Y' then
  5469. do
  5470. DelimiterText=c2d(FieldDelimiter)
  5471. if DelimiterText> '32' then
  5472. DelimiterText=DelimiterText|| ' ("' || FieldDelimiter || '")'
  5473. call DebugLine_IMPORT 'Importing simple delimited file - delimiter = ASCII ' ||DelimiterText
  5474. end
  5475. UseCrLfRoutines=GetImportValue('HANDLE_IMBEDDED_NEWLINES', 'N')
  5476. if UseCrLfRoutines='N' then
  5477. call DebugLine_IMPORT 'Special imbedded newline detecting code is not being used'
  5478. else
  5479. do
  5480. UseCrLfRoutines='Y'
  5481. call DebugLine_IMPORT 'We are using special imbedded newline detecting code'
  5482. end
  5483. call DebugLine_IMPORT 'Reading "' || FullImportName || '"...'
  5484. if UseCrLfRoutines='Y' then
  5485. OpenRc=CrlfOpen(FullImportName,10000)
  5486. ImportFileLine=0
  5487. do forever
  5488. if UseCrLfRoutines='Y' then
  5489. EofIf0=CrLflines(FullImportName)
  5490. else
  5491. EofIf0=lines(FullImportName)
  5492. if EofIf0=0 then
  5493. leave
  5494. CurrentRecord=ImportOneLine(UseCrLfRoutines, 'Y')
  5495. ImportFileLine=ImportFileLine+1
  5496. if CurrentRecord='' then
  5497. do
  5498. if DropBlankLines='Y' then
  5499. iterate
  5500. end
  5501. if ImportFileLine<=DropLine then
  5502. iterate
  5503. if IsCmtLine(CurrentRecord)then
  5504. iterate
  5505. call _NewRecord
  5506. do while CurrentRecord<> ''
  5507. if left(CurrentRecord,1)<>FieldQuote then
  5508. do
  5509. DelPos=pos(FieldDelimiter,CurrentRecord)
  5510. if DelPos<>0 then
  5511. do
  5512. call _AddField2Record left(CurrentRecord,DelPos-1)
  5513. CurrentRecord=substr(CurrentRecord,DelPos+1)
  5514. end
  5515. else
  5516. do
  5517. call _AddField2Record CurrentRecord
  5518. CurrentRecord=''
  5519. end
  5520. end
  5521. else
  5522. do
  5523. LookFrom=2
  5524. do forever
  5525. QuotePos=pos(FieldQuote,CurrentRecord,LookFrom)
  5526. if QuotePos=0 then
  5527. CryAndDie('No ending quote on field #' || FieldCounter+1 || ' of line #' || ImportFileLine || ', Failed at ' ||DebugRightArrow||CurrentRecord||DebugLeftArrow)
  5528. if substr(CurrentRecord,QuotePos+1,1)=FieldQuote then
  5529. LookFrom=QuotePos+2
  5530. else
  5531. leave
  5532. end
  5533. call _AddField2Record ReplaceString(substr(CurrentRecord,2,QuotePos-2),FieldQuote2,FieldQuote)
  5534. CurrentRecord=substr(CurrentRecord,QuotePos+1)
  5535. if CurrentRecord<> '' then
  5536. do
  5537. if left(CurrentRecord,1)<>FieldDelimiter then
  5538. CryAndDie('Expected delimiter after field #' || FieldCounter || ' of line #' || ImportFileLine || ', Failed at ' ||DebugRightArrow||CurrentRecord||DebugLeftArrow)
  5539. CurrentRecord=substr(CurrentRecord,2)
  5540. end
  5541. end
  5542. if FieldCounter>=NumberOfFields then
  5543. leave
  5544. end
  5545. if FieldCounter<NumberOfFields then
  5546. do
  5547. do while FieldCounter<NumberOfFields
  5548. call _AddField2Record ''
  5549. end
  5550. end
  5551. if GenerateRecordFromFields()then
  5552. leave
  5553. end
  5554. if UseCrLfRoutines='Y' then
  5555. CloseRc=CrlfClose(FullImportName)
  5556. return(ImportFileLine)
  5557.  
  5558. _NewRecord:
  5559. RecordType=arg(1)
  5560. if RecordType='H' then
  5561. ThisRecordsCodes=ForHeader
  5562. else
  5563. ThisRecordsCodes=ForEachRecord
  5564. FieldCounter=0
  5565. ColumnCounter=0
  5566. DroppedCounter=0
  5567. NonBlankFieldCounter=0
  5568. return
  5569.  
  5570. _AddField2Record:
  5571. FieldCounter=FieldCounter+1
  5572. if FieldHeading.FieldCounter='' then
  5573. do
  5574. DroppedCounter=DroppedCounter+1
  5575. Dropped.DroppedCounter=arg(1)
  5576. end
  5577. else
  5578. do
  5579. ColumnCounter=ColumnCounter+1
  5580. NewValue=arg(1)
  5581. if NewValue='' then
  5582. NewValue=RepBlankCol.ColumnCounter
  5583. else
  5584. NonBlankFieldCounter=NonBlankFieldCounter+1
  5585. SaveAsIndex=FieldColumn.FieldCounter
  5586. Column.SaveAsIndex=NewValue
  5587. end
  5588. return
  5589.  
  5590. GenerateRecordFromFields:
  5591. call DebugIncrement 1
  5592. if DropBlankLines='Y' then
  5593. do
  5594. if NonBlankFieldCounter=0 then
  5595. do
  5596. call DebugLine_IMPORT 'Dropping record as all fields were blank'
  5597. call DebugIncrement-1
  5598. return(0)
  5599. end
  5600. end
  5601. if RecordFilter<> '' then
  5602. do
  5603. if RecordType<> 'H' then
  5604. do
  5605. Column.0=ColumnCounter
  5606. Dropped.0=DroppedCounter
  5607. call DebugLine_IMPORT 'Calling specified filter'
  5608. call DebugIncrement 1
  5609. Remove=''
  5610. call ExecRexxCmd RecordFilter
  5611. if Remove<> '' then
  5612. do
  5613. if abbrev(Remove, "EOF:")then
  5614. do
  5615. call DebugLine_IMPORT 'This Record and all following dropped ==> ' ||Remove
  5616. call DebugIncrement-2
  5617. return(1)
  5618. end
  5619. else
  5620. do
  5621. call DebugLine_IMPORT 'Record dropped ==> ' ||Remove
  5622. call DebugIncrement-2
  5623. return(0)
  5624. end
  5625. end
  5626. call DebugIncrement-1
  5627. end
  5628. end
  5629. do ThisOne=1 to ColumnCounter
  5630. ThisRecordsCodes=ReplaceString(ThisRecordsCodes,StartsMacroParm|| 'Column' ||ThisOne||EndsMacroParm,Column.ThisOne)
  5631. end
  5632. call DebugLine_IMPORT 'Generating: ' ||ThisRecordsCodes
  5633. call PpwLineout ToInclude,ThisRecordsCodes
  5634. call DebugIncrement-1
  5635. return(0)
  5636.  
  5637. IMPORTT_22:
  5638. signal IMPORTTX_23;
  5639.  
  5640. HandleTextToHtmlImport:
  5641. if OptionCodeType<> 'HTML' then
  5642. CryAndDie("Text to html file importing is only allowed when generating HTML")
  5643. if ImportParms<> '' then
  5644. CryAndDie('There are too many parameters on the T2H #import!')
  5645. UrlNameVar=StartsMacroParm|| 'Url' ||EndsMacroParm
  5646. UrlTypeVar=StartsMacroParm|| 'UrlType' ||EndsMacroParm
  5647. HeadingVar=StartsMacroParm|| 'Heading' ||EndsMacroParm
  5648. call GenerateProtectStartTags
  5649. call GenerateBeforeTags '<PRE><FONT SIZE=-1>'
  5650. T2hFilter=GetImportValue_RecordFilter()
  5651. call GetImportValue_Tabs
  5652. BlankLinesTo=GetImportValue('BLANK_LINES_TO', '')
  5653. HttpLink=GetImportValue('HTTP_LINK',   '<A HREF="' || UrlTypeVar || UrlNameVar || '" TARGET=_top>' || UrlTypeVar || UrlNameVar || '</A>')
  5654. FtpLink=GetImportValue('FTP_LINK',    '<A HREF="' || UrlTypeVar || UrlNameVar || '">' || UrlTypeVar || UrlNameVar || '</A>')
  5655. MailLink=GetImportValue('MAILTO_LINK', '<A HREF="mailto:' || UrlNameVar || '">' || UrlNameVar || '</A>')
  5656. DefaultAllStd=UpperCase||LowerCase||DecimalDigits
  5657. AlwaysOkInUrl=GetImportValue('ALWAYS_OK_IN_URL_CHARS',DefaultAllStd)
  5658. if AlwaysOkInUrl\=='' then
  5659. DefaultAllStd=''
  5660. ExtraValidHttpChar=GetImportValue('EXTRA_VALID_HTTP_CHARS',         DefaultAllStd || './?%+:~_')
  5661. ExtraValidFtpChar=GetImportValue('EXTRA_VALID_FTP_CHARS',ExtraValidHttpChar)
  5662. ExtraValidEmailName=GetImportValue('EXTRA_VALID_EMAIL_NAME_CHARS',   DefaultAllStd || '_')
  5663. ExtraValidEmailSvr=GetImportValue('EXTRA_VALID_EMAIL_SVR_CHARS',    DefaultAllStd || '_.')
  5664. ValidInHttpUrl=AlwaysOkInUrl||ExtraValidHttpChar
  5665. ValidInFtpUrl=AlwaysOkInUrl||ExtraValidFtpChar
  5666. ValidInEmailL=AlwaysOkInUrl||ExtraValidEmailName
  5667. ValidInEmailR=AlwaysOkInUrl||ExtraValidEmailSvr
  5668. call GetImportValue_Comments '', ''
  5669. if OptionCodeType='HTML' then
  5670. call HandleImportAsIsOptions "IMPORT_HTML_BASIC IMPORT_HTML_BOXGRAPHIC_TO_BOXTEXT"
  5671. T2hLineNumber=0
  5672. call DebugLine_IMPORT 'Reading "' || FullImportName || '"...'
  5673. do while lines(FullImportName)<>0
  5674. T2hFileLine=ImportOneLine('N', 'Y')
  5675. T2hLineNumber=T2hLineNumber+1
  5676. if IsCmtLine(T2hFileLine)then
  5677. iterate
  5678. if T2hFileLine='' then
  5679. do
  5680. if BlankLinesTo\=='' then
  5681. T2hNewLine=BlankLinesTo
  5682. else
  5683. T2hNewLine=''
  5684. end
  5685. else
  5686. do
  5687. T2hNewLine=T2hFileLine
  5688. if MailLink\=='' then
  5689. T2hNewLine=_MakeTextImportEmailChanges(T2hNewLine,ValidInEmailL,ValidInEmailR,MailLink)
  5690. if HttpLink\=='' then
  5691. T2hNewLine=_MakeTextImportLinkChanges(T2hNewLine, 'http:',ValidInHttpUrl,HttpLink)
  5692. if FtpLink\=='' then
  5693. T2hNewLine=_MakeTextImportLinkChanges(T2hNewLine, 'ftp:',ValidInFtpUrl,FtpLink)
  5694. end
  5695. if T2hFilter<> '' then
  5696. do
  5697. call DebugLine_IMPORT 'Calling specified filter'
  5698. call DebugIncrement 1
  5699. Remove=''
  5700. call ExecRexxCmd T2hFilter
  5701. if Remove<> '' then
  5702. do
  5703. if abbrev(Remove, "EOF:")then
  5704. do
  5705. call DebugLine_IMPORT 'This Record and all following dropped ==> ' ||Remove
  5706. call DebugIncrement-1
  5707. leave
  5708. end
  5709. else
  5710. do
  5711. call DebugLine_IMPORT 'Record dropped ==> ' ||Remove
  5712. call DebugIncrement-1
  5713. iterate
  5714. end
  5715. end
  5716. call DebugIncrement-1
  5717. end
  5718. call PpwLineout ToInclude,T2hNewLine
  5719. end
  5720. call GenerateAfterTags '</FONT></PRE>'
  5721. call GenerateProtectEndTags
  5722. return(T2hLineNumber)
  5723.  
  5724. _MakeTextImportLinkChanges:
  5725. parse arg RightBit,UrlType,tlOkInUrl,tlTransformSpec
  5726. LeftBit=''
  5727. UrlPos=pos(UrlType,RightBit)
  5728. lUrlType=length(UrlType)
  5729. do while UrlPos<>0
  5730. LeftBit=LeftBit||left(RightBit,UrlPos-1)
  5731. RightBit=substr(RightBit,UrlPos+lUrlType)
  5732. NotUrlCharPos=verify(RightBit,tlOkInUrl)
  5733. if NotUrlCharPos=0 then
  5734. do
  5735. TheUrl=RightBit
  5736. RightBit=''
  5737. end
  5738. else
  5739. do
  5740. TheUrl=left(RightBit,NotUrlCharPos-1)
  5741. RightBit=substr(RightBit,NotUrlCharPos)
  5742. end
  5743. UrlBit=ReplaceString(tlTransformSpec,UrlTypeVar,UrlType)
  5744. UrlBit=ReplaceString(UrlBit,UrlNameVar,TheUrl)
  5745. LeftBit=LeftBit||UrlBit
  5746. UrlPos=pos(UrlType,RightBit)
  5747. end
  5748. return(LeftBit||RightBit)
  5749.  
  5750. _MakeTextImportEmailChanges:
  5751. parse arg RightBit,tlOkInEmailName,tlOkInEmailSvr,tlTransformSpec
  5752. LeftBit=''
  5753. SnailPos=pos('@',RightBit)
  5754. do while SnailPos<>0
  5755. lRightBit=length(RightBit)
  5756. if SnailPos=1|SnailPos=lRightBit then
  5757. do
  5758. LeftBit=LeftBit||left(RightBit,SnailPos)
  5759. RightBit=substr(RightBit,SnailPos+1)
  5760. end
  5761. else
  5762. do
  5763. LeftPos=SnailPos-1
  5764. do until LeftPos=0
  5765. OneChar=substr(RightBit,LeftPos,1)
  5766. if OneChar=' ' | OneChar = '"'  | OneChar = "'" then
  5767. do
  5768. LeftPos=LeftPos+1
  5769. leave
  5770. end
  5771. LeftPos=LeftPos-1
  5772. end
  5773. if LeftPos=0 then
  5774. LeftPos=LeftPos+1
  5775. EmailLeftBit=substr(RightBit,LeftPos,SnailPos-LeftPos)
  5776. RightPos=SnailPos+1
  5777. do until RightPos>lRightBit
  5778. OneChar=substr(RightBit,RightPos,1)
  5779. if OneChar=' ' | OneChar = '"'  | OneChar = "'" then
  5780. do
  5781. RightPos=RightPos-1
  5782. leave
  5783. end
  5784. RightPos=RightPos+1
  5785. end
  5786. if RightPos>lRightBit then
  5787. RightPos=lRightBit
  5788. EmailRightBit=substr(RightBit,SnailPos+1,RightPos-SnailPos)
  5789. if verify(EmailLeftBit,tlOkInEmailName)<>0|verify(EmailRightBit,tlOkInEmailSvr)<>0|pos('.',EmailRightBit)=0 then
  5790. do
  5791. LeftBit=LeftBit||left(RightBit,SnailPos)
  5792. RightBit=substr(RightBit,SnailPos+1)
  5793. end
  5794. else
  5795. do
  5796. EmailBit=ReplaceString(tlTransformSpec,UrlTypeVar, 'mailto:')
  5797. EmailBit=ReplaceString(EmailBit,UrlNameVar,EmailLeftBit|| '@' ||EmailRightBit)
  5798. LeftBit=LeftBit||left(RightBit,LeftPos-1)||EmailBit
  5799. RightBit=substr(RightBit,RightPos+1)
  5800. end
  5801. end
  5802. SnailPos=pos('@',RightBit)
  5803. end
  5804. return(LeftBit||RightBit)
  5805.  
  5806. IMPORTTX_23:
  5807. signal IMPORTWR_24;
  5808.  
  5809. HandleLineWrapping:
  5810. if ImportParms<> '' then
  5811. CryAndDie('There are too many parameters on the WRAP #import!')
  5812. DropBlankLines=translate(GetImportValue('DROP_BLANK_LINES',  'Y'))
  5813. call GetImportValue_Tabs
  5814. WrapFilter=GetImportValue_RecordFilter()
  5815. call GetImportValue_Comments ';', ';' || ';'
  5816. if OptionCodeType='HTML' then
  5817. call HandleImportAsIsOptions ""
  5818. WrapLineNumber=0
  5819. NewDoubleQuote='" || d2c(34) || "'
  5820. call DebugLine_IMPORT 'Reading "' || FullImportName || '"...'
  5821. do while lines(FullImportName)<>0
  5822. WrapLine=ImportOneLine('N', 'Y')
  5823. WrapLineNumber=WrapLineNumber+1
  5824. if WrapLine='' then
  5825. do
  5826. if DropBlankLines='Y' then
  5827. iterate
  5828. end
  5829. if IsCmtLine(WrapLine)then
  5830. iterate
  5831. if WrapFilter='' then
  5832. do
  5833. RebuildCmd='"' || ReplaceString(WrapLine, '"', NewDoubleQuote) || '"'
  5834. SafeQuote=QuoteIt(RebuildCmd,TryQuoteListAny)
  5835. call PpwLineout ToInclude,StartsMacroReplacement||MacroName|| ' Line=' ||SafeQuote||RebuildCmd||SafeQuote||EndsMacroReplacement
  5836. end
  5837. else
  5838. do
  5839. call DebugLine_IMPORT 'Calling filter for line #' ||WrapLineNumber
  5840. call DebugIncrement 1
  5841. Remove=''
  5842. call ExecRexxCmd WrapFilter
  5843. if Remove<> '' then
  5844. do
  5845. if abbrev(Remove, "EOF:")then
  5846. do
  5847. call DebugLine_IMPORT 'This Record and all following dropped ==> ' ||Remove
  5848. call DebugIncrement-1
  5849. leave
  5850. end
  5851. else
  5852. do
  5853. call DebugLine_IMPORT 'Line dropped ==> ' ||Remove
  5854. call DebugIncrement-1
  5855. iterate
  5856. end
  5857. end
  5858. call DebugIncrement-1
  5859. call PpwLineout ToInclude,WrapLine
  5860. end
  5861. end
  5862. return(WrapLineNumber)
  5863.  
  5864. IMPORTWR_24:
  5865. MultiLineImportInProgress='N'
  5866. signal I_ML_25;
  5867.  
  5868. HandleMultiLineImport:
  5869. if OptionDebugOn='Y' then
  5870. call DebugLine_IMPORT 'Importing multi line record file'
  5871. mlDelimiter=GetImportValue('DELIMITER',         '=')
  5872. mlLineCmtChar=GetImportValue('LINE_COMMENT_CHAR',LineComment)
  5873. if mlLineCmtChar='' then
  5874. mlLineCmtChar=' '
  5875. LineFilter=GetImportValue('LINE_FILTER', '')
  5876. drop mlFIndex?.
  5877. do FieldIndex=1 to NumberOfFields
  5878. parse value translate(FieldExtra.FieldIndex)with FieldName ',' FieldOptions
  5879. if FieldName='' then
  5880. CryAndDie('No {field name} supplied for field #' ||FieldIndex)
  5881. call _valueS 'mlFIndex?.mli?' ||c2x(FieldName),FieldOptions
  5882. MlFieldName.FieldIndex=FieldName
  5883. end
  5884. MultiLineImportInProgress='Y'
  5885. ImportFileLine=0
  5886. LastCommentLine=''
  5887. call DebugLine_IMPORT 'Reading "' || FullImportName || '"...'
  5888. call _MlNewRecord
  5889. do while lines(FullImportName)<>0
  5890. MultiLine=strip(ImportOneLine('N', 'N'))
  5891. ImportFileLine=ImportFileLine+1
  5892. if MultiLine='' then
  5893. do
  5894. if MlFieldCnt<>0 then
  5895. do
  5896. call _MlGenerateRecord
  5897. call _MlNewRecord
  5898. end
  5899. end
  5900. else
  5901. do
  5902. if left(MultiLine,1)=LineComment then
  5903. iterate
  5904. if LineFilter<> '' then
  5905. do
  5906. call DebugLine_IMPORT 'Calling specified multi line filter'
  5907. call DebugIncrement 1
  5908. Remove=''
  5909. call ExecRexxCmd LineFilter
  5910. if Remove<> '' then
  5911. do
  5912. if abbrev(Remove, "EOF:")then
  5913. do
  5914. call DebugLine_IMPORT 'Line #' || ImportFileLine || ' to EOF dropped ==> ' ||Remove
  5915. call DebugIncrement-1
  5916. leave
  5917. end
  5918. else
  5919. do
  5920. call DebugLine_IMPORT 'Line #' || ImportFileLine || ' dropped ==> ' ||Remove
  5921. call DebugIncrement-1
  5922. iterate
  5923. end
  5924. end
  5925. call DebugIncrement-1
  5926. end
  5927. parse var MultiLine MultiVar (mlDelimiter) MultiValue
  5928. call _MlRememberFieldsValue strip(MultiVar, 'T'), strip(MultiValue, 'L')
  5929. end
  5930. end
  5931. CloseRc=stream(FullImportName, 'c', 'close')
  5932. if MlFieldCnt<>0 then
  5933. call _MlGenerateRecord
  5934. MultiLineImportInProgress='N'
  5935. return(ImportFileLine)
  5936.  
  5937. _MlNewRecord:
  5938. call _NewRecord
  5939. MlFieldCnt=0
  5940. drop mlFValues?.
  5941. return
  5942.  
  5943. _MlRememberFieldsValue:
  5944. parse arg FieldN,FieldV
  5945. UFieldN=translate(FieldN)
  5946. StoredAs='mlFIndex?.mli?' ||c2x(UFieldN)
  5947. if symbol(StoredAs)<> 'VAR' then
  5948. CryAndDie('Line #' || ImportFileLine || ' - Unknown field name of "' || FieldN || '"')
  5949. FieldOptions=_valueG(StoredAs)
  5950. StoredAs='mlFValues?.mlv?' ||c2x(UFieldN)
  5951. if symbol(StoredAs)='VAR' then
  5952. CryAndDie('Line #' || ImportFileLine || ' - Field name of "' || FieldN || '" specified more than once')
  5953. if FieldV='' then
  5954. do
  5955. if pos('NONBLANK',FieldOptions)<>0 then
  5956. CryAndDie('Line #' || ImportFileLine || ' - Field "' || FieldN || '" contains a blank value')
  5957. end
  5958. if pos('NOASIS',FieldOptions)=0 then
  5959. call _valueS StoredAs,AsIs(FieldV)
  5960. else
  5961. call _valueS StoredAs,FieldV
  5962. MlFieldCnt=MlFieldCnt+1
  5963. return
  5964.  
  5965. _MlGenerateRecord:
  5966. do FieldIndex=1 to NumberOfFields
  5967. FieldName=MlFieldName.FieldIndex
  5968. StoredAs='mlFValues?.mlv?' ||c2x(FieldName)
  5969. if symbol(StoredAs)='VAR' then
  5970. call _AddField2Record _valueG(StoredAs)
  5971. else
  5972. do
  5973. FieldOptions=_valueG('mlFIndex?.mli?' ||c2x(FieldName))
  5974. if pos('REQUIRED',FieldOptions)<>0 then
  5975. CryAndDie('Line #' || ImportFileLine || ' - Required field "' || FieldName || '" was not specified')
  5976. call _AddField2Record ''
  5977. end
  5978. end
  5979. call GenerateRecordFromFields
  5980. return
  5981.  
  5982. GetMlField:call TRACE "OFF"
  5983. if MultiLineImportInProgress<> 'Y' then
  5984. CryAndDie('GetMlField(): Multi line import is not in progress!')
  5985. FieldName=translate(arg(1))
  5986. StoredAs='mlFValues?.mlv?' ||c2x(FieldName)
  5987. if symbol(StoredAs)='VAR' then
  5988. return(_valueG(StoredAs))
  5989. CryAndDie('Line #' || ImportFileLine || ' - GetMlField(): Field "' || FieldName || '" is unknown!')
  5990.  
  5991. I_ML_25:
  5992. call LoopInit
  5993. signal LOOP_26;
  5994.  
  5995. LoopInit:
  5996. InLoop='N'
  5997. LoopCount=0
  5998. LoopLine=1
  5999. LoopFirstLineNumber=-1
  6000. LoopIfNesting=-1
  6001. LoopLinesFromFile=-1
  6002. return
  6003.  
  6004. LoopPush:
  6005. SavedAs=arg(1)
  6006. SFI_InLoop.SavedAs=InLoop
  6007. SFI_LoopCount.SavedAs=LoopCount
  6008. SFI_LoopLine.SavedAs=LoopLine
  6009. SFI_LoopLinesFromFile.SavedAs=LoopLinesFromFile
  6010. SFI_LoopFirstLineNumber.SavedAs=LoopFirstLineNumber
  6011. SFI_LoopIfNesting.SavedAs=LoopIfNesting
  6012. do SaveIndex=1 to LoopCount
  6013. SavedPpwLoop.SaveIndex.SavedAs=PpwLoop.SaveIndex
  6014. end
  6015. call LoopInit
  6016. return
  6017.  
  6018. LoopPop:
  6019. SavedAs=arg(1)
  6020. InLoop=SFI_InLoop.SavedAs
  6021. LoopCount=SFI_LoopCount.SavedAs
  6022. LoopLine=SFI_LoopLine.SavedAs
  6023. LoopLinesFromFile=SFI_LoopLinesFromFile.SavedAs
  6024. LoopFirstLineNumber=SFI_LoopFirstLineNumber.SavedAs
  6025. LoopIfNesting=SFI_LoopIfNesting.SavedAs
  6026. do SaveIndex=1 to LoopCount
  6027. PpwLoop.SaveIndex=SavedPpwLoop.SaveIndex.SavedAs
  6028. end
  6029. return
  6030.  
  6031. ProcessLoopStart:
  6032. if InLoop='Y' then
  6033. CryAndDie("Can't nest loops")
  6034. InLoop='Y'
  6035. LoopCount=0
  6036. LoopLine=1
  6037. LoopFirstLineNumber=IncludeLineNumber
  6038. LoopIfNesting=IfNesting
  6039. if IncludeMemBufferNextLine=='' then
  6040. LoopLinesFromFile=1
  6041. else
  6042. LoopLinesFromFile=0
  6043. LengthEndCmd=length(CmdHashLoopE)
  6044. FoundEnd='N'
  6045. do while IncludeFileLines()<>0
  6046. LoopCount=LoopCount+1
  6047. if LoopLinesFromFile=1 then
  6048. do
  6049. PpwLoop.LoopCount=IncludeFileLineIn()
  6050. InputLines=InputLines+1
  6051. end
  6052. else
  6053. do
  6054. if IncludeMemBufferNextLine=='' then
  6055. leave
  6056. parse var IncludeMemBufferNextLine PpwLoop.LoopCount (MarksNewLine) IncludeMemBufferNextLine
  6057. end
  6058. MaybeEndCmd=left(strip(PpwLoop.LoopCount, 'L'),LengthEndCmd)
  6059. if MaybeEndCmd=CmdHashLoopE then
  6060. do
  6061. FoundEnd='Y'
  6062. LoopCount=LoopCount-1
  6063. if LoopCount=0 then
  6064. CryAndDie("No commands found in body of loop!")
  6065. leave
  6066. end
  6067. end
  6068. if FoundEnd='N' then
  6069. do
  6070. if LoopLinesFromFile then
  6071. eLoop='EOF'
  6072. else
  6073. eLoop='end of macro'
  6074. CryAndDie('Could not find "' || CmdHashLoopE || '" before ' ||eLoop)
  6075. end
  6076. call DebugLine 'Loop is ' || LoopCount || ' line(s) long and ends on line ' ||AddCommasToDecimalNumber(IncludeLineNumber)
  6077. return(0)
  6078.  
  6079. GetLoopLineIntoFileLine:
  6080. FileLine=PpwLoop.LoopLine
  6081. if LoopLinesFromFile then
  6082. IncludeLineNumber=LoopFirstLineNumber+LoopLine
  6083. LoopLine=LoopLine+1
  6084. if LoopLine>LoopCount then
  6085. LoopLine=1
  6086. return(FileLine)
  6087.  
  6088. ProcessLoopBreak:
  6089. call DebugLine 'Exiting loop'
  6090. InLoop='N'
  6091. IfNesting=LoopIfNesting
  6092. if LoopLinesFromFile then
  6093. IncludeLineNumber=LoopFirstLineNumber+LoopCount+1
  6094. return(0)
  6095.  
  6096. ProcessLoopContinue:
  6097. call DebugLine 'Back to start of loop'
  6098. LoopLine=1
  6099. IfNesting=LoopIfNesting
  6100. return(0)
  6101.  
  6102. LOOP_26:
  6103. _RestrictKeyMinimum=xrange('A', 'Z') || xrange('a', 'z') || xrange('0', '9')
  6104. _giCounter=0
  6105. signal GetId_27;
  6106.  
  6107. GetIdPrepare:call TRACE "OFF"
  6108. giHandle=arg(1)
  6109. giUniqueId=translate(arg(2))
  6110. interpret 'drop GI?'  || giHandle || '.'
  6111. call _valueS 'GI?'  || giHandle || '.GI?UID',giUniqueId
  6112. return
  6113.  
  6114. SetId:call TRACE "OFF"
  6115. giHandle=arg(1)
  6116. giName=arg(2)
  6117. giId=arg(3)
  6118. giSaveAsPrefix='GI?'  || giHandle || '.GI?'
  6119. if giName\=='' then
  6120. do
  6121. if _valueG(giSaveAsPrefix|| 'UID') = 'Y' then
  6122. CryAndDie("You have asked for UNIQUE ID's to be generated. Don't use SetId()!!!")
  6123. giKeySavedAs=giSaveAsPrefix|| 'KEY_' ||c2x(giName)
  6124. if symbol(giKeySavedAs)='VAR' then
  6125. CryAndDie('SetId(): The KEY of "' || giName || '" has already been used')
  6126. call _valueS giKeySavedAs,giId
  6127. end
  6128. IdSavedAs=giSaveAsPrefix|| 'ID_' ||c2x(giId)
  6129. if symbol(IdSavedAs)='VAR' then
  6130. CryAndDie('SetId(): The ID of "' || giId || '" has already been used')
  6131. call _valueS IdSavedAs, ''
  6132. return('')
  6133.  
  6134. GetId:call TRACE "OFF"
  6135. giHandle=arg(1)
  6136. giType=translate(arg(2))
  6137. giName=arg(3)
  6138. giSaveAsPrefix='GI?'  || giHandle || '.GI?'
  6139. giUniqueId=_valueG(giSaveAsPrefix|| 'UID')
  6140. if giUniqueId<> 'Y' then
  6141. do
  6142. giKeySavedAs=giSaveAsPrefix|| 'KEY_' ||c2x(giName)
  6143. if symbol(giKeySavedAs)='VAR' then
  6144. return(_valueG(giKeySavedAs))
  6145. end
  6146. GiMaxLength=''
  6147. select
  6148. when giType="MAXCHARS" then
  6149. do
  6150. CanBeDuplicated='Y'
  6151. GiMaxLength=arg(5)
  6152. if GiMaxLength='' then
  6153. GiMaxLength=8
  6154. giId=_Id_2_(giName,arg(4))
  6155. if length(giId)>GiMaxLength then
  6156. giId=left(giId,GiMaxLength)
  6157. end
  6158. when giType="C2X" then
  6159. do
  6160. CanBeDuplicated='N'
  6161. giId=_Id_c2x(giName,arg(4))
  6162. end
  6163. when giType="2_" then
  6164. do
  6165. CanBeDuplicated='Y'
  6166. giId=_Id_2_(giName,arg(4))
  6167. end
  6168. otherwise
  6169. CryAndDie('GetId(): Invalid type of "' || giType || '" specified')
  6170. end
  6171. if CanBeDuplicated='Y' then
  6172. do
  6173. IdSavedAs=giSaveAsPrefix|| 'ID_' ||c2x(giId)
  6174. if symbol(IdSavedAs)='VAR' then
  6175. do
  6176. GiIndex=1
  6177. do forever
  6178. if GiMaxLength='' then
  6179. giTryId=giId||GiIndex
  6180. else
  6181. do
  6182. giChopLength=GiMaxLength-length(GiIndex)
  6183. if length(giId)>giChopLength then
  6184. giTryId=left(giId,giChopLength)||GiIndex
  6185. else
  6186. giTryId=giId||GiIndex
  6187. end
  6188. GiIndex=GiIndex+1
  6189. IdSavedAs=giSaveAsPrefix|| 'ID_' ||c2x(giTryId)
  6190. if symbol(IdSavedAs)<> 'VAR' then
  6191. do
  6192. giId=giTryId
  6193. leave
  6194. end
  6195. end
  6196. end
  6197. call _valueS IdSavedAs, ''
  6198. end
  6199. if giUniqueId<> 'Y' then
  6200. call _valueS giKeySavedAs,giId
  6201. return(giId)
  6202.  
  6203. _Id_2_:
  6204. parse arg KeyR,RestrictTo
  6205. RestrictTo=_RestrictKeyMinimum||RestrictTo
  6206. KeyL=''
  6207. InvPos=verify(KeyR,RestrictTo)
  6208. do while InvPos<>0
  6209. KeyL=KeyL||left(KeyR,InvPos-1)|| '_'
  6210. KeyR=substr(KeyR,InvPos+1)
  6211. InvPos=verify(KeyR,RestrictTo)
  6212. end
  6213. KeyL=strip(KeyL||KeyR,, '_')
  6214. do until BeforeCount=ReplaceCount
  6215. BeforeCount=ReplaceCount
  6216. KeyL=ReplaceString(KeyL, "__", "_")
  6217. end
  6218. if KeyL='' then
  6219. return('_')
  6220. else
  6221. return(KeyL)
  6222.  
  6223. _Id_c2x:
  6224. parse arg KeyR,RestrictTo
  6225. RestrictTo=_RestrictKeyMinimum||RestrictTo
  6226. KeyL=''
  6227. InvPos=verify(KeyR,RestrictTo)
  6228. do while InvPos<>0
  6229. KeyL=KeyL||left(KeyR,InvPos-1)|| 'x' ||c2x(substr(KeyR,InvPos,1))
  6230. KeyR=substr(KeyR,InvPos+1)
  6231. InvPos=verify(KeyR,RestrictTo)
  6232. end
  6233. return(KeyL||KeyR)
  6234.  
  6235. GetId_27:
  6236. signal ExecCmd_28;
  6237.  
  6238. ExecRexxCmd:
  6239. InterpretThisC=arg(1)
  6240. if RexWhich='REGINA' then
  6241. InterpretThisC=ReplaceString(InterpretThisC,DefRexxSpecialSepTag,MarksNewLine)
  6242. else
  6243. InterpretThisC=ReplaceString(InterpretThisC,DefRexxSpecialSepTag, ';')
  6244. InterpretThis=InterpretThisC
  6245. if OptionDebugOn='Y' then
  6246. do
  6247. call DebugLine_INTERPRET 'Interpreting ' ||DebugRightArrow||InterpretThisC||DebugLeftArrow
  6248. call DebugLine_INTERPRET 'Rexx code is ' || AddCommasToDecimalNumber(length(InterpretThisC)) || ' bytes long'
  6249. if bitand(DebugLevel,SeeRexxTrace)==SeeRexxTrace then
  6250. do
  6251. TraceLevel4Rexx=GetDefineValueOrUseDefault('REXXTRACE', 'INTERMEDIATES')
  6252. say ''
  6253. say '---------- REXX TRACE - START(' || TraceLevel4Rexx || ') ----------'
  6254. InterpretThis='TRACE ' || TraceLevel4Rexx || ';' || InterpretThisC || ';call TRACE "OFF";'
  6255. end
  6256. end
  6257. signal ON SYNTAX NAME _SyntaxErrorDuringInterpret
  6258. signal ON NOVALUE NAME _UnknownVariableDuringInterpret
  6259. interpret InterpretThis
  6260. if OptionDebugOn='Y' then
  6261. do
  6262. if bitand(DebugLevel,SeeRexxTrace)==SeeRexxTrace then
  6263. do
  6264. say '---------- REXX TRACE - END(' || TraceLevel4Rexx || ') ----------'
  6265. say ''
  6266. end
  6267. end
  6268. return
  6269.  
  6270. _UnknownVariableDuringInterpret:
  6271. TrappingLine=SIGL
  6272. call TRACE "OFF"
  6273. call CommonTrapHandler TrappingLine, 'NoValue Abort!', 'Unknown Variable', condition('D'),space(InterpretThisC)
  6274.  
  6275. _SyntaxErrorDuringInterpret:
  6276. TrappingLine=SIGL
  6277. call TRACE "OFF"
  6278. call CommonTrapHandler TrappingLine, 'Syntax Error!', 'Reason',errortext(Rc),space(InterpretThisC)
  6279.  
  6280. ExecCmd_28:
  6281. ExpandXEarly='N'
  6282. ExpandXLate='N'
  6283. ExpandXCmd='N'
  6284. signal EndExpandX
  6285.  
  6286. EXPANDX_DEBUG:
  6287. if OptionDebugOn='Y' then
  6288. do
  6289. if ExpandX='NONE' then
  6290. call OptionDebugShow 'EXPANDX', 'X codes are never expanded'
  6291. else
  6292. call OptionDebugShow 'EXPANDX', 'X codes are expanded "' || ExpandX || '"'
  6293. end
  6294. return
  6295.  
  6296. EXPANDX_GET:
  6297. call EXPANDX_DEBUG
  6298. return(ExpandX)
  6299.  
  6300. EXPANDX_SET:
  6301. ExpandX=translate(arg(1))
  6302. if ProcessedCmdLine='N' then
  6303. do
  6304. call OptionDebugShow 'EXPANDX', 'Setting default value of "X" var expansion to "' || EXPANDX || '"'
  6305. Default4_EXPANDX=ExpandX
  6306. return(0)
  6307. end
  6308. if ExpandX=='' then
  6309. ExpandX=Default4_EXPANDX
  6310. ExpandXEarly='N'
  6311. ExpandXLate='N'
  6312. ExpandXCmd='N'
  6313. if ExpandX<> 'NONE' then
  6314. do
  6315. TmpList=translate(ExpandX)
  6316. do while TmpList<> ''
  6317. parse var TmpList ThisItem','TmpList
  6318. select
  6319. when ThisItem='COMMAND' then
  6320. ExpandXCmd='Y'
  6321. when ThisItem='EARLY' then
  6322. ExpandXEarly='Y'
  6323. when ThisItem='LATE' then
  6324. ExpandXLate='Y'
  6325. otherwise
  6326. CryAndDie('Unknown EXPANDX option of "' || ThisItem || '"')
  6327. end
  6328. end
  6329. end
  6330. call EXPANDX_DEBUG
  6331. return
  6332.  
  6333. InitializeCharCodes:
  6334. call DebugLine_DEFINING 'Initializing <' || '?x00-FF> codes + <' || '?xRexxEos>'
  6335. do CharCode=0 to 255
  6336. call _valueS 'XVAR?.X?' ||c2x(translate(d2x(CharCode,2))),d2c(CharCode)
  6337. end
  6338. call _valueS 'XVAR?.X?'  || c2x(translate("RexxEos")),d2c(10)
  6339. return
  6340.  
  6341. ExpandXCodes:call TRACE "OFF"
  6342.  
  6343. ReplaceXCodesIfNotDisabled:
  6344. if pos(StartsStdSymbolReplacement_x,arg(1))=0 then
  6345. return(arg(1))
  6346.  
  6347. ReplaceTheXCodesWeKnowExist:
  6348. LeftBit=''
  6349. RightBit=arg(1)
  6350. StartPos=pos(StartsStdSymbolReplacement_x,RightBit)
  6351. do while StartPos<>0
  6352. ReplaceCount=ReplaceCount+1
  6353. EndPos=pos(EndsMacroReplacement,RightBit,StartPos+1)
  6354. XVarName='XVAR?.X?' ||c2x(translate(substr(RightBit,StartPos+3,(EndPos-StartPos)-3)))
  6355. if symbol(XVarName)='VAR' then
  6356. LeftBit=LeftBit||left(RightBit,StartPos-1)||_valueG(XVarName)
  6357. else
  6358. do
  6359. CryAndDie(StartsStdSymbolReplacement_x||substr(RightBit,StartPos+3,(EndPos-StartPos)-3)||EndsMacroReplacement|| ' is not defined (use "#RexxVar =x=" command)!')
  6360. end
  6361. RightBit=substr(RightBit,EndPos+1)
  6362. StartPos=pos(StartsStdSymbolReplacement_x,RightBit)
  6363. end
  6364. if OptionDebugOn='Y' then
  6365. call DebugOutputAfterReplacement LeftBit||RightBit, '?xXX'
  6366. return(LeftBit||RightBit)
  6367.  
  6368. EndExpandX:
  6369. signal OnExit_29;
  6370.  
  6371. SetUpOnExitProcessingIfEndOfMainFile:
  6372. if IncludeLevel=1 then
  6373. do
  6374. if DoOnExit<> '' then
  6375. do
  6376. call DebugLine ''
  6377. call DebugLine '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
  6378. call DebugLine '!!! "#OnExit" processing follows !!!'
  6379. call DebugLine '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
  6380. call DebugLine ''
  6381. IncludeMemBufferNextLine=DoOnExit
  6382. DoOnExit=''
  6383. return('Y')
  6384. end
  6385. end
  6386. return('N')
  6387.  
  6388. ProcessOnExit:
  6389. Rest=strip(arg(1))
  6390. if Rest='' then
  6391. return
  6392. call DebugLine 'OnExit we will process ' ||DebugRightArrow||Rest||DebugLeftArrow
  6393. if DoOnExit='' then
  6394. DoOnExit=Rest
  6395. else
  6396. DoOnExit=DoOnExit||MarksNewLine||Rest
  6397. return(0)
  6398.  
  6399. OnExit_29:
  6400. IncludeIntoMemory=''
  6401. signal Include_30;
  6402.  
  6403. RecursiveIncludeSave:
  6404. call LoopPush IncludeLevel
  6405. _DebugCurrentFileNumber.IncludeLevel=DebugCurrentFileNumber
  6406. _IncludeMemHandle.IncludeLevel=IncludeMemHandle
  6407. _IncludeEofLine.IncludeLevel=IncludeEofLine
  6408. _IncludeFragmentText.IncludeLevel=IncludeFragmentText
  6409. _IncludeLineNumber.IncludeLevel=IncludeLineNumber
  6410. _IncludeMemBufferNextLine.IncludeLevel=IncludeMemBufferNextLine
  6411. _EofForced.IncludeLevel=EofForced
  6412. EofForced=''
  6413. return
  6414.  
  6415. RecursiveIncludeRestore:
  6416. DebugCurrentFileNumber=_DebugCurrentFileNumber.IncludeLevel
  6417. IncludeMemHandle=_IncludeMemHandle.IncludeLevel
  6418. IncludeEofLine=_IncludeEofLine.IncludeLevel
  6419. IncludeFragmentText=_IncludeFragmentText.IncludeLevel
  6420. IncludeLineNumber=_IncludeLineNumber.IncludeLevel
  6421. IncludeMemBufferNextLine=_IncludeMemBufferNextLine.IncludeLevel
  6422. EofForced=_EofForced.IncludeLevel
  6423. IncludeFileName=IncludeFileName.IncludeLevel
  6424. call LoopPop IncludeLevel
  6425. return
  6426.  
  6427. IncludeFileOpen:
  6428. ifFullFileName=arg(1)
  6429. ifLoad2Mem=arg(2)
  6430. if RexSystemOpSys="UNIX" then
  6431. ifHandle='_IF_' || c2x(ifFullFileName) || '.';
  6432. else
  6433. ifHandle='_IF_' || c2x(translate(ifFullFileName)) || '.'
  6434. if symbol(ifHandle|| '0') = 'VAR' then
  6435. do
  6436. if OptionDebugOn='Y' then
  6437. call DebugLine '"' || ifFullFileName || '" will be read from memory cache'
  6438. return(_valueG(ifHandle|| '0') || ';' ||ifHandle)
  6439. end
  6440. CloseRc=stream(ifFullFileName, 'c', 'close')
  6441. OpenRc=stream(ifFullFileName, 'c', 'open read')
  6442. if ifLoad2Mem='' then
  6443. ifLoad2Mem=IncludeIntoMemory
  6444. if ifLoad2Mem='N' then
  6445. do
  6446. if OptionDebugOn='Y' then
  6447. call DebugLine 'Will read "' || ifFullFileName || '" directly from file'
  6448. return('')
  6449. end
  6450. if OptionDebugOn='Y' then
  6451. call DebugLine 'Reading "' || ifFullFileName || '" into memory cache'
  6452. ifLineNum=0
  6453. do while lines(ifFullFileName)<>0
  6454. ifLineNum=ifLineNum+1
  6455. ifLineTxt=linein(ifFullFileName)
  6456. call _valueS ifHandle||ifLineNum,ifLineTxt
  6457. end
  6458. call _valueS ifHandle|| '0',ifLineNum
  6459. call DieIfIoErrorOccurred ifFullFileName, 'Y'
  6460. CloseRc=stream(ifFullFileName, 'c', 'close')
  6461. if OptionDebugOn='Y' then
  6462. do
  6463. call DebugIncrement 1
  6464. call DebugLine 'Read ' || AddCommasToDecimalNumber(ifLineNum) || ' lines'
  6465. call DebugIncrement-1
  6466. end
  6467. return(ifLineNum|| ';' ||ifHandle)
  6468.  
  6469. IncludeFileClose:
  6470. if IncludeMemHandle='' then
  6471. do
  6472. call DieIfIoErrorOccurred IncludeFileName, 'Y'
  6473. CloseRc=stream(IncludeFileName, 'c', 'close')
  6474. end
  6475. return
  6476.  
  6477. IncludeFileLines:
  6478. if IncludeMemHandle='' then
  6479. return(lines(IncludeFileName))
  6480. else
  6481. return(IncludeLineNumber<IncludeEofLine)
  6482.  
  6483. IncludeFileLineIn:
  6484. IncludeLineNumber=IncludeLineNumber+1
  6485. if IncludeMemHandle='' then
  6486. ifLineTxt=linein(IncludeFileName)
  6487. else
  6488. ifLineTxt=_valueG(IncludeMemHandle||IncludeLineNumber)
  6489. if ExtraWhiteSpace=='' then
  6490. return(ifLineTxt)
  6491. else
  6492. return(translate(ifLineTxt, '', ExtraWhiteSpace, ' '))
  6493.  
  6494. Include_30:
  6495. SummaryUserAllBldCount=0
  6496. SummaryUserOverallCount=0
  6497. SummaryUserThisBldCount=0
  6498. signal Summary_31;
  6499.  
  6500. Summary:call TRACE "OFF"
  6501. parse arg SummaryLeft,SummaryRight,SummaryMode
  6502. SummaryLeft=strip(SummaryLeft)
  6503. SummaryMode1=translate(left(SummaryMode,1))
  6504. select
  6505. when SummaryMode1='D' then
  6506. do
  6507. call DebugLine "Don't" || ' want "' || SummaryLeft || '" in any summaries'
  6508. call _valueS '!SUMMDROP.!' ||c2x(SummaryLeft),CurrentSourceLocation()
  6509. end
  6510. when SummaryMode1='O' then
  6511. do
  6512. SummaryUserOverallCount=SummaryUserOverallCount+1
  6513. SummaryUserOverallL.SummaryUserOverallCount=SummaryLeft
  6514. SummaryUserOverallR.SummaryUserOverallCount=SummaryRight
  6515. end
  6516. when SummaryMode1='A' then
  6517. do
  6518. SummaryUserAllBldCount=SummaryUserAllBldCount+1
  6519. SummaryUserAllBldL.SummaryUserAllBldCount=SummaryLeft
  6520. SummaryUserAllBldR.SummaryUserAllBldCount=SummaryRight
  6521. end
  6522. otherwise
  6523. do
  6524. SummaryUserThisBldCount=SummaryUserThisBldCount+1
  6525. SummaryUserThisBldL.SummaryUserThisBldCount=SummaryLeft
  6526. SummaryUserThisBldR.SummaryUserThisBldCount=SummaryRight
  6527. end
  6528. end
  6529. return
  6530.  
  6531. GenerateUserSummaryThisBuild:
  6532. do SummLine=1 to SummaryUserThisBldCount
  6533. call AddSummaryLine SummaryUserThisBldL.SummLine,SummaryUserThisBldR.SummLine
  6534. end
  6535. SummaryUserThisBldCount=0
  6536. return
  6537.  
  6538. GenerateUserSummaryAllBuilds:
  6539. do SummLine=1 to SummaryUserAllBldCount
  6540. call AddSummaryLine SummaryUserAllBldL.SummLine,SummaryUserAllBldR.SummLine
  6541. end
  6542. return
  6543.  
  6544. GenerateUserSummaryOverall:
  6545. do SummLine=1 to SummaryUserOverallCount
  6546. call AddSummaryLine SummaryUserOverallL.SummLine,SummaryUserOverallR.SummLine
  6547. end
  6548. return
  6549.  
  6550. AboutToGenerateSummary:
  6551. MaxSummaryLeft=0
  6552. SummaryLines=0
  6553. call Line1 ''
  6554. if arg(1)<> 'N' then
  6555. do
  6556. TitleText='Summary'
  6557. call Line1 TitleColor
  6558. call Line1 TitleText
  6559. call Line1 copies('~',length(TitleText))||Reset
  6560. end
  6561. return
  6562.  
  6563. AddSummaryLine:
  6564. parse arg SummaryLeft,SummaryRight
  6565. SummaryLeft=strip(SummaryLeft)
  6566. DropSym='!SUMMDROP.!' ||c2x(SummaryLeft)
  6567. if symbol(DropSym)='VAR' then
  6568. do
  6569. call DebugLine 'Summary line for "' || SummaryLeft || '" unwanted (dropped at ' || _valueG(DropSym) || ')'
  6570. return
  6571. end
  6572. if length(SummaryLeft)>MaxSummaryLeft then
  6573. MaxSummaryLeft=length(SummaryLeft)
  6574. SummaryLines=SummaryLines+1
  6575. SummaryL.SummaryLines=SummaryLeft
  6576. SummaryR.SummaryLines=SummaryRight
  6577. return
  6578.  
  6579. GenerateSummaryLines:
  6580. do SummLine=1 to SummaryLines
  6581. call Line1 "   " || left(SummaryL.SummLine, MaxSummaryLeft) || ': ' ||SummaryR.SummLine
  6582. end
  6583. return
  6584.  
  6585. Summary_31:
  6586. numeric digits 14
  6587. trace off
  6588. CompileTime=date('Weekday') || ', ' || date() || ' ' ||GetAmPmTime()
  6589. LineSourceBeingProcessed='?'
  6590. NullChar=d2c(0)
  6591. TabChar=d2c(9)
  6592. CrLf=d2c(13)||d2c(10)
  6593. MarksNewLine=d2c(10)
  6594. if RexSystemOpSys="UNIX" then
  6595. NewLineChars=MarksNewLine
  6596. else
  6597. NewLineChars=CrLf
  6598. if RexSystemOpSys="UNIX" then
  6599. MarksNewLineInHashDefine=d2c(2)|| 'nl' ||d2c(2)
  6600. else
  6601. MarksNewLineInHashDefine='nl'
  6602. MarksNewLineInHashDefine2=MarksNewLineInHashDefine||MarksNewLineInHashDefine
  6603. Ignore=0
  6604. LowerCase="abcdefghijklmnopqrstuvwxyz"
  6605. UpperCase="ABCDEFGHIJKLMNOPQRSTUVWXYZ"
  6606. DecimalDigits="0123456789"
  6607. DebugOnStuffOutputted='N'
  6608. WantedWarningRc=1
  6609. NotEqualInC='!' || '='
  6610. EofChar=d2c(26)
  6611. RexxCmtStart='/' || '*'
  6612. RexxCmtEnd='*' || '/'
  6613. TagSvNewLine='<' || '?NewLine>'
  6614. if RexSystemOpSys="OS/2" then
  6615. do
  6616. call SetColorCodes
  6617. call SetBeepCode
  6618. end
  6619. else
  6620. do
  6621. call RemoveColorCodes
  6622. call RemoveBeepCode
  6623. end
  6624. InputInterfaceVer="98.131"
  6625. OutputInterfaceVer="98.132"
  6626. call SetEnv "PPWIZARD_VER_II",InputInterfaceVer
  6627. call SetEnv "PPWIZARD_VER_OI",OutputInterfaceVer
  6628. ProtectPrefix='{PROTECT_' || time('Seconds') || '}'
  6629. ProtectFromPpwS="option PUSH LeaveBlankLines=YES KeepIndent=YES linecomment='NULL' LineContinuation='NULL' HashPrefix='" || ProtectPrefix || "'"
  6630. ProtectFromPpwE=ProtectPrefix|| 'option POP'
  6631. OptionWantInfoMsgs='Y'
  6632. OptionHashInclude=''
  6633. OptionTemplate=''
  6634. OptionDependsOn=''
  6635. OptionOutput=''
  6636. OptionScanSubDir=''
  6637. OptionSummary='Y'
  6638. OptionPack='N'
  6639. OptionTranslateFileNames='N'
  6640. OptionFilterIn=''
  6641. OptionFilterOut=''
  6642. OptionTabs='W'
  6643. OptionDefineCount=0
  6644. OptionKeepRexxCmts='N'
  6645. OptionCompleteAddToToDepFile='Y'
  6646. OptionHtmlGeneratorTags=PgmDefaultHtmlMetaTags
  6647. OptionsCmdLine=strip(arg(1))
  6648. OptionsEnvironment=GetEnv('PPWIZARD_OPTIONS')
  6649. TheCmdLine=OptionsEnvironment|| ' ' ||OptionsCmdLine
  6650. UpperTheCmdLine=translate(TheCmdLine)
  6651. LookFor=RexOptionChar|| 'DEBUG'
  6652. if(pos(LookFor|| ' ',UpperTheCmdLine)<>0)|(right(UpperTheCmdLine,length(LookFor))==LookFor)then
  6653. do
  6654. OptionDebugOn='Y'
  6655. OptionWantInfoMsgs='Y'
  6656. call OutputInfoIfDebugOn
  6657. end
  6658. signal on NOVALUE name RexxTrapUninitializedVariable
  6659. signal on SYNTAX name RexxTrapSyntaxError
  6660. signal on HALT name RexxCtrlC
  6661. TrapHandler='FULL'
  6662. call SetUpPpwizardOptionDefaults
  6663. call InitializeCharCodes
  6664. call DebugLine 'Starting Processing of Parameters (from command line + Environment)'
  6665. call DebugIncrement 1
  6666. call DebugLine 'Switches start with "' || RexOptionChar || '"'
  6667. InputMaskCount=0
  6668. FullCommandLine=''
  6669. DebugSwitchUsed='N'
  6670. do while TheCmdLine<> ''
  6671. TheCmdLine=strip(TheCmdLine)
  6672. if left(TheCmdLine,1)='"' then
  6673. do
  6674. BeforeParse=TheCmdLine
  6675. parse value substr(TheCmdLine,2)with ThisParm'"'TheCmdLine
  6676. if TheCmdLine<> '' then
  6677. do
  6678. if left(TheCmdLine,1)\==' ' then
  6679. CryAndDie('Invalid quoted parameter at ==> ' ||BeforeParse)
  6680. end
  6681. end
  6682. else
  6683. do
  6684. parse var TheCmdLine ThisParm TheCmdLine
  6685. end
  6686. call DebugLine 'Option: "' || ThisParm || '"'
  6687. call DebugIncrement 1
  6688. ThisParm=ReplaceCommandLineCodes(ThisParm)
  6689. FullCommandLine=space(FullCommandLine|| ' ' ThisParm)
  6690. if left(ThisParm,1)<>RexOptionChar then
  6691. do
  6692. InputMaskCount=InputMaskCount+1
  6693. InputMask.InputMaskCount=MakeAbsolute(ThisParm)
  6694. call DebugIncrement-1
  6695. iterate
  6696. end
  6697. parse var ThisParm ThisCmd':'ThisCmdOptions
  6698. ThisCmd=translate(substr(ThisCmd,2))
  6699. select
  6700. when ThisCmd='PACK' then
  6701. OptionPack=SwitchWantsYesOrNo(ThisCmd,ThisCmdOptions, 'Y')
  6702. when ThisCmd='GETENV' then
  6703. do
  6704. FromEnv=GetEnv(ThisCmdOptions)
  6705. if FromEnv='' then
  6706. CryAndDie('The environment variable "' || ThisCmdOptions || '" does not exist.')
  6707. call DebugLine 'Contained: ' ||FromEnv
  6708. TheCmdLine=FromEnv|| ' ' ||TheCmdLine
  6709. end
  6710. when ThisCmd='CRLF' then
  6711. do
  6712. if SwitchWantsYesOrNo(ThisCmd,ThisCmdOptions, 'Y') = 'Y' then
  6713. NewLineChars=CrLf
  6714. else
  6715. NewLineChars=MarksNewLine
  6716. end
  6717. when ThisCmd='OTHER' then
  6718. OptionCodeType='OTHER'
  6719. when ThisCmd='HTML' then
  6720. OptionCodeType='HTML'
  6721. when ThisCmd='REXX' then
  6722. do
  6723. call SwitchMustNotHaveOptions ThisCmd,ThisCmdOptions
  6724. OptionCodeType='REXX'
  6725. end
  6726. when ThisCmd='WARNINGSOK' then
  6727. WantedWarningRc=SwitchWantsYesOrNo(ThisCmd,ThisCmdOptions, 'Y')
  6728. when ThisCmd='SCANSUBDIR' then
  6729. OptionScanSubDir=SwitchMustNotHaveOptions(ThisCmd,ThisCmdOptions, 'S')
  6730. when ThisCmd='DEPENDSON' then
  6731. do
  6732. OptionDependsOn=SwitchMustHaveOptions(ThisCmd,ThisCmdOptions)
  6733. if left(OptionDependsOn,1)<> '-' then
  6734. OptionSeeDependsProgress='Y'
  6735. else
  6736. do
  6737. OptionSeeDependsProgress='N'
  6738. OptionDependsOn=substr(OptionDependsOn,2)
  6739. end
  6740. end
  6741. when ThisCmd='DEPENDSONCOMPLETE' then
  6742. OptionCompleteAddToToDepFile=SwitchWantsYesOrNo(ThisCmd,ThisCmdOptions, 'Y')
  6743. when ThisCmd='OUTPUT' then
  6744. OptionOutput=SwitchMustHaveOptions(ThisCmd,ThisCmdOptions)
  6745. when ThisCmd='TEMPLATE' then
  6746. OptionTemplate=SwitchMustHaveOptions(ThisCmd,ThisCmdOptions)
  6747. when ThisCmd='COLOR' | ThisCmd = 'COLOUR' then
  6748. do
  6749. call NotAvailableUnderNtYet ThisCmd
  6750. WantColor=SwitchWantsYesOrNo(ThisCmd,ThisCmdOptions, 'Y')
  6751. if WantColor='N' then
  6752. call RemoveColorCodes
  6753. else
  6754. call SetColorCodes
  6755. end
  6756. when ThisCmd='BEEP' then
  6757. do
  6758. WantBeep=SwitchWantsYesOrNo(ThisCmd,ThisCmdOptions, 'Y')
  6759. if WantBeep='N' then
  6760. call RemoveBeepCode
  6761. else
  6762. call SetBeepCode
  6763. end
  6764. when ThisCmd='WARNINGSIGNORE' then
  6765. WarningsToIgnore=translate(ThisCmdOptions)
  6766. when ThisCmd='FILENAMES' then
  6767. do
  6768. call SwitchMustHaveOptions ThisCmd,ThisCmdOptions
  6769. OptionTranslateFileNames=translate(strip(ThisCmdOptions))
  6770. if OptionTranslateFileNames<> "LOWER" & OptionTranslateFileNames <> "UPPER" then
  6771. UserSyntaxError('Expected "UPPER" or "LOWER" on the "' || TheCmd || '" command, not "' || ThisCmdOptions || '"!')
  6772. end
  6773. when ThisCmd='FILTERINPUT' then
  6774. do
  6775. call NotAvailableUnderNtYet ThisCmd
  6776. OptionFilterIn=SwitchMustHaveOptions(ThisCmd,ThisCmdOptions)
  6777. call DoMacroSpaceOperation "ADD", OptionFilterIn, "HtmlFilterIn"
  6778. end
  6779. when ThisCmd='FILTEROUTPUT' then
  6780. do
  6781. call NotAvailableUnderNtYet ThisCmd
  6782. OptionFilterOut=SwitchMustHaveOptions(ThisCmd,ThisCmdOptions)
  6783. call DoMacroSpaceOperation "ADD", OptionFilterOut, "HtmlFilterOut"
  6784. end
  6785. when ThisCmd='TABS' then
  6786. do
  6787. OptionTabs=left(SwitchOptionsValidateAgainstList(ThisCmd,ThisCmdOptions, "ToSpaces,Ignore,Warnings"),1)
  6788. end
  6789. when ThisCmd='DEFINE' then
  6790. do
  6791. call SwitchMustHaveOptions ThisCmd,ThisCmdOptions
  6792. parse var ThisCmdOptions DefineVar'='DefineContents
  6793. OptionDefineCount=OptionDefineCount+1
  6794. OptionDefine.OptionDefineCount.Var=DefineVar
  6795. OptionDefine.OptionDefineCount.Cont=strip(DefineContents)
  6796. end
  6797. when ThisCmd='OPTION' then
  6798. do
  6799. call SwitchMustHaveOptions ThisCmd,ThisCmdOptions
  6800. call ProcessOption ThisCmdOptions
  6801. end
  6802. when ThisCmd='SPELLSHOWALL' then
  6803. SpellShowEachError=SwitchWantsYesOrNo(ThisCmd,ThisCmdOptions, 'Y')
  6804. when ThisCmd='SPELLCHECK' then
  6805. do
  6806. call SwitchMustHaveOptions ThisCmd,ThisCmdOptions
  6807. call LoadSpellingDictionary ThisCmdOptions
  6808. end
  6809. when ThisCmd='SPELLADDWORD' then
  6810. do
  6811. call SwitchMustHaveOptions ThisCmd,ThisCmdOptions
  6812. SpellingAddFile=ThisCmdOptions
  6813. if left(SpellingAddFile,1)<> '-' then
  6814. SpellingPrompts='Y'
  6815. else
  6816. do
  6817. SpellingPrompts='OK'
  6818. SpellingAddFile=substr(SpellingAddFile,2)
  6819. end
  6820. end
  6821. when ThisCmd='**/' then
  6822. OptionKeepRexxCmts=SwitchWantsYesOrNo(ThisCmd,ThisCmdOptions, 'Y')
  6823. when ThisCmd='INFO' then
  6824. OptionWantInfoMsgs=SwitchWantsYesOrNo(ThisCmd,ThisCmdOptions, 'Y')
  6825. when ThisCmd='#INCLUDE' then
  6826. OptionHashInclude=ThisCmdOptions
  6827. when ThisCmd='CGI' then
  6828. call TurnCgiModeOn ThisCmdOptions
  6829. when ThisCmd='SLEEP' then
  6830. OnExitSleepFor=SwitchMustHaveOptions(ThisCmd,ThisCmdOptions)
  6831. when ThisCmd='HTMLGENERATOR' then
  6832. OptionHtmlGeneratorTags=ThisCmdOptions
  6833. when ThisCmd='EXCLUDE' then
  6834. do
  6835. call SwitchMustHaveOptions ThisCmd,ThisCmdOptions
  6836. ExcludeList.0=0
  6837. call DebugLine 'Looking for files matching "' || ThisCmdOptions || '"'
  6838. call _SysFileTree ThisCmdOptions, 'ExcludeList', 'FO' ||OptionScanSubDir
  6839. call DebugIncrement 1
  6840. call DebugLine 'Found ' || ExcludeList.0 || ' files(s) to exclude'
  6841. call DebugIncrement 1
  6842. do InputIndex=1 to ExcludeList.0
  6843. TheFile=ExcludeList.InputIndex
  6844. call DebugLine TheFile
  6845. call _valueS "_EXCLUDE_._EXF_" || c2x(TheFile), 'you used "' || RexOptionChar || ThisCmd || ':' || ThisCmdOptions || '"'
  6846. end
  6847. call DebugIncrement-1
  6848. end
  6849. when ThisCmd='INC2CACHE' then
  6850. IncludeIntoMemory=SwitchWantsYesOrNo(ThisCmd,ThisCmdOptions, 'Y')
  6851. when ThisCmd='DEBUGTIME' then
  6852. OptionDebugTime=left(SwitchOptionsValidateAgainstList(ThisCmd,ThisCmdOptions, "N,NO,L,LONG,S,SHORT"),1)
  6853. when ThisCmd='DEBUG' then
  6854. do
  6855. call RemoveBeepCode
  6856. call RemoveColorCodes
  6857. call SwitchMustNotHaveOptions ThisCmd,ThisCmdOptions
  6858. DebugSwitchUsed='Y'
  6859. OptionDebugOn='Y'
  6860. OptionWantInfoMsgs='Y'
  6861. call OutputInfoIfDebugOn
  6862. end
  6863. otherwise
  6864. UserSyntaxError('Unknown switch of "' || RexOptionChar || ThisCmd || '" specified')
  6865. end
  6866. call DebugIncrement-1
  6867. end
  6868. call DebugIncrement-1
  6869. call DebugLine 'Finished Processing : ' ||FullCommandLine
  6870. call CheckRexxInterpreter 'Y'
  6871. if OptionDebugOn='Y' then
  6872. do
  6873. TmpSetFile=RexGetTmpFileName()
  6874. call AddressCmd 'set >' ||TmpSetFile,TmpSetFile
  6875. call _SysFileDelete TmpSetFile
  6876. end
  6877. InpFileCount=0
  6878. InpFileCountActuallyMade=0
  6879. AllSameExtn=''
  6880. do SpecIndex=1 to InputMaskCount
  6881. InputList.0=0
  6882. call DebugLine 'Looking for files matching "' || InputMask.SpecIndex || '"'
  6883. call _SysFileTree InputMask.SpecIndex, 'InputList', 'FO' ||OptionScanSubDir
  6884. call DebugIncrement 1
  6885. call DebugLine 'Found ' || InputList.0 || ' files(s)'
  6886. call DebugIncrement 1
  6887. if InputList.0=0 then
  6888. do
  6889. Left1=left(InputMask.SpecIndex,1)
  6890. if Left1<> '-' & Left1 <> '/' then
  6891. Extra=''
  6892. else
  6893. Extra=' (all switches under ' || PpWizardOpSys || ' must start with "' || RexOptionChar || '")'
  6894. UserSyntaxError('No input files matched "' || InputMask.SpecIndex || '"' ||Extra)
  6895. end
  6896. else
  6897. do
  6898. do InputIndex=1 to InputList.0
  6899. TheFile=InputList.InputIndex
  6900. call DebugLine TheFile
  6901. InpFileCount=InpFileCount+1
  6902. InpFile.InpFileCount=TheFile
  6903. InpFileMaskIndex.InpFileCount=SpecIndex
  6904. DotPos=lastpos('.',TheFile)
  6905. if DotPos<>0 then
  6906. do
  6907. FileExtn=translate(substr(TheFile,DotPos+1))
  6908. if InpFileCount=1 then
  6909. AllSameExtn=FileExtn
  6910. if AllSameExtn<>FileExtn then
  6911. AllSameExtn=''
  6912. end
  6913. end
  6914. end
  6915. call DebugIncrement-2
  6916. end
  6917. if OptionCodeType='' then
  6918. do
  6919. select
  6920. when AllSameExtn='X' then
  6921. do
  6922. call DebugLine 'All input files end in ".' || AllSameExtn || '" so /REXX is default.'
  6923. OptionCodeType='REXX'
  6924. end
  6925. otherwise
  6926. OptionCodeType='HTML'
  6927. end
  6928. end
  6929. call DebugLine 'Processing input files in "' || OptionCodeType || '" mode'
  6930. if NewLineChars==CrLf then
  6931. LinesEndWith="CR followed by LF"
  6932. else
  6933. LinesEndWith="LF only"
  6934. call DebugLine 'Output lines are terminated with ' ||LinesEndWith
  6935. if OptionCodeType='HTML' then
  6936. OptionDefaultInputName="DEFAULT.IT"
  6937. else
  6938. OptionDefaultInputName=""
  6939. if OptionDependsOn<> '' & OptionCgiModeOn = 'Y' then
  6940. UserSyntaxError("Can't do dependancy checking in CGI mode!")
  6941. if OptionCodeType<> 'HTML' & OptionCgiModeOn = 'Y' then
  6942. UserSyntaxError("Must stay in HTML mode when /CGI switch used!")
  6943. if OptionCodeType='HTML' then
  6944. call DebugLine 'HTML Generator Tags are ' ||DebugRightArrow||OptionHtmlGeneratorTags||DebugLeftArrow
  6945. else
  6946. OptionHtmlGeneratorTags=''
  6947. if OptionOutput='' then
  6948. do
  6949. if OptionCodeType='REXX' then
  6950. OptionOutput='*.cmd'
  6951. else
  6952. OptionOutput='*.htm'
  6953. end
  6954. call DisplayCopyright
  6955. call OutputInfoIfDebugOn
  6956. if InputMaskCount=0 then
  6957. do
  6958. call DebugLine 'No input masks were specified...'
  6959. if OptionDefaultInputName='' then
  6960. UserSyntaxError('No input files were specified!')
  6961. if stream(OptionDefaultInputName, 'c', 'query exists') = '' then
  6962. UserSyntaxError('No input files were specified and "' || OptionDefaultInputName || '" not found!')
  6963. InputMask.1=OptionDefaultInputName
  6964. InpFileCount=1
  6965. InpFile.InpFileCount=OptionDefaultInputName
  6966. InpFileMaskIndex.InpFileCount=1
  6967. end
  6968. if IncludeIntoMemory='' then
  6969. do
  6970. if InpFileCount=1 then
  6971. IncludeIntoMemory='N'
  6972. else
  6973. IncludeIntoMemory='Y'
  6974. end
  6975. ExitRc=0
  6976. ActuallyProcessed=0
  6977. FailedProcessingWarning=0
  6978. do InputIndex=1 to InpFileCount
  6979. ThisFile=InpFile.InputIndex
  6980. if symbol("_EXCLUDE_._EXF_" || c2x(ThisFile)) = 'VAR' then
  6981. do
  6982. call DebugLine ThisFile|| ' excluded - ' || _valueG("_EXCLUDE_._EXF_" ||c2x(ThisFile))
  6983. iterate
  6984. end
  6985. ActuallyProcessed=ActuallyProcessed+1
  6986. call _valueS "_EXCLUDE_._EXF_" || c2x(ThisFile), "Already processed"
  6987. SpecIndex=InpFileMaskIndex.InputIndex
  6988. MaskUsedForCurrentInputFile=InputMask.SpecIndex
  6989. if OptionTemplate='' then
  6990. GenerateRc=GenerateOutput(ThisFile, '')
  6991. else
  6992. GenerateRc=GenerateOutput(OptionTemplate,ThisFile)
  6993. if GenerateRc>ExitRc then
  6994. ExitRc=GenerateRc
  6995. end
  6996. if ActuallyProcessed=0 then
  6997. UserSyntaxError('All input files were excluded by you!')
  6998. call OutputAnySpellingAdditions
  6999. if OptionSummary='Y' then
  7000. do
  7001. if InpFileCount>1 then
  7002. do
  7003. call AboutToGenerateSummary
  7004. call GenerateUserSummaryOverall
  7005. call AddSummaryLine 'Operating Syst' ,PpWizardOpSys
  7006. call AddSummaryLine 'Rexx Version' ,RexVersionInfo
  7007. if InpFileCount=InpFileCountActuallyMade then
  7008. call AddSummaryLine '# files' ,InpFileCount
  7009. else
  7010. call AddSummaryLine '# files made' ,InpFileCountActuallyMade || ' out of ' ||InpFileCount
  7011. call AddSummaryLine 'Exit Code' ,ExitRc
  7012. if FailedProcessingWarning<>0 then
  7013. call AddSummaryLine '# Warnings' ,FailedProcessingWarning
  7014. call AddSummaryLine 'Elapsed Time'     ,trunc(time('Elapsed'), 2) || ' seconds'
  7015. call GenerateSummaryLines
  7016. end
  7017. end
  7018. ThatsAllFolks(ExitRc)
  7019.  
  7020. SetColorCodes:
  7021. EscapeChar=d2c(27)
  7022. Reset=EscapeChar|| '[0m'
  7023. HighlightColor=EscapeChar|| '[1;35m'
  7024. TitleColor=EscapeChar|| '[0;32m'
  7025. ErrorColor=EscapeChar|| '[1;31m'
  7026. WarningColor=EscapeChar|| '[0;33m'
  7027. InfoColor=EscapeChar|| '[0;1m'
  7028. return
  7029.  
  7030. RemoveColorCodes:
  7031. Reset=''
  7032. HighlightColor=''
  7033. TitleColor=''
  7034. ErrorColor=''
  7035. WarningColor=''
  7036. InfoColor=''
  7037. return
  7038.  
  7039. SetBeepCode:
  7040. Beep=''
  7041. return
  7042.  
  7043. RemoveBeepCode:
  7044. Beep=''
  7045. return
  7046.  
  7047. ReplaceCommandLineCodes:
  7048. Before=arg(1)
  7049. RightBit=Before
  7050. LeftBit=''
  7051. StartPos=pos('{x',RightBit)
  7052. do while StartPos<>0
  7053. Codes2=substr(RightBit,StartPos+2,2)
  7054. if datatype(Codes2, 'X') <> 1 | substr(RightBit, StartPos+4, 1) <> '}' then
  7055. do
  7056. LeftBit=LeftBit||left(RightBit,StartPos+1)
  7057. RightBit=substr(RightBit,StartPos+2)
  7058. end
  7059. else
  7060. do
  7061. LeftBit=LeftBit||left(RightBit,StartPos-1)||x2c(Codes2)
  7062. RightBit=substr(RightBit,StartPos+5)
  7063. end
  7064. StartPos=pos('{x',RightBit)
  7065. end
  7066. LeftBit=LeftBit||RightBit
  7067. if OptionDebugOn='Y' then
  7068. do
  7069. if Before<>LeftBit then
  7070. call DebugOutputAfterReplacement LeftBit, '{xXX}'
  7071. end
  7072. return(LeftBit)
  7073.  
  7074. GetSourceFileDateTimeDieOnError:
  7075. DateTimeRc=GetFileDateTimeButDontWarnOnError(arg(1))
  7076. if DateTimeRc=-1 then
  7077. CryAndDie('Could not get date/time stamp of "' || arg(1) || '".')
  7078. return(DateTimeRc)
  7079.  
  7080. GenerateOutput:
  7081. InputFile=arg(1)
  7082. TemplateDataFile=arg(2)
  7083. if OptionTemplate='' then
  7084. do
  7085. call DebugLine 'Main file is not a template, no point loading into memory'
  7086. InFile=InputFile
  7087. ForceBaseFile2Mem='N'
  7088. end
  7089. else
  7090. do
  7091. call DebugLine 'Main file is a template'
  7092. InFile=TemplateDataFile
  7093. ForceBaseFile2Mem=''
  7094. end
  7095. CurrentOutFile=GenerateFileName(InFile,OptionOutput, 'Y')
  7096. call ClearDependancyTimeStampCache
  7097. if NeedToRemake(InFile)='N' then
  7098. return(0)
  7099. InpFileCountActuallyMade=InpFileCountActuallyMade+1
  7100. TitleText='Making - ' || _filespec('name',CurrentOutFile)
  7101. call Line1 TitleColor||TitleText
  7102. call Line1 copies('~',length(TitleText))||Reset
  7103. call SetUpOptionsForThisBuild
  7104. Dummy=time('Reset')
  7105. call DebugIncrementInit
  7106. call CompletelyInitializeAutoTagState
  7107. call InitializeCharCodes
  7108. call InitializeDefineRexx
  7109. call InitializeOneLine
  7110. DebugIncludeNumber=0
  7111. Warnings=0
  7112. LineSourceBeingProcessed='?'
  7113. GeneratedLines=0
  7114. InputLines=0
  7115. PartialLine=''
  7116. IncludeLevel=0
  7117. EofForced=''
  7118. LineQueued=''
  7119. PPwizardUnique=0
  7120. StackCnt=0
  7121. OptionStackCnt=0
  7122. HtmlGeneratorTags=OptionHtmlGeneratorTags
  7123. AsIsModeOn='N'
  7124. if OptionCompleteAddToToDepFile='Y' then
  7125. call AddInputFileToDependancyList PpWizardPgmName
  7126. call PrepareSpellingForThisBuild
  7127. NewestSourcefile=GetSourceFileDateTimeDieOnError(PpWizardPgmName)
  7128. call InitializeHashDefinesForThisCompile
  7129. OutputLevel=0
  7130. call HaveNewOutputFile CurrentOutFile,,'N',OptionCodeType
  7131. IfNesting=0
  7132. IfState.WantLines.0='Y'
  7133. IfState.IfTrue.0='Y'
  7134. IfState.InTrue.0='Y'
  7135. WantLineCache='Y'
  7136. call OutputHeaderIfWantedOrRequired
  7137. GenerateRc=0
  7138. call CheckRexxInterpreter
  7139. IncludeList=OptionHashInclude
  7140. do while IncludeList<> ''
  7141. parse var IncludeList ThisInclude (PathDelimiterChar) IncludeList
  7142. call DebugLine '/#Include "' ||ThisInclude
  7143. GenerateRc=GenerateRc+ProcessInputFile(ThisInclude)
  7144. end
  7145. InputFileFull=SafeQueryExists(InputFile)
  7146. GenerateRc=GenerateRc+ProcessInputFile(InputFile,,,ForceBaseFile2Mem)
  7147. if GenerateRc=0 then
  7148. do
  7149. select
  7150. when IfNesting<>0 then
  7151. do
  7152. do Index=1 to IfNesting
  7153. NestingLevel=(IfNesting-Index)+1
  7154. call DebugLine 'Missing #endif at EOF - Nesting Level #' ||NestingLevel||MatchesIfDebugText(NestingLevel)
  7155. end
  7156. CryAndDie('Missing #endif at EOF' ||MatchesIfDebugText(IfNesting))
  7157. end
  7158. when StackCnt<>0 then
  7159. do
  7160. do Index=1 to StackCnt
  7161. NestingLevel=(StackCnt-Index)+1
  7162. call DebugLine 'Missing #RexxVar pop at EOF - Nesting Level #' ||NestingLevel||MatchesStackPushDebugText(NestingLevel)
  7163. end
  7164. CryAndDie('Incorrect #RexxVar push/pop nesting at EOF' ||MatchesStackPushDebugText(StackCnt))
  7165. end
  7166. when OptionStackCnt<>0 then
  7167. do
  7168. do Index=1 to OptionStackCnt
  7169. NestingLevel=(OptionStackCnt-Index)+1
  7170. call DebugLine 'Missing pop() at EOF - Nesting Level #' ||NestingLevel||MatchesOptionStackPushDebugText(NestingLevel)
  7171. end
  7172. CryAndDie('Missing #Option pop at EOF' ||MatchesOptionStackPushDebugText(OptionStackCnt))
  7173. end
  7174. when AutoTagStateCnt<>0 then
  7175. do
  7176. do Index=1 to AutoTagStateCnt
  7177. NestingLevel=(AutoTagStateCnt-Index)+1
  7178. call DebugLine 'Missing #AutoTagState- at EOF - Nesting Level #' ||NestingLevel||MatchesAutoTagStateIncDebugText(NestingLevel)
  7179. end
  7180. CryAndDie('Missing #AutoTagState- at EOF' ||MatchesAutoTagStateIncDebugText(AutoTagStateCnt))
  7181. end
  7182. when DefRexxVar<> '' then
  7183. CryAndDie('Missing #DefineRexx[+] at EOF', 'Block started at ' ||DefRexxStartLoc)
  7184. when OneLineOn='Y' then
  7185. CryAndDie('#OneLine block did not end, started at ' ||OneLineStartLoc)
  7186. otherwise
  7187. end
  7188. if GeneratedLines=0 then
  7189. call OutputWarningToScreen 'GEN0', 'No output lines generated'
  7190. end
  7191. call Stream CurrentOutFile, 'c', 'Close'
  7192. if GenerateRc=0 then
  7193. do
  7194. if PartialLine<> '' then
  7195. CryAndDie('A line continued to EOF')
  7196. if OptionCodeType='REXX' then
  7197. call CheckRexxModuleForSyntaxErrors
  7198. call CreateDependancyFileFromLists
  7199. if Warnings<>0 then
  7200. do
  7201. FailedProcessingWarning=FailedProcessingWarning+1
  7202. GenerateRc=WantedWarningRc
  7203. end
  7204. if OptionSummary='Y' then
  7205. do
  7206. if InpFileCount=1 then
  7207. call AboutToGenerateSummary
  7208. else
  7209. call AboutToGenerateSummary 'N'
  7210. call GenerateUserSummaryThisBuild
  7211. call GenerateUserSummaryAllBuilds
  7212. if InpFileCount=1 then
  7213. call GenerateUserSummaryOverall
  7214. if Warnings<>0 then
  7215. call AddSummaryLine 'Warnings'        ,'YES (' || AddCommasToDecimalNumber(Warnings) || ')'
  7216. if InpFileCount=1 then
  7217. do
  7218. call AddSummaryLine 'Operating Syst' ,PpWizardOpSys
  7219. call AddSummaryLine 'Rexx Version' ,RexVersionInfo
  7220. end
  7221. call AddSummaryLine 'Return Code' ,GenerateRc
  7222. call AddSummaryLine 'Elapsed Time'        ,trunc(time('Elapsed'), 2) || ' seconds'
  7223. call GenerateSummaryLines
  7224. end
  7225. end
  7226. call Line1 ''
  7227. return(GenerateRc)
  7228.  
  7229. MyLineNumber:
  7230. return(SIGL)
  7231.  
  7232. OutputHeaderIfWantedOrRequired:
  7233. CommentStart=''
  7234. if OptionCodeType='REXX' then
  7235. do
  7236. CommentStart=RexxCmtStart
  7237. CommentEnd=RexxCmtEnd
  7238. end
  7239. else
  7240. do
  7241. end
  7242. if CommentStart<> '' then
  7243. do
  7244. call GenerateOneLine CommentStart
  7245. call GenerateOneLine ' * Generator   : PPWIZARD version ' ||PgmVersion
  7246. call GenerateOneLine ' *             : FREE tool for OS/2, Windows, DOS and UNIX by ' || PgmAuthor  || ' (' || PgmAuthorEmail || ')'
  7247. call GenerateOneLine ' *             : ' ||PgmHomePage
  7248. call GenerateOneLine " * Time        : " ||space(CompileTime)
  7249. call GenerateOneLine " * Input File  : " ||InputFile
  7250. do Index=1 to OutputLevel
  7251. call GenerateOneLine " * Output File : " ||Output.OutputLevel.File
  7252. end
  7253. call GenerateOneLine ' ' ||CommentEnd
  7254. call GenerateOneLine ''
  7255. if OptionCodeType='REXX' then
  7256. do
  7257. call GenerateOneLine 'if arg(1)="' || SyntaxOkText || '" then exit(' || SyntaxOkRc || ')'
  7258. call GenerateOneLine ''
  7259. end
  7260. end
  7261. return
  7262.  
  7263. FindIncludeFile:
  7264. LookForFile=arg(1)
  7265. FoundFile=_SysSearchPath('PPWIZARD_INCLUDE',LookForFile)
  7266. if FoundFile="" then
  7267. do
  7268. FoundFile=_SysSearchPath('INCLUDE',LookForFile)
  7269. if FoundFile="" then
  7270. do
  7271. parse source . . FoundFile
  7272. FoundFile=_filespec('drive', FoundFile) || _filespec('path',FoundFile)||LookForFile
  7273. if SafeQueryExists(FoundFile)='' then
  7274. FoundFile=''
  7275. end
  7276. end
  7277. return(FoundFile)
  7278.  
  7279. ProcessInputFile:
  7280. RequestedFile=arg(1)
  7281. IncludeFragmentText=arg(2)
  7282. AddToDepFile=arg(3)
  7283. ForceLoadingIntoMemory=arg(4)
  7284. IncludeLineNumber=0
  7285. IncludeMemBufferNextLine=''
  7286. DebugIncludeNumber=DebugIncludeNumber+1
  7287. DebugCurrentFileNumber=DebugIncludeNumber
  7288. IncludeFileName=SafeQueryExists(RequestedFile)
  7289. if IncludeFileName='' then
  7290. IncludeFileName=FindIncludeFile(RequestedFile)
  7291. if IncludeFileName='' then
  7292. do
  7293. call RecursiveIncludeRestore
  7294. CryAndDie('File "' || RequestedFile || '" does not exist!')
  7295. end
  7296. IncludeLevel=IncludeLevel+1
  7297. IncludeFileName.IncludeLevel=IncludeFileName
  7298. if IncludeLevel>=InfiniteIncludeLoopWhen then
  7299. do
  7300. if InfiniteIncludeLoopWhen<>0 then
  7301. do
  7302. say 'Infinite #include loop detected, at level #' ||IncludeLevel
  7303. say 'Use "/define:INFINITE_INCLUDE_LOOP_WHEN=0"   to turn off detection'
  7304. say 'Use "/define:INFINITE_INCLUDE_LOOP_WHEN=100" to increase detection threshold etc'
  7305. IncludeLevel=IncludeLevel-1
  7306. call RecursiveIncludeRestore
  7307. CryAndDie("We seem to be in an infinite #include loop!")
  7308. end
  7309. end
  7310. MemUpdateIndex=0
  7311. do IncIndex=1 to IncludeLevel-1
  7312. if RexSystemOpSys="UNIX" then
  7313. IncSame=(IncludeFileName=IncludeFileName.IncIndex)
  7314. else
  7315. IncSame=(translate(IncludeFileName)=translate(IncludeFileName.IncIndex))
  7316. if IncSame=1 then
  7317. do
  7318. if _IncludeMemHandle.IncIndex<> '' then
  7319. call DebugLine 'File already being processed, already reading from memory cache!'
  7320. else
  7321. do
  7322. call DebugLine 'File already being processed, forcing use from memory cache'
  7323. CloseRc=stream(IncludeFileName, 'c', 'close')
  7324. MemUpdateIndex=IncIndex
  7325. ForceLoadingIntoMemory='Y'
  7326. end
  7327. leave
  7328. end
  7329. end
  7330. if AddToDepFile<> 'N' then
  7331. call AddInputFileToDependancyList(IncludeFileName)
  7332. call OutputProcessingFileStringToScreen '',IncludeFragmentText
  7333. ThisDateTime=GetSourceFileDateTimeDieOnError(IncludeFileName)
  7334. if ThisDateTime>NewestSourcefile then
  7335. NewestSourcefile=ThisDateTime
  7336. parse value IncludeFileOpen(IncludeFileName,ForceLoadingIntoMemory)with IncludeEofLine ';' IncludeMemHandle
  7337. if MemUpdateIndex<>0 then
  7338. do
  7339. _IncludeMemHandle.MemUpdateIndex=IncludeMemHandle
  7340. _IncludeEofLine.MemUpdateIndex=IncludeEofLine
  7341. end
  7342. if IncludeFragmentText<> '' then
  7343. do
  7344. call DebugLine 'Looking for the start of the fragment'
  7345. do while IncludeFileLines()<>0
  7346. InputLines=InputLines+1
  7347. FileLine=IncludeFileLineIn()
  7348. if pos(IncludeFragmentText,FileLine)<>0 then
  7349. leave
  7350. end
  7351. if IncludeFileLines()=0 then
  7352. do
  7353. FT=IncludeFragmentText
  7354. LP=IncludeLineNumber
  7355. IncludeLevel=IncludeLevel-1
  7356. call RecursiveIncludeRestore
  7357. CryAndDie('Did not find the START of the code fragment "' || FT || '" (processed ' || AddCommasToDecimalNumber(LP) || ' lines)')
  7358. end
  7359. end
  7360. do forever
  7361. LastLineAfterMacroRep=''
  7362. select
  7363. when IncludeMemBufferNextLine\=='' then
  7364. do
  7365. if InLoop='Y' &LoopLinesFromFile=0 then
  7366. FileLine=GetLoopLineIntoFileLine()
  7367. else
  7368. do
  7369. parse var IncludeMemBufferNextLine FileLine (MarksNewLine) IncludeMemBufferNextLine
  7370. end
  7371. LastLine=FileLine
  7372. LineSrc='M'
  7373. if OptionDebugOn='Y' then
  7374. call DebugShowCurrentLineWithLineNumber FileLine, '#'
  7375. end
  7376. when LineQueued\=='' then
  7377. do
  7378. call FlushQueuedData
  7379. iterate
  7380. end
  7381. when InLoop='Y' |IncludeFileLines()<>0 then
  7382. do
  7383. if EofForced<> '' then
  7384. do
  7385. if OptionDebugOn='Y' then
  7386. call DebugLine '#EOF (at ' || EofForced || ') told us to stop processing this file any further'
  7387. if SetUpOnExitProcessingIfEndOfMainFile()='Y' then
  7388. iterate
  7389. leave
  7390. end
  7391. if InLoop='Y' then
  7392. FileLine=GetLoopLineIntoFileLine()
  7393. else
  7394. do
  7395. InputLines=InputLines+1
  7396. FileLine=IncludeFileLineIn()
  7397. end
  7398. LastFileLine=FileLine
  7399. LastLine=FileLine
  7400. LineSrc='F'
  7401. if OptionDebugOn='Y' then
  7402. call DebugShowCurrentLineWithLineNumber FileLine
  7403. if IncludeFragmentText<> '' then
  7404. do
  7405. if pos(IncludeFragmentText,FileLine)<>0 then
  7406. do
  7407. call DebugLine 'Found the end of the fragment'
  7408. IncludeFragmentText=''
  7409. leave
  7410. end
  7411. end
  7412. if OptionFilterIn<> '' then
  7413. do
  7414. FileLine=HtmlFilterIn("I",FileLine,IncludeFileName,IncludeLineNumber,InputLines,MarksNewLine)
  7415. if pos(MarksNewLine,FileLine)<>0 then
  7416. do
  7417. IncludeMemBufferNextLine=FileLine
  7418. iterate
  7419. end
  7420. if left(FileLine,1)=NullChar then
  7421. do
  7422. if FileLine=NullChar then
  7423. iterate
  7424. else
  7425. CryAndDie(substr(FileLine,2))
  7426. end
  7427. end
  7428. if AsIsModeOn='Y' then
  7429. FileLine=ExpandAsIsTags(FileLine)
  7430. if AutoTagOn='Y' then
  7431. FileLine=AutoTag(FileLine)
  7432. end
  7433. otherwise
  7434. do
  7435. if SetUpOnExitProcessingIfEndOfMainFile()='Y' then
  7436. iterate
  7437. leave
  7438. end
  7439. end
  7440. if LineSrc<> 'F' then
  7441. do
  7442. LineContinued='N'
  7443. Word1=word(FileLine,1)
  7444. end
  7445. else
  7446. do
  7447. if pos(TabChar,FileLine)<>0 then
  7448. do
  7449. if OptionDebugOn='Y' then
  7450. call DebugLine 'Tab(s) found ("' || OptionTabs || '" handling in progress).'
  7451. select
  7452. when OptionTabs='W' then
  7453. do
  7454. call OutputWarningToScreen 'T000', 'There are TABS in the source (converted to spaces)!'
  7455. FileLine=translate(FileLine, ' ',TabChar)
  7456. end
  7457. when OptionTabs='T' then
  7458. do
  7459. FileLine=translate(FileLine, ' ',TabChar)
  7460. end
  7461. otherwise
  7462. do
  7463. end
  7464. end
  7465. end
  7466. FileLine=strip(FileLine, 'T')
  7467. CmtPos=lastpos(InLineComment,FileLine)
  7468. if CmtPos<>0 then
  7469. do
  7470. AddToEnd=''
  7471. if right(FileLine,1)=LineContChar then
  7472. do
  7473. Right2=right(FileLine,2)
  7474. if Right2=LineContAddNewLine|Right2=LineContAddNewLineObs|Right2=LineContWithoutSpace|Right2=LineContWithSpace|Right2=LineContDefault then
  7475. do
  7476. AddToEnd=' ' ||Right2
  7477. end
  7478. end
  7479. FileLine=strip(left(FileLine,CmtPos-1), 'T')||AddToEnd
  7480. end
  7481. if OptionCodeType='REXX' then
  7482. do
  7483. if OptionDebugOn='N' then
  7484. do
  7485. if OptionKeepRexxCmts='N' &right(FileLine,2)=RexxCmtEnd then
  7486. do
  7487. StartCmtPos=lastpos(RexxCmtStart,FileLine)
  7488. if StartCmtPos<>0 then
  7489. do
  7490. if StartCmtPos=0 then
  7491. FileLine=''
  7492. else
  7493. FileLine=strip(left(FileLine,StartCmtPos-1), 'T')
  7494. if FileLine='' then
  7495. iterate
  7496. end
  7497. end
  7498. end
  7499. if right(FileLine,1)=';' then
  7500. FileLine=left(FileLine,length(FileLine)-1)
  7501. end
  7502. if LineContChar=NullChar then
  7503. LineContinued='N'
  7504. else
  7505. do
  7506. if right(FileLine,1)<>LineContChar then
  7507. LineContinued='N'
  7508. else
  7509. do
  7510. Right2=right(FileLine,2)
  7511. MainBit=strip(left(FileLine,length(FileLine)-2), 'T')
  7512. select
  7513. when Right2=LineContWithoutSpace then
  7514. do
  7515. LineContinued='Y'
  7516. FileLine=MainBit
  7517. end
  7518. when Right2=LineContWithSpace|Right2=LineContDefault then
  7519. do
  7520. FileLine=MainBit
  7521. LineContinued='YS'
  7522. end
  7523. when Right2=LineContAddNewLine then
  7524. do
  7525. LineContinued='Y'
  7526. FileLine=MainBit||CodexNewLine
  7527. end
  7528. when Right2=LineContAddNewLineObs then
  7529. do
  7530. call WarnAboutDepreciatedFeature 'Line continuation using downarrow.  Replace with -> "%\"'
  7531. LineContinued='Y'
  7532. FileLine=MainBit||CodexNewLine
  7533. end
  7534. otherwise
  7535. LineContinued='N'
  7536. end
  7537. end
  7538. end
  7539. if FileLine='' then
  7540. do
  7541. if LeaveBlankLines='N' then
  7542. do
  7543. if OptionDebugOn='Y' then
  7544. call DebugShowLineDropped "Blank Line"
  7545. if LineContinued='N' & PartialLine \== '' then
  7546. do
  7547. if IncludeMemBufferNextLine=='' then
  7548. IncludeMemBufferNextLine=PartialLine
  7549. else
  7550. IncludeMemBufferNextLine=PartialLine||MarksNewLine||IncludeMemBufferNextLine
  7551. PartialLine=''
  7552. end
  7553. iterate
  7554. end
  7555. end
  7556. Word1=word(FileLine,1)
  7557. if left(Word1,1)=LineComment then
  7558. do
  7559. if LineContinued='N' & PartialLine \== '' then
  7560. do
  7561. if OptionDebugOn='Y' then
  7562. call DebugWarning 'Line continuation ends with a comment line'
  7563. if IncludeMemBufferNextLine=='' then
  7564. IncludeMemBufferNextLine=PartialLine
  7565. else
  7566. IncludeMemBufferNextLine=PartialLine||MarksNewLine||IncludeMemBufferNextLine
  7567. PartialLine=''
  7568. end
  7569. iterate
  7570. end
  7571. if LineSrc='F' then
  7572. do
  7573. if KeepIndent='N' then
  7574. FileLine=strip(FileLine, 'L')
  7575. else
  7576. FileLine=LeftIndent||FileLine
  7577. end
  7578. if PartialLine<> '' then
  7579. do
  7580. if left(Word1,HashPrefixLng)<>HashPrefix then
  7581. do
  7582. PartialLine=PartialLine||FileLine
  7583. end
  7584. else
  7585. do
  7586. parse var FileLine TheHashCmd TheRest
  7587. TheRest=strip(TheRest)
  7588. FileLine=TheHashCmd|| ' ' ||TheRest
  7589. PartialLine=PartialLine||PpwCmdDivider1||FileLine||PpwCmdDivider1
  7590. if LineContinued='YS' then
  7591. LineContinued='Y'
  7592. end
  7593. end
  7594. if LineContinued='N' then
  7595. do
  7596. if PartialLine\=='' then
  7597. do
  7598. if IncludeMemBufferNextLine=='' then
  7599. IncludeMemBufferNextLine=PartialLine
  7600. else
  7601. IncludeMemBufferNextLine=PartialLine||MarksNewLine||IncludeMemBufferNextLine
  7602. PartialLine=''
  7603. iterate
  7604. end
  7605. end
  7606. else
  7607. do
  7608. if PartialLine=='' then
  7609. do
  7610. PartialLine=FileLine
  7611. if translate(left(Word1,length(CmdHashDefine)))=CmdHashDefine then
  7612. PpwCmdDivider1=MarksNewLineInHashDefine
  7613. else
  7614. PpwCmdDivider1=MarksNewLine
  7615. end
  7616. if LineContinued='YS' then
  7617. PartialLine=PartialLine|| ' '
  7618. iterate
  7619. end
  7620. end
  7621. if OneLineOn='Y' then
  7622. do
  7623. FileLine=AddToOneLine(FileLine)
  7624. if FileLine=='' then
  7625. iterate
  7626. else
  7627. do
  7628. if IncludeMemBufferNextLine=='' then
  7629. IncludeMemBufferNextLine=FileLine
  7630. else
  7631. IncludeMemBufferNextLine=FileLine||MarksNewLine||IncludeMemBufferNextLine
  7632. iterate
  7633. end
  7634. end
  7635. if left(Word1,HashPrefixLng)=HashPrefix then
  7636. do
  7637. parse var FileLine HashCmd SecondWordEtc
  7638. HashCmd=translate(HashCmd)
  7639. HashRc='?'
  7640. select
  7641. when HashCmd=CmdHashIf then
  7642. do
  7643. HashRc=ProcessHashIfTest(FileLine)
  7644. end
  7645. when HashCmd=CmdHashIfDef then
  7646. do
  7647. HashRc=ProcessHashIfTest(FileLine)
  7648. end
  7649. when HashCmd=CmdHashIfnDef then
  7650. do
  7651. HashRc=ProcessHashIfTest(FileLine)
  7652. end
  7653. when HashCmd=CmdHashElseifL|HashCmd=CmdHashElseifS then
  7654. HashRc=ProcessHashElse(SecondWordEtc)
  7655. when HashCmd=CmdHashEndifL|HashCmd=CmdHashEndifS then
  7656. HashRc=ProcessHashEndif(SecondWordEtc)
  7657. otherwise
  7658. end
  7659. if HashRc<> '?' then
  7660. do
  7661. if HashRc<> 'OK' then
  7662. call CryAndDie 'Hash command failed, Rc = ' ||HashRc
  7663. else
  7664. do
  7665. WantLineCache=WantLine()
  7666. iterate
  7667. end
  7668. end
  7669. end
  7670. if WantLineCache='N' then
  7671. do
  7672. if OptionDebugOn='Y' then
  7673. call DebugShowLineDropped "False"
  7674. iterate
  7675. end
  7676. if left(Word1,HashPrefixLng)=HashPrefix then
  7677. do
  7678. call ProcessHashCommand FileLine
  7679. end
  7680. else
  7681. do
  7682. if DefRexxVar<> '' then
  7683. do
  7684. call AddDefineRexxLine FileLine
  7685. iterate
  7686. end
  7687. if ReplacementsAllowed='Y' then
  7688. do
  7689. NowCount=ReplaceCount
  7690. FileLine=ReplaceHashAndStandardDefines(FileLine,, 'Y')
  7691. if HtmlGeneratorTags<> '' then
  7692. do
  7693. FileLineU=translate(FileLine)
  7694. InsertTags=''
  7695. LookFor="<HEAD>"
  7696. TagPos=pos(LookFor,FileLineU)
  7697. if TagPos<>0 then
  7698. do
  7699. InsertTags=TagSvNewLine||HtmlGeneratorTags||TagSvNewLine
  7700. InsertAt=TagPos+length(LookFor)
  7701. end
  7702. else
  7703. do
  7704. LookFor="<BODY"
  7705. TagPos=pos(LookFor,FileLineU)
  7706. if TagPos<>0 then
  7707. do
  7708. InsertTags='<HEAD>' || TagSvNewLine || '  ' || HtmlGeneratorTags || TagSvNewLine || '</HEAD>' ||TagSvNewLine
  7709. InsertAt=TagPos
  7710. end
  7711. end
  7712. if InsertTags\=='' then
  7713. do
  7714. call DebugLine 'Found "' || LookFor || '" so inserted HTML generator tags'
  7715. FileLine=insert(InsertTags,FileLine,InsertAt-1)
  7716. FileLine=ReplaceHashAndStandardDefines(FileLine,, 'Y')
  7717. HtmlGeneratorTags=''
  7718. end
  7719. end
  7720. if ExpandXEarly='Y' then
  7721. do
  7722. if pos(StartsStdSymbolReplacement_x,FileLine)<>0 then
  7723. FileLine=ReplaceTheXCodesWeKnowExist(FileLine)
  7724. end
  7725. if NowCount<>ReplaceCount then
  7726. do
  7727. if pos(MarksNewLine,FileLine)<>0 then
  7728. do
  7729. if IncludeMemBufferNextLine=='' then
  7730. IncludeMemBufferNextLine=FileLine
  7731. else
  7732. IncludeMemBufferNextLine=FileLine||MarksNewLine||IncludeMemBufferNextLine
  7733. iterate
  7734. end
  7735. end
  7736. if ExpandXLate='Y' then
  7737. do
  7738. if pos(StartsStdSymbolReplacement_x,FileLine)<>0 then
  7739. FileLine=ReplaceTheXCodesWeKnowExist(FileLine)
  7740. end
  7741. end
  7742. if LineSrc='M' then
  7743. do
  7744. LineQueued=LineQueued||FileLine
  7745. iterate
  7746. end
  7747. do until FileLine == ''; parse var FileLine This1 (MarksNewLine) FileLine; if  OptionCodeType  = 'REXX' then call OutputRexxLine This1; else do; if  OptionCodeType <> 'HTML' then call GenerateOneLine This1; else do; call GenerateOneLine This1; end; end; end
  7748. end
  7749. end
  7750. EofForced=''
  7751. call IncludeFileClose
  7752. if IncludeFragmentText<> '' then
  7753. CryAndDie('Did not find the END of the code fragment "' || IncludeFragmentText || '"!')
  7754. IncludeLevel=IncludeLevel-1
  7755. return(0)
  7756.  
  7757. OutputProcessingFileStringToScreen:
  7758. parse arg ProcessingWhat,ProcessingFrag
  7759. if ProcessingWhat='' then
  7760. ProcessingWhat=IncludeFileName
  7761. if ProcessingFrag<> '' then
  7762. ProcessingFrag='(' || ProcessingFrag || ')'
  7763. call Line1 copies("  ", IncludeLevel) || ' * Processing: ' ||ProcessingWhat||ProcessingFrag
  7764. return
  7765.  
  7766. FlushQueuedData:
  7767. LineSrc='Q'
  7768. FileLine=LineQueued
  7769. LastLine=FileLine
  7770. LineQueued=''
  7771. if OptionDebugOn='Y' then
  7772. call DebugShowCurrentLineWithLineNumber FileLine, '+'
  7773. do until FileLine == ''; parse var FileLine This1 (MarksNewLine) FileLine; if  OptionCodeType  = 'REXX' then call OutputRexxLine This1; else do; if  OptionCodeType <> 'HTML' then call GenerateOneLine This1; else do; call GenerateOneLine This1; end; end; end
  7774. return
  7775.  
  7776. OutputInformationToScreen:
  7777. if OptionWantInfoMsgs='Y' then
  7778. do
  7779. InfoText=arg(1)
  7780. if IncludeLevel=0 then
  7781. LineText=''
  7782. else
  7783. LineText='(@' || AddCommasToDecimalNumber(IncludeLineNumber) || ')'
  7784. call Line1 copies("  ", IncludeLevel) || InfoColor || '   ' || LineText || 'INFO: ' ||InfoText||Reset
  7785. end
  7786. return
  7787.  
  7788. ProcessHashCommand:
  7789. HashCmd=translate(word(arg(1),1))
  7790. HashCmdParms=subword(arg(1),2)
  7791. select
  7792. when HashCmd=CmdHashDefine then
  7793. return(ProcessDefine(HashCmdParms))
  7794. when HashCmd=CmdHashDefinePlus then
  7795. return(ProcessDefine(HashCmdParms, 'Y'))
  7796. when HashCmd=CmdHashRexxVar then
  7797. return(ProcessRexxVar(HashCmdParms))
  7798. when HashCmd=CmdHashEvaluateL|HashCmd=CmdHashEvaluateS then
  7799. return(ProcessEvaluate(HashCmdParms))
  7800. when HashCmd=CmdHashEvaluatePlusL|HashCmd=CmdHashEvaluatePlusS then
  7801. return(ProcessEvaluate(HashCmdParms, 'Y'))
  7802. when HashCmd=CmdHashAutoTag then
  7803. do
  7804. ProcessRc=ProcessAutoTag(HashCmdParms)
  7805. return(ProcessRc)
  7806. end
  7807. when HashCmd=CmdHashUndefL|HashCmd=CmdHashUndefS then
  7808. return(HandleUndefCommand(HashCmdParms))
  7809. when HashCmd=CmdHashOption then
  7810. return(ProcessOption(HashCmdParms))
  7811. when HashCmd=CmdHashLoopS then
  7812. return(ProcessLoopStart(HashCmdParms))
  7813. when HashCmd=CmdHashLoopBreak then
  7814. return(ProcessLoopBreak(HashCmdParms))
  7815. when HashCmd=CmdHashLoopContinue then
  7816. return(ProcessLoopContinue(HashCmdParms))
  7817. when HashCmd=CmdHashInclude then
  7818. do
  7819. IncludeParms=strip(PerformReplacementsInCmdsParameters(HashCmdParms))
  7820. if IncludeParms="" then
  7821. return(CryAndDie("No filename specified on #include line!"))
  7822. QuoteChar=left(IncludeParms,1)
  7823. if QuoteChar<> '"' & QuoteChar <> "'" & QuoteChar <> "<" then
  7824. do
  7825. parse var IncludeParms IncludeName Fragment
  7826. end
  7827. else
  7828. do
  7829. if QuoteChar="<" then
  7830. QuoteChar='>'
  7831. IncludeParms=substr(IncludeParms,2)
  7832. QuotePos=pos(QuoteChar,IncludeParms)
  7833. if QuotePos=0 then
  7834. CryAndDie('Could not find the ending quote for the included filename')
  7835. IncludeName=left(IncludeParms,QuotePos-1)
  7836. Fragment=substr(IncludeParms,QuotePos+1)
  7837. end
  7838. if Fragment<> '' then
  7839. Fragment=GetQuotedText(Fragment)
  7840. call RecursiveIncludeSave
  7841. call ProcessInputFile IncludeName,Fragment
  7842. call RecursiveIncludeRestore
  7843. call OutputProcessingFileStringToScreen '',IncludeFragmentText
  7844. return(0)
  7845. end
  7846. when HashCmd=CmdHashImport then
  7847. return(ProcessImport(HashCmdParms))
  7848. when HashCmd=CmdHashOutput then
  7849. return(ProcessHashOutput(HashCmdParms))
  7850. when HashCmd=CmdHashOneLine then
  7851. return(ProcessOneLine(HashCmdParms))
  7852. when HashCmd=CmdHashDefineRexx then
  7853. return(ProcessDefineRexx(HashCmdParms))
  7854. when HashCmd=CmdHashDefineRexxPlus then
  7855. return(ProcessDefineRexx(HashCmdParms, 'Y'))
  7856. when HashCmd=CmdHashMacroSpace then
  7857. do
  7858. call NotAvailableUnderNtYet HashCmd
  7859. MsCommand=translate(GetQuotedText(HashCmdParms, "Rest"))
  7860. MsFile=GetQuotedText(Rest, "Rest")
  7861. if Rest='' then
  7862. MsFunction=''
  7863. else
  7864. MsFunction=GetQuotedText(Rest)
  7865. if MsCommand<> 'ADD' & MsCommand <> 'DROP' then
  7866. CryAndDie('The macro space command "' || MsCommand || '" is unknown!')
  7867. if SafeQueryExists(MsFile)='' then
  7868. CryAndDie('The rexx file "' || MsFile || '" does not exist!')
  7869. call DoMacroSpaceOperation MsCommand,MsFile,MsFunction
  7870. return(0)
  7871. end
  7872. when HashCmd=CmdHashAsIs then
  7873. return(ProcessAsIs(HashCmdParms))
  7874. when HashCmd=CmdHashWarningL|HashCmd=CmdHashWarningS then
  7875. return(ProcessHashWarning(HashCmdParms))
  7876. when HashCmd=CmdHashInfo then
  7877. do
  7878. InfoMsg=PerformReplacementsInCmdsParameters(HashCmdParms)
  7879. InfoMsg=GetQuotedRest(InfoMsg)
  7880. call OutputInformationToScreen InfoMsg
  7881. return(0)
  7882. end
  7883. when HashCmd=CmdHashAutoTagState then
  7884. return(ProcessAutoTagState(HashCmdParms))
  7885. when HashCmd=CmdHashAutoTagClear then
  7886. return(ProcessAutoTagClear(HashCmdParms))
  7887. when HashCmd=CmdHashDependsOn then
  7888. return(ProcessDependsOn(HashCmdParms))
  7889. when HashCmd=CmdHashOnExit then
  7890. return(ProcessOnExit(HashCmdParms))
  7891. when HashCmd=CmdHashEof then
  7892. do
  7893. if HashCmdParms<> '' then
  7894. do
  7895. EndifCounter=GetQuotedText(HashCmdParms)
  7896. EndifCounter=PerformReplacementsInCmdsParameters(EndifCounter)
  7897. if datatype(EndifCounter, 'W')=0 then
  7898. CryAndDie('Invalid #endif simulate count of "' || EndifCounter || '" supplied!')
  7899. do EndifIndex=1 to EndifCounter
  7900. call ProcessHashEndif
  7901. end
  7902. end
  7903. EofForced=CurrentSourceLocation()
  7904. return(0)
  7905. end
  7906. when HashCmd=CmdHashDebug then
  7907. return(ProcessHashDebug(HashCmdParms))
  7908. when HashCmd=CmdHashRequire then
  7909. return(ProcessRequire(HashCmdParms))
  7910. when HashCmd=CmdHashErrorL|HashCmd=CmdHashErrorS then
  7911. call ProcessHashError HashCmdParms
  7912. otherwise
  7913. do
  7914. if HashCmd=CmdHashLoopE then
  7915. CryAndDie('Missing "' || CmdHashLoopS || '" command')
  7916. else
  7917. CryAndDie("Invalid '#' command line of: " ||HashCmd)
  7918. end
  7919. end
  7920. return(0)
  7921.  
  7922. ProcessHashError:
  7923. ErrorMsg=GetQuotedRest(PerformReplacementsInCmdsParameters(arg(1)))
  7924. CryAndDie(ErrorMsg)
  7925.  
  7926. IsStringOnOrOffCmd:
  7927. OoCmd=translate(arg(1))
  7928. if OoCmd='+' | OoCmd = 'YES' |  OoCmd = 'ON' then
  7929. return('Y')
  7930. else
  7931. do
  7932. if OoCmd='-' | OoCmd = 'NO' |  OoCmd = 'OFF' then
  7933. return('N')
  7934. end
  7935. return('')
  7936.  
  7937. SetOnorOffVariable:
  7938. parse arg OnOffSrc,VarName
  7939. OnOrOffText=translate(GetQuotedText(OnOffSrc))
  7940. OnOrOff=IsStringOnOrOffCmd(OnOrOffText)
  7941. if OnOrOff='' then
  7942. CryAndDie(HashCmd|| ' command does not specify a correct value value (ON/OFF)!')
  7943. call _valueS VarName,OnOrOff
  7944. return(0)
  7945.  
  7946. DisplayCopyright:
  7947. if CopyrightDisplayed='N' then
  7948. do
  7949. call Char1 HighlightColor
  7950. call Line1 '[]--------------------------------------------------------------------------[]'
  7951. call Line1 '| PPWIZARD.CMD: Version ' || PgmVersion || ' (C)opyright ' || PgmAuthor || ' 1997                |'
  7952. call Line1 '| ' || PgmAuthorHomePage || '  (' || PgmAuthorEmail || ') |'
  7953. call Line1 '[]--------------------------------------------------------------------------[]'
  7954. call Line1 Reset
  7955. CopyrightDisplayed='Y'
  7956. end
  7957. return
  7958.  
  7959. UserSyntaxError:
  7960. call CgiStartFatalError
  7961. call DisplayCopyright
  7962. call Line1 ErrorColor|| "SYNTAX ERROR"
  7963. call Line1 "~~~~~~~~~~~~"
  7964. call Line1 '    ' ||arg(1)
  7965. call CgiEndFatalError
  7966. call Line1 ''
  7967. call Line1 'CORRECT SYNTAX'
  7968. call Line1 '~~~~~~~~~~~~~~'
  7969. call Line1 '    PPWIZARD[.CMD] InputMask [Option1 ...]'
  7970. call Line1 ''
  7971. call Line1 'SOME OPTIONS'
  7972. call Line1 '~~~~~~~~~~~~'
  7973. call Line1 RexOptionChar|| 'Output:Mask     = Call output what?  Place it where? (example "OUT\*.HTM")'
  7974. call Line1 RexOptionChar|| 'Rexx            = Using as a rexx preprocessor (not HTML!).'
  7975. call Line1 RexOptionChar|| "Pack[:Y|N]      = Compress rexx code (basics always done)?"
  7976. call Line1 RexOptionChar|| 'CrLf[:Y|N]      = Use Carriage Return + Line Feed on end of lines?'
  7977. call Line1 RexOptionChar|| 'DependsOn:Mask  = Generate & check dependencies (only make if required).'
  7978. call Line1 RexOptionChar|| 'Debug           = Generate debug comments in generated output.'
  7979. call Line1 ''
  7980. call Line1 'Please see "PPWIZARD.INF" for more details (and more options).' ||Beep||Beep||Reset
  7981. AbnormalExit(MyLineNumber())
  7982.  
  7983. SwitchMustHaveOptions:
  7984. parse arg TheCmd,TheOptions
  7985. if TheOptions='' then
  7986. UserSyntaxError('You must supply parameters on the "' || RexOptionChar || TheCmd || '" switch!')
  7987. return(TheOptions)
  7988.  
  7989. SwitchMustNotHaveOptions:
  7990. parse arg TheCmd,TheOptions,Value2Set
  7991. if TheOptions<> '' then
  7992. UserSyntaxError('No parameters are expected for the "' || RexOptionChar || TheCmd || '" switch!')
  7993. return(Value2Set)
  7994.  
  7995. SwitchOptionsValidateAgainstList:
  7996. TheCmd=arg(1)
  7997. TheOption=translate(arg(2))
  7998. ValidList=',' || translate(arg(3)) || ','
  7999. if pos(',' || TheOption || ',',ValidList)<>0 then
  8000. return(TheOption)
  8001. UserSyntaxError('An invalid parameter of "' || TheOption || '" was specified on the "' || RexOptionChar || TheCmd || '" switch!')
  8002.  
  8003. SwitchWantsYesOrNo:
  8004. TheCmd=arg(1)
  8005. TheOption=translate(arg(2))
  8006. Default=arg(3)
  8007. if TheOption='' then
  8008. return(Default)
  8009. else
  8010. return(left(SwitchOptionsValidateAgainstList(TheCmd,TheOption, "Y,N,YES,NO"),1))
  8011.  
  8012. NotAvailableUnderNtYet:
  8013. TheCmd=arg(1)
  8014. if RexWhich='REGINA' then
  8015. UserSyntaxError('"' || RexOptionChar || TheCmd || '" can not be performed under NT (or regina).... Yet...')
  8016. return
  8017.  
  8018. CheckRexxInterpreter:
  8019. if RexWhich='REGINA' then
  8020. do
  8021. if pos(RexVerRegina,SupportedReginaVersions)<>0 then
  8022. return(0)
  8023. criText="The Regina " || RexVerRegina || " interpreter is unsupported, use " || SupportedReginaVersions || ' instead!'
  8024. if arg(1)='Y' then
  8025. call DebugLine criText
  8026. else
  8027. call OutputWarningToScreen 'URI0',criText
  8028. return(1)
  8029. end
  8030. return(0)
  8031.  
  8032. GetCurrentDirectory:
  8033. if RexWhich='STANDARD_OS/2' then
  8034. cwDir=directory()
  8035. else
  8036. do
  8037. cwDir=stream('.', 'c', 'query exists')
  8038. cwDirRegina=cwDir
  8039. cwLength=length(cwDir)
  8040. if lastpos(RexDirChar,cwDir)=cwLength then
  8041. do
  8042. if RexSystemOpSys="UNIX" then
  8043. do
  8044. if cwDir<>RexDirChar then
  8045. cwDir=left(cwDir,cwLength-1)
  8046. end
  8047. else
  8048. do
  8049. cwColonPos=pos(':',cwDir)
  8050. if cwColonPos+1<>cwLength then
  8051. cwDir=left(cwDir,cwLength-1)
  8052. end
  8053. end
  8054. if cwDirRegina<>cwDir then
  8055. call DebugLine 'Regina returned "' || cwDirRegina || '" for current directory'
  8056. end
  8057. if OptionDebugOn='Y' then
  8058. call DebugLine 'Current Directory = "' || cwDir || '"'
  8059. return(cwDir)
  8060.  
  8061. MakeAbsolute:
  8062. maFileOrig=arg(1)
  8063. maFile=maFileOrig
  8064. if left(maFile,1)='.' |pos(RexDirChar,maFile)=0 then
  8065. do
  8066. DotSlash='.' ||RexDirChar
  8067. DotDotSlash='.' ||DotSlash
  8068. maDir=GetCurrentDirectory()
  8069. if OptionDebugOn='Y' then
  8070. do
  8071. call DebugLine 'Converting relative "' || maFile || '"'
  8072. call DebugIncrement 1
  8073. end
  8074. if pos(RexDirChar,maFile)<>0 then
  8075. do
  8076. do forever
  8077. select
  8078. when left(maFile,2)==DotSlash then
  8079. do
  8080. maFile=substr(maFile,3)
  8081. end
  8082. when left(maFile,3)==DotDotSlash then
  8083. do
  8084. LastChar=right(maDir,1)
  8085. SlashPos=lastpos(RexDirChar,maDir)
  8086. if SlashPos=0|LastChar=RexDirChar|LastChar=':' then
  8087. CryAndDie('The spec "' || maFileOrig || '" can not be converted to absolute', 'from the current directory "' || GetCurrentDirectory() || '"')
  8088. maDir=left(maDir,SlashPos-1)
  8089. maFile=substr(maFile,4)
  8090. end
  8091. otherwise
  8092. leave
  8093. end
  8094. end
  8095. end
  8096. if right(maDir,1)=RexDirChar then
  8097. maFile=maDir||maFile
  8098. else
  8099. maFile=maDir||RexDirChar||maFile
  8100. if OptionDebugOn='Y' then
  8101. do
  8102. call DebugLine 'To Absolute "' || maFile || '"'
  8103. call DebugIncrement-1
  8104. end
  8105. end
  8106. return(maFile)
  8107.  
  8108. SafeQueryExists:
  8109. sfeFile=arg(1)
  8110. if sfeFile='' then
  8111. CryAndDie('The filename "" is invalid!')
  8112. else
  8113. return(RexQueryExists(sfeFile))
  8114.  
  8115. GetInputFileNameAndLine:call TRACE "OFF"
  8116.  
  8117. CurrentSourceLocation:
  8118. if IncludeLevel=0 then
  8119. return("unknown")
  8120. else
  8121. return('line ' || AddCommasToDecimalNumber(IncludeLineNumber) || ' of "' || IncludeFileName || '"')
  8122.  
  8123. GetLineBeingProcessed:call TRACE "OFF"
  8124. return(strip(LastLine))
  8125.  
  8126. GetFileLineBeingProcessed:call TRACE "OFF"
  8127. return(strip(LastFileLine))
  8128.  
  8129. DumpVarsIfCompoundVariable:
  8130. if pos('.',arg(1))<>0 then
  8131. ExpressionKilledUs=arg(1)
  8132. return
  8133.  
  8134. CryAndDie:
  8135. SynErrLine=SIGL
  8136. SynErrorText=arg(1)
  8137. SynErrLineC=AddCommasToDecimalNumber(SynErrLine)
  8138. call DebugIncrementInit
  8139. call DebugLine 'Fatal Error Detected (at line ' || SynErrLineC || ' of ppwizard)'
  8140. call DebugIncrement 1
  8141. PpwSize=stream(PpWizardPgmName, 'c', 'query size')
  8142. if PpwSize<> '' then
  8143. PpwSize=AddCommasToDecimalNumber(PpwSize)
  8144. PpwDateTime=GetFileTimeStamp(PpWizardPgmName)
  8145. call Char1 ErrorColor
  8146. call Line1 ''
  8147. call Line1 copies('!!',38)
  8148. call Line1 copies('!!', 15) || '[ Fatal  Error ]' || copies('!!',15)
  8149. call Line1 copies('!!',38)
  8150. call CgiStartFatalError
  8151. if IncludeLevel<>0 then
  8152. do
  8153. LastFileLine=strip(LastFileLine)
  8154. LastLine=strip(LastLine)
  8155. call Line1 'Location  : ' ||CurrentSourceLocation()
  8156. call Line1 'File Line : ' ||LastFileLine
  8157. if LastLine<>LastFileLine then
  8158. call Line1 'Fail Line : ' ||LastLine
  8159. if LastLineAfterMacroRep<> '' &LastLine<>LastLineAfterMacroRep&LastFileLine<>LastLineAfterMacroRep then
  8160. call Line1 'After Repl: ' ||LastLineAfterMacroRep
  8161. if MacroBeingExpanded<> '' then
  8162. call Line1 'Expanding : ' || StartsMacroReplacement || MacroBeingExpanded || ' ...' ||EndsMacroReplacement
  8163. end
  8164. call Line1 'Detected @: Line ' || SynErrLineC || ' of ' || _filespec('name', PpWizardPgmName) || ' (v' || PgmVersion || ' in ' || PpWizardOpSys || ')'
  8165. call Line1 'PPWIZARD  : Length ' || PpwSize || ' bytes.  TimeStamped ' ||PpwDateTime
  8166. call Line1 'Reason'
  8167. call Line1 '~~~~~~'
  8168. LastArg=1
  8169. do LineIndex=1 to arg()
  8170. if arg(LineIndex)<> '' then
  8171. LastArg=LineIndex
  8172. end
  8173. do LineIndex=1 to LastArg
  8174. call Line1 arg(LineIndex)
  8175. end
  8176. if ExpressionKilledUs<> '' then
  8177. call DumpVarsInExpression ExpressionKilledUs,, "KNOWN VARIABLES"
  8178. call CgiEndFatalError
  8179. call Line1 copies('!!',38)
  8180. call Line1 ''
  8181. call Line1 ''
  8182. call Char1 Beep||Reset
  8183. AbnormalExit(SynErrLine)
  8184.  
  8185. RexSystemFailure:
  8186. FailedAt=SIGL
  8187. if TrapHandler='FULL' then
  8188. call DebugLine 'RexSystemFailure(REXSYSTM.XH routine failed)'
  8189. call DisplayCopyright
  8190. call RexDumpSystemInfo
  8191. say ''
  8192. if TrapHandler='FULL' then
  8193. CryAndDie(arg(1))
  8194. say 'ERROR'
  8195. say '~~~~~'
  8196. say arg(1)
  8197. exit(FailedAt)
  8198.  
  8199. AbnormalExit:
  8200. call DebugLine 'AbnormalExit(' || arg(1) || ') called.'
  8201. OnExitSleepFor=1
  8202. ThatsAllFolks(arg(1))
  8203.  
  8204. ThatsAllFolks:
  8205. call DebugLine 'ThatsAllFolks() called to exit program.'
  8206. if CurrentOutFile<> '' then
  8207. CloseRc=stream(CurrentOutFile, 'c', 'close')
  8208. if IncludeLevel<>0 then
  8209. do
  8210. do FileIndex=1 to IncludeLevel
  8211. CloseRc=stream(IncludeFileName.FileIndex, 'c', 'close')
  8212. end
  8213. end
  8214. call CloseCgiFileIfOpen
  8215. if OptionFilterIn<> '' then
  8216. call DoMacroSpaceOperation "DROP", OptionFilterIn,  "HtmlFilterIn",  "QUIET"
  8217. if OptionFilterOut<> '' then
  8218. call DoMacroSpaceOperation "DROP", OptionFilterOut, "HtmlFilterOut", "QUIET"
  8219. call DebugLine 'Exiting with a return code of ' ||arg(1)
  8220. if OnExitSleepFor<>0&OptionCgiModeOn='N' then
  8221. do
  8222. call DebugLine 'Sleeping for ' || OnExitSleepFor || ' second(s)'
  8223. call _SysSleep OnExitSleepFor
  8224. end
  8225. exit(arg(1))
  8226. signal INDENT_32;
  8227.  
  8228. EXTRAINDENT_DEBUG:
  8229. if OptionDebugOn='Y' then
  8230. call OptionDebugShow 'EXTRAINDENT', 'Extra left indent is now "' || LeftIndent || '"'
  8231. return
  8232.  
  8233. EXTRAINDENT_GET:
  8234. call EXTRAINDENT_DEBUG
  8235. return(LeftIndentSet2)
  8236.  
  8237. EXTRAINDENT_SET:
  8238. LeftIndentSet2=arg(1)
  8239. if ProcessedCmdLine='N' then
  8240. do
  8241. call OptionDebugShow 'EXTRAINDENT', 'Setting default value of extra left indent to "' || LeftIndentSet2 || '"'
  8242. Default4_LeftIndent=LeftIndentSet2
  8243. return(0)
  8244. end
  8245. if LeftIndentSet2=='' then
  8246. LeftIndentCmd=Default4_LeftIndent
  8247. else
  8248. LeftIndentCmd=LeftIndentSet2
  8249. if translate(LeftIndentCmd)='NULL' then
  8250. LeftIndent=''
  8251. else
  8252. call ExecRexxCmd "LeftIndent = " ||LeftIndentCmd
  8253. call EXTRAINDENT_DEBUG
  8254. return
  8255.  
  8256. INDENT_32:
  8257.  
  8258. _DieAsNoTextConditionSupplied:
  8259. CryAndDie('No test condition supplied on "#if" command')
  8260.  
  8261. _PerformSimpleHashIfTest:
  8262. SimpleTest=arg(1)
  8263. if left(SimpleTest,1)<> '[' | right(SimpleTest, 1) <> ']' then
  8264. CryAndDie('Incorrectly bracketed simple #if command.')
  8265. SimpleTest=substr(SimpleTest,2,length(SimpleTest)-2)
  8266. if SimpleTest='' then
  8267. call _DieAsNoTextConditionSupplied
  8268. Parm1=GetSimpleRexxValue(SimpleTest, "SimpleTest")
  8269. parse var SimpleTest FastOperator SimpleTest
  8270. if SimpleTest='' then
  8271. CryAndDie('#if [] has too few parameters (you must put spaces around operator!)')
  8272. Parm3=GetSimpleRexxValue(SimpleTest, "SimpleTest")
  8273. if SimpleTest<> '' then
  8274. CryAndDie('#if [] has too many parameters, expected 3!')
  8275. select
  8276. when FastOperator='==' then
  8277. return(Parm1==Parm3);
  8278. when FastOperator='<>' then
  8279. return(Parm1<>Parm3);
  8280. when FastOperator='=' then
  8281. return(Parm1=Parm3);
  8282. when FastOperator='<' then
  8283. return(Parm1<Parm3);
  8284. when FastOperator='>' then
  8285. return(Parm1>Parm3);
  8286. when FastOperator='<=' then
  8287. return(Parm1<=Parm3);
  8288. when FastOperator='>=' then
  8289. return(Parm1>=Parm3);
  8290. otherwise
  8291. CryAndDie("Unsupported operator of '" || FastOperator || "' used on simple " || HashCmd, '', 'ONLY "==, <>, =, <, >, <=, >=" are supported!')
  8292. end
  8293. CryAndDie('BUG: Did not expect to get here!')
  8294.  
  8295. MatchesIfDebugText:
  8296. MatchIndex=arg(1)
  8297. if MatchIndex<=0 then
  8298. return('')
  8299. else
  8300. return(' (matches #if at ' || IfState.IfAtLine.MatchIndex || ')')
  8301.  
  8302. WantLine:
  8303. if IfState.WantLines.IfNesting='N' then
  8304. return('N')
  8305. else
  8306. do
  8307. if IfState.IfTrue.IfNesting=IfState.InTrue.IfNesting then
  8308. return('Y')
  8309. else
  8310. return('N')
  8311. end
  8312.  
  8313. ProcessHashIfTest:
  8314. if OptionDebugOn='Y' then
  8315. do
  8316. call DebugLine_CONDITIONAL '#If? at nesting level ' ||IfNesting+1
  8317. call DebugIncrement 1
  8318. end
  8319. WantTheLines=WantLine()
  8320. if WantTheLines='N' then
  8321. IfResult='N'
  8322. else
  8323. do
  8324. if OptionDebugOn='Y' then
  8325. call DebugIncrement 1
  8326. parse value PerformReplacementsInCmdsParameters(arg(1))with HashCmd TestCondition
  8327. TestCondition=strip(TestCondition)
  8328. if translate(HashCmd)=CmdHashIf then
  8329. do
  8330. if left(TestCondition,1)<> '[' then
  8331. do
  8332. if TestCondition='' then
  8333. call _DieAsNoTextConditionSupplied
  8334. call ExecRexxCmd 'IfResult = (' || TestCondition || ')'
  8335. end
  8336. else
  8337. do
  8338. IfResult=_PerformSimpleHashIfTest(TestCondition)
  8339. end
  8340. if IfResult then
  8341. IfResult='Y'
  8342. else
  8343. IfResult='N'
  8344. end
  8345. else
  8346. do
  8347. if TestCondition='' then
  8348. CryAndDie(HashCmd|| ' command does not specify the variable name!')
  8349. IfResult=VariableExists(TestCondition)
  8350. if translate(HashCmd)=CmdHashIfndef then
  8351. IfResult=translate(IfResult, 'YN', 'NY')
  8352. end
  8353. if OptionDebugOn='Y' then
  8354. do
  8355. call DebugIncrement-1
  8356. if IfResult='N' then
  8357. Tf='FALSE'
  8358. else
  8359. Tf='TRUE'
  8360. if OptionDebugOn='Y' then
  8361. call DebugLine_CONDITIONAL 'Answer is ' ||Tf
  8362. end
  8363. end
  8364. IfNesting=IfNesting+1
  8365. IfState.WantLines.IfNesting=WantTheLines
  8366. IfState.InTrue.IfNesting='Y'
  8367. IfState.IfTrue.IfNesting=IfResult
  8368. IfState.IfAtLine.IfNesting=CurrentSourceLocation()
  8369. if OptionDebugOn='Y' then
  8370. call DebugIncrement-1
  8371. return('OK')
  8372.  
  8373. ProcessHashElse:
  8374. if OptionDebugOn='Y' then
  8375. call DebugLine_CONDITIONAL '#elseif at level #' ||IfNesting||MatchesIfDebugText(IfNesting)
  8376. if IfNesting=0 then
  8377. CryAndDie("Found #elseif without matching #if")
  8378. if IfState.InTrue.IfNesting='N' then
  8379. CryAndDie("Found unexpected #elseif - duplicated #elseif?" ||MatchesIfDebugText(IfNesting))
  8380. if arg(1)<> '' then
  8381. CryAndDie('The #elseif command does not take parameters')
  8382. IfState.InTrue.IfNesting='N'
  8383. return('OK')
  8384.  
  8385. ProcessHashEndif:
  8386. if OptionDebugOn='Y' then
  8387. call DebugLine_CONDITIONAL 'Endif at level #' ||IfNesting||MatchesIfDebugText(IfNesting)
  8388. if IfNesting=0 then
  8389. CryAndDie("Found #endif without matching #if")
  8390. IfNesting=IfNesting-1
  8391. return('OK')
  8392.  
  8393. _GetNameOfMacroSpaceExe:
  8394. if Symbol('MacroSpaceExe') <> 'VAR' then
  8395. do
  8396. MacroSpaceExeBase='MacroSpc.EXE'
  8397. MacroSpaceExe=_filespec('drive', PpWizardPgmName) || _filespec('Path',PpWizardPgmName)||MacroSpaceExeBase
  8398. if SafeQueryExists(MacroSpaceExe)='' then
  8399. do
  8400. MacroSpaceExe=_SysSearchPath('PATH',MacroSpaceExeBase)
  8401. if MacroSpaceExe="" then
  8402. MacroSpaceExe=_SysSearchPath('DPATH',MacroSpaceExeBase)
  8403. end
  8404. call DebugLine 'Macro Space Pgm: ' ||MacroSpaceExe
  8405. end
  8406. return(MacroSpaceExe)
  8407.  
  8408. DoMacroSpaceOperation:
  8409. parse arg MsCommand,MsFile,MsFunction,MsQuiet
  8410. CallersLine=SIGL
  8411. call DebugLine 'Trying to macrospace "' || MsCommand || '" "' || MsFile || '" alias (' || MsFunction || ')'
  8412. TmpFile=RexGetTmpFileName()
  8413. CheckPgm=_GetNameOfMacroSpaceExe()
  8414. if CheckPgm='' then
  8415. do
  8416. if MsQuiet="QUIET" then
  8417. return
  8418. else
  8419. CryAndDie("Can't perform macro space command as " || MacroSpaceExeBase || ' is unavailable.')
  8420. end
  8421. FailMsg='MACRO SPACE COMMAND FAILED'
  8422. call AddressCmd CheckPgm|| ' ' || MsCommand || ' ' || MsFile || ' ' || MsFunction || ' >' || TmpFile || ' 2>&1'
  8423. if MsQuiet="QUIET" then
  8424. return
  8425. else
  8426. signal CheckMacroSpaceRc
  8427.  
  8428. CallStubInGeneratedCodeToCheckSyntax:
  8429. CheckingFile=Output.1.File
  8430. call DebugIncrement 1
  8431. call DebugLine 'Calling stub in generated code'
  8432. signal ON SYNTAX NAME SyntaxErrorInGeneratedCode
  8433. CheckRc='*?*'
  8434. interpret 'CheckRc =  "' || CheckingFile || '"("' || SyntaxOkText || '")'
  8435. if CheckRc<>SyntaxOkRc then
  8436. CryAndDie('Probably Syntax Error, got unexpected RC of "' || CheckRc || '"')
  8437. call DebugIncrement-1
  8438. return
  8439.  
  8440. SyntaxErrorInGeneratedCode:
  8441. CryAndDie('Faulty syntax in generated "' || CheckingFile || '"!')
  8442.  
  8443. CheckRexxModuleForSyntaxErrors:
  8444. call DebugLine 'CheckRexxModuleForSyntaxErrors()'
  8445. if RexWhich='REGINA' then
  8446. do
  8447. call CallStubInGeneratedCodeToCheckSyntax
  8448. return
  8449. end
  8450. CallersLine=SIGL
  8451. TmpFile=RexGetTmpFileName()
  8452. CheckPgm=_GetNameOfMacroSpaceExe()
  8453. if CheckPgm='' then
  8454. do
  8455. call DebugLine "Can't use normal validation method on the rexx syntax - " || MacroSpaceExeBase || ' file not found!'
  8456. call CallStubInGeneratedCodeToCheckSyntax
  8457. return
  8458. end
  8459. FailMsg='INVALID SYNTAX'
  8460. call AddressCmd CheckPgm|| ' CheckSyntax ' || Output.1.File || ' >nul 2>' ||TmpFile
  8461.  
  8462. CheckMacroSpaceRc:
  8463. CheckRc=Rc
  8464. if CheckRc=0 then
  8465. do
  8466. DosDelRc=_SysFileDelete(TmpFile)
  8467. return
  8468. end
  8469. call Line1 ''
  8470. call Char1 ErrorColor
  8471. call Line1 FailMsg
  8472. call Line1 copies('~',length(FailMsg))
  8473. do while lines(TmpFile)<>0
  8474. call Line1 linein(TmpFile)
  8475. end
  8476. call Char1 Reset|| ''
  8477. CloseRc=stream(TmpFile, 'c', 'close')
  8478. DosDelRc=_SysFileDelete(TmpFile)
  8479. AbnormalExit(CallersLine)
  8480.  
  8481. _ReportCurrentOutputFile:
  8482. call DebugLine 'Current Output file = "' || CurrentOutFile || '" (level ' || OutputLevel || ')'
  8483. return
  8484.  
  8485. HaveNewOutputFile:
  8486. hnofAppend=arg(3)
  8487. hnofNOCTYPE=arg(4)
  8488. if OutputLevel<>0 then
  8489. CloseRc=stream(CurrentOutFile, 'c', 'close')
  8490. if OptionCgiModeOn='Y' then
  8491. do
  8492. CurrentOutFile=RexStdoutStream
  8493. call DebugLine 'In CGI mode, will output to "' || CurrentOutFile || '" (standard output)'
  8494. end
  8495. else
  8496. do
  8497. if arg(2)<> '' then
  8498. CurrentOutFile=GenerateFileName(arg(1),arg(2), 'Y')
  8499. else
  8500. do
  8501. CurrentOutFile=arg(1)
  8502. call MakeDirectoryTree _filespec('drive', CurrentOutFile) || _filespec('path',CurrentOutFile)
  8503. end
  8504. end
  8505. CurrentOutLine=0
  8506. do ChkIndex=1 to OutputLevel
  8507. if Output.ChkIndex.File=CurrentOutFile then
  8508. do
  8509. if hnofAppend='Y' then
  8510. call OutputWarningToScreen 'OFO0', 'Appending to currently opened file ("' || CurrentOutFile || '")!'
  8511. else
  8512. CryAndDie('Already have "' || CurrentOutFile || '" open for output!')
  8513. end
  8514. end
  8515. OutputLevel=OutputLevel+1
  8516. Output.OutputLevel.File=CurrentOutFile
  8517. Output.OutputLevel.Line=CurrentOutLine
  8518. Output.OutputLevel.OCTYPE=OptionCodeType
  8519. if OptionCodeType<>hnofNOCTYPE then
  8520. do
  8521. call DebugLine 'Processing mode for "' || CurrentOutFile || '" is "' || hnofNOCTYPE || '" (changed from "' || OptionCodeType || '")'
  8522. OptionCodeType=hnofNOCTYPE
  8523. end
  8524. if OptionCgiModeOn='N' then
  8525. do
  8526. if SafeQueryExists(CurrentOutFile)<> "" then
  8527. do
  8528. if hnofAppend='Y' then
  8529. call DebugLine 'Appending to "' || CurrentOutFile || '"'
  8530. else
  8531. do
  8532. call DebugLine 'Deleting "' || CurrentOutFile || '"'
  8533. call Stream CurrentOutFile, 'c', 'Close'
  8534. DeleteRc=_SysFileDelete(CurrentOutFile)
  8535. if SafeQueryExists(CurrentOutFile)<> "" then
  8536. CryAndDie('Could not delete "' || CurrentOutFile || '", it must be in use (DosRc=' || DeleteRc || ')...')
  8537. end
  8538. end
  8539. end
  8540. call AddOutputFileToDependancyList CurrentOutFile
  8541. call charout CurrentOutFile, ""
  8542. CloseRc=stream(CurrentOutFile, 'c', 'close')
  8543. call _ReportCurrentOutputFile
  8544. return
  8545.  
  8546. _BackToPreviousOutput:
  8547. CloseRc=stream(CurrentOutFile, 'c', 'close')
  8548. call DebugLine 'Closed the Output file = "' || CurrentOutFile || '" (wrote ' || CurrentOutLine || ' line(s))'
  8549. if OutputLevel<=1 then
  8550. CryAndDie('No output files on stack!')
  8551. else
  8552. do
  8553. OutputLevel=OutputLevel-1
  8554. CurrentOutFile=Output.OutputLevel.File
  8555. CurrentOutLine=Output.OutputLevel.Line
  8556. if OptionCodeType<>Output.OutputLevel.OCTYPE then
  8557. do
  8558. OptionCodeType=Output.OutputLevel.OCTYPE
  8559. call DebugLine 'Restoring mode for "' || CurrentOutFile || '" to "' || OptionCodeType || '"'
  8560. end
  8561. end
  8562. call _ReportCurrentOutputFile
  8563. return
  8564.  
  8565. ProcessHashOutput:
  8566. call DieIfCgiModeOn
  8567. if LineQueued\=='' then
  8568. do
  8569. if OptionDebugOn='Y' then
  8570. do
  8571. call DebugLine 'Need to flush queued data'
  8572. call DebugIncrement 3
  8573. end
  8574. call FlushQueuedData
  8575. if OptionDebugOn='Y' then
  8576. call DebugIncrement-3
  8577. end
  8578. OutputParms=PerformReplacementsInCmdsParameters(arg(1))
  8579. if OutputParms='' then
  8580. call _BackToPreviousOutput
  8581. else
  8582. do
  8583. NewOutFile=GetQuotedText(OutputParms, "OutputParms")
  8584. OutputParms=translate(OutputParms)
  8585. NewOutAsIs='N'
  8586. NewOutAppend='N'
  8587. NewOCTYPE=OptionCodeType
  8588. do while OutputParms<> ''
  8589. ThisParm=GetQuotedText(OutputParms, "OutputParms")
  8590. select
  8591. when ThisParm="ASIS" then
  8592. NewOutAsIs='Y'
  8593. when ThisParm="APPEND" then
  8594. NewOutAppend='Y'
  8595. when ThisParm="HTML" | ThisParm = "REXX" | ThisParm = "OTHER" then
  8596. NewOCTYPE=ThisParm
  8597. otherwise
  8598. CryAndDie('The parameter "' || ThisParm || '" is unknown!')
  8599. end
  8600. end
  8601. if NewOutAsIs='N' then
  8602. call HaveNewOutputFile NewOutFile,OptionOutput,NewOutAppend,NewOCTYPE
  8603. else
  8604. call HaveNewOutputFile NewOutFile,,NewOutAppend,NewOCTYPE
  8605. end
  8606. return(0)
  8607.  
  8608. GetQuotedText:
  8609. parse arg TheString,RestVarName,QuoteDel
  8610. TheString=strip(TheString, 'L')
  8611. QuoteDel=' ' ||QuoteDel
  8612. if TheString='' then
  8613. call _ErrorNoQuotedParm
  8614. QuoteChar=left(TheString,1)
  8615. if datatype(QuoteChar, 'Alphanumeric')then
  8616. do
  8617. DelPos=verify(TheString,QuoteDel, 'M')
  8618. if DelPos=0 then
  8619. do
  8620. QuotedString=TheString
  8621. TheRest=''
  8622. end
  8623. else
  8624. do
  8625. QuotedString=substr(TheString,1,DelPos-1)
  8626. TheRest=substr(TheString,DelPos)
  8627. end
  8628. end
  8629. else
  8630. do
  8631. SecondQuotePosn=pos(QuoteChar,TheString,2)
  8632. if SecondQuotePosn=0 then
  8633. call _ErrorNoEndQuote
  8634. QuotedString=substr(TheString,2,SecondQuotePosn-2)
  8635. TheRest=substr(TheString,SecondQuotePosn+1)
  8636. end
  8637. if TheRest<> '' then
  8638. do
  8639. if QuoteDel<> 'Y' then
  8640. do
  8641. if pos(left(TheRest,1),QuoteDel)=0 then
  8642. do
  8643. Line1='There is no whitespace after the 2nd quote char of "' || QuoteChar || '" (did not expect to find "' || left(TheRest, 1) || '")'
  8644. Line2='The rest of the line:'
  8645. Line3=copies(' ',8)||DebugRightArrow||TheRest||DebugLeftArrow
  8646. CryAndDie(Line1,Line2,Line3)
  8647. end
  8648. end
  8649. end
  8650. TheRest=strip(TheRest, 'L')
  8651. if RestVarName<> '' then
  8652. call _valueS RestVarName,TheRest
  8653. else
  8654. do
  8655. if TheRest<> '' then
  8656. call DieIfExtraUnexpectedParms TheRest
  8657. end
  8658. return(QuotedString)
  8659.  
  8660. GetQuotedRest:
  8661. TheString=strip(arg(1))
  8662. if TheString='' then
  8663. call _ErrorNoQuotedParm
  8664. QuoteChar=left(TheString,1)
  8665. if datatype(QuoteChar, 'Alphanumeric')then
  8666. QuotedString=TheString
  8667. else
  8668. do
  8669. SecondQuotePosn=length(TheString)
  8670. if SecondQuotePosn<2|substr(TheString,SecondQuotePosn,1)<>QuoteChar then
  8671. call _ErrorNoEndQuote
  8672. QuotedString=substr(TheString,2,SecondQuotePosn-2)
  8673. end
  8674. return(QuotedString)
  8675.  
  8676. DieIfExtraUnexpectedParms:
  8677. if arg(1)='' then
  8678. return
  8679. CryAndDie('Unexpected parameter(s) of "' || strip(arg(1)) || '" found!')
  8680.  
  8681. _ErrorNoQuotedParm:
  8682. CryAndDie('Expect a quoted string, not enough parameters available!')
  8683.  
  8684. _ErrorNoEndQuote:
  8685. Line1='Could not find a matching end quote character of "' || QuoteChar || '"!'
  8686. Line2='Processing:'
  8687. Line3=copies(' ',8)||DebugRightArrow||TheString||DebugLeftArrow
  8688. CryAndDie(Line1,Line2,Line3)
  8689.  
  8690. GetRexxVarValueOrDie:
  8691. grvVar=arg(1)
  8692. if symbol(grvVar)='VAR' then
  8693. return(_valueG(grvVar))
  8694. else
  8695. do
  8696. if symbol(grvVar)='BAD' then
  8697. Reason="contains invalid character(s)"
  8698. else
  8699. Reason="is unknown"
  8700. call DumpVarsIfCompoundVariable grvVar
  8701. CryAndDie('The rexx variable "' || grvVar || '" ' || Reason || '!')
  8702. end
  8703.  
  8704. ProcessRexxVar:
  8705. ResultVar=GetQuotedText(PerformReplacementsInCmdsParameters(arg(1)), "Rest")
  8706. XVarName=''
  8707. ResultVarU=translate(ResultVar)
  8708. if ResultVarU="PUSH" then
  8709. do
  8710. do while Rest<> ''
  8711. ResultVar=GetQuotedText(Rest, "Rest")
  8712. call _StackPush GetRexxVarValueOrDie(ResultVar)
  8713. end
  8714. return(0)
  8715. end
  8716. if ResultVarU="POP" then
  8717. do
  8718. TmpVarCnt=0
  8719. do while Rest<> ''
  8720. ResultVar=GetQuotedText(Rest, "Rest")
  8721. TmpVarCnt=TmpVarCnt+1
  8722. TmpVar.TmpVarCnt=ResultVar
  8723. end
  8724. do while TmpVarCnt<>0
  8725. call _valueS TmpVar.TmpVarCnt,_StackPop()
  8726. TmpVarCnt=TmpVarCnt-1
  8727. end
  8728. return(0)
  8729. end
  8730. parse var Rest FastOperator Rest
  8731. if FastOperator<> '=' then
  8732. do
  8733. FastOperator=translate(FastOperator)
  8734. if left(FastOperator,1)='=' then
  8735. do
  8736. if FastOperator='=X=' then
  8737. do
  8738. XVarName=ResultVar
  8739. ResultVar='XVAR?.X?' ||c2x(translate(XVarName))
  8740. end
  8741. else
  8742. do
  8743. Rest=strip(Rest)
  8744. if symbol(Rest)='VAR' then
  8745. ResultValue=GetRexxVarValueOrDie(Rest)
  8746. else
  8747. ResultValue=GetQuotedRest(Rest)
  8748. select
  8749. when FastOperator='=ASIS=' then
  8750. do
  8751. RestVar=AsIs(ResultValue)
  8752. end
  8753. otherwise
  8754. CryAndDie('Unsupported "=?=" operator of "' || FastOperator || '" used on ' ||HashCmd)
  8755. end
  8756. Rest='RestVar'
  8757. end
  8758. FastOperator='='
  8759. end
  8760. end
  8761. select
  8762. when FastOperator='=' then
  8763. do
  8764. Rest=strip(Rest)
  8765. if symbol(Rest)='VAR' then
  8766. ResultValue=GetRexxVarValueOrDie(Rest)
  8767. else
  8768. ResultValue=GetQuotedRest(Rest)
  8769. end
  8770. when FastOperator='PUSH' then
  8771. do
  8772. call DieIfExtraUnexpectedParms Rest
  8773. call _StackPush GetRexxVarValueOrDie(ResultVar)
  8774. return(0)
  8775. end
  8776. when FastOperator='POP' then
  8777. do
  8778. call DieIfExtraUnexpectedParms Rest
  8779. ResultValue=_StackPop()
  8780. end
  8781. otherwise
  8782. do
  8783. AfterOperator=GetSimpleRexxValue(Rest, "Rest")
  8784. if Rest<> '' then
  8785. SourceValue=GetSimpleRexxValue(Rest)
  8786. else
  8787. SourceValue=GetRexxVarValueOrDie(ResultVar)
  8788. if OptionDebugOn='Y' then
  8789. call DebugLine_REXXVAR 'Evaluating: ' || SourceValue || ' ' || FastOperator || ' ' ||AfterOperator
  8790. select
  8791. when FastOperator='+' then
  8792. ResultValue=SourceValue+AfterOperator
  8793. when FastOperator='-' then
  8794. ResultValue=SourceValue-AfterOperator
  8795. when FastOperator='||' then
  8796. ResultValue=SourceValue||AfterOperator
  8797. when FastOperator='*' then
  8798. ResultValue=SourceValue*AfterOperator
  8799. when FastOperator='/' then
  8800. ResultValue=SourceValue/AfterOperator
  8801. when FastOperator='//' then
  8802. ResultValue=SourceValue//AfterOperator
  8803. when FastOperator='%' then
  8804. ResultValue=SourceValue%AfterOperator
  8805. otherwise
  8806. CryAndDie("Unsupported operator of '" || FastOperator || "' used on " ||HashCmd)
  8807. end
  8808. end
  8809. end
  8810. call _valueS ResultVar,ResultValue
  8811. if OptionDebugOn='Y' then
  8812. do
  8813. call DebugIncrement 1
  8814. if XVarName='' then
  8815. DbgPrefix=ResultVar
  8816. else
  8817. DbgPrefix='"X" Variable ' ||XVarName
  8818. call DebugLine_REXXVAR DbgPrefix|| ' = ' ||DebugRightArrow||ResultValue||DebugLeftArrow
  8819. call DebugIncrement-1
  8820. end
  8821. return(0)
  8822.  
  8823. GetSimpleRexxValue:
  8824. sParm=strip(arg(1), 'L')
  8825. sRestVar=arg(2)
  8826. sQuote=left(sParm,1)
  8827. if sQuote="'" | sQuote = '"' then
  8828. do
  8829. sEndPos=pos(sQuote,sParm,2)
  8830. if sEndPos=0 then
  8831. CryAndDie('Incorrectly quoted rexx literal (could not find ending quote)')
  8832. sValue=substr(sParm,2,sEndPos-2)
  8833. sRest=substr(sParm,sEndPos+1)
  8834. end
  8835. else
  8836. do
  8837. parse var sParm sValue sRest
  8838. if datatype(sValue, 'Number')=0 then
  8839. sValue=GetRexxVarValueOrDie(sValue)
  8840. end
  8841. if sRestVar<> '' then
  8842. call _valueS sRestVar,sRest
  8843. else
  8844. do
  8845. if sRestVar<> '' then
  8846. CryAndDie('Extra unexpected parameters of "' || sRestVar || '" found')
  8847. end
  8848. return(sValue)
  8849.  
  8850. _StackPush:
  8851. StackCnt=StackCnt+1
  8852. Stack.StackCnt.StackData=arg(1)
  8853. Stack.StackCnt.StackPosn=CurrentSourceLocation()
  8854. if OptionDebugOn='Y' then
  8855. call DebugLine_REXXVAR 'Stack Push(#' || StackCnt || ') = ' ||DebugRightArrow||arg(1)||DebugLeftArrow
  8856. return
  8857.  
  8858. _StackPop:
  8859. if StackCnt<=0 then
  8860. CryAndDie('There is nothing on the stack!')
  8861. spData=Stack.StackCnt.StackData
  8862. if OptionDebugOn='Y' then
  8863. do
  8864. call DebugLine_REXXVAR 'Stack pop(#' || StackCnt || ') = ' ||DebugRightArrow||spData||DebugLeftArrow
  8865. call DebugLine_REXXVAR 'matched push() at ' ||Stack.StackCnt.StackPosn
  8866. end
  8867. StackCnt=StackCnt-1
  8868. return(spData)
  8869.  
  8870. MatchesStackPushDebugText:
  8871. MatchIndex=arg(1)
  8872. if MatchIndex<=0 then
  8873. return('')
  8874. else
  8875. return(' (matches "#RexxVar PUSH" at ' || Stack.MatchIndex.StackPosn || ')')
  8876.  
  8877. _EnsureVersionY2KSafe:
  8878. TheVer=arg(1)
  8879. if datatype(TheVer, 'Number')=0|(length(TheVer)<>6&length(TheVer)<>8)then
  8880. CryAndDie('The version number "' || TheVer || '" is not valid')
  8881. if TheVer<100 then
  8882. do
  8883. if TheVer>98 then
  8884. TheVer='19' ||TheVer
  8885. else
  8886. TheVer='20' ||TheVer
  8887. end
  8888. return(TheVer)
  8889.  
  8890. ProcessRequire:
  8891. MinimumVersion=GetQuotedText(PerformReplacementsInCmdsParameters(arg(1)))
  8892. MinimumVersionY2k=_EnsureVersionY2KSafe(MinimumVersion)
  8893. ThisVersionY2k=_EnsureVersionY2KSafe(PgmVersion)
  8894. if OptionDebugOn='Y' then
  8895. do
  8896. call DebugLine 'You require "' || MinimumVersionY2k || '"'
  8897. call DebugLine 'You have    "' || ThisVersionY2k || '"'
  8898. end
  8899. if ThisVersionY2k<MinimumVersionY2k then
  8900. CryAndDie('You required at least PPWIZARD version "' || MinimumVersion || '", you are using version "' || PgmVersion || '"')
  8901. return(0)
  8902.  
  8903. RexxCtrlC:
  8904. LineCtrlC=SIGL
  8905. TRACE OFF
  8906. call Line1 ''
  8907. call Line1 HighlightColor||copies('=+',39)||ErrorColor
  8908. call CgiStartFatalError
  8909. call Line1 "Come on, you pressed Ctrl+C or Break didn't you!"
  8910. call CgiEndFatalError
  8911. call Line1 HighlightColor||copies('=+',39)||Reset
  8912. AbnormalExit(LineCtrlC)
  8913.  
  8914. _FindLastLabel:
  8915. FailedOnLine=arg(1)
  8916. TryLine=FailedOnLine
  8917. do while TryLine>1
  8918. TryLine=TryLine-1
  8919. TheLine=sourceline(TryLine)
  8920. ColonPos=pos(':',TheLine)
  8921. if ColonPos<>0 then
  8922. do
  8923. MaybeLabel=strip(left(TheLine,ColonPos-1))
  8924. if symbol(MaybeLabel)<> 'BAD' then
  8925. do
  8926. FoundLabelOnLine=TryLine
  8927. return(MaybeLabel|| ':  (line #' || AddCommasToDecimalNumber(TryLine) || ')')
  8928. end
  8929. end
  8930. end
  8931. FoundLabelOnLine=0
  8932. return('')
  8933.  
  8934. CommonTrapHandler:
  8935. signal on NOVALUE name SimpleRexxTrapUninitializedVariable
  8936. signal on SYNTAX name SimpleRexxTrapSyntaxError
  8937. FailingLine=arg(1)
  8938. TrapHeading=arg(2)
  8939. TextDescription=arg(3)
  8940. Text=arg(4)
  8941. CmdBeingEvaluated=arg(5)
  8942. HaveCapturedTrapDetails='Y'
  8943. call Line1 ''
  8944. call Line1 HighlightColor||copies('=+',39)||ErrorColor
  8945. call CgiStartFatalError
  8946. call Line1 TrapHeading
  8947. call Line1 copies('~',length(TrapHeading))
  8948. call Line1 substr(TextDescription,1,16)|| ': ' ||Text
  8949. BetterErrorText=Condition('D')
  8950. if BetterErrorText<> '' &BetterErrorText<>Text then
  8951. call Line1 copies(' ',18)||BetterErrorText
  8952. if IncludeLevel<>0 then
  8953. do
  8954. call Line1 'Processing locn : ' ||CurrentSourceLocation()
  8955. LastFileLine=strip(LastFileLine)
  8956. LastLine=strip(LastLine)
  8957. call Line1 'Line from file  : ' ||LastFileLine
  8958. if LastLine<>LastFileLine then
  8959. call Line1 'Failing line    : ' ||LastLine
  8960. if LastLineAfterMacroRep<> '' &LastLine<>LastLineAfterMacroRep&LastFileLine<>LastLineAfterMacroRep then
  8961. call Line1 'After Replace   : ' ||LastLineAfterMacroRep
  8962. if MacroBeingExpanded<> '' then
  8963. call Line1 'Expanding Macro : ' || StartsMacroReplacement || MacroBeingExpanded || ' ...' ||EndsMacroReplacement
  8964. end
  8965. if CmdBeingEvaluated<> '' then
  8966. call Line1 'Evaluating This : ' ||CmdBeingEvaluated
  8967. if RexWhich='REGINA' then
  8968. ReginaUname=' (' || uname() || ')'
  8969. else
  8970. ReginaUname=''
  8971. FailingLineText=AddCommasToDecimalNumber(FailingLine)
  8972. call Line1 'Operating System: ' ||RexSystemOpSys||ReginaUname
  8973. call Line1 'Rexx Version    : ' ||RexVersionInfo
  8974. if CmdBeingEvaluated='' then
  8975. DumpSource='Y'
  8976. else
  8977. do
  8978. DumpSource='N'
  8979. call DumpVarsInExpression CmdBeingEvaluated,, 'KNOWN VARIABLES', 'Line1'
  8980. end
  8981. if DumpSource='Y' then
  8982. do
  8983. call Line1 'Failing Module  : ' || PpWizardPgmName || ' (' || PgmVersion || ')'
  8984. call Line1 'Failing Line #  : ' ||FailingLineText
  8985. InRoutine=_FindLastLabel(FailingLine)
  8986. StartAt=FailingLine-4
  8987. if FoundLabelOnLine<>0 then
  8988. do
  8989. if FoundLabelOnLine>StartAt then
  8990. StartAt=FoundLabelOnLine
  8991. else
  8992. do
  8993. if FoundLabelOnLine<>0 then
  8994. do
  8995. if(FailingLine-FoundLabelOnLine)<10 then
  8996. StartAt=FoundLabelOnLine
  8997. else
  8998. call Line1 'After label     : ' ||InRoutine
  8999. end
  9000. end
  9001. end
  9002. call Line1 'SOURCE'
  9003. call Line1 '~~~~~~'
  9004. vlist.0=0
  9005. do ShowLine=StartAt to FailingLine
  9006. FailingSrcLineTxt=strip(SourceLine(ShowLine))
  9007. call Line1 left(AddCommasToDecimalNumber(ShowLine),length(FailingLineText))|| ' : ' ||FailingSrcLineTxt
  9008. call DumpVarsInExpression FailingSrcLineTxt, 'vlist'
  9009. end
  9010. call DumpVarsInExpressionNow 'vlist', 'KNOWN VARIABLES', 'Line1'
  9011. end
  9012. call CgiEndFatalError
  9013. call Line1 HighlightColor||copies('=+',39)||Reset
  9014. call Line1 ''
  9015. AbnormalExit(FailingLine)
  9016.  
  9017. RexxTrapUninitializedVariable:
  9018. TrappingLine=SIGL
  9019. call CommonTrapHandler TrappingLine, 'NoValue Abort!', 'Unknown Variable', condition('D')
  9020.  
  9021. RexxTrapSyntaxError:
  9022. TrappingLine=SIGL
  9023. call CommonTrapHandler TrappingLine, 'Syntax Error!', 'Reason',errortext(Rc)
  9024.  
  9025. SimpleCommonTrapHandler:
  9026. if HaveCapturedTrapDetails='N' then
  9027. do
  9028. FailingLine=arg(1)
  9029. TrapHeading=arg(2)
  9030. TextDescription=arg(3)
  9031. Text=arg(4)
  9032. end
  9033. FailingLineText=AddCommasToDecimalNumber(FailingLine)
  9034. say ''
  9035. say copies('*-',39)
  9036. say TrapHeading
  9037. say copies('~',length(TrapHeading))
  9038. if HaveCapturedTrapDetails='Y' then
  9039. say 'Trap within Trap: Original trap details saved and displayed below!'
  9040. say substr(TextDescription,1,16)|| ': ' ||Text
  9041. BetterErrorText=Condition('D')
  9042. if BetterErrorText<> '' &BetterErrorText<>Text then
  9043. call Line1 copies(' ',18)||BetterErrorText
  9044. parse source . . PpWizardPgmName
  9045. parse version VersionOfRexx
  9046. FailingSrcLineTxt=strip(SourceLine(FailingLine))
  9047. say 'Failed at       : ' || PpWizardPgmName || ' (line ' || FailingLineText || ', version ' || PgmVersion || ')'
  9048. say 'Source Code     : ' ||FailingSrcLineTxt
  9049. say 'Rexx Version    : ' ||VersionOfRexx
  9050. call DumpVarsInExpression FailingSrcLineTxt, '', 'KNOWN VARIABLES'
  9051. if HaveCapturedTrapDetails='Y' then
  9052. do
  9053. FailingLine=arg(1)
  9054. TrapHeading=arg(2)
  9055. TextDescription=arg(3)
  9056. Text=arg(4)
  9057. say ''
  9058. say 'Reason for secondary trap'
  9059. say '~~~~~~~~~~~~~~~~~~~~~~~~~'
  9060. say substr(TextDescription,1,16)|| ': ' ||Text
  9061. say 'Failed at       : ' || PpWizardPgmName || ' (line ' || FailingLineText || ', version ' || PgmVersion || ')'
  9062. say 'Source Code     : ' ||strip(SourceLine(FailingLine))
  9063. end
  9064. say copies('*-',39)
  9065. exit(FailingLine)
  9066.  
  9067. SimpleRexxTrapUninitializedVariable:
  9068. TrappingLine=SIGL
  9069. call SimpleCommonTrapHandler TrappingLine, 'NoValue Abort!', 'Unknown Variable', condition('D')
  9070.  
  9071. SimpleRexxTrapSyntaxError:
  9072. TrappingLine=SIGL
  9073. call SimpleCommonTrapHandler TrappingLine, 'Syntax Error!', 'Reason',errortext(Rc)
  9074.