1. 0 [IF]

1. 0 [IF]

3. 
4.    Main contributors:
5.       Brad Eckert       brad1NO@SPAMtinyboot.com            Original author

3. 
4.    Main contributors:
5.       Brad Eckert       brad1NO@SPAMtinyboot.com            Original author

7.       Dirk Busch         dirkNO@SPAMschneider-busch.de      Added some features
8. 

7.       Dirk Busch         dirkNO@SPAMschneider-busch.de      Added some features
8. 

10. 

10. 

13.    standard words. Hyperlinks to user definitions are included.
14. 

16.    standard words. Hyperlinks to user definitions are included.
17. 

16.                            Output file is Filename with .HTM extension.

19.                            Output file is Filename with .HTM extension.

18. 
19.    Keep in mind that whatever path you use for the input filename will be in the

21. 
22.    Keep in mind that whatever path you use for the input filename will be in the

21.    distribution on CD or a web site.
22. 

24.    distribution on CD or a web site.
25. 

28.    Q is for debugging. You can use "linenum ?" to show the line number if an

26.    Q is for debugging. You can use "linenum ?" to show the line number if an

30.    all the links, color changes and whitespace.
31. 

28.    all the links, color changes and whitespace.
29. 

33.    it is skipped. Otherwise it is nested.
34. 
35.    When you INCLUDE this file some redefinition complaints may occur. That's
36.    okay since you won't be loading an application on top of this. You can make
37.    a text version of this file by cut-and-paste to a text editor. The browser's
38.    save-as-text function will work too. This file is only 80 columns wide. Note
39.    that the browser may wrap after 80 columns when saving as a text file.
40. 
41.    Users of specific Forths can extend the hyperlink table to point to anchors
42.    in a glossary for that particular Forth.
43. 
44.    This code has been tested under Win32forth, SwiftForth, VFX and Gforth.
45. 

31.    it is skipped. Otherwise it is nested.
32. 
33.    When you INCLUDE this file some redefinition complaints may occur. That's
34.    okay since you won't be loading an application on top of this. You can make
35.    a text version of this file by cut-and-paste to a text editor. The browser's
36.    save-as-text function will work too. This file is only 80 columns wide. Note
37.    that the browser may wrap after 80 columns when saving as a text file.
38. 
39.    Users of specific Forths can extend the hyperlink table to point to anchors
40.    in a glossary for that particular Forth.
41. 
42.    This code has been tested under Win32forth, SwiftForth, VFX and Gforth.
43. 

47. [THEN]
48. 
49. ONLY FORTH ALSO DEFINITIONS
50. \ ------------------------------------------------------------------------------

45. [THEN]
46. 
47. ONLY FORTH ALSO DEFINITIONS
48. \ ------------------------------------------------------------------------------

54. 1 VALUE nestable                                  \ T if INCLUDE nested files

50. 1 VALUE nestable                                  \ T if INCLUDE nested files

61. \ ------------------------------------------------------------------------------
62. 
63. : undefined ( <name> -- f ) BL WORD FIND NIP 0= ;
64. undefined NOOP   [IF] : NOOP ;                                            [THEN]
65. undefined BOUNDS [IF] : BOUNDS OVER + SWAP ;                              [THEN]
66. undefined /STRING [IF] : /STRING TUCK - >R CHARS + R> ;                   [THEN]
67. undefined C+!    [IF] : C+! SWAP OVER C@ + SWAP C! ;                      [THEN]
68. undefined FDROP  [IF] : FDROP ;         ( no floating point? fake it )    [THEN]
69. undefined >FLOAT [IF] : >FLOAT DROP C@ [CHAR] 0 [CHAR] 9 1+ WITHIN ;      [THEN]
70. undefined SCAN   [IF] : SCAN            ( addr len char -- addr' len' )
71.    >R BEGIN DUP WHILE OVER C@ R@ <> WHILE 1 /STRING REPEAT THEN R> DROP ; [THEN]
72. undefined SKIP   [IF] : SKIP            ( addr len char -- addr' len' )
73.    >R BEGIN DUP WHILE OVER C@ R@ = WHILE 1 /STRING REPEAT THEN R> DROP ;  [THEN]
74. : +PLACE        ( addr len a -- ) 2DUP 2>R COUNT CHARS + SWAP MOVE 2R> C+! ;
75. : PLACE         ( addr len a -- ) 0 OVER C! +PLACE ;
76. : UPC           ( c -- C )  DUP [CHAR] a [CHAR] z 1+ WITHIN IF 32 - THEN ;

51. \ ------------------------------------------------------------------------------
52. 
53. : undefined ( <name> -- f ) BL WORD FIND NIP 0= ;
54. undefined NOOP   [IF] : NOOP ;                                            [THEN]
55. undefined BOUNDS [IF] : BOUNDS OVER + SWAP ;                              [THEN]
56. undefined /STRING [IF] : /STRING TUCK - >R CHARS + R> ;                   [THEN]
57. undefined C+!    [IF] : C+! SWAP OVER C@ + SWAP C! ;                      [THEN]
58. undefined FDROP  [IF] : FDROP ;         ( no floating point? fake it )    [THEN]
59. undefined >FLOAT [IF] : >FLOAT DROP C@ [CHAR] 0 [CHAR] 9 1+ WITHIN ;      [THEN]
60. undefined SCAN   [IF] : SCAN            ( addr len char -- addr' len' )
61.    >R BEGIN DUP WHILE OVER C@ R@ <> WHILE 1 /STRING REPEAT THEN R> DROP ; [THEN]
62. undefined SKIP   [IF] : SKIP            ( addr len char -- addr' len' )
63.    >R BEGIN DUP WHILE OVER C@ R@ = WHILE 1 /STRING REPEAT THEN R> DROP ;  [THEN]
64. : +PLACE        ( addr len a -- ) 2DUP 2>R COUNT CHARS + SWAP MOVE 2R> C+! ;
65. : PLACE         ( addr len a -- ) 0 OVER C! +PLACE ;
66. : UPC           ( c -- C )  DUP [CHAR] a [CHAR] z 1+ WITHIN IF 32 - THEN ;

