Annotation of gforth/ds2texi.fs, revision 1.3
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:
27: : emittexi ( c -- )
28: >r
29: s" @{}" r@ scan 0<>
30: if
31: [char] @ emit
32: endif
33: drop r> emit ;
34:
35: : typetexi ( addr u -- )
36: 0
37: ?do
38: dup c@ emittexi
39: char+
40: loop
41: drop ;
42:
43: : print-short ( doc-entry -- )
1.3 ! anton 44: >r ." @format" cr
1.1 anton 45: ." @code{" r@ doc-name 2@ typetexi ." } "
46: ." @i{" r@ doc-stack-effect 2@ type ." } "
47: r@ doc-wordset 2@ type ." ``"
1.3 ! anton 48: r@ doc-pronounciation 2@ type ." ''" cr ." @end format" cr
1.1 anton 49: rdrop ;
50:
51: : print-doc ( doc-entry -- )
52: >r
53: r@ print-short
54: r@ doc-description 2@ dup 0<>
55: if
56: type ." @*" cr
57: else
58: 2drop cr
59: endif
60: rdrop ;
61:
62: : do-doc ( addr1 u1 addr2 u2 xt -- f )
63: \ xt is the word to be executed if addr1 u1 is a string starting
64: \ with the prefix addr2 u2 and continuing with a word in the
65: \ wordlist `documentation'. f is true if xt is executed.
66: >r dup >r
67: 3 pick over compare 0=
68: if \ addr2 u2 is a prefix of addr1 u1
69: r> /string documentation search-wordlist
70: if \ the rest of addr1 u1 is in documentation
71: execute r> execute true
72: else
73: rdrop false
74: endif
75: else
76: 2drop 2rdrop false
77: endif ;
78:
79: : process-line ( addr u -- )
80: 2dup s" doc-" ['] print-doc do-doc 0=
81: if
82: 2dup s" short-" ['] print-short do-doc 0=
83: if
84: type cr EXIT
85: endif
86: endif
87: 2drop ;
88:
89: 1024 constant doclinelength
90:
91: create docline doclinelength chars allot
92:
93: : ds2texi ( file-id -- )
94: >r
95: begin
96: docline doclinelength r@ read-line throw
97: while
98: dup doclinelength = abort" docline too long"
99: docline swap process-line
100: repeat
101: drop rdrop ;
1.2 pazsan 102:
103: script? [IF]
104: include prims2x.fs
105: s" primitives.b" ' register-doc process-file
106: s" gforth.ds" r/o open-file throw ds2texi bye
107: [THEN]
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>