home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 March / Chip_2002-03_cd1.bin / sharewar / Slunec / app / ppww32.exe / REGIT.REX < prev    next >
OS/2 REXX Batch file  |  2001-12-08  |  18KB  |  650 lines
  1. /*
  2.  * Generator   : PPWIZARD version 01.340
  3.  *             : FREE tool for Windows, OS/2, DOS and UNIX by Dennis Bareis (dbareis@labyrinth.net.au)
  4.  *             : http://www.labyrinth.net.au/~dbareis/ppwizard.htm
  5.  * Time        : Saturday, 8 Dec 2001 4:54:35pm
  6.  * Input File  : C:\DBAREIS\Projects\Win32\RegIt\REGIT.x
  7.  * Output File : C:\DBAREIS\Projects\Win32\RegIt\out\REGIT.rex
  8.  */
  9.  
  10. if arg(1)="!CheckSyntax!" then exit(21924)
  11.  
  12. /*
  13. *  REGIT: Makes associations (including Right-Click on objects) easier
  14. *
  15. *  Note ppwizard makes a good front end for this and gives you
  16. *  more programability, conditional inclusion as well as file
  17. *  inclusion.
  18. *
  19. *  Get the latest version from:
  20. *
  21. *      http://www.labyrinth.net.au/~dbareis/index.htm
  22. *
  23. */
  24. /* Need to add:
  25. *
  26. * add standard trap handlers etc
  27. *
  28. * Add debug code/mode
  29. *
  30. */
  31. LineNum = ''
  32. PgmVersion  = '01.342'
  33. ShownHeader = 'N'
  34. trace off
  35. OPTIONS 'NOEXT_COMMANDS_AS_FUNCS'
  36. call MakeSureRequiredDllsAreAvailable
  37. VarStart  = '$['
  38. VarEnd    = ']'
  39. VarStartL = length(VarStart)
  40. VarEndL   = length(VarEnd)
  41. IncludeLvl            = 1
  42. LineNum.IncludeLvl    = 0
  43. signal on NOVALUE name RexxTrapUninitializedVariable
  44. signal on SYNTAX  name RexxTrapSyntaxError
  45. /*
  46. * REPLSTR.XH Version 99.134 By Dennis Bareis
  47. *            http://www.labyrinth.net.au/~dbareis/index.htm (db0@anz.com)
  48. */
  49. ReplaceCount = 0
  50. signal EndREPLSTR
  51.  
  52. ReplaceString: 
  53. parse arg rs?TheString, rs?ChangeFrom
  54. rs?FoundPosn = pos(rs?ChangeFrom, rs?TheString)
  55. if  rs?FoundPosn = 0 then
  56. return(rs?TheString)
  57. rs?ChangeTo = arg(3)
  58. rs?ChangeFromLength = length(rs?ChangeFrom)
  59. rs?LeftPart         = ''
  60. do  until rs?FoundPosn = 0
  61. rs?LeftPart      = rs?LeftPart || left(rs?TheString, rs?FoundPosn-1) || rs?ChangeTo
  62. rs?TheString     = substr(rs?TheString, rs?FoundPosn+rs?ChangeFromLength)
  63. ReplaceCount = ReplaceCount + 1
  64. rs?FoundPosn = pos(rs?ChangeFrom, rs?TheString)
  65. end
  66. return(rs?LeftPart || rs?TheString)
  67.  
  68. EndREPLSTR:
  69. RitFile  = strip(arg(1))
  70. RitFileF = stream(RitFile, 'c', 'query exists')
  71. if RitFileF <> '' then
  72. RitFile = RitFileF
  73. else
  74. do
  75. RitFileE = RitFile || '.rit'
  76. RitFileF = stream(RitFileE, 'c', 'query exists')
  77. if  RitFileF <> '' then
  78. RitFile = RitFileF
  79. else
  80. do
  81. call ShowSyntax
  82. Die('The ASSOCIATE file "' || RitFile || '" does not exist!')
  83. end
  84. end
  85. Colon2     = ';' || ';'
  86. EofChar    = '1A'x
  87. LineBuffer = ''
  88. WithinRexx = ''
  89. InFile.IncludeLvl     = RitFile
  90. CloseRc    = stream(InFile.IncludeLvl, 'c', 'close')
  91. do while IncludeLvl >= 1 | LineBuffer <> ''
  92. if  LineBuffer <> '' then
  93. do
  94. CurrentLine = LineBuffer
  95. LineBuffer  = ''
  96. end
  97. else
  98. do
  99. if  lines(InFile.IncludeLvl) = 0 then
  100. do
  101. CloseRc    = stream(InFile.IncludeLvl, 'c', 'close')
  102. IncludeLvl = IncludeLvl - 1
  103. iterate
  104. end
  105. CurrentLine = strip(linein(InFile.IncludeLvl))
  106. LineNum.IncludeLvl     = LineNum.IncludeLvl + 1
  107. end
  108. ScriptLine = CurrentLine
  109. CurrentLine = strip(translate(CurrentLine, ' ', EofChar))
  110. if  CurrentLine = '' then
  111. iterate
  112. if  left(CurrentLine, 1) = ';' then
  113. iterate
  114. InLinePos = lastpos(Colon2, CurrentLine)
  115. if  InLinePos <> 0 then
  116. CurrentLine = strip(left(CurrentLine, InLinePos-1))
  117. parse var CurrentLine Word1 .
  118. Word1 = translate(Word1)
  119. if  Word1 <> 'IF' then
  120. CurrentLine =  ExpandVariables(CurrentLine)
  121. if  WithinRexx <> '' then
  122. do
  123. if  CurrentLine = '}' then
  124. do
  125. call ExecuteRexx RexxBlock
  126. WithinRexx = ''
  127. end
  128. else
  129. do
  130. if  RexxBlock  <> '' then
  131. RexxBlock = RexxBlock || '0A'x
  132. RexxBlock = RexxBlock || CurrentLine
  133. end
  134. iterate
  135. end
  136. parse var CurrentLine Word1 AfterWord1Ws
  137. Word1      = translate(Word1)
  138. AfterWord1 = strip(AfterWord1Ws)
  139. select
  140. when translate(CurrentLine) = 'EOF' then
  141. leave
  142. when CurrentLine = '{' then
  143. do
  144. RexxBlock  = ''
  145. WithinRexx = LineNum.IncludeLvl
  146. end
  147. when Word1 = 'VERSION' then
  148. do
  149. if  FixVersion(AfterWord1) > FixVersion(PgmVersion) then
  150. Die('This script requires REGIT.REX to be at least version "' || AfterWord1 || '" but it is "' || PgmVersion || '".')
  151. end
  152. when Word1 = 'SAY' then
  153. say strip(AfterWord1Ws, 'T')
  154. when Word1 = 'PATH' | Word1 = 'PATHEXT' then
  155. call HandlePathTypeRegEnvVar Word1
  156. when Word1 = 'PATHTYPE' then
  157. do
  158. parse var AfterWord1 Word1 AfterWord1Ws
  159. AfterWord1 = strip(AfterWord1Ws)
  160. call HandlePathTypeRegEnvVar Word1
  161. end
  162. when Word1 = 'ENVVAR' then
  163. call HandleEnvironmentVariable
  164. when Word1 = 'REQUIRED' then
  165. call RequiredFile(AfterWord1)
  166. when Word1 = 'REXX' then
  167. do
  168. call ExecuteRexx AfterWord1
  169. end
  170. when Word1 = 'IF' then
  171. do
  172. LookFor     = ' THEN '
  173. AfterWord1U = translate(AfterWord1)
  174. ThenPos     = pos(LookFor, AfterWord1U)
  175. if  ThenPos = 0 then
  176. Die('"THEN" missing')
  177. IfResult = 0
  178. IfTest = 'IfResult = ( ' || strip(left(AfterWord1, ThenPos-1)) || ' )'
  179. call ExecuteRexx IfTest
  180. if  IfResult = 1 then
  181. LineBuffer = strip(substr(AfterWord1, ThenPos+length(LookFor)))
  182. end
  183. when Word1 = 'DEFINE' then
  184. do
  185. parse var AfterWord1 VarName '=' VarContents
  186. Alias = 'VAR_' || c2x(strip(VarName))
  187. call value Alias, VarContents
  188. end
  189. when Word1 = 'INCLUDE' then
  190. do
  191. parse var AfterWord1 '"' FileParm '"' .
  192. FileParmFull = stream(FileParm, 'c', 'query exists')
  193. if  FileParmFull = '' then
  194. do
  195. Die('Could not find the include file "' || FileParm || '"')
  196. end
  197. IncludeLvl            = IncludeLvl + 1
  198. LineNum.IncludeLvl    = 0
  199. InFile.IncludeLvl     = FileParmFull
  200. end
  201. when Word1 = 'ASSOC' then
  202. do
  203. parse var AfterWord1 AssExtn '=' AssName
  204. AssExtn = strip(AssExtn)
  205. AssName = strip(AssName)
  206. if  AssName = '' then
  207. do
  208. hRoot = w32RegOpenKey("CLASSES_ROOT")
  209. if  hRoot <> 0 then
  210. call w32RegDeleteKey hRoot, AssExtn
  211. end
  212. else
  213. do
  214. hAss = w32RegCreateKey('CLASSES_ROOT', AssExtn)
  215. call w32RegSetValue hAss, '', 'REG_SZ', AssName
  216. end
  217. end
  218. when Word1 = 'ASSOCMIME' then
  219. do
  220. parse var AfterWord1 AssExtn '=' AssMimeType
  221. AssExtn     = strip(AssExtn)
  222. AssMimeType = strip(AssMimeType)
  223. if  AssMimeType = '' then
  224. do
  225. hExtn = w32RegOpenKey("CLASSES_ROOT", AssExtn)
  226. if  hExtn <> 0 then
  227. call w32RegDeleteKey hExtn, 'Content Type'
  228. Die('ASSOCMIME does not yet support deletion')
  229. end
  230. else
  231. do
  232. hAss = w32RegOpenKey('CLASSES_ROOT', AssExtn)
  233. call w32RegSetValue hAss, 'Content Type', 'REG_SZ', AssMimeType
  234. end
  235. end
  236. when Word1 = 'FTYPE' then
  237. do
  238. parse var AfterWord1 AssName '/' AssOpenTitle '/' AssCommand
  239. AssName      = strip(AssName)
  240. AssOpenTitle = strip(AssOpenTitle)
  241. if  AssCommand = '' then
  242. do
  243. hRoot = w32RegOpenKey("CLASSES_ROOT")
  244. if  hRoot <> 0 then
  245. call w32RegUnloadKey hRoot, AssName
  246. Die('FTYPE does not yet support deletion')
  247. end
  248. else
  249. do
  250. hAss   = w32RegCreateKey('CLASSES_ROOT', AssName)
  251. hShell = w32RegCreateKey(hAss,   'Shell')
  252. hOpen  = w32RegCreateKey(hShell, 'Open')
  253. hCmd   = w32RegCreateKey(hOpen,  'Command')
  254. call w32RegSetValue hOpen, '', 'REG_SZ', AssOpenTitle
  255. call w32RegSetValue hCmd,  '', 'REG_SZ', AssCommand
  256. end
  257. end
  258. when Word1 = 'FTYPEICON' then
  259. do
  260. parse var AfterWord1 AssName '/' AssIcon
  261. AssName = strip(AssName)
  262. AssIcon = strip(AssIcon)
  263. if  AssIcon = '' then
  264. do
  265. hRoot = w32RegOpenKey("CLASSES_ROOT")
  266. if  hRoot <> 0 then
  267. call w32RegDeleteKey hRoot, AssName || '\DefaultIcon'
  268. end
  269. else
  270. do
  271. hAss   = w32RegCreateKey('CLASSES_ROOT', AssName)
  272. hIcon  = w32RegCreateKey(hAss,   'DefaultIcon')
  273. call w32RegSetValue hIcon, '', 'REG_SZ', AssIcon
  274. end
  275. end
  276. when Word1 = 'FTYPEDESC' then
  277. do
  278. parse var AfterWord1 AssName '/' AssDescription
  279. AssName        = strip(AssName)
  280. AssDescription = strip(AssDescription)
  281. hAss = w32RegCreateKey('CLASSES_ROOT', AssName)
  282. call w32RegSetValue hAss, '', 'REG_SZ', AssDescription
  283. end
  284. when Word1 = 'RCLICK' then
  285. do
  286. parse var AfterWord1 AssName '/' AssTitle '/' AssCommand
  287. if  AssCommand = '' then
  288. Die('Command to execute missing')
  289. AssTitle = strip(AssTitle)
  290. if  left(AssTitle, 1) <> '(' then
  291. AssAlias = MakeAlias(AssTitle)
  292. else
  293. do
  294. parse var AssTitle '(' AssAlias ')' AssTitle
  295. AssAlias = strip(AssAlias)
  296. AssTitle = strip(AssTitle)
  297. end
  298. hAss   = w32RegCreateKey('CLASSES_ROOT', AssName)
  299. hShell = w32RegCreateKey(hAss, 'Shell')
  300. hTitle = w32RegCreateKey(hShell, AssAlias)
  301. hCmd   = w32RegCreateKey(hTitle, 'Command')
  302. call w32RegSetValue hTitle, '', 'REG_SZ', AssTitle
  303. call w32RegSetValue hCmd, '', 'REG_SZ', AssCommand
  304. end
  305. when left(CurrentLine, 1) = '(' then
  306. do
  307. parse var CurrentLine '(' Test4Ok ')' WinCmd
  308. if  WinCmd = '' then
  309. Die('Missing operating system command')
  310. say 'Executing: ' || WinCmd
  311. address system WinCmd
  312. if  Test4Ok <> '' then
  313. do
  314. CmdRc = Rc
  315. interpret 'TestOk = ' || Test4Ok
  316. if  TestOk <> 1 then
  317. Die('Command failed with Return code of ' || CmdRc)
  318. end
  319. end
  320. otherwise
  321. do
  322. if  left(CurrentLine, 1) <> '#' then
  323. Die('Command unknown: ' || CurrentLine)
  324. else
  325. do
  326. say 'You may need to run this through ppwizard...'
  327. Die('Command unknown: ' || CurrentLine)
  328. end
  329. end
  330. end
  331. end
  332. if WithinRexx <> '' then
  333. Die('Incomplete rexx block found, block started on line ' || WithinRexx)
  334. exit(0)
  335.  
  336. FixVersion:
  337. parse value strip(arg(1)) with VerYY '.' VerDDD
  338. if  translate(VerYY) = '2K' then
  339. VerYY = '00'
  340. return(VerYY || '.' || VerDDD)
  341.  
  342. HandleEnvironmentVariable:
  343. parse var AfterWord1 ChangeLevel '/' VarName '/' VarContents
  344. ChangeLevel = translate(strip(ChangeLevel))
  345. VarName = strip(VarName)
  346. if  VarName = '' then
  347. Die('No environment variable specified!')
  348. select
  349. when ChangeLevel = 'SYSTEM' then
  350. hEnv = w32RegOpenKey('LOCAL_MACHINE', 'System\CurrentControlSet\Control\Session Manager\Environment')
  351. when ChangeLevel = 'USER' then
  352. hEnv = w32RegCreateKey('CURRENT_USER', 'Environment')
  353. otherwise
  354. Die('Unknown update level of "' || ChangeLevel || '"')
  355. end
  356. Failed = w32RegSetValue(hEnv, VarName, 'REG_SZ', VarContents)
  357. if  Failed then
  358. Die('Failed updating "' || ChangeLevel || '" registry for "' || VarName || '"')
  359. return
  360.  
  361. HandlePathTypeRegEnvVar:
  362. RegEnvVar = arg(1)
  363. if  RegEnvVar = 'PATHEXT' then
  364. RegAdding = 'extension'
  365. else
  366. RegAdding = 'directory'
  367. parse var AfterWord1 ChangeLevel '/' BeingAdded '/' Positioning
  368. ChangeLevel = translate(ChangeLevel)
  369. if  ChangeLevel <> 'USER' & ChangeLevel <> 'SYSTEM' & ChangeLevel <> 'SYSTEM?' then
  370. Die('Change level of "' || ChangeLevel || '" unknown expected "SYSTEM" or "USER"')
  371. if  BeingAdded = '' then
  372. Die('Missing ' || RegAdding || ' on "' || RegEnvVar || '" command')
  373. if  RegEnvVar = 'PATHEXT' then
  374. do
  375. if  left(BeingAdded, 1) <> '.' then
  376. Die('The ' || RegAdding || ' of "' || BeingAdded || '" does not start with a dot')
  377. end
  378. if  Positioning <> '' then
  379. do
  380. Positioning1 = left(Positioning, 1)
  381. if  Positioning1 <> '<' & Positioning1 <> '>' then
  382. Die('The positioning command "' || Positioning || '" does not start with "<" or ">"')
  383. if  length(Positioning) <> 1 then
  384. Die('Sorry currently only support "<" or ">" for positioning')
  385. end
  386. hSystem     = w32RegOpenKey('LOCAL_MACHINE', 'System\CurrentControlSet\Control\Session Manager\Environment')
  387. SystemValue = w32RegQueryValue(hSystem, RegEnvVar)
  388. if  SystemValue = '' then
  389. do
  390. if  RegEnvVar = 'PATHEXT' then
  391. SystemValue = GetEnv(RegEnvVar)
  392. if  SystemValue = '' then
  393. Die('"' || RegEnvVar || '" not found in system''s configuration!')
  394. end
  395. if  ChangeLevel <> 'USER' then
  396. do
  397. NewSystemValue = Add2PathLikeVariable(SystemValue, Positioning, BeingAdded)
  398. Failed = w32RegSetValue(hSystem, RegEnvVar, 'REG_SZ', NewSystemValue)
  399. if  Failed then
  400. Die('Failed updating system registry for "' || RegEnvVar || '"')
  401. if  ChangeLevel = 'SYSTEM' then
  402. return
  403. end
  404. UserVersionExists = 'N'
  405. if  ChangeLevel = 'SYSTEM' then
  406. PathExt = SystemValue
  407. else
  408. do
  409. hUser = w32RegOpenKey('CURRENT_USER', 'Environment')
  410. if  hUser = 0 then
  411. UserValue = SystemValue
  412. else
  413. do
  414. UserValue = w32RegQueryValue(hUser, RegEnvVar)
  415. if  UserValue = '' then
  416. UserValue = SystemValue
  417. else
  418. UserVersionExists = 'Y'
  419. end
  420. end
  421. if  UserVersionExists = 'N' & ChangeLevel = 'SYSTEM?' then
  422. return
  423. UserValue = Add2PathLikeVariable(UserValue, Positioning, BeingAdded)
  424. Failed = w32RegSetValue(hUser, RegEnvVar, 'REG_SZ', UserValue)
  425. if  Failed then
  426. Die('Failed updating registry for "' || RegEnvVar || '"')
  427. return
  428.  
  429. Add2PathLikeVariable: procedure expose LineNum ScriptLine
  430. parse arg UserValue, Positioning, BeingAdded
  431. UserValue    = translate(UserValue) || ';'
  432. BeingAdded   = translate(BeingAdded)
  433. Positioning1 = left(Positioning, 1)
  434. ExtPos  = pos(BeingAdded || ';', UserValue)
  435. if  ExtPos <> 0 then
  436. do
  437. UserValue = left(UserValue, ExtPos-1) || substr(UserValue, ExtPos + length(BeingAdded)+1)
  438. end
  439. if  Positioning <> '' then
  440. do
  441. if  Positioning1 = '<' then
  442. UserValue = BeingAdded || ';' || UserValue
  443. else
  444. UserValue = UserValue || BeingAdded || ';'
  445. end
  446. UserValue = FixPathExt(UserValue)
  447. return(UserValue)
  448.  
  449. RequiredFile: procedure expose LineNum ScriptLine
  450. FullName = stream(arg(1), 'c', 'query exists')
  451. if  FullName = '' then
  452. Die('Required file "' || arg(1) || '" could not be found')
  453. return(FullName)
  454.  
  455. ExpandVariables:
  456. RightBit = arg(1)
  457. LeftBit  = ''
  458. VarPos = pos(VarStart, RightBit)
  459. do  while VarPos <> 0
  460. LeftBit  = LeftBit || left(RightBit, VarPos-1)
  461. RightBit = substr(RightBit, VarPos+VarStartL)
  462. EndPos = pos(VarEnd, RightBit)
  463. if  EndPos = 0 then
  464. Die('Could not find end of variable in: ' || RightBit)
  465. VarName = left(RightBit, EndPos-1)
  466. RightBit = substr(RightBit, EndPos+VarEndL)
  467. select
  468. when VarName = "STD:VERSION" then
  469. VarContents = Pgmversion
  470. when VarName = "STD:VARSTART" then
  471. VarContents = VarStart
  472. when VarName = "STD:VAREND" then
  473. VarContents = VarEnd
  474. when VarName = "STD:CDIR" then
  475. VarContents = directory()
  476. when VarName = "STD:RitFile" then
  477. VarContents = RitFile
  478. when VarName = "STD:RITPATH" then
  479. do
  480. SlashPos = lastpos('\', RitFile)
  481. if  SlashPos = 0 then
  482. VarContents = ''
  483. else
  484. VarContents = left(RitFile, SlashPos)
  485. end
  486. when abbrev(VarName, "FULLNAME:") then
  487. do
  488. ShortName   = substr(VarName, 10)
  489. VarContents = RequiredFile(ShortName)
  490. end
  491. when abbrev(VarName, "GETENV:") then
  492. do
  493. EnvVar      = substr(VarName, 8)
  494. VarContents = GetEnv(EnvVar)
  495. if  VarContents = '' then
  496. Die('The environment variable "' || EnvVar || '" does not exist')
  497. end
  498. when abbrev(VarName, "REG:") then
  499. do
  500. Stuff = substr(VarName, 5)
  501. parse var Stuff RegRoot '/' RegKey '/' RegValue
  502. hUser       = w32RegOpenKey(RegRoot, RegKey)
  503. VarContents = w32RegQueryValue(hUser, RegValue)
  504. QueryRc = Rc
  505. call w32regclosekey hUser
  506. if  QueryRc <> 0 then
  507. Die('Registry value "' || Stuff || '" unknown' )
  508. end
  509. when abbrev(VarName, "?") then
  510. do
  511. RexVar = substr(VarName, 2)
  512. if  symbol(RexVar) <> 'VAR' then
  513. Die('The rexx variable "' || RexVar || '" does not exist')
  514. VarContents = value(RexVar)
  515. end
  516. otherwise
  517. do
  518. Alias = 'VAR_' || c2x(VarName)
  519. if  symbol(Alias) = 'VAR' then
  520. VarContents = value(Alias)
  521. else
  522. Die('The user defined variable "' || VarName || '" does not exist')
  523. end
  524. end
  525. LeftBit = LeftBit || VarContents
  526. VarPos = pos(VarStart, RightBit)
  527. end
  528. return(LeftBit || RightBit)
  529.  
  530. _w32RegSetValue:
  531. if  w32RegSetValue(arg(1), arg(2), arg(3), arg(4)) then
  532. Die('Failed to set "' || arg(2) || '" in key "' || arg(1) || '"')
  533. return
  534.  
  535. MakeSureRequiredDllsAreAvailable:
  536. signal ON  SYNTAX  NAME SysIniMissing
  537. call rxfuncadd 'w32loadfuncs', 'w32util', 'w32loadfuncs'
  538. call w32loadfuncs
  539. return
  540.  
  541. SysIniMissing:
  542. Reason = ''
  543. signal ON  SYNTAX  NAME NoErrMsgCall
  544. Reason = RxFuncErrMsg()
  545.  
  546. NoErrMsgCall:
  547. CrLf = d2c(13) || d2c(10)
  548. if  Reason = '' then
  549. Die("Can't load W32UTIL.DLL.' || CrLf || 'If on WIN95 'C' runtime must be available!")
  550. else
  551. Die('Can''t load "W32UTIL.DLL" (' || Reason || ').' || CrLf || 'If on WIN95 'C' runtime probably needs installation!')
  552.  
  553. ExecuteRexx:
  554. interpret arg(1)
  555. return
  556.  
  557. FixPathExt: procedure expose LineNum ScriptLine
  558. PathExt = arg(1)
  559. do  while left(PathExt, 1) = ';'
  560. PathExt = substr(PathExt, 2)
  561. end
  562. do  while right(PathExt, 1) = ';'
  563. PathExt = left(PathExt, length(PathExt)-1)
  564. end
  565. Colon2 = ';' || ';'
  566. FixPos = pos(Colon2, PathExt)
  567. Colon2 = ';' || ';'
  568. do  while FixPos <> 0
  569. PathExt = left(PathExt, FixPos-1) || substr(PathExt, FixPos+1)
  570. FixPos = pos(Colon2, PathExt)
  571. end
  572. return(PathExt)
  573.  
  574. MakeAlias: procedure expose LineNum ScriptLine
  575. New  = ''
  576. From = arg(1)
  577. do  Index = 1 to length(From)
  578. ThisChar = substr(From, Index, 1)
  579. if  ThisChar == ' ' | datatype(ThisChar, 'A') then
  580. New = New || ThisChar
  581. end
  582. New = translate(space(New), '_', ' ')
  583. return(New)
  584.  
  585. ShowHeader:
  586. if  ShownHeader = 'N' then
  587. do
  588. say '[]------------------------------------[]'
  589. say '| REGIT.REX v' || PgmVersion || ', "Super" associate |'
  590. say '[]------------------------------------[]'
  591. say ''
  592. ShownHeader = 'Y'
  593. end
  594. return
  595.  
  596. ShowSyntax:
  597. call ShowHeader
  598. say 'SYNTAX'
  599. say '~~~~~~'
  600. say 'REGIT[.REX] RitFile[.RIT]'
  601. say ''
  602. say 'This program replaces Windows "ASSOC" and "FTYPE" commands with much more'
  603. say 'powerful facilities and creates other associations such as updating icons,'
  604. say 'descriptions and right click menus or extensions or file types. No registry'
  605. say 'knowledge is required.'
  606. return
  607.  
  608. GetEnv:
  609. return( value(arg(1),,'ENVIRONMENT') )
  610.  
  611. Die:
  612. ExitCode = SIGL
  613. if  LineNum.IncludeLvl <> '' then
  614. LineNum.IncludeLvl = '(' || LineNum.IncludeLvl || ')'
  615. say ''
  616. say 'ERROR' || LineNum.IncludeLvl || ': ' || arg(1) || d2c(7)
  617. call ExitingWithErrorCode ExitCode
  618.  
  619. CommonTrapHandler:
  620. FailingLine     = arg(1)
  621. TrapHeading     = 'BUG: ' || arg(2)
  622. TextDescription = arg(3)
  623. Text            = arg(4)
  624. parse source . . SourceFileName
  625. say copies('=+', 39)
  626. say TrapHeading
  627. say copies('~', length(TrapHeading))
  628. say substr(TextDescription, 1 , 16) || ': ' || Text
  629. say 'Failing Module  : ' || SourceFileName
  630. say 'Failing Line #  : ' || FailingLine
  631. say 'Failing Command : ' || strip(SourceLine(FailingLine))
  632. say 'Script Line #   : ' || LineNum.IncludeLvl
  633. say 'Script Line     : ' || ScriptLine
  634. say copies('=+', 39)
  635. call ExitingWithErrorCode FailingLine
  636.  
  637. RexxTrapUninitializedVariable:
  638. FatalLine = SIGL
  639. call CommonTrapHandler FatalLine, 'NoValue Abort!', 'Unknown Variable', condition('D')
  640.  
  641. RexxTrapSyntaxError:
  642. FatalLine = SIGL
  643. call CommonTrapHandler FatalLine, 'Syntax Error!', 'Reason', errortext(Rc)
  644.  
  645. ExitingWithErrorCode:
  646. call charout , d2c(7)
  647. call sleep 1
  648. address system 'pause'
  649. exit( arg(1) )
  650.