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: include search-order.fs
13: include struct.fs
14: include debugging.fs
15: [THEN]
16:
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:
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:
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 -- )
75: >r ." @format" cr
76: ." @code{" r@ doc-name 2@ typetexi ." } "
77: ." @i{" r@ doc-stack-effect 2@ type ." } "
78: r@ doc-wordset 2@ type ." ``"
79: r@ doc-pronounciation 2@ type ." ''" cr ." @end format" cr
80: rdrop ;
81:
82: : print-doc ( doc-entry -- )
83: >r
84: r@ print-short
85: r@ doc-description 2@ dup 0<>
86: if
87: type ." @*" cr
88: else
89: 2drop cr
90: endif
91: rdrop ;
92:
93: : do-doc ( addr1 u1 addr2 u2 xt -- f )
94: \ xt is the word to be executed if addr1 u1 is a string starting
95: \ with the prefix addr2 u2 and continuing with a word in the
96: \ wordlist `documentation'. f is true if xt is executed.
97: >r dup >r
98: 3 pick over compare 0=
99: if \ addr2 u2 is a prefix of addr1 u1
100: r> /string documentation search-wordlist
101: if \ the rest of addr1 u1 is in documentation
102: execute r> execute true
103: else
104: rdrop false
105: endif
106: else
107: 2drop 2rdrop false
108: endif ;
109:
110: : process-line ( addr u -- )
111: 2dup s" doc-" ['] print-doc do-doc 0=
112: if
113: 2dup s" short-" ['] print-short do-doc 0=
114: if
115: type cr EXIT
116: endif
117: endif
118: 2drop ;
119:
120: 1024 constant doclinelength
121:
122: create docline doclinelength chars allot
123:
124: : ds2texi ( file-id -- )
125: >r
126: begin
127: docline doclinelength r@ read-line throw
128: while
129: dup doclinelength = abort" docline too long"
130: docline swap process-line
131: repeat
132: drop rdrop ;
133:
134: script? [IF]
135: include prims2x.fs
136: s" primitives.b" ' register-doc process-file
137: require doc.fd
138: require crossdoc.fd
139: s" gforth.ds" r/o open-file throw ds2texi bye
140: [THEN]
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>