Annotation of gforth/ds2texi.fs, revision 1.26
1.1 anton 1: \ documentation source to texi format converter
2:
1.23 anton 3: \ Copyright (C) 1995,1996,1997,1998,1999 Free Software Foundation, Inc.
1.9 anton 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
1.24 anton 19: \ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111, USA.
1.9 anton 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]
1.13 pazsan 29: warnings off
1.18 pazsan 30: require search.fs
1.13 pazsan 31: require extend.fs
32: require glocals.fs
33: require float.fs
34: require struct.fs
1.15 anton 35: require debugs.fs
1.2 pazsan 36: [THEN]
37:
1.1 anton 38: wordlist constant documentation
39:
40: struct
1.16 anton 41: cell% 2* field doc-name
42: cell% 2* field doc-stack-effect
43: cell% 2* field doc-wordset
44: cell% 2* field doc-pronounciation
45: cell% 2* field doc-description
1.1 anton 46: end-struct doc-entry
47:
1.4 anton 48: create description-buffer 4096 chars allot
49:
50: : get-description ( -- addr u )
51: description-buffer
52: begin
53: refill
54: while
55: source nip
56: while
57: source swap >r 2dup r> -rot cmove
58: chars +
59: #lf over c! char+
60: repeat then
61: description-buffer tuck - ;
62:
1.17 pazsan 63: : skip-prefix ( c-addr1 u1 -- c-addr2 u2 )
1.25 anton 64: 2dup s" --" string-prefix?
1.17 pazsan 65: IF
1.21 pazsan 66: [char] - skip [char] - scan 1 /string
1.17 pazsan 67: THEN ;
68:
1.8 anton 69: : replace-_ ( c-addr u -- )
70: \ replaces _ with -
71: chars bounds
72: +DO
73: i c@ [char] _ =
74: if
75: [char] - i c!
76: endif
77: 1 chars
78: +loop ;
79:
80: : condition-stack-effect ( c-addr1 u1 -- c-addr2 u2 )
1.10 anton 81: save-mem 2dup replace-_ ;
1.8 anton 82:
83: : condition-wordset ( c-addr1 u1 -- c-addr2 u2 )
84: dup 0=
85: if
86: 2drop s" unknown"
87: else
1.10 anton 88: save-mem
1.8 anton 89: endif ;
90:
91: : condition-pronounciation ( c-addr1 u1 -- c-addr2 u2 )
1.10 anton 92: save-mem 2dup replace-_ ;
1.8 anton 93:
1.4 anton 94: : make-doc ( -- )
95: get-current documentation set-current
96: create
1.17 pazsan 97: last @ name>string skip-prefix 2, \ name
1.10 anton 98: [char] ) parse save-mem 2, \ stack-effect
1.19 anton 99: bl sword condition-wordset 2, \ wordset
100: bl sword dup \ pronounciation
1.4 anton 101: if
1.8 anton 102: condition-pronounciation
1.4 anton 103: else
1.17 pazsan 104: 2drop last @ name>string skip-prefix
1.4 anton 105: endif
106: 2,
1.10 anton 107: get-description save-mem 2,
1.4 anton 108: set-current ;
109:
1.1 anton 110: : emittexi ( c -- )
111: >r
112: s" @{}" r@ scan 0<>
113: if
114: [char] @ emit
115: endif
116: drop r> emit ;
117:
118: : typetexi ( addr u -- )
119: 0
120: ?do
121: dup c@ emittexi
122: char+
123: loop
124: drop ;
125:
126: : print-short ( doc-entry -- )
1.7 anton 127: >r
128: ." @findex "
129: r@ doc-name 2@ typetexi
130: ." @var{ " r@ doc-stack-effect 2@ type ." } "
131: r@ doc-wordset 2@ type
132: cr
1.12 anton 133: ." @cindex "
134: ." @code{" r@ doc-name 2@ typetexi ." }"
135: cr
1.22 anton 136: r@ doc-name 2@ drop c@ [char] : <> if
137: \ cut out words starting with :, info-lookup cannot handle them
138: \ !! deal with : by replacing it here and in info-lookup?
139: ." @kindex "
140: r@ doc-name 2@ typetexi
141: cr
142: endif
1.7 anton 143: ." @format" cr
1.1 anton 144: ." @code{" r@ doc-name 2@ typetexi ." } "
145: ." @i{" r@ doc-stack-effect 2@ type ." } "
146: r@ doc-wordset 2@ type ." ``"
1.3 anton 147: r@ doc-pronounciation 2@ type ." ''" cr ." @end format" cr
1.1 anton 148: rdrop ;
149:
150: : print-doc ( doc-entry -- )
151: >r
152: r@ print-short
153: r@ doc-description 2@ dup 0<>
154: if
1.14 anton 155: \ ." @iftex" cr ." @vskip-0ex" cr ." @end iftex" cr
156: type cr cr
157: \ ." @ifinfo" cr ." @*" cr ." @end ifinfo" cr cr
1.1 anton 158: else
159: 2drop cr
160: endif
161: rdrop ;
162:
163: : do-doc ( addr1 u1 addr2 u2 xt -- f )
164: \ xt is the word to be executed if addr1 u1 is a string starting
165: \ with the prefix addr2 u2 and continuing with a word in the
166: \ wordlist `documentation'. f is true if xt is executed.
167: >r dup >r
1.25 anton 168: 3 pick over str=
1.1 anton 169: if \ addr2 u2 is a prefix of addr1 u1
170: r> /string documentation search-wordlist
171: if \ the rest of addr1 u1 is in documentation
172: execute r> execute true
173: else
174: rdrop false
175: endif
176: else
177: 2drop 2rdrop false
178: endif ;
179:
180: : process-line ( addr u -- )
181: 2dup s" doc-" ['] print-doc do-doc 0=
182: if
183: 2dup s" short-" ['] print-short do-doc 0=
184: if
185: type cr EXIT
186: endif
187: endif
188: 2drop ;
189:
190: 1024 constant doclinelength
191:
192: create docline doclinelength chars allot
193:
194: : ds2texi ( file-id -- )
195: >r
196: begin
197: docline doclinelength r@ read-line throw
198: while
199: dup doclinelength = abort" docline too long"
200: docline swap process-line
201: repeat
202: drop rdrop ;
1.2 pazsan 203:
1.8 anton 204: : compare-ci ( addr1 u1 addr2 u2 -- n )
205: \ case insensitive string compare
1.26 ! anton 206: \ !! works correctly only for comparing for equality
1.8 anton 207: 2 pick swap -
208: ?dup-0=-if
209: capscomp
210: else
211: nip nip nip
212: 0<
213: if
214: -1
215: else
216: 1
217: endif
218: endif ;
219:
220: : answord ( "name wordset pronounciation" -- )
221: \ check the documentaion of an ans word
222: name { D: wordname }
223: name { D: wordset }
224: name { D: pronounciation }
225: wordname documentation search-wordlist
226: if
227: execute { doc }
228: wordset doc doc-wordset 2@ compare-ci
229: if
230: ." wordset: " wordname type ." : '" doc doc-wordset 2@ type ." ' instead of '" wordset type ." '" cr
231: endif
232: pronounciation doc doc-pronounciation 2@ compare-ci
233: if
234: ." pronounciation: " wordname type ." : '" doc doc-pronounciation 2@ type ." ' instead of '" pronounciation type ." '" cr
235: endif
236: else
237: ." undocumented: " wordname type cr
238: endif ;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>