File:
[gforth] /
gforth /
ds2texi.fs
Revision
1.34:
download - view:
text,
annotated -
select for diffs
Tue Jul 15 16:11:49 2008 UTC (15 years, 8 months ago) by
anton
Branches:
MAIN
CVS tags:
v0-7-0,
HEAD
updated copyright years
updated copyright-blacklist (added libltdl)
updated distributed files (don't distribute files without distribution terms)
added copyright to preforth.in and build-ec.in
1: \ documentation source to texi format converter
2:
3: \ Copyright (C) 1995,1996,1997,1998,1999,2003,2005,2007,2008 Free Software Foundation, Inc.
4:
5: \ This file is part of Gforth.
6:
7: \ Gforth is free software; you can redistribute it and/or
8: \ modify it under the terms of the GNU General Public License
9: \ as published by the Free Software Foundation, either version 3
10: \ of the License, or (at your option) any later version.
11:
12: \ This program is distributed in the hope that it will be useful,
13: \ but WITHOUT ANY WARRANTY; without even the implied warranty of
14: \ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15: \ GNU General Public License for more details.
16:
17: \ You should have received a copy of the GNU General Public License
18: \ along with this program. If not, see http://www.gnu.org/licenses/.
19:
20: \ documentation source can contain lines in the form `doc-word' and
21: \ `short-word'. These are converted to appropriate full or short
22: \ (without the description) glossary entries for word.
23:
24: \ The glossary entries are generated from data present in the wordlist
25: \ `documentation'. Each word resides there under its own name.
26:
27: script? [IF]
28: warnings off
29: [THEN]
30:
31: wordlist constant documentation
32:
33: struct
34: cell% 2* field doc-name
35: cell% 2* field doc-stack-effect
36: cell% 2* field doc-wordset
37: cell% 2* field doc-pronounciation
38: cell% 2* field doc-description
39: end-struct doc-entry
40:
41: create description-buffer 4096 chars allot
42:
43: : get-description ( -- addr u )
44: description-buffer
45: begin
46: refill
47: while
48: source nip
49: while
50: source swap >r 2dup r> -rot cmove
51: chars +
52: #lf over c! char+
53: repeat then
54: description-buffer tuck - ;
55:
56: : skip-prefix ( c-addr1 u1 -- c-addr2 u2 )
57: 2dup s" --" string-prefix?
58: IF
59: [char] - skip [char] - scan 1 /string
60: THEN ;
61:
62: : replace-_ ( c-addr u -- )
63: \ replaces _ with -
64: chars bounds
65: +DO
66: i c@ [char] _ =
67: if
68: [char] - i c!
69: endif
70: 1 chars
71: +loop ;
72:
73: : condition-stack-effect ( c-addr1 u1 -- c-addr2 u2 )
74: save-mem 2dup replace-_ ;
75:
76: : condition-wordset ( c-addr1 u1 -- c-addr2 u2 )
77: dup 0=
78: if
79: 2drop s" unknown"
80: else
81: save-mem
82: endif ;
83:
84: : condition-pronounciation ( c-addr1 u1 -- c-addr2 u2 )
85: save-mem 2dup replace-_ ;
86:
87: : make-doc ( -- )
88: get-current documentation set-current
89: create
90: latest name>string skip-prefix 2, \ name
91: [char] ) parse save-mem 2, \ stack-effect
92: bl sword condition-wordset 2, \ wordset
93: bl sword dup \ pronounciation
94: if
95: condition-pronounciation
96: else
97: 2drop latest name>string skip-prefix
98: endif
99: 2,
100: get-description save-mem 2,
101: set-current ;
102:
103: : emittexi ( c -- )
104: >r
105: s" @{}" r@ scan 0<>
106: if
107: [char] @ emit
108: endif
109: drop r> emit ;
110:
111: : typetexi ( addr u -- )
112: 0
113: ?do
114: dup c@ emittexi
115: char+
116: loop
117: drop ;
118:
119: : print-short ( doc-entry -- )
120: >r
121: ." @findex "
122: r@ doc-name 2@ typetexi
123: ." @var{ " r@ doc-stack-effect 2@ type ." } "
124: r@ doc-wordset 2@ type
125: cr
126: ." @cindex "
127: ." @code{" r@ doc-name 2@ typetexi ." }"
128: cr
129: r@ doc-name 2@ drop c@ [char] : <> if
130: \ cut out words starting with :, info-lookup cannot handle them
131: \ !! deal with : by replacing it here and in info-lookup?
132: ." @kindex "
133: r@ doc-name 2@ typetexi
134: cr
135: endif
136: ." @format" cr
137: ." @code{" r@ doc-name 2@ typetexi ." } "
138: ." @i{" r@ doc-stack-effect 2@ type ." } "
139: r@ doc-wordset 2@ type ." ``"
140: r@ doc-pronounciation 2@ type ." ''" cr ." @end format" cr
141: rdrop ;
142:
143: : print-doc ( doc-entry -- )
144: >r
145: r@ print-short
146: r@ doc-description 2@ dup 0<>
147: if
148: \ ." @iftex" cr ." @vskip-0ex" cr ." @end iftex" cr
149: type cr cr
150: \ ." @ifinfo" cr ." @*" cr ." @end ifinfo" cr cr
151: else
152: 2drop cr
153: endif
154: rdrop ;
155:
156: : do-doc ( addr1 u1 addr2 u2 xt -- f )
157: \ xt is the word to be executed if addr1 u1 is a string starting
158: \ with the prefix addr2 u2 and continuing with a word in the
159: \ wordlist `documentation'. f is true if xt is executed.
160: >r dup >r
161: 3 pick over str=
162: if \ addr2 u2 is a prefix of addr1 u1
163: r> /string -trailing documentation search-wordlist
164: if \ the rest of addr1 u1 is in documentation
165: execute r> execute true
166: else
167: rdrop false
168: endif
169: else
170: 2drop 2rdrop false
171: endif ;
172:
173: : process-line ( addr u -- )
174: 2dup s" doc-" ['] print-doc do-doc 0=
175: if
176: 2dup s" short-" ['] print-short do-doc 0=
177: if
178: type cr EXIT
179: endif
180: endif
181: 2drop ;
182:
183: 1024 constant doclinelength
184:
185: create docline doclinelength chars allot
186:
187: : ds2texi ( file-id -- )
188: >r
189: begin
190: docline doclinelength r@ read-line throw
191: while
192: dup doclinelength = abort" docline too long"
193: docline swap process-line
194: repeat
195: drop rdrop ;
196:
197: : compare-ci ( addr1 u1 addr2 u2 -- n )
198: \ case insensitive string compare
199: \ !! works correctly only for comparing for equality
200: 2 pick swap -
201: ?dup-0=-if
202: capscomp
203: else
204: nip nip nip
205: 0<
206: if
207: -1
208: else
209: 1
210: endif
211: endif ;
212:
213: : answord ( "name wordset pronounciation" -- )
214: \ check the documentaion of an ans word
215: name { D: wordname }
216: name { D: wordset }
217: name { D: pronounciation }
218: wordname documentation search-wordlist
219: if
220: execute { doc }
221: wordset doc doc-wordset 2@ compare-ci
222: if
223: ." wordset: " wordname type ." : '" doc doc-wordset 2@ type ." ' instead of '" wordset type ." '" cr
224: endif
225: pronounciation doc doc-pronounciation 2@ compare-ci
226: if
227: ." pronounciation: " wordname type ." : '" doc doc-pronounciation 2@ type ." ' instead of '" pronounciation type ." '" cr
228: endif
229: else
230: ." undocumented: " wordname type cr
231: endif ;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>