Annotation of gforth/ds2texi.fs, revision 1.6
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
12: include search-order.fs
13: include struct.fs
14: include debugging.fs
15: [THEN]
16:
1.1 anton 17: wordlist constant documentation
18:
19: struct
20: 2 cells: field doc-name
21: 2 cells: field doc-stack-effect
22: 2 cells: field doc-wordset
23: 2 cells: field doc-pronounciation
24: 2 cells: field doc-description
25: end-struct doc-entry
26:
1.4 anton 27: create description-buffer 4096 chars allot
28:
29: : get-description ( -- addr u )
30: description-buffer
31: begin
32: refill
33: while
34: source nip
35: while
36: source swap >r 2dup r> -rot cmove
37: chars +
38: #lf over c! char+
39: repeat then
40: description-buffer tuck - ;
41:
42: : make-doc ( -- )
43: get-current documentation set-current
44: create
45: last @ name>string 2, \ name
46: [char] ) parse save-string 2, \ stack-effect
47: bl parse-word save-string 2, \ wordset
48: bl parse-word dup \ pronounciation
49: if
50: save-string
51: else
52: 2drop last @ name>string
53: endif
54: 2,
55: get-description save-string 2,
56: set-current ;
57:
1.1 anton 58: : emittexi ( c -- )
59: >r
60: s" @{}" r@ scan 0<>
61: if
62: [char] @ emit
63: endif
64: drop r> emit ;
65:
66: : typetexi ( addr u -- )
67: 0
68: ?do
69: dup c@ emittexi
70: char+
71: loop
72: drop ;
73:
74: : print-short ( doc-entry -- )
1.3 anton 75: >r ." @format" cr
1.1 anton 76: ." @code{" r@ doc-name 2@ typetexi ." } "
77: ." @i{" r@ doc-stack-effect 2@ type ." } "
78: r@ doc-wordset 2@ type ." ``"
1.3 anton 79: r@ doc-pronounciation 2@ type ." ''" cr ." @end format" cr
1.6 ! anton 80: ." @findex " r@ doc-name 2@ typetexi cr
1.1 anton 81: rdrop ;
82:
83: : print-doc ( doc-entry -- )
84: >r
85: r@ print-short
86: r@ doc-description 2@ dup 0<>
87: if
88: type ." @*" cr
89: else
90: 2drop cr
91: endif
92: rdrop ;
93:
94: : do-doc ( addr1 u1 addr2 u2 xt -- f )
95: \ xt is the word to be executed if addr1 u1 is a string starting
96: \ with the prefix addr2 u2 and continuing with a word in the
97: \ wordlist `documentation'. f is true if xt is executed.
98: >r dup >r
99: 3 pick over compare 0=
100: if \ addr2 u2 is a prefix of addr1 u1
101: r> /string documentation search-wordlist
102: if \ the rest of addr1 u1 is in documentation
103: execute r> execute true
104: else
105: rdrop false
106: endif
107: else
108: 2drop 2rdrop false
109: endif ;
110:
111: : process-line ( addr u -- )
112: 2dup s" doc-" ['] print-doc do-doc 0=
113: if
114: 2dup s" short-" ['] print-short do-doc 0=
115: if
116: type cr EXIT
117: endif
118: endif
119: 2drop ;
120:
121: 1024 constant doclinelength
122:
123: create docline doclinelength chars allot
124:
125: : ds2texi ( file-id -- )
126: >r
127: begin
128: docline doclinelength r@ read-line throw
129: while
130: dup doclinelength = abort" docline too long"
131: docline swap process-line
132: repeat
133: drop rdrop ;
1.2 pazsan 134:
135: script? [IF]
136: include prims2x.fs
137: s" primitives.b" ' register-doc process-file
1.5 pazsan 138: require doc.fd
139: require crossdoc.fd
1.2 pazsan 140: s" gforth.ds" r/o open-file throw ds2texi bye
141: [THEN]
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>