Annotation of gforth/ds2texi.fs, revision 1.4
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.1 anton 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 ;
1.2 pazsan 133:
134: script? [IF]
135: include prims2x.fs
136: s" primitives.b" ' register-doc process-file
1.4 ! anton 137: require doc.fs
1.2 pazsan 138: s" gforth.ds" r/o open-file throw ds2texi bye
139: [THEN]
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>