77. 
78. 0 VALUE outf                                    \ output to file
79. 1 VALUE screen-only                             \ screen is for testing
80. : werr  ABORT" Error writing file" ;
81. : out   screen-only IF TYPE    ELSE outf WRITE-FILE werr THEN ;
82. : outln screen-only IF TYPE CR ELSE outf WRITE-LINE werr THEN ;
83. 
84. WORDLIST CONSTANT hyperlinks                    \ list of hyperlinks
85. WORDLIST CONSTANT superlinks                    \ hyperlinks that can't change
86. 

68. 
69. 0 VALUE outf                                    \ output to file
70. 1 VALUE screen-only                             \ screen is for testing
71. : werr  ABORT" Error writing file" ;
72. : out   screen-only IF TYPE    ELSE outf WRITE-FILE werr THEN ;
73. : outln screen-only IF TYPE CR ELSE outf WRITE-LINE werr THEN ;
74. 
75. WORDLIST CONSTANT hyperlinks                    \ list of hyperlinks
76. WORDLIST CONSTANT superlinks                    \ hyperlinks that can't change
77. 

87. VARIABLE attrib
88. : /a      ( -- )         attrib @ IF S" </a>" out THEN 0 attrib ! ;
89. : ,$      ( a len -- )   DUP C, BOUNDS ?DO I C@ C, LOOP ; \ text to dictionary
90. : ,|      ( <text> -- )  [CHAR] | WORD COUNT -TRAILING ,$ ;
91. : line    ( a line# -- ) 0 ?DO COUNT + LOOP COUNT out ;   \ output one string
92. : boiler  ( addr -- )    BEGIN COUNT DUP WHILE 2DUP + >R outln R> REPEAT 2DROP ;

83. VARIABLE attrib
84. : /a      ( -- )         attrib @ IF S" </a>" out THEN 0 attrib ! ;
85. : ,$      ( a len -- )   DUP C, BOUNDS ?DO I C@ C, LOOP ; \ text to dictionary
86. : ,|      ( <text> -- )  [CHAR] | WORD COUNT -TRAILING ,$ ;
87. : line    ( a line# -- ) 0 ?DO COUNT + LOOP COUNT out ;   \ output one string
88. : boiler  ( addr -- )    BEGIN COUNT DUP WHILE 2DUP + >R outln R> REPEAT 2DROP ;

95. : newline ( -- )         S" <br />" outln ;

89. : newline ( -- )         S" <br />" outln ;

97. 
98. CREATE misctext                                 \ various attribute strings
99.    ,| <a href="                                                         | \ 0

93. 
94. CREATE misctext                                 \ various attribute strings
95.    ,| <a href="                                                         | \ 0

118.    0 C,
119. 

102.    0 C,
103. 

122. 
123. : <href="       misctext 0 line ;

106. 
107. : <href="       misctext 0 line ;

124. : ">            misctext 2 line ;

109. : ">            misctext 2 line ;

125. 

146. 

182.    ,| <?xml version="1.0"?>                                                    |

148.    ,| <?xml version="1.0"?>                                                    |

198.    0 C,
199. 

150.    0 C,
151. 

203.    0 C,
204. 

154.    0 C,
155. 

216. 

158. 

223. 
224. \ In order to represent all ASCII chars as text, some puncuation needs to be

162. 
163. \ In order to represent all ASCII chars as text, some puncuation needs to be

226. 
227. VARIABLE bltally

165. 
166. VARIABLE bltally

230.    BOUNDS ?DO I C@ CASE
231.       [CHAR] & OF S" &"     out ENDOF
232.       [CHAR] < OF S" &lt;"      out ENDOF
233.       [CHAR] > OF S" &gt;"      out ENDOF
234.       [CHAR] " OF S" &quot;"    out ENDOF

169.    BOUNDS ?DO I C@ CASE
170.       [CHAR] & OF S" &"     out ENDOF
171.       [CHAR] < OF S" &lt;"      out ENDOF
172.       [CHAR] > OF S" &gt;"      out ENDOF
173.       [CHAR] " OF S" &quot;"    out ENDOF

237.                 1 bltally +!     ENDOF
238.       I 1 out   0 bltally !
239.    ENDCASE LOOP ;
240. 

176.                 1 bltally +!     ENDOF
177.       I 1 out   0 bltally !
178.    ENDCASE LOOP ;
179. 

242.    BOUNDS ?DO I C@ CASE
243.       [CHAR] & OF S" amp"       out ENDOF
244.       [CHAR] < OF S" lt"        out ENDOF
245.       [CHAR] > OF S" gt"        out ENDOF
246.       [CHAR] " OF S" quot"      out ENDOF
247.       [CHAR] + OF S" plus"      out ENDOF
248.       [CHAR] ! OF S" bang"      out ENDOF
249.       [CHAR] / OF S" slash"     out ENDOF
250.       [CHAR] \ OF S" backslash" out ENDOF
251.       [CHAR] ' OF S" apos"      out ENDOF
252.       [CHAR] = OF S" equal"     out ENDOF
253.       [CHAR] - OF S" dash"      out ENDOF
254.       [CHAR] @ OF S" at"        out ENDOF
255.       [CHAR] ; OF S" semi"      out ENDOF
256.       [CHAR] * OF S" star"      out ENDOF
257.       [CHAR] ? OF S" question"  out ENDOF
258.       [CHAR] ~ OF S" tilde"     out ENDOF
259.       [CHAR] # OF S" pound"     out ENDOF
260.       [CHAR] , OF S" comma"     out ENDOF
261.       [CHAR] $ OF S" dollar"    out ENDOF
262.       [CHAR] | OF S" bar"       out ENDOF
263.       [CHAR] [ OF S" ltbracket" out ENDOF
264.       [CHAR] ( OF S" ltparen"   out ENDOF
265.       [CHAR] { OF S" ltbrace"   out ENDOF
266.       [CHAR] ] OF S" rtbracket" out ENDOF
267.       [CHAR] ) OF S" rtparen"   out ENDOF
268.       [CHAR] } OF S" rtbrace"   out ENDOF

181.    BOUNDS ?DO I C@ CASE
182.       [CHAR] & OF S" amp"       out ENDOF
183.       [CHAR] < OF S" lt"        out ENDOF
184.       [CHAR] > OF S" gt"        out ENDOF
185.       [CHAR] " OF S" quot"      out ENDOF
186.       [CHAR] + OF S" plus"      out ENDOF
187.       [CHAR] ! OF S" bang"      out ENDOF
188.       [CHAR] / OF S" slash"     out ENDOF
189.       [CHAR] \ OF S" backslash" out ENDOF
190.       [CHAR] ' OF S" apos"      out ENDOF
191.       [CHAR] = OF S" equal"     out ENDOF
192.       [CHAR] - OF S" dash"      out ENDOF
193.       [CHAR] @ OF S" at"        out ENDOF
194.       [CHAR] ; OF S" semi"      out ENDOF
195.       [CHAR] * OF S" star"      out ENDOF
196.       [CHAR] ? OF S" question"  out ENDOF
197.       [CHAR] ~ OF S" tilde"     out ENDOF
198.       [CHAR] # OF S" pound"     out ENDOF
199.       [CHAR] , OF S" comma"     out ENDOF
200.       [CHAR] $ OF S" dollar"    out ENDOF
201.       [CHAR] | OF S" bar"       out ENDOF
202.       [CHAR] [ OF S" ltbracket" out ENDOF
203.       [CHAR] ( OF S" ltparen"   out ENDOF
204.       [CHAR] { OF S" ltbrace"   out ENDOF
205.       [CHAR] ] OF S" rtbracket" out ENDOF
206.       [CHAR] ) OF S" rtparen"   out ENDOF
207.       [CHAR] } OF S" rtbrace"   out ENDOF

269.       BL       OF S" _"         out ENDOF
270.       I 1 out
271.    ENDCASE LOOP ;
272. 

209.       BL       OF S" _"         out ENDOF
210.       I 1 out
211.    ENDCASE LOOP ;
212. 

277. 
278. : label ( addr len -- ) /a                      \ associate a label with a word

215. 
216. : label ( addr len -- ) /a                      \ associate a label with a word

280.    "> 1 attrib ! ;
281. 
282. \ Assuming this is running on a PC, we allocate enough storage that crashes from
283. \ string overflows can't happen.
284. 
285. CREATE inbuf 260 CHARS ALLOT                    \ current line from file
286. CREATE token 260 CHARS ALLOT                    \ last blank delimited string
287. CREATE XPAD  260 CHARS ALLOT                    \ temporary pad for word storage
288. CREATE EPAD  260 CHARS ALLOT                    \ temporary pad for evaluation
289. CREATE fn    260 CHARS ALLOT                    \ file name
290. CREATE fn1   260 CHARS ALLOT                    \ file name backup
291. CREATE fn2   260 CHARS ALLOT                    \ global file name
292. CREATE fn3   260 CHARS ALLOT                    \ index file name
293. CREATE "str" 260 CHARS ALLOT                    \ parsed string storage
294. CREATE uname 260 CHARS ALLOT                    \ : definition name
295. 0 VALUE inf
296. VARIABLE nufile                                 \ T if nesting a file
297. VARIABLE utype                                  \ type of defined word
298. VARIABLE hstate
299. VARIABLE linenum
300. VARIABLE special                                \ special action, 0=none
301. 

218.    "> 1 attrib ! ;
219. 
220. \ Assuming this is running on a PC, we allocate enough storage that crashes from
221. \ string overflows can't happen.
222. 
223. CREATE inbuf 260 CHARS ALLOT                    \ current line from file
224. CREATE token 260 CHARS ALLOT                    \ last blank delimited string
225. CREATE XPAD  260 CHARS ALLOT                    \ temporary pad for word storage
226. CREATE EPAD  260 CHARS ALLOT                    \ temporary pad for evaluation
227. CREATE fn    260 CHARS ALLOT                    \ file name
228. CREATE fn1   260 CHARS ALLOT                    \ file name backup
229. CREATE fn2   260 CHARS ALLOT                    \ global file name
230. CREATE fn3   260 CHARS ALLOT                    \ index file name
231. CREATE "str" 260 CHARS ALLOT                    \ parsed string storage
232. CREATE uname 260 CHARS ALLOT                    \ : definition name
233. 0 VALUE inf
234. VARIABLE nufile                                 \ T if nesting a file
235. VARIABLE utype                                  \ type of defined word
236. VARIABLE hstate
237. VARIABLE linenum
238. VARIABLE special                                \ special action, 0=none
239. 

303. 

241. 

306.    DOES> /a DUP >R  2 CELLS +

244.    DOES> /a DUP >R  2 CELLS +

311.    1 attrib !
312.    R> 2@ SWAP EXECUTE EXECUTE ;                 \ extra attributes
313. 

246.    1 attrib !
247.    R> 2@ SWAP EXECUTE EXECUTE ;                 \ extra attributes
248. 

316. 
317. : isnumber? ( addr len -- f )                   \ string converts to number?
318.    0 0 2SWAP >NUMBER NIP NIP NIP 0= ;
319. 
320. : hparse ( a len char -- a' len' )
321.    >R 2DUP R@ SKIP R> SCAN BL SCAN
322.    2SWAP 2 PICK - token +PLACE ;
323. 
324. : >XPAD ( -- ) token COUNT BL SKIP XPAD PLACE ; \ move to temporary pad
325. 
326. : hint  ( addr len -- )                         \ interpret one line...
327.    BEGIN
328.       0 token !  BL hparse token C@

251. 
252. : isnumber? ( addr len -- f )                   \ string converts to number?
253.    0 0 2SWAP >NUMBER NIP NIP NIP 0= ;
254. 
255. : hparse ( a len char -- a' len' )
256.    >R 2DUP R@ SKIP R> SCAN BL SCAN
257.    2SWAP 2 PICK - token +PLACE ;
258. 
259. : >XPAD ( -- ) token COUNT BL SKIP XPAD PLACE ; \ move to temporary pad
260. 
261. : hint  ( addr len -- )                         \ interpret one line...
262.    BEGIN
263.       0 token !  BL hparse token C@

330.       >XPAD XPAD COUNT superlinks SEARCH-WORDLIST 0=  \ fixed hyperlink?
331.       IF    XPAD COUNT hyperlinks SEARCH-WORDLIST \ got a hyperlink for this?
332.       ELSE  TRUE
333.       THEN
334.       IF DEPTH >R EXECUTE

265.       >XPAD XPAD COUNT superlinks SEARCH-WORDLIST 0=  \ fixed hyperlink?
266.       IF    XPAD COUNT hyperlinks SEARCH-WORDLIST \ got a hyperlink for this?
267.       ELSE  TRUE
268.       THEN
269.       IF DEPTH >R EXECUTE

336.       ELSE
337.          XPAD COUNT BASE @ 10 = IF
338.             >FLOAT IF FDROP numeric THEN        \ valid float or integer
339.          ELSE
340.             isnumber? IF numeric THEN
341.          THEN

271.       ELSE
272.          XPAD COUNT BASE @ 10 = IF
273.             >FLOAT IF FDROP numeric THEN        \ valid float or integer
274.          ELSE
275.             isnumber? IF numeric THEN
276.          THEN

343.    REPEAT 2DROP newline ;
344. 
345. : shortname   ( -- )
346.    fn COUNT 2DUP [CHAR] . SCAN NIP - EPAD PLACE ;
347. 
348. : ofn    ( -- addr len )                        \ output file name

278.    REPEAT 2DROP newline ;
279. 
280. : shortname   ( -- )
281.    fn COUNT 2DUP [CHAR] . SCAN NIP - EPAD PLACE ;
282. 
283. : ofn    ( -- addr len )                        \ output file name

353. 
354. : hcreate ( addr len -- )
355.    DUP 0= IF 2DROP S" fakename" THEN            \ in case the name is missing
356.    S" CREATE " EPAD PLACE  EPAD +PLACE
357.    GET-CURRENT >R hyperlinks SET-CURRENT
358.    EPAD COUNT EVALUATE    R> SET-CURRENT ;      \ create a hyperlink generator
359. 
360. \ The user defined words use the following data structure:
361. \ CELL   xt of coloring word
362. \ CELL   pointer to index                       \ /9/
363. \ STRING name of reference word
364. \ STRING name of file
365. 
366. \ An index is a list of all of the words that call a defined word. The master
367. \ index is a list of indexes.
368. 
369. variable index  0 index !                       \ index is a SLL of SLLs.
370. variable ulast  0 ulast !                       \ last compiled definition name
371. variable tally  0 tally !                       \ tally of defined words
372. 
373. \ Each index entry consists of a pointer to the previous index entry and a SLL.
374. \ The SLL (single linked list) starts out empty so upon creation it is 0.
375. 
376. \ index --> link_to_next
377. \           link_to_usedby_list <-- 'index
378. \           link to defined name structure
379. \           tally
380. 

285. 
286. : hcreate ( addr len -- )
287.    DUP 0= IF 2DROP S" fakename" THEN            \ in case the name is missing
288.    S" CREATE " EPAD PLACE  EPAD +PLACE
289.    GET-CURRENT >R hyperlinks SET-CURRENT
290.    EPAD COUNT EVALUATE    R> SET-CURRENT ;      \ create a hyperlink generator
291. 
292. \ The user defined words use the following data structure:
293. \ CELL   xt of coloring word
294. \ CELL   pointer to index                       \ /9/
295. \ STRING name of reference word
296. \ STRING name of file
297. 
298. \ An index is a list of all of the words that call a defined word. The master
299. \ index is a list of indexes.
300. 
301. variable index  0 index !                       \ index is a SLL of SLLs.
302. variable ulast  0 ulast !                       \ last compiled definition name
303. variable tally  0 tally !                       \ tally of defined words
304. 
305. \ Each index entry consists of a pointer to the previous index entry and a SLL.
306. \ The SLL (single linked list) starts out empty so upon creation it is 0.
307. 
308. \ index --> link_to_next
309. \           link_to_usedby_list <-- 'index
310. \           link to defined name structure
311. \           tally
312. 

388. : newindex ( -- 'index )                        \ add an index to the list
389.    HERE index @ , HERE SWAP 0 , index ! 0 ,     \ /9/
390.    1 tally +!  tally @ , ;
391. 
392. \ 'index -> link_to_next
393. \           link to usedby name structure
394. 
395. : newlink  ( 'index -- 'index )                 \ add a name to the index /9/
396.    dup @ @ ?dup if                              \ non-empty sublist?
397.       cell+ @ ulast @ = if exit then            \ duplicate entry
398.    then
399.    HERE OVER @ @ , ulast @ , OVER @ ! ;
400. 
401. variable indexing
402. 
403. : deflink ( addr -- )                           \ defined word makes hyperlink

313. : newindex ( -- 'index )                        \ add an index to the list
314.    HERE index @ , HERE SWAP 0 , index ! 0 ,     \ /9/
315.    1 tally +!  tally @ , ;
316. 
317. \ 'index -> link_to_next
318. \           link to usedby name structure
319. 
320. : newlink  ( 'index -- 'index )                 \ add a name to the index /9/
321.    dup @ @ ?dup if                              \ non-empty sublist?
322.       cell+ @ ulast @ = if exit then            \ duplicate entry
323.    then
324.    HERE OVER @ @ , ulast @ , OVER @ ! ;
325. 
326. variable indexing
327. 
328. : deflink ( addr -- )                           \ defined word makes hyperlink

405.    ulast @ IF newlink THEN CELL+                \ /9/ optional addition to index
406.    DUP COUNT + COUNT ofn COMPARE                \ in an external file?

330.    ulast @ IF newlink THEN CELL+                \ /9/ optional addition to index
331.    DUP COUNT + COUNT ofn COMPARE                \ in an external file?

411.    THEN

335.    THEN

413.    1 attrib ! ;
414. 

337.    1 attrib ! ;
338. 

429. : defx  ( a len xt -- a' len' )
430.    newindex >R

339. : defx  ( a len xt -- a' len' )
340.    newindex >R

432.    XPAD COUNT 2DUP hcreate R> HERE SWAP ,
433.    R@ CELL+ !                                   \ resolve link to definition name
434.    R> , ,$ ofn ,$                               \ rest of structure
435.    DOES> deflink ;
436. 

342.    XPAD COUNT 2DUP hcreate R> HERE SWAP ,
343.    R@ CELL+ !                                   \ resolve link to definition name
344.    R> , ,$ ofn ,$                               \ rest of structure
345.    DOES> deflink ;
346. 

438. : defdat ['] numeric   defx numeric   labelnow ;
439. : defvar ['] variables defx variables labelnow ;
440. : defusr ['] userwords defx userwords labelnow ;
441. : defval ['] values    defx values    labelnow ;
442. : defdef ['] userdefiner defx userdefiner labelnow ;
443. 
444. : hstate=0 ( -- )             0 hstate ! ;
445. : hstate=1 ( -- )             1 hstate ! ;
446. : spec=zero ( -- )            1 special ! ;
447. : NONE     ( -- )             0 special ! ;     \ plain word
448. : skip)  ( a len -- a' len' ) [CHAR] ) hparse ;
449. : skip}  ( a len -- a' len' ) [CHAR] } hparse ; \ /7/
450. : skipw  ( a len -- a' len' ) BL hparse ;
451. : skipc  ( a len -- a len )   hstate @ 0= IF numeric skipw THEN ;
452. : skip"  ( a len -- a' len' )                   \ copy string to "str"

348. : defdat ['] numeric   defx numeric   labelnow ;
349. : defvar ['] variables defx variables labelnow ;
350. : defusr ['] userwords defx userwords labelnow ;
351. : defval ['] values    defx values    labelnow ;
352. : defdef ['] userdefiner defx userdefiner labelnow ;
353. 
354. : hstate=0 ( -- )             0 hstate ! ;
355. : hstate=1 ( -- )             1 hstate ! ;
356. : spec=zero ( -- )            1 special ! ;
357. : NONE     ( -- )             0 special ! ;     \ plain word
358. : skip)  ( a len -- a' len' ) [CHAR] ) hparse ;
359. : skip}  ( a len -- a' len' ) [CHAR] } hparse ; \ /7/
360. : skipw  ( a len -- a' len' ) BL hparse ;
361. : skipc  ( a len -- a len )   hstate @ 0= IF numeric skipw THEN ;
362. : skip"  ( a len -- a' len' )                   \ copy string to "str"

454. 
455. \ ------------------------------------------------------------------------------
456. \ ":" definitions might be defining words, so they can't be assumed to be defusr
457. \ types. ":" makes a label and saves the name for later use by ";" which makes
458. \ a hyperlink or a hyperlink defining word.
459. 
460. :NONAME                                         \ normal : definition
461.    ulast @ if                                   \ ending a : definition?
462.       uname COUNT ['] userwords defx 2DROP  0 token !
463.    then
464. ; CONSTANT normal_def
465. 
466. :NONAME
467.    newindex >R
468.    uname COUNT 2DUP hcreate HERE ['] userwords , R@ CELL+ ! R> , ,$ ofn ,$
469.    DOES> deflink defdef
470. ; CONSTANT defining_def
471. 
472. \ ULAST points to a data structure containing the hyperlink to the word being
473. \ defined. It is used when building the index because it can't wait until ;
474. \ resolves the definition before requiring the hyperlink.
475. 
476. : defunk ( a len -- a' len' )                   \ starting unknown definition
477.    hstate=1  normal_def utype !                 \ save name of : definition

364. 
365. \ ------------------------------------------------------------------------------
366. \ ":" definitions might be defining words, so they can't be assumed to be defusr
367. \ types. ":" makes a label and saves the name for later use by ";" which makes
368. \ a hyperlink or a hyperlink defining word.
369. 
370. :NONAME                                         \ normal : definition
371.    ulast @ if                                   \ ending a : definition?
372.       uname COUNT ['] userwords defx 2DROP  0 token !
373.    then
374. ; CONSTANT normal_def
375. 
376. :NONAME
377.    newindex >R
378.    uname COUNT 2DUP hcreate HERE ['] userwords , R@ CELL+ ! R> , ,$ ofn ,$
379.    DOES> deflink defdef
380. ; CONSTANT defining_def
381. 
382. \ ULAST points to a data structure containing the hyperlink to the word being
383. \ defined. It is used when building the index because it can't wait until ;
384. \ resolves the definition before requiring the hyperlink.
385. 
386. : defunk ( a len -- a' len' )                   \ starting unknown definition
387.    hstate=1  normal_def utype !                 \ save name of : definition

480.    2DUP HERE ulast ! ['] NOOP , PAD , ,$ ofn ,$ \ save name of definition /9/
481.    uname PLACE ;
482. 
483. : resunk ( -- )                                 \ resolve unknown defined word

390.    2DUP HERE ulast ! ['] NOOP , PAD , ,$ ofn ,$ \ save name of definition /9/
391.    uname PLACE ;
392. 
393. : resunk ( -- )                                 \ resolve unknown defined word

485.    0 ulast ! ;                                  \ indexing off
486. 
487. : created ( -- ) hstate @
488.    IF   defining_def utype !                    \ make ; create a defining word
489.    ELSE defdat                                  \ not compiling
490.    THEN ;
491. 
492. \ ------------------------------------------------------------------------------
493. 

395.    0 ulast ! ;                                  \ indexing off
396. 
397. : created ( -- ) hstate @
398.    IF   defining_def utype !                    \ make ; create a defining word
399.    ELSE defdat                                  \ not compiling
400.    THEN ;
401. 
402. \ ------------------------------------------------------------------------------
403. 

504. : _incfil ( addr -- )                           \ trigger file nesting  /4/
505.    nestable 0= IF DROP EXIT THEN                \ don't nest files if disabled
506.    COUNT BL SKIP  2DUP R/O OPEN-FILE            \ can the file be opened?
507.    IF   DROP 2DROP                              \ no
508.    ELSE CLOSE-FILE DROP                         \ yes
509.         fn COUNT fn1 PLACE  fn PLACE 1 nufile !
510.    THEN ;
511. 
512. : incfile ( a len -- a' len' )                  \ include a file

404. : _incfil ( addr -- )                           \ trigger file nesting  /4/
405.    nestable 0= IF DROP EXIT THEN                \ don't nest files if disabled
406.    COUNT BL SKIP  2DUP R/O OPEN-FILE            \ can the file be opened?
407.    IF   DROP 2DROP                              \ no
408.    ELSE CLOSE-FILE DROP                         \ yes
409.         fn COUNT fn1 PLACE  fn PLACE 1 nufile !
410.    THEN ;
411. 
412. : incfile ( a len -- a' len' )                  \ include a file

514. 
515. : "incfil ( a len -- a' len' )                  \ include file from S" filename"
516.    skipw "str" _incfil ;
517. 
518. : hfill  ( -- len ior )                         \ read next line of file
519.    inbuf 256 BL FILL
520.    XPAD 256 inf READ-LINE ABORT" Error reading file"
521.    >R >R 0 XPAD R> BOUNDS                       ( idx . . )
522.    ?DO  I C@ 9 = IF 3 RSHIFT 1+ 3 LSHIFT        \ tab
523.         ELSE I C@ OVER 255 AND CHARS inbuf + C!
524.            1+ DUP 256 = IF CR ." Input line too long" THEN
525.         THEN
526.    LOOP R>
527.    1 linenum +! ;
528. 
529. \ OPEN and CLOSE input files
530. 
531. : open  ( -- ) CR ." Reading " fn COUNT TYPE ."  at line " linenum @ decimal .
532.    0 linenum !
533.    fn COUNT R/O OPEN-FILE ABORT" Error opening source file" TO inf ;
534. 
535. : close  ( -- ) CR ." closing " fn COUNT TYPE
536.    inf CLOSE-FILE ABORT" Error closing file" ;
537. 
538. : .title  ( addr len -- )                       \ output as title string
539.    BOUNDS ?DO I C@ BL = IF S" %20" out ELSE I 1 out THEN LOOP ;
540. 
541. \ OPEN and CLOSE output files
542. 
543. : ocreate ( addr len -- )
544.    W/O CREATE-FILE ABORT" Error creating file" TO outf ;
545. 
546. : oopen  ( -- )                                 \ create new output file
547.    ofn ocreate begin_header boiler              \ begin boilerplate

414. 
415. : "incfil ( a len -- a' len' )                  \ include file from S" filename"
416.    skipw "str" _incfil ;
417. 
418. : hfill  ( -- len ior )                         \ read next line of file
419.    inbuf 256 BL FILL
420.    XPAD 256 inf READ-LINE ABORT" Error reading file"
421.    >R >R 0 XPAD R> BOUNDS                       ( idx . . )
422.    ?DO  I C@ 9 = IF 3 RSHIFT 1+ 3 LSHIFT        \ tab
423.         ELSE I C@ OVER 255 AND CHARS inbuf + C!
424.            1+ DUP 256 = IF CR ." Input line too long" THEN
425.         THEN
426.    LOOP R>
427.    1 linenum +! ;
428. 
429. \ OPEN and CLOSE input files
430. 
431. : open  ( -- ) CR ." Reading " fn COUNT TYPE ."  at line " linenum @ decimal .
432.    0 linenum !
433.    fn COUNT R/O OPEN-FILE ABORT" Error opening source file" TO inf ;
434. 
435. : close  ( -- ) CR ." closing " fn COUNT TYPE
436.    inf CLOSE-FILE ABORT" Error closing file" ;
437. 
438. : .title  ( addr len -- )                       \ output as title string
439.    BOUNDS ?DO I C@ BL = IF S" %20" out ELSE I 1 out THEN LOOP ;
440. 
441. \ OPEN and CLOSE output files
442. 
443. : ocreate ( addr len -- )
444.    W/O CREATE-FILE ABORT" Error creating file" TO outf ;
445. 
446. : oopen  ( -- )                                 \ create new output file
447.    ofn ocreate begin_header boiler              \ begin boilerplate

550. 
551. : fclose  ( -- )
552.    outf CLOSE-FILE ABORT" Error closing file" ;
553. 
554. : new-output  ( -- )                            \ start a new output file /9/

451. 
452. : fclose  ( -- )
453.    outf CLOSE-FILE ABORT" Error closing file" ;
454. 
455. : new-output  ( -- )                            \ start a new output file /9/

556. 

457. 

558. 

459. 

588.    S" /basic-links/" hyperlinks SEARCH-WORDLIST
589.    IF   EXECUTE  THEN                           \ remove user hyperlinks
590.    GET-CURRENT >R hyperlinks SET-CURRENT        \ replace the fence
591.    S" MARKER /basic-links/" EVALUATE
592.    R> SET-CURRENT
593.    0 TO outf                                    \ no output file yet
594.    0 TO screen-only  0 nufile !  1 linenum !    \ force usage of file
595.    0 ulast ! 0 index ! 0 tally !                \ clear index
596.    0 indexing !
597.    BL WORD COUNT  2dup fn2 place                \ save global filename /9/
598.    fn PLACE shortname S" _i.htm" epad +place epad count fn3 place \ index name
599.    new-output                                   \ open input and output files
600.    -1 DUP >R outf >R                            \ file nest uses stacks
601.    hstate=0
602.    BEGIN
603.       BEGIN 0 special !                         \ process line
604.          nufile @                               \ nest a file?
605.          IF   inf outf
606.               new-output outf >R                \ open new files
607.               0 nufile !
608.          THEN hfill
609.       WHILE inbuf SWAP hint
610.       REPEAT DROP
611.       close fn1 COUNT fn PLACE                  \ restore file name
612.       DUP -1 <>
613.       IF   TO outf TO inf FALSE                 \ unnest files
614.       ELSE TRUE
615.       THEN
616.    UNTIL DROP
617.    BEGIN R> DUP -1 <>                           \ close all output files
618.    WHILE TO outf

461.    S" /basic-links/" hyperlinks SEARCH-WORDLIST
462.    IF   EXECUTE  THEN                           \ remove user hyperlinks
463.    GET-CURRENT >R hyperlinks SET-CURRENT        \ replace the fence
464.    S" MARKER /basic-links/" EVALUATE
465.    R> SET-CURRENT
466.    0 TO outf                                    \ no output file yet
467.    0 TO screen-only  0 nufile !  1 linenum !    \ force usage of file
468.    0 ulast ! 0 index ! 0 tally !                \ clear index
469.    0 indexing !
470.    BL WORD COUNT  2dup fn2 place                \ save global filename /9/
471.    fn PLACE shortname S" _i.htm" epad +place epad count fn3 place \ index name
472.    new-output                                   \ open input and output files
473.    -1 DUP >R outf >R                            \ file nest uses stacks
474.    hstate=0
475.    BEGIN
476.       BEGIN 0 special !                         \ process line
477.          nufile @                               \ nest a file?
478.          IF   inf outf
479.               new-output outf >R                \ open new files
480.               0 nufile !
481.          THEN hfill
482.       WHILE inbuf SWAP hint
483.       REPEAT DROP
484.       close fn1 COUNT fn PLACE                  \ restore file name
485.       DUP -1 <>
486.       IF   TO outf TO inf FALSE                 \ unnest files
487.       ELSE TRUE
488.       THEN
489.    UNTIL DROP
490.    BEGIN R> DUP -1 <>                           \ close all output files
491.    WHILE TO outf

620.          fclose

493.          fclose

623. 
624. : q  ( -- ) 1 TO screen-only                    \ single line test
625.    -1 WORD COUNT inbuf PLACE inbuf COUNT hint ;
626. 
627. \ 0 [IF] is often used as a comment. If it is used as a comment, scan the file
628. \ for a [THEN]. [THEN] must be on the next line or beyond.
629. 
630. CREATE terminator 16 CHARS ALLOT                \ multiline comment terminator
631. 
632. : multicomment ( a len searchstring -- a' len' )
633.    terminator PLACE

495. 
496. : q  ( -- ) 1 TO screen-only                    \ single line test
497.    -1 WORD COUNT inbuf PLACE inbuf COUNT hint ;
498. 
499. \ 0 [IF] is often used as a comment. If it is used as a comment, scan the file
500. \ for a [THEN]. [THEN] must be on the next line or beyond.
501. 
502. CREATE terminator 16 CHARS ALLOT                \ multiline comment terminator
503. 
504. : multicomment ( a len searchstring -- a' len' )
505.    terminator PLACE

636.    WHILE >R inbuf EPAD R@ MOVE
637.       EPAD R@ BOUNDS ?DO I C@ UPC I C! LOOP     \ uppercase for search
638.       EPAD R@ terminator COUNT SEARCH

508.    WHILE >R inbuf EPAD R@ MOVE
509.       EPAD R@ BOUNDS ?DO I C@ UPC I C! LOOP     \ uppercase for search
510.       EPAD R@ terminator COUNT SEARCH

641.            inbuf R> ROT /STRING

514.            inbuf R> ROT /STRING

644.       THEN

519.       THEN

646. 
647. : bigif  ( a len -- a len )  special @ 1 =
648.    IF S" [THEN]" multicomment THEN ;
649. 
650. \ =============================================================================
651. 
652. : _DEFINITIONS DEFINITIONS ;
653. \ : _order order ;  : _words words ; : _see see ;
654. 
655. superlinks SET-CURRENT \ These hyperlinks cannot be overridden.
656. 
657. \ The following words are not in the ANS standard but are very common.
658. : VOCABULARY    defusr ;
659. : DEFER         defusr ;
660. : INCLUDE       hstate @ 0= IF incfile THEN ;
661. : FLOAD         hstate @ 0= IF incfile THEN ;
662. : SYS-FLOAD     hstate @ 0= IF incfile THEN ;
663. : BINARY        2 BASE ! ;
664. : OCTAL         8 BASE ! ;
665. : 0             numeric spec=zero ;
666. : 1             numeric  ;
667. : -1            numeric  ;
668. : COMMENT:      S" COMMENT;" multicomment ;
669. : ((            S" ))"       multicomment ;
670. 
671. \ The following words are not in the ANS standard but are used in Win32Forth
672. : ANEW          skipw ;                    \ /7/
673. : CallBack:     defunk ;                   \ /7/
674. : :M            defunk ;                   \ /7/
675. : ;M            resunk ;                   \ /7/
676. : z"            numeric skip" ;
677. 
678. \ Forth Inc uses { for comment while others use it for locals. } on the same
679. \ line indicates locals, which are grayed. Otherwise a multiline comment.
680. 
681. : {             2DUP [CHAR] } SCAN NIP 0=

521. 
522. : bigif  ( a len -- a len )  special @ 1 =
523.    IF S" [THEN]" multicomment THEN ;
524. 
525. \ =============================================================================
526. 
527. : _DEFINITIONS DEFINITIONS ;
528. \ : _order order ;  : _words words ; : _see see ;
529. 
530. superlinks SET-CURRENT \ These hyperlinks cannot be overridden.
531. 
532. \ The following words are not in the ANS standard but are very common.
533. : VOCABULARY    defusr ;
534. : DEFER         defusr ;
535. : INCLUDE       hstate @ 0= IF incfile THEN ;
536. : FLOAD         hstate @ 0= IF incfile THEN ;
537. : SYS-FLOAD     hstate @ 0= IF incfile THEN ;
538. : BINARY        2 BASE ! ;
539. : OCTAL         8 BASE ! ;
540. : 0             numeric spec=zero ;
541. : 1             numeric  ;
542. : -1            numeric  ;
543. : COMMENT:      S" COMMENT;" multicomment ;
544. : ((            S" ))"       multicomment ;
545. 
546. \ The following words are not in the ANS standard but are used in Win32Forth
547. : ANEW          skipw ;                    \ /7/
548. : CallBack:     defunk ;                   \ /7/
549. : :M            defunk ;                   \ /7/
550. : ;M            resunk ;                   \ /7/
551. : z"            numeric skip" ;
552. 
553. \ Forth Inc uses { for comment while others use it for locals. } on the same
554. \ line indicates locals, which are grayed. Otherwise a multiline comment.
555. 
556. : {             2DUP [CHAR] } SCAN NIP 0=

683. 
684. \ The rest is ANS Forth standard
685. 

558. 
559. \ The rest is ANS Forth standard
560. 

687. 

562. 

718. 
719. hyperlinks SET-CURRENT \ These hyperlinks can be overridden.
720. 

593. 
594. hyperlinks SET-CURRENT \ These hyperlinks can be overridden.
595. 

1051. 
1052. _DEFINITIONS
1053. 
1054. \ Revision history
1055. \ 0. 1st release to guinea pigs via comp.lang.forth
1056. \ 1. (BNE) Added multi-line comment 0 [IF]. Colored CHAR outside definitions.
1057. \ 2. (EJB) Added missing definitions for common but nonstandard words
1058. \    and cleaned up to account for case sensitivity.
1059. \ 3. (EJB) Fixed up to create conforming XHTML 1.0 Strict
1060. \ 4. (BNE) File check before nesting, moved file names to the hyperlink table,
1061. \    added some option flags, cleared hyperlink list for each run. Added more
1062. \    multiline comment words. Expands tabs to spaces. Title uses %20 for blanks.
1063. \ 5. (BNE) Added multiline { comment. Replaced -1 WORD with [CHAR] |.
1064. \    Put hyperlinks that should not be overridden in a separate wordlist.
1065. \ 6. (BNE) Limited this text to 80 columns, cleaned up comments a bit. Added
1066. \    option for different color schemes.
1067. \ 7. (DBU) Added dpanspath to configure the path to the dpans-files. Added
1068. \    linksource to output a hyperlink to the original source file. Added
1069. \    some words used in Win32Forth. Added copyright to output a copyright text

926. 
927. _DEFINITIONS
928. 
929. \ Revision history
930. \ 0. 1st release to guinea pigs via comp.lang.forth
931. \ 1. (BNE) Added multi-line comment 0 [IF]. Colored CHAR outside definitions.
932. \ 2. (EJB) Added missing definitions for common but nonstandard words
933. \    and cleaned up to account for case sensitivity.
934. \ 3. (EJB) Fixed up to create conforming XHTML 1.0 Strict
935. \ 4. (BNE) File check before nesting, moved file names to the hyperlink table,
936. \    added some option flags, cleared hyperlink list for each run. Added more
937. \    multiline comment words. Expands tabs to spaces. Title uses %20 for blanks.
938. \ 5. (BNE) Added multiline { comment. Replaced -1 WORD with [CHAR] |.
939. \    Put hyperlinks that should not be overridden in a separate wordlist.
940. \ 6. (BNE) Limited this text to 80 columns, cleaned up comments a bit. Added
941. \    option for different color schemes.
942. \ 7. (DBU) Added dpanspath to configure the path to the dpans-files. Added
943. \    linksource to output a hyperlink to the original source file. Added
944. \    some words used in Win32Forth. Added copyright to output a copyright text

1071. \ 8. (BNE) Put in Dirk's link to source file in header. Changed ['] to be

946. \ 8. (BNE) Put in Dirk's link to source file in header. Changed ['] to be

1073. \ 9. (BNE) Added index creation, fixed UPC & minor file nesting bug.
1074. \ 10. (BNE) Fixed glass jaw in SKIP". S" etc crashed if nothing else was on the

948. \ 9. (BNE) Added index creation, fixed UPC & minor file nesting bug.
949. \ 10. (BNE) Fixed glass jaw in SKIP". S" etc crashed if nothing else was on the

1077. 

952.