home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 18 REXX / 18-REXX.zip / tem98233.zip / TEMPLATE.CMD < prev    next >
OS/2 REXX Batch file  |  1998-08-21  |  36KB  |  1,274 lines
  1. /*
  2.  * Pgm Name    : E:\DB\BATCH\CMD\PPWIZARD.CMD
  3.  * Pgm Version : 98.233
  4.  * Time        : Friday, 21 Aug 1998  8:30:48pm
  5.  * Input File  : E:\DB\PROJECTS\OS2\template\TEMPLATE.X
  6.  * Output File : .\OUT\TEMPLATE.CMD
  7.  */
  8.  
  9. /*
  10. * $Header:   E:/DB/PVCS.IT/OS2/TEMPLATE/TEMPLATE.X_V   1.1   21 Aug 1998 20:30:42   Dennis_Bareis  $/template/Template.x_v   1.0   16 Jan 1998 16:19:40   Dennis_Bareis  $
  11. */
  12. PgmVersion = "98.233"
  13. Aborting   = 'N'
  14. say '[]--------------------------------------------------------------------------[]'
  15. say '| TEMPLATE.CMD, v' || PgmVersion || ' (C)opyright Dennis Bareis 1998. All Rights Reserved. |'
  16. say '|               http://www.ozemail.com.au/~dbareis (db0@anz.com)             |'
  17. say '[]--------------------------------------------------------------------------[]'
  18. say ''
  19. /*
  20. * REXSYSTM.XH Version 98.232 By Dennis Bareis
  21. *            http://www.ozemail.com.au/~dbareis (db0@anz.com)
  22. */
  23. parse version RexVersionInfo
  24. if pos('REGINA', translate(RexVersionInfo)) <> 0 then
  25. RexWhich = 'REGINA'
  26. else
  27. RexWhich = 'STANDARD_OS/2'
  28. parse source RexSystemOpSys .
  29. if RexSystemOpSys = "WIN32" then
  30. do
  31. parse value uname() with RexSystemOpSys .
  32. if  RexSystemOpSys <> "WIN95" & RexSystemOpSys <> "WINNT" then
  33. do
  34. call RexSystemFailure 'Regina uname() returned "' || uname() || '" (expected WIN95 or WINNT)'
  35. end
  36. end
  37. RexSystmRexxPgmName = '?'; RexSystmRexxPgmName = RexGetFullSourceName()
  38. if  arg(2) <> '' then
  39. call RexSystemFailure 'ARG(2) contains unexpected data of ' || arg(2) || '.'
  40. if translate(strip(arg(1))) = 'DEBUG' then
  41. do
  42. call RexDumpSystemInfo
  43. exit(0)
  44. end
  45. if RexWhich = 'STANDARD_OS/2' then
  46. do
  47. call RxFuncAdd  'SysFileDelete',   'RexxUtil', 'SysFileDelete'
  48. call RxFuncAdd  'SysSearchPath',   'RexxUtil', 'SysSearchPath'
  49. call SetLocal
  50. RexEnvVarPool = 'OS2ENVIRONMENT'
  51. RexStdoutStream = 'STDOUT'
  52. RexStderrStream = 'STDERR'
  53. end
  54. else
  55. do
  56. OPTIONS NOEXT_COMMANDS_AS_FUNCS
  57. RexEnvVarPool = 'SYSTEM'
  58. RexStdoutStream = '<stdout>'
  59. RexStderrStream = '<stderr>'
  60. end
  61. OverrideId = GetEnv("REXSYSTM_OPSYS")
  62. if OverrideId <> '' then
  63. RexSystemOpSys = OverrideId
  64. signal EndREXSYSTMXh
  65. RexDumpSystemInfo:
  66. say 'Program Name  : ' || RexSystmRexxPgmName
  67. say 'Op System     : ' || RexSystemOpSys
  68. say 'Rexx Ver      : ' || RexVersionInfo
  69. say 'Which System  : ' || RexWhich
  70. if RexWhich = 'REGINA' then
  71. say 'regina uname(): ' || uname()
  72. return
  73. RexNeedReginaWorkAround:
  74. if  RexWhich = 'STANDARD_OS/2' then
  75. return('N')
  76. else
  77. return('Y')
  78. RexGetFullSourceName:
  79. parse source . . TmpRexxSrc
  80. if RexWhich = 'REGINA' then
  81. TmpRexxSrc = stream(strip(TmpRexxSrc), 'c', 'query exists')
  82. if   TmpRexxSrc = '' then
  83. call RexSystemFailure 'Could not determine the name of the rexx program!'
  84. return(TmpRexxSrc)
  85. RexQueryExists:
  86. return( stream(arg(1), 'c', 'query exists') )
  87. RexGetNameOfTmpDir:
  88. TmpDir = GetEnv('TMP')
  89. if  TmpDir = '' then
  90. TmpDir = GetEnv('TEMP')
  91. return(TmpDir)
  92. Stderr2:
  93. if RexSystemOpSys = "DOS" | RexSystemOpSys = "WIN95" then
  94. return('')
  95. else
  96. return(' 2>' || arg(1))
  97. AddressCmd:
  98. if  RexWhich = 'STANDARD_OS/2' then
  99. address cmd     '@' || arg(1)
  100. else
  101. do
  102. if  RexSystemOpSys = "DOS" | RexSystemOpSys = "WIN95" then
  103. address command arg(1)
  104. else
  105. address command '@' || arg(1)
  106. end
  107. return(Rc)
  108. _SysFileDelete:
  109. if  RexWhich = 'STANDARD_OS/2' then
  110. return( SysFileDelete(arg(1)) )
  111. if RexSystemOpSys = "DOS" | RexSystemOpSys = "WIN95" then
  112. return( AddressCmd('if exist ' || arg(1) || ' del ' || arg(1) || ' > nul') )
  113. else
  114. return( AddressCmd('del ' || arg(1) || ' > nul ' || Stderr2('&1')) )
  115. _SysSearchPath:
  116. if  RexWhich = 'STANDARD_OS/2' then
  117. return( SysSearchPath(arg(1),arg(2)) )
  118. SspPath = GetEnv(arg(1))
  119. if SspPath = '' then
  120. return('')
  121. do while SspPath <> ''
  122. parse var SspPath SspThisFile';'SspPath
  123. if  right(SspThisFile, 1) <> '\' then
  124. SspThisFile = SspThisFile || '\'
  125. SspThisFile = RexQueryExists(SspThisFile || arg(2))
  126. if  SspThisFile <> '' then
  127. return(SspThisFile)
  128. end
  129. return('')
  130. GetEnv:
  131. return( value(arg(1),, RexEnvVarPool) )
  132. SetEnv:
  133. return( value(arg(1), arg(2), RexEnvVarPool) )
  134. EndREXSYSTMXh:
  135. if RexWhich = 'STANDARD_OS/2' then
  136. call RxFuncAdd  'SysCurPos', 'RexxUtil', 'SysCurPos'
  137. /*
  138. * ADDCOMMA.XH Version 98.090 by Dennis Bareis
  139. *            http://www.ozemail.com.au/~dbareis (db0@anz.com)
  140. */
  141. signal EndOfADDCOMMACode
  142. AddCommasToDecimalNumber: procedure
  143. NoComma = strip( arg(1) )
  144. if  pos(',', NoComma) <> 0 then
  145. return(NoComma)
  146. DotPos = pos('.', NoComma)
  147. if  DotPos = 0 then
  148. AfterDecimal = ''
  149. else
  150. do
  151. if  DotPos = 1 then
  152. return("0" || NoComma)
  153. AfterDecimal = substr(NoComma, DotPos+1)
  154. NoComma      = left(NoComma, DotPos-1)
  155. end
  156. NoComma = reverse(NoComma)
  157. ResultWithCommas = ""
  158. do  while length(NoComma) > 3
  159. ResultWithCommas = ResultWithCommas || left(NoComma, 3) || ','
  160. NoComma          = substr(NoComma, 4)
  161. end
  162. ResultWithCommas = ResultWithCommas || NoComma
  163. ResultWithCommas = reverse(ResultWithCommas)
  164. if  AfterDecimal <> '' then
  165. ResultWithCommas = ResultWithCommas || '.' || AfterDecimal
  166. return(ResultWithCommas)
  167. EndOfADDCOMMACode:
  168. signal on HALT    name RexxCtrlC
  169. signal on NOVALUE name RexxTrapUninitializedVariable
  170. signal on SYNTAX  name RexxTrapSyntaxError
  171. InLineCmt     = ';' || ';'
  172. Tt.OutputFile = ''
  173. DebugMode     = 'N'
  174. IncludeLevel  = 0
  175. call SetupHashVariables '#'
  176. ValidIfOutsideOrInPrompt = '-' || 'P'
  177. CmdState                 = '-'
  178. Parameters = arg(1)
  179. parse var Parameters TemplateFile GeneratedFileBase Crap
  180. if GeneratedFileBase = '' | Crap <> '' then
  181. CmdlineSyntaxError("Invalid number of parameters (2 expected)!")
  182. if stream(TemplateFile, 'c', 'query exists') = '' then
  183. AbortProcessing('ERROR: The template file "' || TemplateFile || '" does not seem to exist...')
  184. /*
  185. * $Header:   E:/DB/PVCS.IT/OS2/TEMPLATE/HASHIF.XHV   1.0   26 Jul 1998 10:44:12   Dennis_Bareis  $/template/hashif.xhv   1.0   16 Jan 1998 16:19:38   Dennis_Bareis  $
  186. */
  187. IfNesting           = 0
  188. IfState.WantLines.0 = 'Y'
  189. IfState.IfTrue.0    = 'Y'
  190. IfState.InTrue.0    = 'Y'
  191. signal EndHashIf
  192. WantLine:
  193. if  IfNesting = 0 then
  194. return('Y')
  195. if  IfState.WantLines.IfNesting = 'N' then
  196. return('N')
  197. else
  198. do
  199. if  IfState.IfTrue.IfNesting = IfState.InTrue.IfNesting then
  200. return('Y')
  201. else
  202. return('N')
  203. end
  204. ProcessHashIf:
  205. TestCondition = arg(1)
  206. WantTheLines = WantLine()
  207. if  WantTheLines = 'N' then
  208. IfResult = 'N'
  209. else
  210. do
  211. call SayIfDebugOn 'COMMAND: #if ' || TestCondition
  212. interpret 'IfResult = (' || strip( TestCondition ) || ')'
  213. if  IfResult then
  214. IfResult = 'Y'
  215. else
  216. IfResult = 'N'
  217. if  IfResult = 'Y' then
  218. call SayIfDebugOn '    #if: True'
  219. else
  220. call SayIfDebugOn '    #if: False'
  221. end
  222. IfNesting                   = IfNesting + 1
  223. IfState.WantLines.IfNesting = WantTheLines
  224. IfState.InTrue.IfNesting    = 'Y'
  225. IfState.IfTrue.IfNesting    = IfResult
  226. return('OK')
  227. ProcessHashElse:
  228. if  IfNesting = 0 then
  229. AbortProcessing("Found #elseif without matching #if")
  230. if  IfState.InTrue.IfNesting = 'N' then
  231. AbortProcessing("Found unexpected #elseif (duplicated #elseif?)")
  232. IfState.InTrue.IfNesting = 'N'
  233. return('OK')
  234. ProcessHashEndif:
  235. if  IfNesting = 0 then
  236. AbortProcessing("Found #endif without matching #if")
  237. IfNesting = IfNesting - 1
  238. return('OK')
  239. EndHashIf:
  240. /*
  241. * $Header:   E:/DB/PVCS.IT/OS2/TEMPLATE/DEFINE.XHV   1.0   26 Jul 1998 10:44:12   Dennis_Bareis  $/template/define.xhv   1.0   16 Jan 1998 16:19:36   Dennis_Bareis  $
  242. */
  243. HashDefineCount = 0
  244. G.StdVar.TemplateFile   = translate(TemplateFile)
  245. signal EndDefine
  246. HashDefineExists:
  247. do  DefineIndex = 1 to HashDefineCount
  248. if  arg(1) = DefineVariable.DefineIndex then
  249. return(DefineIndex)
  250. end
  251. return('N')
  252. AddHashDefine:
  253. DefineVariable = '{' || arg(1) || '}'
  254. DefineContents = strip(arg(2))
  255. ItExists = HashDefineExists(DefineVariable)
  256. if  ItExists <> 'N' then
  257. do
  258. SaveIndex = ItExists
  259. end
  260. else
  261. do
  262. HashDefineCount = HashDefineCount + 1
  263. SaveIndex       = HashDefineCount
  264. end
  265. DefineVariable.SaveIndex = DefineVariable
  266. DefineContents.SaveIndex = DefineContents
  267. return(0)
  268. ReplaceHashAndStandardDefines:
  269. HashDefineString = arg(1)
  270. TotalChanges     = 0
  271. if  pos("{", HashDefineString) <> 0 then
  272. do
  273. do  until ChangeCount = 0
  274. ChangeCount = 0
  275. do  DefineIndex = 1 to HashDefineCount
  276. HashDefineString = ReplaceString(HashDefineString, DefineVariable.DefineIndex, DefineContents.DefineIndex, "ChangeCount")
  277. end
  278. TotalChanges = TotalChanges + ChangeCount
  279. end
  280. if  pos("${", HashDefineString) <> 0 then
  281. HashDefineString = ReplaceStandardDefinitions(HashDefineString, "TotalChanges")
  282. end
  283. if  arg(2) <> '' then
  284. interpret arg(2) || " = TotalChanges"
  285. return(HashDefineString)
  286. ReplaceStandardDefinitions:
  287. DefineString  = arg(1)
  288. DefineString = ReplaceString(DefineString, "${Template}", G.StdVar.TemplateFile, arg(2))
  289. if  pos("${", DefineString) <> 0 then
  290. do
  291. DefineString = ReplaceString(DefineString, "${Version}",      PgmVersion,           arg(2))
  292. ChangeTime   = date('Weekday') || ', ' || date() || ' ' || GetAmPmTime()
  293. DefineString = ReplaceString(DefineString, "${ChangeTime}", ChangeTime, arg(2))
  294. end
  295. return(DefineString)
  296. ReplaceString:
  297. TheString    = arg(1)
  298. ChangeFrom   = arg(2)
  299. ChangeTo     = arg(3)
  300. ChangeCntVar = arg(4)
  301. LimitChange  = arg(5)
  302. if  LimitChange = '' then
  303. LimitChange = 99999
  304. ChangeFromLength = length(ChangeFrom)
  305. ChangeToLength   = length(ChangeTo)
  306. FoundPosn = pos(ChangeFrom, TheString)
  307. ReplaceStringCounter = 0
  308. do  while FoundPosn <> 0 & LimitChange > 0
  309. TheString = left(TheString, FoundPosn-1) || ChangeTo || substr(TheString, FoundPosn+ChangeFromLength)
  310. FoundPosn = pos(ChangeFrom, TheString, FoundPosn+ChangeToLength)
  311. ReplaceStringCounter = ReplaceStringCounter + 1
  312. LimitChange          = LimitChange - 1
  313. end
  314. if  ChangeCntVar <> '' then
  315. interpret ChangeCntVar || " = ReplaceStringCounter + " || ChangeCntVar
  316. return(TheString)
  317. EndDefine:
  318. /*
  319. * $Header:   E:/DB/PVCS.IT/OS2/TEMPLATE/EVALUATE.XHV   1.0   26 Jul 1998 10:44:12   Dennis_Bareis  $/template/evaluate.xhv   1.0   16 Jan 1998 16:19:36   Dennis_Bareis  $
  320. */
  321. signal EndEvaluate
  322. ProcessEvaluate:
  323. HashDefineAnswerName = GetQuotedText(arg(1), "Rest")
  324. if  Rest = '' then
  325. CmdToEvaluate = HashDefineAnswerName
  326. else
  327. do
  328. CmdToEvaluate = GetQuotedText(Rest, "Rest")
  329. call ExpectNoMoreParms TheRest
  330. end
  331. signal ON  SYNTAX NAME SyntaxErrorInEvaluateCommand
  332. signal ON  NOVALUE NAME UnknownVariableInEvaluateCommand
  333. HashDefineRc = 0
  334. if  HashDefineAnswerName = '' then
  335. do
  336. FullCmdBeingEvaluated = CmdToEvaluate
  337. interpret CmdToEvaluate
  338. end
  339. else
  340. do
  341. FullCmdBeingEvaluated = 'EvaluateAnswer = ' || CmdToEvaluate
  342. interpret FullCmdBeingEvaluated
  343. HashDefineRc = AddHashDefine(HashDefineAnswerName, EvaluateAnswer)
  344. end
  345. signal on NOVALUE name RexxTrapUninitializedVariable
  346. signal on SYNTAX  name RexxTrapSyntaxError
  347. return(HashDefineRc)
  348. SyntaxErrorInEvaluateCommand:
  349. FailReason = errortext(RC)
  350. AbortProcessing( 'Evaluate of "' || FullCmdBeingEvaluated || '" failed with syntax error (' || FailReason || ')' )
  351. UnknownVariableInEvaluateCommand:
  352. FailReason = "Variable=" || condition('D')
  353. AbortProcessing( 'Evaluate of "' || FullCmdBeingEvaluated || '" failed with unknown variable (' || FailReason || ')' )
  354. EndEvaluate:
  355. /*
  356. * $Header:   E:/DB/PVCS.IT/OS2/REXXHDR/GETRESP.XHV   1.1   01 Jun 1998 17:57:56   Dennis_Bareis  $
  357. */
  358. GetRespVer = "98.152"
  359. call RxFuncAdd  'SysCurPos', 'RexxUtil', 'SysCurPos'
  360. call RxFuncAdd  'SysGetKey', 'RexxUtil', 'SysGetKey'
  361. CursorTAvailable  = 'Y'
  362. trace off
  363. CurrentCursorMode = -1
  364. signal SkipOver_GETRESP
  365. GetKeyFromUser:
  366. if  CursorTAvailable = 'Y' then
  367. do
  368. WantedCursorMode = !CmdLine.History.insert
  369. if  WantedCursorMode <> CurrentCursorMode then
  370. do
  371. if  WantedCursorMode = "0" then
  372. CursorSize = "0 15"
  373. else
  374. CursorSize = "13 15"
  375. address cmd '@CursorT.EXE ' || CursorSize || ' >nul 2>&1'
  376. if  Rc = 0 then
  377. CurrentCursorMode = WantedCursorMode
  378. else
  379. CursorTAvailable = 'N'
  380. end
  381. end
  382. return( SysGetKey("NoEcho") )
  383. GetRespErrorBeep:
  384. call beep 400, 50
  385. return
  386. CmdLineProcedure: procedure expose !history. CurrentCursorMode
  387. CmdLine:
  388. CmdLine.Hidden=0
  389. CmdLine.History=1
  390. CmdLine.Keep=1
  391. CmdLine.SameLine=0
  392. CmdLine.Required=0
  393. CmdLine.Reset=0
  394. CmdLine.Valid=xrange()
  395. CmdLine.Upper=0
  396. CmdLine.Lower=0
  397. CmdLine.Width=0
  398. CmdLine.AutoSkip=0
  399. /* DB$ */ EscapeCancels = 0; InitialValue = ""
  400. parse value SysCurPos() with x y
  401. do i=1 to arg()
  402. cmd=translate(left(arg(i),1))
  403. parm=""
  404. if pos("=",arg(i))\=0 then
  405. parse value arg(i) with ."="parm
  406. select
  407. when arg(i)="~Esc~" then
  408. EscapeCancels=1
  409. when cmd="B" then
  410. do
  411. parse value SysCurPos() with x y
  412. if parm="" then
  413. do
  414. i = i + 1
  415. parm=arg(i)
  416. end
  417. InitialValue = parm
  418. end
  419. when cmd="X" then
  420. do
  421. parse value SysCurPos() with x y
  422. if parm="" then
  423. do;i=i+1;parm=arg(i);end
  424. if datatype(parm,"W") then
  425. Call SysCurPos parm,y
  426. end
  427. when cmd="Y" then
  428. do
  429. parse value SysCurPos() with x y
  430. if parm="" then
  431. do;i=i+1;parm=arg(i);end
  432. if datatype(parm,"W") then
  433. Call SysCurPos x,parm
  434. end
  435. when cmd="T" then
  436. do
  437. if parm="" then
  438. do;i=i+1;parm=arg(i);end
  439. call charout, parm
  440. end
  441. when cmd="H" then
  442. do
  443. CmdLine.Hidden=1
  444. CmdLine.Keep=0
  445. CmdLine.History=0
  446. end
  447. when cmd="C" then
  448. CmdLine.Reset=1
  449. when cmd="O" then
  450. !CmdLine.History.insert = 0
  451. when cmd="I" then
  452. !CmdLine.History.insert = 1
  453. when cmd="F" then
  454. CmdLine.Keep=0
  455. when cmd="S" then
  456. CmdLine.SameLine=1
  457. when cmd="R" then
  458. CmdLine.Required=1
  459. when cmd="V" then
  460. do
  461. if parm="" then
  462. do;i=i+1;parm=arg(i);end
  463. CmdLine.Valid=parm
  464. CmdLine.History=0
  465. CmdLine.Keep=0
  466. end
  467. when cmd="U" then
  468. do; CmdLine.Upper=1; CmdLine.Lower=0; CmdLine.History=0; CmdLine.Keep=0; end
  469. when cmd="L" then
  470. do; CmdLine.Upper=0; CmdLine.Lower=1; CmdLine.History=0; CmdLine.Keep=0; end
  471. when cmd="A" then
  472. CmdLine.AutoSkip=1
  473. when cmd="W" then
  474. do
  475. if parm="" then
  476. do;i=i+1;parm=arg(i);end
  477. CmdLine.Width=parm
  478. if \datatype(CmdLine.Width,"Whole") then CmdLine.Width=0
  479. if CmdLine.Width<0 then CmdLine.Width=0
  480. CmdLine.History=0
  481. CmdLine.Keep=0
  482. end
  483. otherwise nop
  484. end
  485. end
  486. if CmdLine.Width=0 then CmdLine.AutoSkip=0
  487. if CmdLine.Reset then
  488. do
  489. drop !CmdLine.History.
  490. return ""
  491. end
  492. if symbol("!CmdLine.History.0")="LIT" then
  493. !CmdLine.History.0=0
  494. if symbol("!CmdLine.History.insert")="LIT" then
  495. !CmdLine.History.insert = 1
  496. word = InitialValue
  497. if word <> "" then
  498. call charout, word
  499. pos = length(word)
  500. historical=-1
  501. TheKey = GetKeyFromUser()
  502. do forever
  503. if TheKey=d2c(13) then
  504. if CmdLine.Required & word="" then
  505. call GetRespErrorBeep
  506. else
  507. leave
  508. else if (TheKey=d2c(8)) then
  509. do
  510. if  pos = 0 then
  511. call GetRespErrorBeep
  512. else
  513. do
  514. word=delstr(word,pos,1)
  515. call rubout 1
  516. pos=pos-1
  517. if pos<length(word) then
  518. do
  519. if  \CmdLine.Hidden then
  520. call charout, substr(word,pos+1)||" "
  521. else
  522. call charout, copies("*",length(substr(word,pos+1)))||" "
  523. call charout, copies(d2c(8),length(word)-pos+1)
  524. end
  525. end
  526. end
  527. else if TheKey=d2c(27) then
  528. do
  529. if   EscapeCancels then
  530. do
  531. if  word == '' then
  532. do
  533. word="~Esc~"
  534. pos=0
  535. leave
  536. end
  537. end
  538. historical=-1
  539. if pos<length(word) then
  540. do
  541. if \CmdLine.Hidden then
  542. call charout, substr(word,pos+1)
  543. else
  544. call charout, copies("*",length(substr(word,pos+1)))
  545. end
  546. call rubout length(word)
  547. word=""
  548. pos=0
  549. /*
  550. *if pos<length(word) then
  551. *    if \CmdLine.Hidden then call charout, substr(word,pos+1)
  552. *    else call charout, copies("*",length(substr(word,pos+1)))
  553. * call rubout length(word)
  554. * word=""
  555. * pos=0
  556. */
  557. end
  558. else if TheKey=d2c(10) | TheKey=d2c(9) then
  559. nop
  560. else if TheKey=d2c(224) | TheKey=d2c(0) then
  561. do
  562. key2 = GetKeyFromUser()
  563. select
  564. when key2=d2c(59) then
  565. if (CmdLine.History) & (!CmdLine.History.0<>0) then
  566. do
  567. if  symbol('search')='LIT' then
  568. search=word
  569. if  symbol('LastFind')='LIT' then
  570. search=word
  571. else
  572. do
  573. if  LastFind\=word then
  574. search=word
  575. end
  576. if  historical=-1 then
  577. start=!CmdLine.History.0
  578. else
  579. start=historical-1
  580. if  start=0 then
  581. start=!CmdLine.History.0
  582. found=0
  583. do i=start to 1 by -1
  584. if abbrev(!CmdLine.History.i,search) then
  585. do
  586. found=1
  587. historical=i
  588. LastFind=!CmdLine.History.i
  589. leave
  590. end
  591. end
  592. if found then
  593. do
  594. if pos<length(word) then
  595. do
  596. if  \CmdLine.Hidden then
  597. call charout, substr(word,pos+1)
  598. else
  599. call charout, copies("*",length(substr(word,pos+1)))
  600. end
  601. call rubout length(word)
  602. word=!CmdLine.History.historical
  603. pos=length(word)
  604. if   \CmdLine.Hidden then
  605. call charout, word
  606. else
  607. call charout, copies("*",length(word))
  608. end
  609. end
  610. when key2=d2c(72) then
  611. if (CmdLine.History) & (!CmdLine.History.0<>0) then
  612. do
  613. if historical=-1 then
  614. historical=!CmdLine.History.0
  615. else historical=historical-1
  616. if historical=0 then
  617. historical=!CmdLine.History.0
  618. if pos<length(word) then
  619. if \CmdLine.Hidden then call charout, substr(word,pos+1)
  620. else call charout, copies("*",length(substr(word,pos+1)))
  621. call rubout length(word)
  622. word=!CmdLine.History.historical
  623. pos=length(word)
  624. if \CmdLine.Hidden then call charout, word
  625. else call charout, copies("*",length(word))
  626. end
  627. when key2=d2c(80) then
  628. if (CmdLine.History) & (!CmdLine.History.0<>0) then
  629. do
  630. if historical=-1 then
  631. historical=1
  632. else historical=historical+1
  633. if historical>!CmdLine.History.0 then
  634. historical=1
  635. if pos<length(word) then
  636. if \CmdLine.Hidden then call charout, substr(word,pos+1)
  637. else call charout, copies("*",length(substr(word,pos+1)))
  638. call rubout length(word)
  639. word=!CmdLine.History.historical
  640. pos=length(word)
  641. if \CmdLine.Hidden then call charout, word
  642. else call charout, copies("*",length(word))
  643. end
  644. when key2=d2c(75) then
  645. if pos>0 then
  646. do
  647. call Charout, d2c(8)
  648. pos=pos-1
  649. end
  650. when key2=d2c(77) then
  651. if pos<length(word) then
  652. do
  653. if \CmdLine.Hidden then call Charout, substr(word,pos+1,1)
  654. else call charout, "*"
  655. pos=pos+1
  656. end
  657. when key2=d2c(115) then
  658. if pos>0 then
  659. do
  660. call charout, d2c(8)
  661. pos=pos-1
  662. do forever
  663. if pos=0 then leave
  664. if substr(word,pos+1,1)\==" " & substr(word,pos,1)==" " then
  665. leave
  666. else
  667. do
  668. call charout, d2c(8)
  669. pos=pos-1
  670. end
  671. end
  672. end
  673. when key2=d2c(116) then
  674. if pos<length(word) then
  675. do
  676. if \CmdLine.Hidden then call Charout, substr(word,pos+1,1)
  677. else call charout, "*"
  678. pos=pos+1
  679. do forever
  680. if pos=length(word) then
  681. leave
  682. if substr(word,pos,1)==" " & substr(word,pos+1,1)\==" " then
  683. leave
  684. else
  685. do
  686. if \CmdLine.Hidden then call Charout, substr(word,pos+1,1)
  687. else call charout, "*"
  688. pos=pos+1
  689. end
  690. end
  691. end
  692. when key2=d2c(83) then
  693. if pos<length(word) then
  694. do
  695. word=delstr(word,pos+1,1)
  696. if \CmdLine.Hidden then call Charout, substr(word,pos+1)||" "
  697. else call Charout, copies("*",length(substr(word,pos+1)))||" "
  698. call charout, copies(d2c(8),length(word)-pos+1)
  699. end
  700. when key2=d2c(82) then
  701. !CmdLine.History.insert = \!CmdLine.History.insert
  702. when key2=d2c(79) then
  703. if pos<length(word) then
  704. do
  705. if \CmdLine.Hidden then call Charout, substr(word,pos+1)
  706. else call Charout, copies("*",length(substr(word,pos+1)))
  707. pos=length(word)
  708. end
  709. when key2=d2c(71) then
  710. if pos\=0 then
  711. do
  712. call Charout, copies(d2c(8),pos)
  713. pos=0
  714. end
  715. when key2=d2c(117) then
  716. if pos<length(word) then
  717. do
  718. call Charout, copies(" ",length(word)-pos)
  719. call Charout, copies(d2c(8),length(word)-pos)
  720. word=left(word,pos)
  721. end
  722. when key2=d2c(119) then
  723. if pos>0 then
  724. do
  725. if pos<length(word) then
  726. if \CmdLine.Hidden then call charout, substr(word,pos+1)
  727. else call charout, copies("*",length(substr(word,pos+1)))
  728. call rubout length(word)
  729. word=substr(word,pos+1)
  730. if \CmdLine.Hidden then call Charout, word
  731. else call Charout, copies("*",length(word))
  732. call Charout, copies(d2c(8),length(word))
  733. pos=0
  734. end
  735. otherwise
  736. if CmdLine.History & symbol('!CmdLine.History.key.'||c2d(key2))\='LIT' then
  737. do
  738. if pos<length(word) then
  739. if \CmdLine.Hidden then call charout, substr(word,pos+1)
  740. else call charout, copies("*",length(substr(word,pos+1)))
  741. call rubout length(word)
  742. i=c2d(key2)
  743. word=!CmdLine.History.key.i
  744. pos=length(word)
  745. if \CmdLine.Hidden then call charout, word
  746. else call charout, copies("*",length(word))
  747. end
  748. end
  749. end
  750. else
  751. if CmdLine.Width=0 | (length(word)<CmdLine.Width | (pos<CmdLine.Width & !CmdLine.History.insert = 0)) then
  752. do
  753. if CmdLine.Upper then TheKey=translate(TheKey)
  754. if CmdLine.Lower then TheKey=translate(TheKey,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
  755. if pos(TheKey,CmdLine.Valid)\=0 then
  756. do
  757. if \CmdLine.Hidden then
  758. call Charout, TheKey
  759. else
  760. call charout, "*"
  761. if !CmdLine.History.insert then
  762. word=insert(TheKey,word,pos)
  763. else
  764. word=overlay(TheKey,word,pos+1)
  765. pos=pos+1
  766. if pos<length(word) then
  767. do
  768. if \CmdLine.Hidden then
  769. call Charout, substr(word,pos+1)
  770. else
  771. call Charout, copies("*", length(substr(word,pos+1)))
  772. call Charout, copies(d2c(8),length(word)-pos)
  773. end
  774. end
  775. else
  776. call GetRespErrorBeep
  777. end
  778. else
  779. call GetRespErrorBeep
  780. if CmdLine.AutoSkip & length(word)=CmdLine.Width then leave
  781. TheKey = GetKeyFromUser()
  782. end
  783. if \CmdLine.SameLine then say
  784. if (CmdLine.Keep) & (word\=="") then
  785. do
  786. historical=!CmdLine.History.0
  787. if word\=!CmdLine.History.historical then
  788. do
  789. !CmdLine.History.0=!CmdLine.History.0+1
  790. historical=!CmdLine.History.0
  791. !CmdLine.History.historical=word
  792. end
  793. end
  794. return word
  795. rubout: procedure
  796. arg n
  797. do i=1 to n
  798. call Charout, d2c(8)||" "||d2c(8)
  799. end
  800. return
  801. SkipOver_GETRESP:
  802. DefaultP.StripAnswer       = 'B'
  803. DefaultP.ValidationRoutine = "*Empty*"
  804. if RexSystemOpSys = "OS/2" then
  805. do
  806. DefaultP.BeforePrompt = ''
  807. DefaultP.AfterPrompt  = ''
  808. AnsiReset             = ''
  809. end
  810. else
  811. do
  812. DefaultP.BeforePrompt = ''
  813. DefaultP.AfterPrompt  = ''
  814. AnsiReset             = ''
  815. end
  816. call  ProcessInputFile(TemplateFile)
  817. exit(0)
  818. FindIncludeFile:
  819. LookForFile = arg(1)
  820. FoundFile   = _SysSearchPath('TEMPLATE', LookForFile)
  821. if  FoundFile = "" then
  822. FoundFile = _SysSearchPath('INCLUDE', LookForFile)
  823. return(FoundFile)
  824. ProcessInputFile:
  825. RequestedFile          = arg(1)
  826. IncludeLevel           = IncludeLevel + 1
  827. InputFile.IncludeLevel = stream(RequestedFile, 'c', 'query exists')
  828. InputFile.IncludeLevel = stream(RequestedFile, 'c', 'query exists')
  829. if  InputFile.IncludeLevel = '' then
  830. InputFile.IncludeLevel = FindIncludeFile(RequestedFile)
  831. if  InputFile.IncludeLevel = '' then
  832. AbortProcessing('File "' || RequestedFile || '" does not exist!')
  833. call OutputProcessingFileStringToScreen
  834. CloseRc = stream(InputFile.IncludeLevel, 'c', 'close')
  835. LinesProcessed.IncludeLevel = 0
  836. do  while lines(InputFile.IncludeLevel) <> 0
  837. CurrentLine = linein(InputFile.IncludeLevel)
  838. LinesProcessed.IncludeLevel = LinesProcessed.IncludeLevel + 1
  839. if  DebugMode = 'Y' then
  840. call SayIfDebugOn InputFile.IncludeLevel || '(' || LinesProcessed.IncludeLevel || '): ' || CurrentLine
  841. CurrentLine = ReplaceHashAndStandardDefines(CurrentLine)
  842. if  DebugMode = 'Y' then
  843. do
  844. if  pos('{', CurrentLine) <> 0 then
  845. call SayIfDebugOn "FOUND '{': " || CurrentLine
  846. end
  847. if  CmdState <> 'T' then
  848. do
  849. CmtPos = lastpos(InLineCmt, CurrentLine)
  850. if  CmtPos > 1 then
  851. CurrentLine = left(CurrentLine, CmtPos - 1)
  852. CurrentLine = strip(CurrentLine)
  853. if  CurrentLine = '' then
  854. iterate
  855. if  left(CurrentLine, 1) = ';' then
  856. iterate
  857. end
  858. CurrentCmd      = translate( word(CurrentLine, 1) )
  859. CurrentCmdParms = subword(CurrentLine, 2)
  860. select
  861. when CurrentCmd = HashIf then
  862. do
  863. call ProcessHashIf CurrentCmdParms
  864. iterate
  865. end
  866. when CurrentCmd = HashElseIf then
  867. do
  868. call ProcessHashElse
  869. iterate
  870. end
  871. when CurrentCmd = HashEndIf then
  872. do
  873. call ProcessHashEndif
  874. iterate
  875. end
  876. otherwise
  877. end
  878. if  WantLine() <> 'Y' then
  879. iterate
  880. if  CmdState <> 'T' then
  881. do
  882. select
  883. when CurrentCmd = HashHash then
  884. do
  885. NewHash = GetQuotedText(CurrentCmdParms, "TheRest")
  886. call ExpectNoMoreParms TheRest
  887. call SetupHashVariables NewHash
  888. iterate
  889. end
  890. when CurrentCmd = 'DEBUG' then
  891. do
  892. DebugMode = 'Y'
  893. iterate
  894. end
  895. otherwise
  896. end
  897. end
  898. select
  899. when CurrentCmd = 'STARTPROMPT' then
  900. do
  901. call MustBeInOrOutsideAnyPromptOrTemplateDefinition
  902. CmdState             = 'P'
  903. Tp.PromptVar         = GetQuotedText(CurrentCmdParms, "TheRest")
  904. call ExpectNoMoreParms TheRest
  905. Tp.PromptText        = "*Empty*"
  906. Tp.AnswerLengthFrom  = 0
  907. Tp.AnswerLengthTo    = "*Empty*"
  908. Tp.ValidCharList     = "*Empty*"
  909. Tp.ValidationRoutine = DefaultP.ValidationRoutine
  910. Tp.StripAnswer       = DefaultP.StripAnswer
  911. Tp.BeforePrompt      = DefaultP.BeforePrompt
  912. Tp.AfterPrompt       = DefaultP.AfterPrompt
  913. Tp.EntryValue        = ''
  914. Tp.PromptOptionList  = ''
  915. end
  916. when CurrentCmd = 'ENDPROMPT' then
  917. do
  918. call MustBeWithinPromptDefinition
  919. call ExpectNoMoreParms CurrentCmdParms
  920. if  Tp.PromptText = "*Empty*" then
  921. call AbortProcessing 'ERROR: Expected a "PromptText" command'
  922. if  Tp.AnswerLengthTo = "*Empty*" then
  923. Tp.AnswerLengthTo = 79 - length(Tp.PromptText)
  924. Tp.PromptAnswer = PromptUserAndGetAnswer()
  925. CmdState = '-'
  926. end
  927. when CurrentCmd = 'STARTTEMPLATE' then
  928. do
  929. call MustBeInOrOutsideAnyPromptOrTemplateDefinition
  930. CmdState             = 'T'
  931. Tt.OutputFile        = GeneratedFileBase || GetQuotedText(CurrentCmdParms, "TheRest")
  932. call ExpectNoMoreParms TheRest
  933. CloseRc = stream(Tt.OutputFile, 'c', 'close')
  934. DosDelRc = _SysFileDelete(Tt.OutputFile)
  935. if  stream(Tt.OutputFile, 'c', 'query exists') <> '' then
  936. call AbortProcessing 'ERROR: Could not delete the output file "' || Tt.OutputFile || '"'
  937. Tt.OutputLine        = 0
  938. end
  939. when CurrentCmd = 'ENDTEMPLATE' then
  940. do
  941. call MustBeWithinTemplateDefinition
  942. call ExpectNoMoreParms CurrentCmdParms
  943. call OutputProcessingStatusStringToScreen 'Wrote ' || AddCommasToDecimalNumber(Tt.OutputLine) || ' line(s) to "' || Tt.OutputFile || '".'
  944. CloseRc = stream(Tt.OutputFile, 'c', 'close')
  945. Tt.OutputFile = ''
  946. CmdState = '-'
  947. end
  948. when CurrentCmd = 'ANSWERLENGTH' then
  949. do
  950. call MustBeWithinPromptDefinition
  951. Tp.AnswerLengthFrom = GetQuotedText(CurrentCmdParms, "CurrentCmdParms")
  952. Tp.AnswerLengthTo   = GetQuotedText(CurrentCmdParms, "TheRest")
  953. call ExpectNoMoreParms TheRest
  954. end
  955. when CurrentCmd = 'PROMPTOPTION' then
  956. do
  957. call MustBeWithinPromptDefinition
  958. TheOption = GetQuotedText(CurrentCmdParms, "TheRest")
  959. call ExpectNoMoreParms TheRest
  960. Tp.PromptOptionList = Tp.PromptOptionList || ', "' || TheOption || '"'
  961. end
  962. when CurrentCmd = 'PROMPTTEXT' then
  963. do
  964. call MustBeWithinPromptDefinition
  965. Tp.PromptText = GetQuotedText(CurrentCmdParms, "TheRest")
  966. call ExpectNoMoreParms TheRest
  967. end
  968. when CurrentCmd = 'VALIDCHARLIST' then
  969. do
  970. call MustBeWithinPromptDefinition
  971. Tp.ValidCharList = GetQuotedText(CurrentCmdParms, "TheRest")
  972. call ExpectNoMoreParms TheRest
  973. end
  974. when CurrentCmd = 'INITIALVALUE' then
  975. do
  976. call MustBeWithinPromptDefinition
  977. Tp.EntryValue = GetQuotedText(CurrentCmdParms, "TheRest")
  978. call ExpectNoMoreParms TheRest
  979. end
  980. when CurrentCmd = 'STRIPANSWER' then
  981. do
  982. TheOption      = GetQuotedText(CurrentCmdParms, "TheRest")
  983. TheOptionUpper = translate(TheOption)
  984. call ExpectNoMoreParms TheRest
  985. if  TheOption = 'OFF' then
  986. TheOption = ''
  987. if  TheOption <> '' & TheOption <> 'L' & TheOption <> 'T' & TheOption <> 'B' then
  988. call AbortProcessing 'ERROR: Invalid value of "' || TheOption || '" on "StripAnswer" command.'
  989. CurrentCmdParms = '"' || TheOptionUpper || '"'
  990. call GetSinglePromptParm 'StripAnswer', ValidIfOutsideOrInPrompt
  991. end
  992. when CurrentCmd = 'BEFOREPROMPT' then
  993. call GetSinglePromptParm 'BeforePrompt', ValidIfOutsideOrInPrompt
  994. when CurrentCmd = 'AFTERPROMPT' then
  995. call GetSinglePromptParm 'AfterPrompt', ValidIfOutsideOrInPrompt
  996. when CurrentCmd = 'VALIDATIONROUTINE' then
  997. call GetSinglePromptParm 'ValidationRoutine', ValidIfOutsideOrInPrompt
  998. when CurrentCmd = "EVALUATE" then
  999. call ProcessEvaluate CurrentCmdParms
  1000. when CurrentCmd = HashInclude then
  1001. call ProcessHashInclude CurrentCmdParms
  1002. when CurrentCmd = HashDefine then
  1003. do
  1004. DefineVar = GetQuotedText(CurrentCmdParms, "TheRest")
  1005. DefineVal = GetQuotedText(TheRest,         "TheRest")
  1006. call ExpectNoMoreParms TheRest
  1007. call AddHashDefine DefineVar, DefineVal
  1008. iterate
  1009. end
  1010. otherwise
  1011. if  CmdState <> 'T' then
  1012. call AbortProcessing 'ERROR: Invalid Template command of "' || CurrentCmd || '" found on line ' || LinesProcessed.IncludeLevel
  1013. if  lineout(Tt.OutputFile, CurrentLine) <> 0 then
  1014. AbortProcessing('Could not write to the file "' || Tt.OutputFile || '"!')
  1015. Tt.OutputLine = Tt.OutputLine + 1
  1016. end
  1017. end
  1018. CloseRc = stream(InputFile.IncludeLevel, 'c', 'close')
  1019. IncludeLevel = IncludeLevel - 1
  1020. return(0)
  1021. ProcessHashInclude:
  1022. NextFile = GetQuotedText(arg(1), "TheRest")
  1023. call ExpectNoMoreParms TheRest
  1024. call  ProcessInputFile(NextFile)
  1025. call OutputProcessingFileStringToScreen
  1026. return
  1027. OutputProcessingFileStringToScreen:
  1028. call SayIfDebugOn copies("  ", IncludeLevel) || ' * Processing: ' || InputFile.IncludeLevel
  1029. return
  1030. OutputProcessingStatusStringToScreen:
  1031. if  DebugMode = 'N' then
  1032. say  arg(1)
  1033. else
  1034. say  copies("  ", IncludeLevel) || '   * ' || arg(1)
  1035. return
  1036. SayIfDebugOn:
  1037. if  DebugMode = 'Y' then
  1038. say arg(1)
  1039. return
  1040. GetSinglePromptParm:
  1041. AnswerBase  = arg(1)
  1042. ValidStates = arg(2)
  1043. if  pos(CmdState, ValidStates) = 0 then
  1044. do
  1045. call MustBeWithinPromptDefinition
  1046. call MustBeInOrOutsideAnyPromptOrTemplateDefinition
  1047. end
  1048. ThisParm = GetQuotedText(CurrentCmdParms, "TheRest")
  1049. call ExpectNoMoreParms TheRest
  1050. if  CmdState = '-' then
  1051. VarDot = "DefaultP."
  1052. else
  1053. do
  1054. if  CmdState = 'T' then
  1055. VarDot = "Tt."
  1056. else
  1057. VarDot = "Tp."
  1058. end
  1059. interpret VarDot || AnswerBase || ' = ThisParm'
  1060. return
  1061. ExpectNoMoreParms:
  1062. if  arg(1) <> '' then
  1063. call AbortProcessing 'ERROR: Too many parameters on "' || CurrentCmd || '" command ("' || arg(1) || '" was unexpected).'
  1064. return
  1065. MustBeWithinPromptDefinition:
  1066. if  CmdState <> 'P' then
  1067. call AbortProcessing 'ERROR: Command of "' || CurrentCmd || '" is outside of Prompt Definition!'
  1068. return
  1069. MustBeWithinTemplateDefinition:
  1070. if  CmdState <> 'T' then
  1071. call AbortProcessing 'ERROR: Command of "' || CurrentCmd || '" is outside of Template Definition!'
  1072. return
  1073. MustBeInOrOutsideAnyPromptOrTemplateDefinition:
  1074. if  CmdState <> '-' then
  1075. call AbortProcessing 'ERROR: Command of "' || CurrentCmd || '" is inside of Prompt/Template Definition!'
  1076. return
  1077. PromptUserAndGetAnswer:
  1078. call charout ,Tp.BeforePrompt || Tp.PromptText || Tp.AfterPrompt
  1079. if  RexWhich = 'STANDARD_OS/2' then
  1080. parse value SysCurPos() with StartX StartY
  1081. ThePromptOptionList = '"SameLine", "Overwrite", "Forget", "NoHistory", "Beginning", TheInitialValue' || ', "Width", Tp.AnswerLengthTo' || Tp.PromptOptionList 
  1082. if  Tp.ValidCharList <> "*Empty*" then
  1083. ThePromptOptionList = ThePromptOptionList || ', "Valid", Tp.ValidCharList'
  1084. TheInitialValue = Tp.EntryValue
  1085. do  forever
  1086. if  RexWhich = 'STANDARD_OS/2' then
  1087. interpret "UsersAnswer = CmdLine(" || ThePromptOptionList || ')'
  1088. else
  1089. UsersAnswer = linein()
  1090. if  Tp.StripAnswer <> '' then
  1091. UsersAnswer = strip(UsersAnswer, Tp.StripAnswer)
  1092. call SetEnv '_' || Tp.PromptVar || '_', UsersAnswer
  1093. call AddHashDefine Tp.PromptVar, UsersAnswer
  1094. UsersAnswerOk = 'Y'
  1095. if  length(UsersAnswer) < Tp.AnswerLengthFrom then
  1096. UsersAnswerOk = 'N'
  1097. if  Tp.ValidationRoutine <> "*Empty*" then
  1098. do
  1099. interpret 'ValResult = "' || Tp.ValidationRoutine || '"("' || Tp.PromptVar || '")'
  1100. if  ValResult <> "OK" then
  1101. UsersAnswerOk = 'N'
  1102. end
  1103. if  UsersAnswerOk = 'Y' then
  1104. leave
  1105. call charout  ,''
  1106. if  RexWhich = 'STANDARD_OS/2' then
  1107. do
  1108. call SysCurPos StartX, StartY
  1109. call charout  ,copies(' ', length(UsersAnswer))
  1110. call SysCurPos StartX, StartY
  1111. end
  1112. else
  1113. do
  1114. call charout ,Tp.BeforePrompt || Tp.PromptText || Tp.AfterPrompt
  1115. end
  1116. TheInitialValue = UsersAnswer
  1117. end
  1118. call charout ,AnsiReset
  1119. if  RexWhich = 'STANDARD_OS/2' then
  1120. say ''
  1121. return(UsersAnswer)
  1122. GetQuotedText:
  1123. TheString          = strip(arg(1))
  1124. RestVarName        = arg(2)
  1125. NoCheckWhitespace  = arg(3)
  1126. if  TheString = '' then
  1127. AbortProcessing('Expect a quoted string, no parameters available')
  1128. QuoteChar = left(TheString, 1)
  1129. if  datatype(QuoteChar, 'Alphanumeric') then
  1130. do
  1131. SpacePos = pos(' ', TheString)
  1132. if  SpacePos = 0 then
  1133. do
  1134. QuotedString = TheString
  1135. TheRest      = ''
  1136. end
  1137. else
  1138. do
  1139. QuotedString = substr(TheString, 1, SpacePos-1)
  1140. TheRest      = substr(TheString,    SpacePos+1)
  1141. end
  1142. end
  1143. else
  1144. do
  1145. SecondQuotePosn = pos(QuoteChar, substr(TheString, 2))
  1146. if  SecondQuotePosn <> 0 then
  1147. SecondQuotePosn = SecondQuotePosn + 1
  1148. else
  1149. AbortProcessing('Could not find a matching end quote character of "' || QuoteChar || '"')
  1150. QuotedString = substr(TheString, 2, SecondQuotePosn-2)
  1151. TheRest      = substr(TheString, SecondQuotePosn+1)
  1152. end
  1153. if  TheRest <> '' then
  1154. do
  1155. if  NoCheckWhitespace <> 'Y' then
  1156. do
  1157. if  left(TheRest, 1) <> ' ' then
  1158. AbortProcessing('There is no whitespace after the 2nd quote char of "' || QuoteChar || '" (did not expect to find "' || left(TheRest, 1) || '")')
  1159. end
  1160. end
  1161. TheRest = strip(TheRest)
  1162. if  RestVarName <> '' then
  1163. interpret RestVarName || " = TheRest;"
  1164. else
  1165. do
  1166. if  TheRest <> '' then
  1167. AbortProcessing('Extra unexpected parameters of "' || TheRest || '" found')
  1168. end
  1169. return(QuotedString)
  1170. AddHashDefine:
  1171. HashDefineV = arg(1)
  1172. HashDefineC = arg(2)
  1173. if  pos('{', HashDefineV) <> 0 | pos('}', HashDefineV) <> 0 then
  1174. AbortProcessing('Attempt to #define invalid name of "' || HashDefineV || '".')
  1175. HashDefineV = '<' || '$' || HashDefineV
  1176. ItExists = HashDefineExists(HashDefineV)
  1177. if  ItExists <> 'N' then
  1178. do
  1179. SaveIndex = ItExists
  1180. if  HashDefineC.SaveIndex = strip(HashDefineC)
  1181. then
  1182. ReplaceMsg = "Redefinition same as previous"
  1183. else
  1184. ReplaceMsg = "Redefinition old value = " || HashDefineC.SaveIndex
  1185. call SayIfDebugOn ReplaceMsg
  1186. end
  1187. else
  1188. do
  1189. HashDefineCount = HashDefineCount + 1
  1190. SaveIndex       = HashDefineCount
  1191. end
  1192. HashDefineV.SaveIndex = HashDefineV
  1193. HashDefineC.SaveIndex = strip(HashDefineC)
  1194. return(0)
  1195. SetupHashVariables:
  1196. HashChar    = arg(1)
  1197. HashHash    = HashChar || "HASH"
  1198. HashDefine  = HashChar || "DEFINE"
  1199. HashInclude = HashChar || "INCLUDE"
  1200. HashIf      = HashChar || "IF"
  1201. HashElseIf  = HashChar || "ELSEIF"
  1202. HashEndIf   = HashChar || "ENDIF"
  1203. return
  1204. CmdlineSyntaxError:
  1205. say "SYNTAX ERROR"
  1206. say "~~~~~~~~~~~~"
  1207. say '    ' || arg(1)
  1208. say ''
  1209. say 'CORRECT SYNTAX'
  1210. say '~~~~~~~~~~~~~~'
  1211. say '    TEMPLATE[.CMD] InputTemplateFileName OutputPrefix'
  1212. say ''
  1213. say ''
  1214. say 'Please view "TEMPLATE.INF" for full details.'
  1215. exit(SIGL)
  1216. AbortProcessing:
  1217. if  arg(2) = '' then
  1218. AbortLocation = SIGL
  1219. else
  1220. AbortLocation = arg(2)
  1221. AbortMsg      = arg(1)
  1222. if  AbortMsg <> '' then
  1223. say AbortMsg || ''
  1224. if  Aborting = 'N' then
  1225. do
  1226. Aborting = 'Y'
  1227. if  Tt.OutputFile <> '' then
  1228. CloseRc = stream(Tt.OutputFile, 'c', 'close')
  1229. if  IncludeLevel <> 0 then
  1230. do
  1231. do  FileIndex = 1 to IncludeLevel
  1232. if  InputFile.FileIndex <> '' then
  1233. CloseRc = stream(InputFile.FileIndex, 'c', 'close')
  1234. end
  1235. end
  1236. end
  1237. exit(AbortLocation)
  1238. GetAmPmTime:
  1239. CivilTime  = time('C');  if length(CivilTime)  = 6 then CivilTime=' 'CivilTime
  1240. TheTime    = time();     NumSeconds = ':'substr(TheTime, 7, 2)
  1241. return( insert(NumSeconds, CivilTime, 5) )
  1242. RexxCtrlC:
  1243. LineCtrlC = SIGL
  1244. say ''
  1245. say copies('=+', 39)
  1246. say "Come on, you pressed Ctrl+C or Break didn't you!"
  1247. say copies('=+', 39)
  1248. call AbortProcessing ,LineCtrlC
  1249. CommonTrapHandler:
  1250. FailingLine     = arg(1)
  1251. TrapHeading     = 'BUG: ' || arg(2)
  1252. TextDescription = arg(3)
  1253. Text            = arg(4)
  1254. say ''
  1255. say copies('=+', 39)
  1256. say TrapHeading
  1257. say copies('~', length(TrapHeading))
  1258. say substr(TextDescription, 1 , 16) || ': ' || Text
  1259. say 'Failing Module  : ' || RexSystmRexxPgmName
  1260. say 'Failing Line #  : ' || FailingLine
  1261. say 'Failing Command : ' || strip(SourceLine(FailingLine))
  1262. say copies('=+', 39)
  1263. call AbortProcessing ,FailingLine
  1264. RexxTrapUninitializedVariable:
  1265. FailedAt = SIGL
  1266. call CommonTrapHandler FailedAt, 'NoValue Abort!', 'Unknown Variable', condition('D')
  1267. RexxTrapSyntaxError:
  1268. FailedAt = SIGL
  1269. call CommonTrapHandler FailedAt, 'Syntax Error!', 'Reason', errortext(Rc)
  1270. RexSystemFailure:
  1271. FailedAt = SIGL
  1272. call RexDumpSystemInfo
  1273. call AbortProcessing arg(1), FailedAt
  1274.