Annotation of gforth/ds2texi.fs, revision 1.8
1.1 anton 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:
1.2 pazsan 10: script? [IF]
11: warnings off
1.7 anton 12: require search-order.fs
1.8 ! anton 13: require glocals.fs
1.7 anton 14: require float.fs
15: require struct.fs
16: require debugging.fs
1.2 pazsan 17: [THEN]
18:
1.1 anton 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:
1.4 anton 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:
1.8 ! anton 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:
1.4 anton 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
1.8 ! anton 74: bl parse-word condition-wordset 2, \ wordset
1.4 anton 75: bl parse-word dup \ pronounciation
76: if
1.8 ! anton 77: condition-pronounciation
1.4 anton 78: else
79: 2drop last @ name>string
80: endif
81: 2,
82: get-description save-string 2,
83: set-current ;
84:
1.1 anton 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 -- )
1.7 anton 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
1.1 anton 109: ." @code{" r@ doc-name 2@ typetexi ." } "
110: ." @i{" r@ doc-stack-effect 2@ type ." } "
111: r@ doc-wordset 2@ type ." ``"
1.3 anton 112: r@ doc-pronounciation 2@ type ." ''" cr ." @end format" cr
1.1 anton 113: rdrop ;
114:
115: : print-doc ( doc-entry -- )
116: >r
117: r@ print-short
118: r@ doc-description 2@ dup 0<>
119: if
1.7 anton 120: ." @iftex" cr ." @vskip-3ex" cr ." @end iftex" cr
121: type cr cr \ ." @ifinfo" cr ." @*" cr ." @end ifinfo" cr cr
1.1 anton 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 ;
1.2 pazsan 167:
1.8 ! anton 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:
1.2 pazsan 203: script? [IF]
1.7 anton 204: require prims2x.fs
1.2 pazsan 205: s" primitives.b" ' register-doc process-file
1.8 ! anton 206: require crossdoc.fd
1.5 pazsan 207: require doc.fd
1.2 pazsan 208: [THEN]
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