1 ;;; doc-snarf --- Extract documentation from source files
3 ;; Copyright (C) 2001, 2006, 2011 Free Software Foundation, Inc.
5 ;; This program is free software; you can redistribute it and/or
6 ;; modify it under the terms of the GNU Lesser General Public License
7 ;; as published by the Free Software Foundation; either version 3, or
8 ;; (at your option) any later version.
10 ;; This program is distributed in the hope that it will be useful,
11 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
12 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
13 ;; Lesser General Public License for more details.
15 ;; You should have received a copy of the GNU Lesser General Public
16 ;; License along with this software; see the file COPYING.LESSER. If
17 ;; not, write to the Free Software Foundation, Inc., 51 Franklin
18 ;; Street, Fifth Floor, Boston, MA 02110-1301 USA
20 ;;; Author: Martin Grabmueller
24 ;; Usage: doc-snarf FILE
26 ;; This program reads in a Scheme source file and extracts docstrings
27 ;; in the format specified below. Additionally, a procedure protoype
28 ;; is infered from the procedure definition line starting with
31 ;; Currently, two output modi are implemented: texinfo and plaintext.
32 ;; Default is plaintext, texinfo can be switched on with the
33 ;; `--texinfo, -t' command line option.
35 ;; Format: A docstring can span multiple lines and a docstring line
36 ;; begins with `;; ' (two semicoli and a space). A docstring is ended
37 ;; by either a line beginning with (define ...) or one or more lines
38 ;; beginning with `;;-' (two semicoli and a dash). These lines are
39 ;; called `options' and begin with a keyword, followed by a colon and
42 ;; Additionally, "standard internal docstrings" (for Scheme source) are
43 ;; recognized and output as "options". The output formatting is likely
44 ;; to change in the future.
48 ;; This procedure foos, or bars, depending on the argument @var{braz}.
49 ;;-Author: Martin Grabmueller
50 (define (foo/bar braz)
53 ;;; Which results in the following docstring if texinfo output is
57 @deffn procedure foo/bar braz
58 This procedure foos, or bars, depending on the argument @var{braz}.
59 @c Author: Martin Grabmueller
63 ;;; Or in this if plaintext output is used:
65 Procedure: foo/bar braz
66 This procedure foos, or bars, depending on the argument @var{braz}.
67 ;; Author: Martin Grabmueller
71 ;; TODO: Convert option lines to alist.
72 ;; More parameterization.
73 ;; (maybe) Use in Guile build itself.
75 (define doc-snarf-version "0.0.2") ; please update before publishing!
79 (define-module (scripts doc-snarf)
80 :use-module (ice-9 getopt-long)
81 :use-module (ice-9 regex)
82 :use-module (ice-9 string-fun)
83 :use-module (ice-9 rdelim)
86 (define %summary "Snarf out documentation from a file.")
88 (define command-synopsis
89 '((version (single-char #\v) (value #f))
90 (help (single-char #\h) (value #f))
91 (output (single-char #\o) (value #t))
92 (texinfo (single-char #\t) (value #f))
93 (lang (single-char #\l) (value #t))))
95 ;; Display version information and exit.
97 (define (display-version)
98 (display "doc-snarf ") (display doc-snarf-version) (newline))
100 ;; Display the usage help message and exit.
101 ;;-ttn-mod: change option "source" to "lang"
102 (define (display-help)
103 (display "Usage: doc-snarf [options...] inputfile\n")
104 (display " --help, -h Show this usage information\n")
105 (display " --version, -v Show version information\n")
107 " --output=FILE, -o Specify output file [default=stdout]\n")
108 (display " --texinfo, -t Format output as texinfo\n")
109 (display " --lang=[c,scheme], -l Specify the input language\n"))
112 ;;-ttn-mod: canonicalize lang
113 (define (doc-snarf . args)
114 (let ((options (getopt-long (cons "doc-snarf" args) command-synopsis)))
115 (let ((help-wanted (option-ref options 'help #f))
116 (version-wanted (option-ref options 'version #f))
117 (texinfo-wanted (option-ref options 'texinfo #f))
118 (lang (string->symbol
119 (string-downcase (option-ref options 'lang "scheme")))))
121 (version-wanted (display-version))
122 (help-wanted (display-help))
124 (let ((input (option-ref options '() #f))
125 (output (option-ref options 'output #f)))
127 ;; Bonard B. Timmons III says `(pair? input)' alone is sufficient.
128 ;; (and input (pair? input))
130 (snarf-file (car input) output texinfo-wanted lang)
131 (display-help))))))))
133 (define main doc-snarf)
135 ;; Supported languages and their parameters. Each element has form:
136 ;; (LANG DOC-START DOC-END DOC-PREFIX OPT-PREFIX SIG-START STD-INT-DOC?)
137 ;; LANG is a symbol, STD-INT-DOC? is a boolean indicating whether or not
138 ;; LANG supports "standard internal docstring" (a string after the formals),
139 ;; everything else is a string specifying a regexp.
141 (define supported-languages
147 "NOTHING AT THIS TIME!!!"
159 ;; Get @var{lang}'s @var{parameter}. Both args are symbols.
161 (define (lang-parm lang parm)
162 (list-ref (assq-ref supported-languages lang)
164 ((docstring-start) 0)
166 ((docstring-prefix) 2)
168 ((signature-start) 4)
169 ((std-int-doc?) 5))))
171 ;; Snarf all docstrings from the file @var{input} and write them to
172 ;; file @var{output}. Use texinfo format for the output if
173 ;; @var{texinfo?} is true.
174 ;;-ttn-mod: don't use string comparison, consult table instead
175 (define (snarf-file input output texinfo? lang)
176 (or (memq lang (map car supported-languages))
177 (error "doc-snarf: input language must be c or scheme."))
178 (write-output (snarf input lang) output
179 (if texinfo? format-texinfo format-plain)))
181 ;; fixme: this comment is required to trigger standard internal
182 ;; docstring snarfing... ideally, it wouldn't be necessary.
183 ;;-ttn-mod: new proc, from snarf-docs (aren't these names fun?)
184 (define (find-std-int-doc line input-port)
185 "Unread @var{line} from @var{input-port}, then read in the entire form and
186 return the standard internal docstring if found. Return #f if not."
187 (unread-string line input-port) ; ugh
188 (let ((form (read input-port)))
189 (cond ((and (list? form) ; (define (PROC ARGS) "DOC" ...)
191 (eq? 'define (car form))
193 (symbol? (caadr form))
194 (string? (caddr form)))
196 ((and (list? form) ; (define VAR (lambda ARGS "DOC" ...))
198 (eq? 'define (car form))
199 (symbol? (cadr form))
201 (< 3 (length (caddr form)))
202 (eq? 'lambda (car (caddr form)))
203 (string? (caddr (caddr form))))
204 (caddr (caddr form)))
207 ;; Split @var{string} into lines, adding @var{prefix} to each.
209 (define (split-prefixed string prefix)
210 (separate-fields-discarding-char
214 (string-append prefix line))
217 ;; snarf input-file output-file
218 ;; Extract docstrings from the input file @var{input}, presumed
219 ;; to be written in language @var{lang}.
220 ;;-Author: Martin Grabmueller <mgrabmue@cs.tu-berlin.de>
221 ;;-Created: 2001-02-17
222 ;;-ttn-mod: regluarize lang parm lookup, add "std int doc" snarfing (2 places)
223 (define (snarf input-file lang)
224 (let* ((i-p (open-input-file input-file))
225 (parm-regexp (lambda (parm) (make-regexp (lang-parm lang parm))))
226 (docstring-start (parm-regexp 'docstring-start))
227 (docstring-end (parm-regexp 'docstring-end))
228 (docstring-prefix (parm-regexp 'docstring-prefix))
229 (option-prefix (parm-regexp 'option-prefix))
230 (signature-start (parm-regexp 'signature-start))
232 (lambda (line i-p options)
233 (let ((int-doc (and (lang-parm lang 'std-int-doc?)
234 (let ((d (find-std-int-doc line i-p)))
235 (and d (split-prefixed d "internal: "))))))
237 (append (reverse int-doc) options)
240 (let lp ((line (read-line i-p)) (state 'neutral) (doc-strings '())
241 (options '()) (entries '()) (lno 0))
244 (close-input-port i-p)
247 ;; State 'neutral: we're currently not within a docstring or
249 ((eq? state 'neutral)
250 (let ((m (regexp-exec docstring-start line)))
252 (lp (read-line i-p) 'doc-string
253 (list (match:substring m 1)) '() entries (+ lno 1))
254 (lp (read-line i-p) state '() '() entries (+ lno 1)))))
256 ;; State 'doc-string: we have started reading a docstring and
257 ;; are waiting for more, for options or for a define.
258 ((eq? state 'doc-string)
259 (let ((m0 (regexp-exec docstring-prefix line))
260 (m1 (regexp-exec option-prefix line))
261 (m2 (regexp-exec signature-start line))
262 (m3 (regexp-exec docstring-end line)))
265 (lp (read-line i-p) 'doc-string
266 (cons (match:substring m0 1) doc-strings) '() entries
269 (lp (read-line i-p) 'options
270 doc-strings (cons (match:substring m1 1) options) entries
273 (let ((options (augmented-options line i-p options))) ; ttn-mod
274 (lp (read-line i-p) 'neutral '() '()
275 (cons (parse-entry doc-strings options line input-file lno)
279 (lp (read-line i-p) 'neutral '() '()
280 (cons (parse-entry doc-strings options #f input-file lno)
284 (lp (read-line i-p) 'neutral '() '() entries (+ lno 1))))))
286 ;; State 'options: We're waiting for more options or for a
288 ((eq? state 'options)
289 (let ((m1 (regexp-exec option-prefix line))
290 (m2 (regexp-exec signature-start line))
291 (m3 (regexp-exec docstring-end line)))
294 (lp (read-line i-p) 'options
295 doc-strings (cons (match:substring m1 1) options) entries
298 (let ((options (augmented-options line i-p options))) ; ttn-mod
299 (lp (read-line i-p) 'neutral '() '()
300 (cons (parse-entry doc-strings options line input-file lno)
304 (lp (read-line i-p) 'neutral '() '()
305 (cons (parse-entry doc-strings options #f input-file lno)
309 (lp (read-line i-p) 'neutral '() '() entries (+ lno 1))))))))))
311 (define (make-entry symbol signature docstrings options filename line)
312 (vector 'entry symbol signature docstrings options filename line))
313 (define (entry-symbol e)
315 (define (entry-signature e)
317 (define (entry-docstrings e)
319 (define (entry-options e)
321 (define (entry-filename e)
323 (define (entry-line e)
324 "This docstring will not be snarfed, unfortunately..."
327 ;; Create a docstring entry from the docstring line list
328 ;; @var{doc-strings}, the option line list @var{options} and the
329 ;; define line @var{def-line}
330 (define (parse-entry docstrings options def-line filename line-no)
331 ; (write-line docstrings)
334 (make-entry (get-symbol def-line)
335 (make-prototype def-line) (reverse docstrings)
336 (reverse options) filename
337 (+ (- line-no (length docstrings) (length options)) 1)))
338 ((> (length docstrings) 0)
339 (make-entry (string->symbol (car (reverse docstrings)))
340 (car (reverse docstrings))
341 (cdr (reverse docstrings))
342 (reverse options) filename
343 (+ (- line-no (length docstrings) (length options)) 1)))
345 (make-entry 'foo "" (reverse docstrings) (reverse options) filename
346 (+ (- line-no (length docstrings) (length options)) 1)))))
348 ;; Create a string which is a procedure prototype. The necessary
349 ;; information for constructing the prototype is taken from the line
350 ;; @var{def-line}, which is a line starting with @code{(define...}.
351 (define (make-prototype def-line)
352 (call-with-input-string
355 (let* ((paren (read-char s-p))
362 (symbol->string tmp))
366 (define (get-symbol def-line)
367 (call-with-input-string
370 (let* ((paren (read-char s-p))
381 ;; Append the symbols in the string list @var{s}, separated with a
383 (define (join-symbols s)
387 (string-append ". " (symbol->string s)))
389 (symbol->string (car s)))
391 (string-append (symbol->string (car s)) " " (join-symbols (cdr s))))))
393 ;; Write @var{entries} to @var{output-file} using @var{writer}.
394 ;; @var{writer} is a proc that takes one entry.
395 ;; If @var{output-file} is #f, write to stdout.
397 (define (write-output entries output-file writer)
398 (with-output-to-port (cond (output-file (open-output-file output-file))
399 (else (current-output-port)))
400 (lambda () (for-each writer entries))))
402 ;; Write an @var{entry} using texinfo format.
403 ;;-ttn-mod: renamed from `texinfo-output', distilled
404 (define (format-texinfo entry)
406 (display (entry-symbol entry))
408 (display "@c snarfed from ")
409 (display (entry-filename entry))
411 (display (entry-line entry))
413 (display "@deffn procedure ")
414 (display (entry-signature entry))
416 (for-each (lambda (s) (write-line s))
417 (entry-docstrings entry))
418 (for-each (lambda (s) (display "@c ") (write-line s))
419 (entry-options entry))
420 (write-line "@end deffn"))
422 ;; Write an @var{entry} using plain format.
423 ;;-ttn-mod: renamed from `texinfo-output', distilled
424 (define (format-plain entry)
425 (display "Procedure: ")
426 (display (entry-signature entry))
428 (for-each (lambda (s) (write-line s))
429 (entry-docstrings entry))
430 (for-each (lambda (s) (display ";; ") (write-line s))
431 (entry-options entry))
432 (display "Snarfed from ")
433 (display (entry-filename entry))
435 (display (entry-line entry))
439 ;;; doc-snarf ends here