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