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