Annotation of gforth/ds2texi.fs, revision 1.13
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]
1.13 ! pazsan 29: warnings off
! 30: require extend.fs
! 31: require search-order.fs
! 32: require glocals.fs
! 33: require float.fs
! 34: require struct.fs
! 35: require debugging.fs
1.2 pazsan 36: [THEN]
37:
1.1 anton 38: wordlist constant documentation
39:
40: struct
41: 2 cells: field doc-name
42: 2 cells: field doc-stack-effect
43: 2 cells: field doc-wordset
44: 2 cells: field doc-pronounciation
45: 2 cells: field doc-description
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.8 anton 63: : replace-_ ( c-addr u -- )
64: \ replaces _ with -
65: chars bounds
66: +DO
67: i c@ [char] _ =
68: if
69: [char] - i c!
70: endif
71: 1 chars
72: +loop ;
73:
74: : condition-stack-effect ( c-addr1 u1 -- c-addr2 u2 )
1.10 anton 75: save-mem 2dup replace-_ ;
1.8 anton 76:
77: : condition-wordset ( c-addr1 u1 -- c-addr2 u2 )
78: dup 0=
79: if
80: 2drop s" unknown"
81: else
1.10 anton 82: save-mem
1.8 anton 83: endif ;
84:
85: : condition-pronounciation ( c-addr1 u1 -- c-addr2 u2 )
1.10 anton 86: save-mem 2dup replace-_ ;
1.8 anton 87:
1.4 anton 88: : make-doc ( -- )
89: get-current documentation set-current
90: create
91: last @ name>string 2, \ name
1.10 anton 92: [char] ) parse save-mem 2, \ stack-effect
1.8 anton 93: bl parse-word condition-wordset 2, \ wordset
1.4 anton 94: bl parse-word dup \ pronounciation
95: if
1.8 anton 96: condition-pronounciation
1.4 anton 97: else
98: 2drop last @ name>string
99: endif
100: 2,
1.10 anton 101: get-description save-mem 2,
1.4 anton 102: set-current ;
103:
1.1 anton 104: : emittexi ( c -- )
105: >r
106: s" @{}" r@ scan 0<>
107: if
108: [char] @ emit
109: endif
110: drop r> emit ;
111:
112: : typetexi ( addr u -- )
113: 0
114: ?do
115: dup c@ emittexi
116: char+
117: loop
118: drop ;
119:
120: : print-short ( doc-entry -- )
1.7 anton 121: >r
122: ." @findex "
123: r@ doc-name 2@ typetexi
124: ." @var{ " r@ doc-stack-effect 2@ type ." } "
125: r@ doc-wordset 2@ type
126: cr
1.12 anton 127: ." @cindex "
128: ." @code{" r@ doc-name 2@ typetexi ." }"
129: cr
1.7 anton 130: ." @format" cr
1.1 anton 131: ." @code{" r@ doc-name 2@ typetexi ." } "
132: ." @i{" r@ doc-stack-effect 2@ type ." } "
133: r@ doc-wordset 2@ type ." ``"
1.3 anton 134: r@ doc-pronounciation 2@ type ." ''" cr ." @end format" cr
1.1 anton 135: rdrop ;
136:
137: : print-doc ( doc-entry -- )
138: >r
139: r@ print-short
140: r@ doc-description 2@ dup 0<>
141: if
1.7 anton 142: ." @iftex" cr ." @vskip-3ex" cr ." @end iftex" cr
143: type cr cr \ ." @ifinfo" cr ." @*" cr ." @end ifinfo" cr cr
1.1 anton 144: else
145: 2drop cr
146: endif
147: rdrop ;
148:
149: : do-doc ( addr1 u1 addr2 u2 xt -- f )
150: \ xt is the word to be executed if addr1 u1 is a string starting
151: \ with the prefix addr2 u2 and continuing with a word in the
152: \ wordlist `documentation'. f is true if xt is executed.
153: >r dup >r
154: 3 pick over compare 0=
155: if \ addr2 u2 is a prefix of addr1 u1
156: r> /string documentation search-wordlist
157: if \ the rest of addr1 u1 is in documentation
158: execute r> execute true
159: else
160: rdrop false
161: endif
162: else
163: 2drop 2rdrop false
164: endif ;
165:
166: : process-line ( addr u -- )
167: 2dup s" doc-" ['] print-doc do-doc 0=
168: if
169: 2dup s" short-" ['] print-short do-doc 0=
170: if
171: type cr EXIT
172: endif
173: endif
174: 2drop ;
175:
176: 1024 constant doclinelength
177:
178: create docline doclinelength chars allot
179:
180: : ds2texi ( file-id -- )
181: >r
182: begin
183: docline doclinelength r@ read-line throw
184: while
185: dup doclinelength = abort" docline too long"
186: docline swap process-line
187: repeat
188: drop rdrop ;
1.2 pazsan 189:
1.8 anton 190: : compare-ci ( addr1 u1 addr2 u2 -- n )
191: \ case insensitive string compare
192: 2 pick swap -
193: ?dup-0=-if
194: capscomp
195: else
196: nip nip nip
197: 0<
198: if
199: -1
200: else
201: 1
202: endif
203: endif ;
204:
205: : answord ( "name wordset pronounciation" -- )
206: \ check the documentaion of an ans word
207: name { D: wordname }
208: name { D: wordset }
209: name { D: pronounciation }
210: wordname documentation search-wordlist
211: if
212: execute { doc }
213: wordset doc doc-wordset 2@ compare-ci
214: if
215: ." wordset: " wordname type ." : '" doc doc-wordset 2@ type ." ' instead of '" wordset type ." '" cr
216: endif
217: pronounciation doc doc-pronounciation 2@ compare-ci
218: if
219: ." pronounciation: " wordname type ." : '" doc doc-pronounciation 2@ type ." ' instead of '" pronounciation type ." '" cr
220: endif
221: else
222: ." undocumented: " wordname type cr
223: endif ;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to ds2texi.fs CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [gforth] / gforth