Annotation of gforth/glosgen.fs, revision 1.7
1.1 anton 1: \ Glossary generator.
2: \ Written in ANS Forth, requires FILES wordset.
1.2 anton 3:
4: \ This file is part of Gforth.
5:
1.7 ! anton 6: \ Copyright (C) 1995,1997,2000,2003,2007 Free Software Foundation, Inc.
1.1 anton 7: \ Copyright (c)1993 L.C. Benschop Eindhoven.
1.2 anton 8:
9: \ Gforth is free software; you can redistribute it and/or
10: \ modify it under the terms of the GNU General Public License
1.6 anton 11: \ as published by the Free Software Foundation, either version 3
1.2 anton 12: \ of the License, or (at your option) any later version.
13:
14: \ This program is distributed in the hope that it will be useful,
15: \ but WITHOUT ANY WARRANTY; without even the implied warranty of
16: \ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17: \ GNU General Public License for more details.
18:
19: \ You should have received a copy of the GNU General Public License
1.6 anton 20: \ along with this program. If not, see http://www.gnu.org/licenses/.
1.2 anton 21:
1.1 anton 22: decimal
23:
24: : \G postpone \ ; immediate
25: \G \G is an alias for \, so it is a comment till end-of-line, but
26: \G it has a special meaning for the Glossary Generator.
27:
28: \G \G comments should appear immediately above or below the definition of
29: \G the word it belongs to. The definition line should contain no more
30: \G than the definition, a stack comment and a \ comment after which
31: \G the wordset and pronounciation.
32: \G An isolated block of \G comments is placed at the beginning of the
33: \G glossary file.
34:
35: VARIABLE GLOSLIST
36: VARIABLE CURRENT-COMMENT
37: VARIABLE FIXLINE
38:
39: \ The Glossary entries in memory have the following form.
40: \ 1 cell: address of next entry, 1 cell: address of comment field
41: \ counted string: name counted string: stack picture
42: \ counted string: extra field counted string: pronunciation.
43:
44:
45: \G This command starts a fresh glossary.
46: : NEWGLOS
47: \ S" FORGET GSTART CREATE GSTART" EVALUATE
48: 0 GLOSLIST ! ;
49:
50: CREATE OLDLINE 256 CHARS ALLOT
51:
52: VARIABLE CHARPTR
53:
54:
55: \G Insert the header into the list at the alphabetically correct place.
56: : INSERT-HEADER ( addr ---)
57: CHARPTR !
58: GLOSLIST
59: BEGIN
60: DUP @
61: IF
62: DUP @ 2 CELLS + COUNT CHARPTR @ 2 CELLS + COUNT COMPARE 0<=
63: ELSE
64: 0
65: THEN
66: WHILE
67: @
68: REPEAT
69: DUP @ CHARPTR @ ! CHARPTR @ SWAP !
70: ;
71:
72: \G Scan a word on oldline through pointer charptr
73: : SCAN-WORD ( ---- addr len)
74: BEGIN
75: CHARPTR @ OLDLINE - OLDLINE C@ <= CHARPTR @ C@ BL = AND
76: WHILE
77: 1 CHARS CHARPTR +!
78: REPEAT
79: CHARPTR @ 0
80: BEGIN
81: CHARPTR @ OLDLINE - OLDLINE C@ <= CHARPTR @ C@ BL <> AND
82: WHILE
83: 1 CHARS CHARPTR +! 1+
84: REPEAT
85: ;
86:
87: : SEARCH-NAME
88: SCAN-WORD 2DROP
89: SCAN-WORD 2DUP BOUNDS ?DO
90: I C@ [CHAR] a [CHAR] { WITHIN IF I C@ 32 - I C! THEN
91: LOOP \ translate to caps.
92: DUP HERE C! HERE CHAR+ SWAP DUP 1+ CHARS ALLOT CMOVE
93: ;
94:
95: : SEARCH-STACK
96: 0 C,
97: SCAN-WORD S" (" COMPARE 0= IF
98: HERE 1 CHARS -
99: BEGIN
100: CHARPTR @ OLDLINE - OLDLINE C@ <= CHARPTR @ C@ [CHAR] ) <> AND
101: WHILE
102: CHARPTR @ C@ C,
103: DUP C@ 1+ OVER C!
104: 1 CHARS CHARPTR +!
105: REPEAT
106: DROP
107: THEN
108: ;
109:
110: : SEARCH-SETS
111: 0 C,
112: ;
113:
114: : SEARCH-PRON
115: 0 C,
116: ;
117:
118: \G Process the header information stored in OLDLINE
119: : PROCESS-HEADER
120: HERE 0 , CURRENT-COMMENT @ ,
121: OLDLINE CHARPTR !
122: SEARCH-NAME
123: SEARCH-STACK
124: SEARCH-SETS
125: SEARCH-PRON
126: INSERT-HEADER
127: ;
128:
129: \G Determine if line at HERE is glossary comment, if so.
130: \G allot it, else store into oldline.
131: : GLOS-COMMENT? ( --- flag)
132: HERE C@ 1 > HERE CHAR+ 2 S" \G" COMPARE 0= AND
133: IF
134: HERE C@ 1+ CHARS ALLOT 1 \G incorporate current line.
135: ELSE
136: FIXLINE @ 0=
137: IF
138: HERE OLDLINE HERE C@ 1+ CHARS CMOVE
139: THEN 0
140: THEN
141: ;
142:
143: \G Read lines from the file fid until \G line encountered.
144: \G Collect all adjacent \G lines and find header line.
145: \G then insert entry into list flag=0 if no entry found.
146: : MAKE-GLOSENTRY ( fid --- fid flag)
147: >R
148: HERE CURRENT-COMMENT !
149: 0 FIXLINE ! 0 OLDLINE C!
150: BEGIN
151: HERE CHAR+ 255 R@ READ-LINE THROW 0= IF
152: DROP R> 0 EXIT \ end of file.
153: THEN
154: HERE C! \ Store length at here.
155: GLOS-COMMENT?
156: UNTIL
157: OLDLINE COUNT -TRAILING NIP IF 1 FIXLINE ! THEN
158: BEGIN
159: HERE CHAR+ 255 R@ READ-LINE THROW
160: IF
161: HERE C!
162: GLOS-COMMENT?
163: ELSE
164: DROP 0
165: THEN
166: 0= UNTIL
167: R> 1
168: 0 C, ALIGN \ allocate end flag after included comment lines.
169: PROCESS-HEADER
170: ;
171:
172: \G This command reads a source file and builds glossary info
173: \G for it in memory.
174: : MAKEGLOS ( "name")
175: BL WORD COUNT R/O OPEN-FILE THROW
176: BEGIN
177: MAKE-GLOSENTRY
178: 0= UNTIL
179: CLOSE-FILE THROW
180: ;
181:
182: \G Build header line for glossary entry.
183: : BUILD-HLINE ( addr ---)
184: 79 OLDLINE C! \ Line will be 79 chars long.
185: OLDLINE CHAR+ 79 BL FILL
186: 2 CELLS +
187: COUNT 2DUP OLDLINE CHAR+ SWAP CMOVE \ place name
188: DUP >R \ save name length.
189: CHARS +
190: COUNT 2DUP OLDLINE R> 3 + CHARS + SWAP CMOVE \ move stack diagram.
191: CHARS +
192: COUNT 2DUP OLDLINE 45 CHARS + SWAP CMOVE \ move wordsets field.
193: CHARS +
194: COUNT OLDLINE 63 CHARS + SWAP CMOVE \ move pronunciation field.
195: ;
196:
197: \G write the glossary entry at address addr to file fid.
198: : WRITE-GLOSENTRY ( addr fid --- )
199: >R
200: DUP 2 CELLS + C@
201: IF
202: DUP BUILD-HLINE
203: OLDLINE CHAR+ OLDLINE C@ R@ WRITE-LINE THROW \ write header line.
204: THEN
205: CELL+ @
206: BEGIN
207: DUP C@ 1 >
208: WHILE \ write all comment lines without prefixing \G.
209: DUP 4 CHARS + OVER C@ 3 - 0 MAX R@ WRITE-LINE THROW
210: COUNT CHARS +
211: REPEAT DROP
212: HERE 0 R> WRITE-LINE THROW \ Write final empty line.
213: ;
214:
215:
216: \G This command writes the glossary info from memory to a file.
217: \G The glossary info may be collected from more source files.
218: : WRITEGLOS ( "name")
219: BL WORD COUNT W/O CREATE-FILE THROW
220: GLOSLIST
221: BEGIN
222: @ DUP
223: WHILE
224: 2DUP SWAP WRITE-GLOSENTRY
225: REPEAT DROP
226: CLOSE-FILE THROW
227: ;
228:
229: \G A typical glossary session may look like:
230: \G NEWGLOS MAKEGLOS SOURCE1.FS MAKEGLOS SOURCE2.FS WRITEGLOS GLOS.GLO
231:
232:
233: CREATE GSTART
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to glosgen.fs CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [gforth] / gforth