[gforth] / gforth / glosgen.fs  

gforth: gforth/glosgen.fs

1 : anton 1.1 \ Glossary generator.
2 :     \ Written in ANS Forth, requires FILES wordset.
3 : anton 1.2
4 :     \ This file is part of Gforth.
5 :    
6 : anton 1.5 \ Copyright (C) 1995,1997,2000,2003 Free Software Foundation, Inc.
7 : anton 1.1 \ Copyright (c)1993 L.C. Benschop Eindhoven.
8 : anton 1.2
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 : anton 1.3 \ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111, USA.
22 : anton 1.2
23 : anton 1.1 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
CVS Admin

Powered by ViewCVS 1.0-dev 		(Powered by ViewCVS)

ViewCVS and CVS Help