1: \ create a documentation file
2:
3: \ Copyright (C) 1995,1999,2000,2003,2004,2007,2010 Free Software Foundation, Inc.
4:
5: \ This file is part of Gforth.
6:
7: \ Gforth is free software; you can redistribute it and/or
8: \ modify it under the terms of the GNU General Public License
9: \ as published by the Free Software Foundation, either version 3
10: \ of the License, or (at your option) any later version.
11:
12: \ This program is distributed in the hope that it will be useful,
13: \ but WITHOUT ANY WARRANTY; without even the implied warranty of
14: \ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15: \ GNU General Public License for more details.
16:
17: \ You should have received a copy of the GNU General Public License
18: \ along with this program. If not, see http://www.gnu.org/licenses/.
19:
20:
21: \ the stack effect of loading this file is: ( addr u -- )
22: \ it takes the name of the doc-file to be generated.
23:
24: \ the forth source must have the following format:
25: \ .... name ( stack-effect ) \ [prefix-] wordset [pronounciation]
26: \ \G description ...
27:
28: \ The output is a file of entries that look like this:
29: \ make-doc [--prefix]-entry name stack-effect ) wordset [pronounciation]
30: \ description
31: \
32: \ (i.e., the entry is terminated by an empty line or the end-of-file)
33:
34: \ this stuff uses the same mechanism as etags.fs, i.e., the
35: \ documentation is generated during compilation using a deferred
36: \ HEADER. It should be possible to use this togeter with etags.fs.
37:
38: \ This is not very general. Input should come from stream files,
39: \ otherwise the results are unpredictable. It also does not detect
40: \ errors in the input (e.g., if there is something else on the
41: \ definition line) and reacts strangely to them.
42:
43: \ possible improvements: we could analyse the defining word and guess
44: \ the stack effect. This would be handy for variables. Unfortunately,
45: \ we have to look back in the input buffer; we cannot use the cfa
46: \ because it does not exist when header is called.
47:
48: \ This is ANS Forth with the following serious environmental
49: \ dependences: the variable LAST must contain a pointer to the last
50: \ header, NAME>STRING must convert that pointer to a string, and
51: \ HEADER must be a deferred word that is called to create the name.
52:
53:
54: r/w create-file throw value doc-file-id
55: \ contains the file-id of the documentation file
56:
57: s" \ automatically generated by makedoc.fs" doc-file-id write-line throw
58:
59: : >fileCR ( c-addr u -- )
60: doc-file-id write-line throw ;
61: : >file ( c-addr u -- )
62: doc-file-id write-file throw ;
63:
64: : \G ( -- )
65: source >in @ /string >fileCR
66: source >in ! drop ; immediate
67:
68: : put-doc-entry ( -- )
69: dpp @ normal-dp = \ not defining locals
70: latest 0<> and \ not an anonymous (i.e. noname) header
71: if
72: s" " >fileCR
73: s" make-doc " >file
74: >in @ >r
75: parse-name 2dup s" (" str= if
76: 2drop ') parse
77: else
78: 2dup s" {" str= if
79: 2drop '} parse
80: else \ no stack comment or locals
81: 2drop
82: r@ >in ! \ restore "\"
83: s" unknown " \ default stack comment
84: endif
85: endif
86: [char] \ parse 2drop
87: >in @
88: parse-name dup
89: IF
90: 2dup 1- chars + c@ [char] - =
91: IF
92: s" --" >file
93: >file drop
94: ELSE
95: 2drop >in !
96: THEN
97: ELSE
98: 2drop >in !
99: THEN
100: latest name>string >file
101: s" " >file
102: >file
103: s" )" >file
104: POSTPONE \g
105: r> >in !
106: endif ;
107:
108: : (doc-header) ( -- )
109: defers header
110: put-doc-entry ;
111:
112: ' (doc-header) IS header
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>