2 # aside from this initial boilerplate, this is actually -*- scheme -*- code
3 main
='(module-ref (resolve-module '\''(scripts doc-snarf)) '\'main
')'
4 exec ${GUILE-guile} -c "(apply $main (cdr (command-line)))" "$@"
6 ;;; doc-snarf
--- Extract documentation from
source files
8 ;; Copyright
(C
) 2001 Free Software Foundation
, Inc.
10 ;; This program is free software
; you can redistribute it and
/or
11 ;; modify it under the terms of the GNU General Public License as
12 ;; published by the Free Software Foundation
; either version
2, or
13 ;; (at your option
) any later version.
15 ;; This program is distributed
in the hope that it will be useful
,
16 ;; but WITHOUT ANY WARRANTY
; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
18 ;; General Public License
for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with this software
; see the
file COPYING. If not
, write to
22 ;; the Free Software Foundation
, Inc.
, 59 Temple Place
, Suite
330,
23 ;; Boston
, MA
02111-1307 USA
27 ;; Usage
: doc-snarf FILE
29 ;; This program reads
in a Scheme
source file and extracts docstrings
30 ;; in the format specified below. Additionally
, a procedure protoype
31 ;; is infered from the procedure definition line starting with
34 ;; Currently
, two output modi are implemented
: texinfo and plaintext.
35 ;; Default is plaintext
, texinfo can be switched on with the
36 ;; `--texinfo, -t' command line option.
38 ;; Format: A docstring can span multiple lines and a docstring line
39 ;; begins with `;; ' (two semicoli and a space). A docstring is ended
40 ;; by either a line beginning with (define ...) or one or more lines
41 ;; beginning with `;;-' (two semicoli and a dash
). These lines are
42 ;; called
`options' and begin with a keyword, followed by a colon and
45 ;; Additionally, "standard internal docstrings" (for Scheme source) are
46 ;; recognized and output as "options". The output formatting is likely
47 ;; to change in the future.
51 ;; This procedure foos, or bars, depending on the argument @var{braz}.
52 ;;-Author: Martin Grabmueller
53 (define (foo/bar braz)
56 ;;; Which results in the following docstring if texinfo output is
60 @deffn procedure foo/bar braz
61 This procedure foos, or bars, depending on the argument @var{braz}.
62 @c Author: Martin Grabmueller
66 ;;; Or in this if plaintext output is used:
68 Procedure: foo/bar braz
69 This procedure foos, or bars, depending on the argument @var{braz}.
70 ;; Author: Martin Grabmueller
74 ;; TODO: Convert option lines to alist.
75 ;; More parameterization.
76 ;; ../libguile/guile-doc-snarf emulation
78 (define doc-snarf-version "0.0.2") ; please update before publishing!
82 (define-module (scripts doc-snarf)
83 :use-module (ice-9 getopt-long)
84 :use-module (ice-9 regex)
85 :use-module (ice-9 string-fun)
86 :use-module (ice-9 rdelim)
89 (define command-synopsis
90 '((version (single-char #\v) (value #f))
91 (help (single-char #\h) (value #f))
92 (output (single-char #\o) (value #t))
93 (texinfo (single-char #\t) (value #f))
94 (lang (single-char #\l) (value #t))))
96 ;; Display version information and exit.
98 (define (display-version)
99 (display "doc-snarf ") (display doc-snarf-version) (newline))
101 ;; Display the usage help message and exit.
102 ;;-ttn-mod: change option "source" to "lang"
103 (define (display-help)
104 (display "Usage: doc-snarf [options...] inputfile\n")
105 (display " --help, -h Show this usage information\n")
106 (display " --version, -v Show version information\n")
108 " --output=FILE, -o Specify output file [default=stdout]\n")
109 (display " --texinfo, -t Format output as texinfo\n")
110 (display " --lang=[c,scheme], -l Specify the input language\n"))
113 ;;-ttn-mod: canonicalize lang
114 (define (doc-snarf . args)
115 (let ((options (getopt-long (cons "doc-snarf" args) command-synopsis)))
116 (let ((help-wanted (option-ref options 'help #f))
117 (version-wanted (option-ref options 'version #f))
118 (texinfo-wanted (option-ref options 'texinfo #f))
119 (lang (string->symbol
120 (string-downcase (option-ref options 'lang "scheme")))))
122 (version-wanted (display-version))
123 (help-wanted (display-help))
125 (let ((input (option-ref options '() #f))
126 (output (option-ref options 'output #f)))
128 ;; Bonard B. Timmons III says `(pair? input
)' alone is sufficient.
129 ;; (and input (pair? input))
131 (snarf-file (car input) output texinfo-wanted lang)
132 (display-help))))))))
134 (define main doc-snarf)
136 ;; Supported languages and their parameters. Each element has form:
137 ;; (LANG DOC-START DOC-END DOC-PREFIX OPT-PREFIX SIG-START STD-INT-DOC?)
138 ;; LANG is a symbol, STD-INT-DOC? is a boolean indicating whether or not
139 ;; LANG supports "standard internal docstring" (a string after the formals),
140 ;; everything else is a string specifying a regexp.
142 (define supported-languages
148 "NOTHING AT THIS TIME!!!"
160 ;; Get @var
{lang
}'s @var{parameter}. Both args are symbols.
162 (define (lang-parm lang parm)
163 (list-ref (assq-ref supported-languages lang)
165 ((docstring-start) 0)
167 ((docstring-prefix) 2)
169 ((signature-start) 4)
170 ((std-int-doc?) 5))))
172 ;; Snarf all docstrings from the file @var{input} and write them to
173 ;; file @var{output}. Use texinfo format for the output if
174 ;; @var{texinfo?} is true.
175 ;;-ttn-mod: don't use string comparison
, consult table instead
176 (define
(snarf-file input output texinfo? lang
)
177 (or
(memq lang
(map car supported-languages
))
178 (error
"doc-snarf: input language must be c or scheme."))
179 (write-output
(snarf input lang
) output
180 (if texinfo? format-texinfo format-plain
)))
182 ;; fixme
: this comment is required to trigger standard internal
183 ;; docstring snarfing... ideally
, it wouldn
't be necessary.
184 ;;-ttn-mod: new proc, from snarf-docs (aren't these names fun?
)
185 (define
(find-std-int-doc line input-port
)
186 "Unread @var{line} from @var{input-port}, then read in the entire form and
187 return the standard internal docstring if found. Return #f if not."
188 (unread-string line input-port
) ; ugh
189 (let ((form
(read input-port
)))
190 (cond
((and
(list? form
) ; (define
(PROC ARGS
) "DOC" ...
)
192 (eq?
'define (car form))
194 (symbol? (caadr form))
195 (string? (caddr form)))
197 ((and (list? form) ; (define VAR (lambda ARGS "DOC" ...))
199 (eq? 'define
(car form
))
200 (symbol?
(cadr form
))
202 (< 3 (length
(caddr form
)))
203 (eq?
'lambda (car (caddr form)))
204 (string? (caddr (caddr form))))
205 (caddr (caddr form)))
208 ;; Split @var{string} into lines, adding @var{prefix} to each.
210 (define (split-prefixed string prefix)
211 (separate-fields-discarding-char
215 (string-append prefix line))
218 ;; snarf input-file output-file
219 ;; Extract docstrings from the input file @var{input}, presumed
220 ;; to be written in language @var{lang}.
221 ;;-Author: Martin Grabmueller <mgrabmue@cs.tu-berlin.de>
222 ;;-Created: 2001-02-17
223 ;;-ttn-mod: regluarize lang parm lookup, add "std int doc" snarfing (2 places)
224 (define (snarf input-file lang)
225 (let* ((i-p (open-input-file input-file))
226 (parm-regexp (lambda (parm) (make-regexp (lang-parm lang parm))))
227 (docstring-start (parm-regexp 'docstring-start
))
228 (docstring-end
(parm-regexp
'docstring-end))
229 (docstring-prefix (parm-regexp 'docstring-prefix
))
230 (option-prefix
(parm-regexp
'option-prefix))
231 (signature-start (parm-regexp 'signature-start
))
233 (lambda
(line i-p options
)
234 (let ((int-doc
(and
(lang-parm lang
'std-int-doc?)
235 (let ((d (find-std-int-doc line i-p)))
236 (and d (split-prefixed d "internal: "))))))
238 (append (reverse int-doc) options)
241 (let lp ((line (read-line i-p)) (state 'neutral
) (doc-strings
'())
242 (options '()) (entries
'()) (lno 0))
245 (close-input-port i-p)
248 ;; State 'neutral
: we
're currently not within a docstring or
250 ((eq? state 'neutral
)
251 (let ((m
(regexp-exec docstring-start line
)))
253 (lp (read-line i-p
) 'doc-string
254 (list (match:substring m 1)) '() entries
(+ lno
1))
255 (lp (read-line i-p
) state
'() '() entries
(+ lno
1)))))
257 ;; State
'doc-string: we have started reading a docstring and
258 ;; are waiting for more, for options or for a define.
259 ((eq? state 'doc-string
)
260 (let ((m0
(regexp-exec docstring-prefix line
))
261 (m1
(regexp-exec option-prefix line
))
262 (m2
(regexp-exec signature-start line
))
263 (m3
(regexp-exec docstring-end line
)))
266 (lp (read-line i-p
) 'doc-string
267 (cons (match:substring m0 1) doc-strings) '() entries
270 (lp (read-line i-p
) 'options
271 doc-strings (cons (match:substring m1 1) options) entries
274 (let ((options (augmented-options line i-p options))) ; ttn-mod
275 (lp (read-line i-p) 'neutral
'() '()
276 (cons
(parse-entry doc-strings options line input-file lno
)
280 (lp (read-line i-p
) 'neutral '() '()
281 (cons (parse-entry doc-strings options #f input-file lno)
285 (lp (read-line i-p) 'neutral
'() '() entries
(+ lno
1))))))
287 ;; State
'options: We're waiting
for more options or
for a
289 ((eq? state
'options)
290 (let ((m1 (regexp-exec option-prefix line))
291 (m2 (regexp-exec signature-start line))
292 (m3 (regexp-exec docstring-end line)))
295 (lp (read-line i-p) 'options
296 doc-strings
(cons
(match
:substring m1
1) options
) entries
299 (let ((options
(augmented-options line i-p options
))) ; ttn-mod
300 (lp (read-line i-p
) 'neutral '() '()
301 (cons (parse-entry doc-strings options line input-file lno)
305 (lp (read-line i-p) 'neutral
'() '()
306 (cons
(parse-entry doc-strings options
#f input-file lno)
310 (lp (read-line i-p
) 'neutral '() '() entries (+ lno 1))))))))))
312 (define (make-entry symbol signature docstrings options filename line)
313 (vector 'entry symbol signature docstrings options filename line
))
314 (define
(entry-symbol e
)
316 (define
(entry-signature e
)
318 (define
(entry-docstrings e
)
320 (define
(entry-options e
)
322 (define
(entry-filename e
)
324 (define
(entry-line e
)
325 "This docstring will not be snarfed, unfortunately..."
328 ;; Create a docstring entry from the docstring line list
329 ;; @var
{doc-strings
}, the option line list @var
{options
} and the
330 ;; define line @var
{def-line
}
331 (define
(parse-entry docstrings options def-line filename line-no
)
332 ; (write-line docstrings
)
335 (make-entry
(get-symbol def-line
)
336 (make-prototype def-line
) (reverse docstrings
)
337 (reverse options
) filename
338 (+ (- line-no
(length docstrings
) (length options
)) 1)))
339 ((> (length docstrings
) 0)
340 (make-entry
(string-
>symbol
(car
(reverse docstrings
)))
341 (car
(reverse docstrings
))
342 (cdr
(reverse docstrings
))
343 (reverse options
) filename
344 (+ (- line-no
(length docstrings
) (length options
)) 1)))
346 (make-entry
'foo "" (reverse docstrings) (reverse options) filename
347 (+ (- line-no (length docstrings) (length options)) 1)))))
349 ;; Create a string which is a procedure prototype. The necessary
350 ;; information for constructing the prototype is taken from the line
351 ;; @var{def-line}, which is a line starting with @code{(define...}.
352 (define (make-prototype def-line)
353 (call-with-input-string
356 (let* ((paren (read-char s-p))
363 (symbol->string tmp))
367 (define (get-symbol def-line)
368 (call-with-input-string
371 (let* ((paren (read-char s-p))
382 ;; Append the symbols
in the string list @var
{s
}, separated with a
384 (define
(join-symbols s
)
388 (string-append
". " (symbol-
>string s
)))
390 (symbol-
>string
(car s
)))
392 (string-append
(symbol-
>string
(car s
)) " " (join-symbols
(cdr s
))))))
394 ;; Write @var
{entries
} to @var
{output-file
} using @var
{writer
}.
395 ;; @var
{writer
} is a proc that takes one entry.
396 ;; If @var
{output-file
} is
#f, write to stdout.
398 (define
(write-output entries output-file writer
)
399 (with-output-to-port
(cond
(output-file
(open-output-file output-file
))
400 (else (current-output-port
)))
401 (lambda
() (for-each writer entries
))))
403 ;; Write an @var
{entry
} using texinfo format.
404 ;;-ttn-mod: renamed from
`texinfo-output', distilled
405 (define (format-texinfo entry)
407 (display (entry-symbol entry))
409 (display "@c snarfed from ")
410 (display (entry-filename entry))
412 (display (entry-line entry))
414 (display "@deffn procedure ")
415 (display (entry-signature entry))
417 (for-each (lambda (s) (write-line s))
418 (entry-docstrings entry))
419 (for-each (lambda (s) (display "@c ") (write-line s))
420 (entry-options entry))
421 (write-line "@end deffn"))
423 ;; Write an @var{entry} using plain format.
424 ;;-ttn-mod: renamed from `texinfo-output
', distilled
425 (define (format-plain entry)
426 (display "Procedure: ")
427 (display (entry-signature entry))
429 (for-each (lambda (s) (write-line s))
430 (entry-docstrings entry))
431 (for-each (lambda (s) (display ";; ") (write-line s))
432 (entry-options entry))
433 (display "Snarfed from ")
434 (display (entry-filename entry))
436 (display (entry-line entry))
440 ;;; doc-snarf ends here