1: \ documentation source to texi format converter
2:
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:
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:
28: script? [IF]
29: warnings off
30: require extend.fs
31: require search.fs
32: require glocals.fs
33: require float.fs
34: require struct.fs
35: require debugs.fs
36: [THEN]
37:
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:
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:
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 )
75: save-mem 2dup replace-_ ;
76:
77: : condition-wordset ( c-addr1 u1 -- c-addr2 u2 )
78: dup 0=
79: if
80: 2drop s" unknown"
81: else
82: save-mem
83: endif ;
84:
85: : condition-pronounciation ( c-addr1 u1 -- c-addr2 u2 )
86: save-mem 2dup replace-_ ;
87:
88: : make-doc ( -- )
89: get-current documentation set-current
90: create
91: last @ name>string 2, \ name
92: [char] ) parse save-mem 2, \ stack-effect
93: bl parse-word condition-wordset 2, \ wordset
94: bl parse-word dup \ pronounciation
95: if
96: condition-pronounciation
97: else
98: 2drop last @ name>string
99: endif
100: 2,
101: get-description save-mem 2,
102: set-current ;
103:
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 -- )
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
127: ." @cindex "
128: ." @code{" r@ doc-name 2@ typetexi ." }"
129: cr
130: ." @format" cr
131: ." @code{" r@ doc-name 2@ typetexi ." } "
132: ." @i{" r@ doc-stack-effect 2@ type ." } "
133: r@ doc-wordset 2@ type ." ``"
134: r@ doc-pronounciation 2@ type ." ''" cr ." @end format" cr
135: rdrop ;
136:
137: : print-doc ( doc-entry -- )
138: >r
139: r@ print-short
140: r@ doc-description 2@ dup 0<>
141: if
142: \ ." @iftex" cr ." @vskip-0ex" cr ." @end iftex" cr
143: type cr cr
144: \ ." @ifinfo" cr ." @*" cr ." @end ifinfo" cr cr
145: else
146: 2drop cr
147: endif
148: rdrop ;
149:
150: : do-doc ( addr1 u1 addr2 u2 xt -- f )
151: \ xt is the word to be executed if addr1 u1 is a string starting
152: \ with the prefix addr2 u2 and continuing with a word in the
153: \ wordlist `documentation'. f is true if xt is executed.
154: >r dup >r
155: 3 pick over compare 0=
156: if \ addr2 u2 is a prefix of addr1 u1
157: r> /string documentation search-wordlist
158: if \ the rest of addr1 u1 is in documentation
159: execute r> execute true
160: else
161: rdrop false
162: endif
163: else
164: 2drop 2rdrop false
165: endif ;
166:
167: : process-line ( addr u -- )
168: 2dup s" doc-" ['] print-doc do-doc 0=
169: if
170: 2dup s" short-" ['] print-short do-doc 0=
171: if
172: type cr EXIT
173: endif
174: endif
175: 2drop ;
176:
177: 1024 constant doclinelength
178:
179: create docline doclinelength chars allot
180:
181: : ds2texi ( file-id -- )
182: >r
183: begin
184: docline doclinelength r@ read-line throw
185: while
186: dup doclinelength = abort" docline too long"
187: docline swap process-line
188: repeat
189: drop rdrop ;
190:
191: : compare-ci ( addr1 u1 addr2 u2 -- n )
192: \ case insensitive string compare
193: 2 pick swap -
194: ?dup-0=-if
195: capscomp
196: else
197: nip nip nip
198: 0<
199: if
200: -1
201: else
202: 1
203: endif
204: endif ;
205:
206: : answord ( "name wordset pronounciation" -- )
207: \ check the documentaion of an ans word
208: name { D: wordname }
209: name { D: wordset }
210: name { D: pronounciation }
211: wordname documentation search-wordlist
212: if
213: execute { doc }
214: wordset doc doc-wordset 2@ compare-ci
215: if
216: ." wordset: " wordname type ." : '" doc doc-wordset 2@ type ." ' instead of '" wordset type ." '" cr
217: endif
218: pronounciation doc doc-pronounciation 2@ compare-ci
219: if
220: ." pronounciation: " wordname type ." : '" doc doc-pronounciation 2@ type ." ' instead of '" pronounciation type ." '" cr
221: endif
222: else
223: ." undocumented: " wordname type cr
224: 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