File:
[gforth] /
gforth /
ds2texi.fs
Revision
1.8:
download - view:
text,
annotated -
select for diffs
Mon Oct 16 18:33:06 1995 UTC (28 years, 6 months ago) by
anton
Branches:
MAIN
CVS tags:
HEAD
added answords.fs and strsignal.c
added checking of documenetation of ANS Forth words
Fixed many documentation errors and added some documentation
signal handling now uses strsignal and can handle signals not present on all machines
1: \ documentation source to texi format converter
2:
3: \ documentation source can contain lines in the form `doc-word' and
4: \ `short-word'. These are converted to appropriate full or short
5: \ (without the description) glossary entries for word.
6:
7: \ The glossary entries are generated from data present in the wordlist
8: \ `documentation'. Each word resides there under its own name.
9:
10: script? [IF]
11: warnings off
12: require search-order.fs
13: require glocals.fs
14: require float.fs
15: require struct.fs
16: require debugging.fs
17: [THEN]
18:
19: wordlist constant documentation
20:
21: struct
22: 2 cells: field doc-name
23: 2 cells: field doc-stack-effect
24: 2 cells: field doc-wordset
25: 2 cells: field doc-pronounciation
26: 2 cells: field doc-description
27: end-struct doc-entry
28:
29: create description-buffer 4096 chars allot
30:
31: : get-description ( -- addr u )
32: description-buffer
33: begin
34: refill
35: while
36: source nip
37: while
38: source swap >r 2dup r> -rot cmove
39: chars +
40: #lf over c! char+
41: repeat then
42: description-buffer tuck - ;
43:
44: : replace-_ ( c-addr u -- )
45: \ replaces _ with -
46: chars bounds
47: +DO
48: i c@ [char] _ =
49: if
50: [char] - i c!
51: endif
52: 1 chars
53: +loop ;
54:
55: : condition-stack-effect ( c-addr1 u1 -- c-addr2 u2 )
56: save-string 2dup replace-_ ;
57:
58: : condition-wordset ( c-addr1 u1 -- c-addr2 u2 )
59: dup 0=
60: if
61: 2drop s" unknown"
62: else
63: save-string
64: endif ;
65:
66: : condition-pronounciation ( c-addr1 u1 -- c-addr2 u2 )
67: save-string 2dup replace-_ ;
68:
69: : make-doc ( -- )
70: get-current documentation set-current
71: create
72: last @ name>string 2, \ name
73: [char] ) parse save-string 2, \ stack-effect
74: bl parse-word condition-wordset 2, \ wordset
75: bl parse-word dup \ pronounciation
76: if
77: condition-pronounciation
78: else
79: 2drop last @ name>string
80: endif
81: 2,
82: get-description save-string 2,
83: set-current ;
84:
85: : emittexi ( c -- )
86: >r
87: s" @{}" r@ scan 0<>
88: if
89: [char] @ emit
90: endif
91: drop r> emit ;
92:
93: : typetexi ( addr u -- )
94: 0
95: ?do
96: dup c@ emittexi
97: char+
98: loop
99: drop ;
100:
101: : print-short ( doc-entry -- )
102: >r
103: ." @findex "
104: r@ doc-name 2@ typetexi
105: ." @var{ " r@ doc-stack-effect 2@ type ." } "
106: r@ doc-wordset 2@ type
107: cr
108: ." @format" cr
109: ." @code{" r@ doc-name 2@ typetexi ." } "
110: ." @i{" r@ doc-stack-effect 2@ type ." } "
111: r@ doc-wordset 2@ type ." ``"
112: r@ doc-pronounciation 2@ type ." ''" cr ." @end format" cr
113: rdrop ;
114:
115: : print-doc ( doc-entry -- )
116: >r
117: r@ print-short
118: r@ doc-description 2@ dup 0<>
119: if
120: ." @iftex" cr ." @vskip-3ex" cr ." @end iftex" cr
121: type cr cr \ ." @ifinfo" cr ." @*" cr ." @end ifinfo" cr cr
122: else
123: 2drop cr
124: endif
125: rdrop ;
126:
127: : do-doc ( addr1 u1 addr2 u2 xt -- f )
128: \ xt is the word to be executed if addr1 u1 is a string starting
129: \ with the prefix addr2 u2 and continuing with a word in the
130: \ wordlist `documentation'. f is true if xt is executed.
131: >r dup >r
132: 3 pick over compare 0=
133: if \ addr2 u2 is a prefix of addr1 u1
134: r> /string documentation search-wordlist
135: if \ the rest of addr1 u1 is in documentation
136: execute r> execute true
137: else
138: rdrop false
139: endif
140: else
141: 2drop 2rdrop false
142: endif ;
143:
144: : process-line ( addr u -- )
145: 2dup s" doc-" ['] print-doc do-doc 0=
146: if
147: 2dup s" short-" ['] print-short do-doc 0=
148: if
149: type cr EXIT
150: endif
151: endif
152: 2drop ;
153:
154: 1024 constant doclinelength
155:
156: create docline doclinelength chars allot
157:
158: : ds2texi ( file-id -- )
159: >r
160: begin
161: docline doclinelength r@ read-line throw
162: while
163: dup doclinelength = abort" docline too long"
164: docline swap process-line
165: repeat
166: drop rdrop ;
167:
168: : compare-ci ( addr1 u1 addr2 u2 -- n )
169: \ case insensitive string compare
170: 2 pick swap -
171: ?dup-0=-if
172: capscomp
173: else
174: nip nip nip
175: 0<
176: if
177: -1
178: else
179: 1
180: endif
181: endif ;
182:
183: : answord ( "name wordset pronounciation" -- )
184: \ check the documentaion of an ans word
185: name { D: wordname }
186: name { D: wordset }
187: name { D: pronounciation }
188: wordname documentation search-wordlist
189: if
190: execute { doc }
191: wordset doc doc-wordset 2@ compare-ci
192: if
193: ." wordset: " wordname type ." : '" doc doc-wordset 2@ type ." ' instead of '" wordset type ." '" cr
194: endif
195: pronounciation doc doc-pronounciation 2@ compare-ci
196: if
197: ." pronounciation: " wordname type ." : '" doc doc-pronounciation 2@ type ." ' instead of '" pronounciation type ." '" cr
198: endif
199: else
200: ." undocumented: " wordname type cr
201: endif ;
202:
203: script? [IF]
204: require prims2x.fs
205: s" primitives.b" ' register-doc process-file
206: require crossdoc.fd
207: require doc.fd
208: [THEN]
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>