Annotation of gforth/ds2texi.fs, revision 1.11
1.1 anton 1: \ documentation source to texi format converter
2:
1.9 anton 3: \ Copyright (C) 1995 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 2
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, write to the Free Software
19: \ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
20:
1.1 anton 21: \ documentation source can contain lines in the form `doc-word' and
22: \ `short-word'. These are converted to appropriate full or short
23: \ (without the description) glossary entries for word.
24:
25: \ The glossary entries are generated from data present in the wordlist
26: \ `documentation'. Each word resides there under its own name.
27:
1.2 pazsan 28: script? [IF]
29: warnings off
1.7 anton 30: require search-order.fs
1.8 anton 31: require glocals.fs
1.7 anton 32: require float.fs
33: require struct.fs
34: require debugging.fs
1.2 pazsan 35: [THEN]
36:
1.1 anton 37: wordlist constant documentation
38:
39: struct
40: 2 cells: field doc-name
41: 2 cells: field doc-stack-effect
42: 2 cells: field doc-wordset
43: 2 cells: field doc-pronounciation
44: 2 cells: field doc-description
45: end-struct doc-entry
46:
1.4 anton 47: create description-buffer 4096 chars allot
48:
49: : get-description ( -- addr u )
50: description-buffer
51: begin
52: refill
53: while
54: source nip
55: while
56: source swap >r 2dup r> -rot cmove
57: chars +
58: #lf over c! char+
59: repeat then
60: description-buffer tuck - ;
61:
1.8 anton 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 )
1.10 anton 74: save-mem 2dup replace-_ ;
1.8 anton 75:
76: : condition-wordset ( c-addr1 u1 -- c-addr2 u2 )
77: dup 0=
78: if
79: 2drop s" unknown"
80: else
1.10 anton 81: save-mem
1.8 anton 82: endif ;
83:
84: : condition-pronounciation ( c-addr1 u1 -- c-addr2 u2 )
1.10 anton 85: save-mem 2dup replace-_ ;
1.8 anton 86:
1.4 anton 87: : make-doc ( -- )
88: get-current documentation set-current
89: create
90: last @ name>string 2, \ name
1.10 anton 91: [char] ) parse save-mem 2, \ stack-effect
1.8 anton 92: bl parse-word condition-wordset 2, \ wordset
1.4 anton 93: bl parse-word dup \ pronounciation
94: if
1.8 anton 95: condition-pronounciation
1.4 anton 96: else
97: 2drop last @ name>string
98: endif
99: 2,
1.10 anton 100: get-description save-mem 2,
1.4 anton 101: set-current ;
102:
1.1 anton 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 -- )
1.7 anton 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: ." @format" cr
1.1 anton 127: ." @code{" r@ doc-name 2@ typetexi ." } "
128: ." @i{" r@ doc-stack-effect 2@ type ." } "
129: r@ doc-wordset 2@ type ." ``"
1.3 anton 130: r@ doc-pronounciation 2@ type ." ''" cr ." @end format" cr
1.1 anton 131: rdrop ;
132:
133: : print-doc ( doc-entry -- )
134: >r
135: r@ print-short
136: r@ doc-description 2@ dup 0<>
137: if
1.7 anton 138: ." @iftex" cr ." @vskip-3ex" cr ." @end iftex" cr
139: type cr cr \ ." @ifinfo" cr ." @*" cr ." @end ifinfo" cr cr
1.1 anton 140: else
141: 2drop cr
142: endif
143: rdrop ;
144:
145: : do-doc ( addr1 u1 addr2 u2 xt -- f )
146: \ xt is the word to be executed if addr1 u1 is a string starting
147: \ with the prefix addr2 u2 and continuing with a word in the
148: \ wordlist `documentation'. f is true if xt is executed.
149: >r dup >r
150: 3 pick over compare 0=
151: if \ addr2 u2 is a prefix of addr1 u1
152: r> /string documentation search-wordlist
153: if \ the rest of addr1 u1 is in documentation
154: execute r> execute true
155: else
156: rdrop false
157: endif
158: else
159: 2drop 2rdrop false
160: endif ;
161:
162: : process-line ( addr u -- )
163: 2dup s" doc-" ['] print-doc do-doc 0=
164: if
165: 2dup s" short-" ['] print-short do-doc 0=
166: if
167: type cr EXIT
168: endif
169: endif
170: 2drop ;
171:
172: 1024 constant doclinelength
173:
174: create docline doclinelength chars allot
175:
176: : ds2texi ( file-id -- )
177: >r
178: begin
179: docline doclinelength r@ read-line throw
180: while
181: dup doclinelength = abort" docline too long"
182: docline swap process-line
183: repeat
184: drop rdrop ;
1.2 pazsan 185:
1.8 anton 186: : compare-ci ( addr1 u1 addr2 u2 -- n )
187: \ case insensitive string compare
188: 2 pick swap -
189: ?dup-0=-if
190: capscomp
191: else
192: nip nip nip
193: 0<
194: if
195: -1
196: else
197: 1
198: endif
199: endif ;
200:
201: : answord ( "name wordset pronounciation" -- )
202: \ check the documentaion of an ans word
203: name { D: wordname }
204: name { D: wordset }
205: name { D: pronounciation }
206: wordname documentation search-wordlist
207: if
208: execute { doc }
209: wordset doc doc-wordset 2@ compare-ci
210: if
211: ." wordset: " wordname type ." : '" doc doc-wordset 2@ type ." ' instead of '" wordset type ." '" cr
212: endif
213: pronounciation doc doc-pronounciation 2@ compare-ci
214: if
215: ." pronounciation: " wordname type ." : '" doc doc-pronounciation 2@ type ." ' instead of '" pronounciation type ." '" cr
216: endif
217: else
218: ." undocumented: " wordname type cr
219: endif ;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>