--- /dev/null
+#!/bin/sh
+# aside from this initial boilerplate, this is actually -*- scheme -*- code
+main='(module-ref (resolve-module '\''(scripts doc-snarf)) '\'main')'
+exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@"
+!#
+;;; doc-snarf --- Extract documentation from source files
+
+;; Copyright (C) 2001, 2006 Free Software Foundation, Inc.
+;;
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or
+;; (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this software; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301 USA
+
+;;; Author: Martin Grabmueller
+
+;;; Commentary:
+
+;; Usage: doc-snarf FILE
+;;
+;; This program reads in a Scheme source file and extracts docstrings
+;; in the format specified below. Additionally, a procedure protoype
+;; is infered from the procedure definition line starting with
+;; (define... ).
+;;
+;; Currently, two output modi are implemented: texinfo and plaintext.
+;; Default is plaintext, texinfo can be switched on with the
+;; `--texinfo, -t' command line option.
+;;
+;; Format: A docstring can span multiple lines and a docstring line
+;; begins with `;; ' (two semicoli and a space). A docstring is ended
+;; by either a line beginning with (define ...) or one or more lines
+;; beginning with `;;-' (two semicoli and a dash). These lines are
+;; called `options' and begin with a keyword, followed by a colon and
+;; a string.
+;;
+;; Additionally, "standard internal docstrings" (for Scheme source) are
+;; recognized and output as "options". The output formatting is likely
+;; to change in the future.
+;;
+;; Example:
+
+;; This procedure foos, or bars, depending on the argument @var{braz}.
+;;-Author: Martin Grabmueller
+(define (foo/bar braz)
+ (if braz 'foo 'bar))
+
+;;; Which results in the following docstring if texinfo output is
+;;; enabled:
+#!
+\ffoo/bar
+@deffn procedure foo/bar braz
+This procedure foos, or bars, depending on the argument @var{braz}.
+@c Author: Martin Grabmueller
+@end deffn
+!#
+
+;;; Or in this if plaintext output is used:
+#!
+Procedure: foo/bar braz
+This procedure foos, or bars, depending on the argument @var{braz}.
+;; Author: Martin Grabmueller
+^L
+!#
+
+;; TODO: Convert option lines to alist.
+;; More parameterization.
+;; ../libguile/guile-doc-snarf emulation
+
+(define doc-snarf-version "0.0.2") ; please update before publishing!
+
+;;; Code:
+
+(define-module (scripts doc-snarf)
+ :use-module (ice-9 getopt-long)
+ :use-module (ice-9 regex)
+ :use-module (ice-9 string-fun)
+ :use-module (ice-9 rdelim)
+ :export (doc-snarf))
+
+(define command-synopsis
+ '((version (single-char #\v) (value #f))
+ (help (single-char #\h) (value #f))
+ (output (single-char #\o) (value #t))
+ (texinfo (single-char #\t) (value #f))
+ (lang (single-char #\l) (value #t))))
+
+;; Display version information and exit.
+;;-ttn-mod: use var
+(define (display-version)
+ (display "doc-snarf ") (display doc-snarf-version) (newline))
+
+;; Display the usage help message and exit.
+;;-ttn-mod: change option "source" to "lang"
+(define (display-help)
+ (display "Usage: doc-snarf [options...] inputfile\n")
+ (display " --help, -h Show this usage information\n")
+ (display " --version, -v Show version information\n")
+ (display
+ " --output=FILE, -o Specify output file [default=stdout]\n")
+ (display " --texinfo, -t Format output as texinfo\n")
+ (display " --lang=[c,scheme], -l Specify the input language\n"))
+
+;; Main program.
+;;-ttn-mod: canonicalize lang
+(define (doc-snarf . args)
+ (let ((options (getopt-long (cons "doc-snarf" args) command-synopsis)))
+ (let ((help-wanted (option-ref options 'help #f))
+ (version-wanted (option-ref options 'version #f))
+ (texinfo-wanted (option-ref options 'texinfo #f))
+ (lang (string->symbol
+ (string-downcase (option-ref options 'lang "scheme")))))
+ (cond
+ (version-wanted (display-version))
+ (help-wanted (display-help))
+ (else
+ (let ((input (option-ref options '() #f))
+ (output (option-ref options 'output #f)))
+ (if
+ ;; Bonard B. Timmons III says `(pair? input)' alone is sufficient.
+ ;; (and input (pair? input))
+ (pair? input)
+ (snarf-file (car input) output texinfo-wanted lang)
+ (display-help))))))))
+
+(define main doc-snarf)
+
+;; Supported languages and their parameters. Each element has form:
+;; (LANG DOC-START DOC-END DOC-PREFIX OPT-PREFIX SIG-START STD-INT-DOC?)
+;; LANG is a symbol, STD-INT-DOC? is a boolean indicating whether or not
+;; LANG supports "standard internal docstring" (a string after the formals),
+;; everything else is a string specifying a regexp.
+;;-ttn-mod: new var
+(define supported-languages
+ '((c
+ "^/\\*(.*)"
+ "^ \\*/"
+ "^ \\* (.*)"
+ "^ \\*-(.*)"
+ "NOTHING AT THIS TIME!!!"
+ #f
+ )
+ (scheme
+ "^;; (.*)"
+ "^;;\\."
+ "^;; (.*)"
+ "^;;-(.*)"
+ "^\\(define"
+ #t
+ )))
+
+;; Get @var{lang}'s @var{parameter}. Both args are symbols.
+;;-ttn-mod: new proc
+(define (lang-parm lang parm)
+ (list-ref (assq-ref supported-languages lang)
+ (case parm
+ ((docstring-start) 0)
+ ((docstring-end) 1)
+ ((docstring-prefix) 2)
+ ((option-prefix) 3)
+ ((signature-start) 4)
+ ((std-int-doc?) 5))))
+
+;; Snarf all docstrings from the file @var{input} and write them to
+;; file @var{output}. Use texinfo format for the output if
+;; @var{texinfo?} is true.
+;;-ttn-mod: don't use string comparison, consult table instead
+(define (snarf-file input output texinfo? lang)
+ (or (memq lang (map car supported-languages))
+ (error "doc-snarf: input language must be c or scheme."))
+ (write-output (snarf input lang) output
+ (if texinfo? format-texinfo format-plain)))
+
+;; fixme: this comment is required to trigger standard internal
+;; docstring snarfing... ideally, it wouldn't be necessary.
+;;-ttn-mod: new proc, from snarf-docs (aren't these names fun?)
+(define (find-std-int-doc line input-port)
+ "Unread @var{line} from @var{input-port}, then read in the entire form and
+return the standard internal docstring if found. Return #f if not."
+ (unread-string line input-port) ; ugh
+ (let ((form (read input-port)))
+ (cond ((and (list? form) ; (define (PROC ARGS) "DOC" ...)
+ (< 3 (length form))
+ (eq? 'define (car form))
+ (pair? (cadr form))
+ (symbol? (caadr form))
+ (string? (caddr form)))
+ (caddr form))
+ ((and (list? form) ; (define VAR (lambda ARGS "DOC" ...))
+ (< 2 (length form))
+ (eq? 'define (car form))
+ (symbol? (cadr form))
+ (list? (caddr form))
+ (< 3 (length (caddr form)))
+ (eq? 'lambda (car (caddr form)))
+ (string? (caddr (caddr form))))
+ (caddr (caddr form)))
+ (else #f))))
+
+;; Split @var{string} into lines, adding @var{prefix} to each.
+;;-ttn-mod: new proc
+(define (split-prefixed string prefix)
+ (separate-fields-discarding-char
+ #\newline string
+ (lambda lines
+ (map (lambda (line)
+ (string-append prefix line))
+ lines))))
+
+;; snarf input-file output-file
+;; Extract docstrings from the input file @var{input}, presumed
+;; to be written in language @var{lang}.
+;;-Author: Martin Grabmueller <mgrabmue@cs.tu-berlin.de>
+;;-Created: 2001-02-17
+;;-ttn-mod: regluarize lang parm lookup, add "std int doc" snarfing (2 places)
+(define (snarf input-file lang)
+ (let* ((i-p (open-input-file input-file))
+ (parm-regexp (lambda (parm) (make-regexp (lang-parm lang parm))))
+ (docstring-start (parm-regexp 'docstring-start))
+ (docstring-end (parm-regexp 'docstring-end))
+ (docstring-prefix (parm-regexp 'docstring-prefix))
+ (option-prefix (parm-regexp 'option-prefix))
+ (signature-start (parm-regexp 'signature-start))
+ (augmented-options
+ (lambda (line i-p options)
+ (let ((int-doc (and (lang-parm lang 'std-int-doc?)
+ (let ((d (find-std-int-doc line i-p)))
+ (and d (split-prefixed d "internal: "))))))
+ (if int-doc
+ (append (reverse int-doc) options)
+ options)))))
+
+ (let lp ((line (read-line i-p)) (state 'neutral) (doc-strings '())
+ (options '()) (entries '()) (lno 0))
+ (cond
+ ((eof-object? line)
+ (close-input-port i-p)
+ (reverse entries))
+
+ ;; State 'neutral: we're currently not within a docstring or
+ ;; option section
+ ((eq? state 'neutral)
+ (let ((m (regexp-exec docstring-start line)))
+ (if m
+ (lp (read-line i-p) 'doc-string
+ (list (match:substring m 1)) '() entries (+ lno 1))
+ (lp (read-line i-p) state '() '() entries (+ lno 1)))))
+
+ ;; State 'doc-string: we have started reading a docstring and
+ ;; are waiting for more, for options or for a define.
+ ((eq? state 'doc-string)
+ (let ((m0 (regexp-exec docstring-prefix line))
+ (m1 (regexp-exec option-prefix line))
+ (m2 (regexp-exec signature-start line))
+ (m3 (regexp-exec docstring-end line)))
+ (cond
+ (m0
+ (lp (read-line i-p) 'doc-string
+ (cons (match:substring m0 1) doc-strings) '() entries
+ (+ lno 1)))
+ (m1
+ (lp (read-line i-p) 'options
+ doc-strings (cons (match:substring m1 1) options) entries
+ (+ lno 1)))
+ (m2
+ (let ((options (augmented-options line i-p options))) ; ttn-mod
+ (lp (read-line i-p) 'neutral '() '()
+ (cons (parse-entry doc-strings options line input-file lno)
+ entries)
+ (+ lno 1))))
+ (m3
+ (lp (read-line i-p) 'neutral '() '()
+ (cons (parse-entry doc-strings options #f input-file lno)
+ entries)
+ (+ lno 1)))
+ (else
+ (lp (read-line i-p) 'neutral '() '() entries (+ lno 1))))))
+
+ ;; State 'options: We're waiting for more options or for a
+ ;; define.
+ ((eq? state 'options)
+ (let ((m1 (regexp-exec option-prefix line))
+ (m2 (regexp-exec signature-start line))
+ (m3 (regexp-exec docstring-end line)))
+ (cond
+ (m1
+ (lp (read-line i-p) 'options
+ doc-strings (cons (match:substring m1 1) options) entries
+ (+ lno 1)))
+ (m2
+ (let ((options (augmented-options line i-p options))) ; ttn-mod
+ (lp (read-line i-p) 'neutral '() '()
+ (cons (parse-entry doc-strings options line input-file lno)
+ entries)
+ (+ lno 1))))
+ (m3
+ (lp (read-line i-p) 'neutral '() '()
+ (cons (parse-entry doc-strings options #f input-file lno)
+ entries)
+ (+ lno 1)))
+ (else
+ (lp (read-line i-p) 'neutral '() '() entries (+ lno 1))))))))))
+
+(define (make-entry symbol signature docstrings options filename line)
+ (vector 'entry symbol signature docstrings options filename line))
+(define (entry-symbol e)
+ (vector-ref e 1))
+(define (entry-signature e)
+ (vector-ref e 2))
+(define (entry-docstrings e)
+ (vector-ref e 3))
+(define (entry-options e)
+ (vector-ref e 4))
+(define (entry-filename e)
+ (vector-ref e 5))
+(define (entry-line e)
+ "This docstring will not be snarfed, unfortunately..."
+ (vector-ref e 6))
+
+;; Create a docstring entry from the docstring line list
+;; @var{doc-strings}, the option line list @var{options} and the
+;; define line @var{def-line}
+(define (parse-entry docstrings options def-line filename line-no)
+; (write-line docstrings)
+ (cond
+ (def-line
+ (make-entry (get-symbol def-line)
+ (make-prototype def-line) (reverse docstrings)
+ (reverse options) filename
+ (+ (- line-no (length docstrings) (length options)) 1)))
+ ((> (length docstrings) 0)
+ (make-entry (string->symbol (car (reverse docstrings)))
+ (car (reverse docstrings))
+ (cdr (reverse docstrings))
+ (reverse options) filename
+ (+ (- line-no (length docstrings) (length options)) 1)))
+ (else
+ (make-entry 'foo "" (reverse docstrings) (reverse options) filename
+ (+ (- line-no (length docstrings) (length options)) 1)))))
+
+;; Create a string which is a procedure prototype. The necessary
+;; information for constructing the prototype is taken from the line
+;; @var{def-line}, which is a line starting with @code{(define...}.
+(define (make-prototype def-line)
+ (call-with-input-string
+ def-line
+ (lambda (s-p)
+ (let* ((paren (read-char s-p))
+ (keyword (read s-p))
+ (tmp (read s-p)))
+ (cond
+ ((pair? tmp)
+ (join-symbols tmp))
+ ((symbol? tmp)
+ (symbol->string tmp))
+ (else
+ ""))))))
+
+(define (get-symbol def-line)
+ (call-with-input-string
+ def-line
+ (lambda (s-p)
+ (let* ((paren (read-char s-p))
+ (keyword (read s-p))
+ (tmp (read s-p)))
+ (cond
+ ((pair? tmp)
+ (car tmp))
+ ((symbol? tmp)
+ tmp)
+ (else
+ 'foo))))))
+
+;; Append the symbols in the string list @var{s}, separated with a
+;; space character.
+(define (join-symbols s)
+ (cond ((null? s)
+ "")
+ ((symbol? s)
+ (string-append ". " (symbol->string s)))
+ ((null? (cdr s))
+ (symbol->string (car s)))
+ (else
+ (string-append (symbol->string (car s)) " " (join-symbols (cdr s))))))
+
+;; Write @var{entries} to @var{output-file} using @var{writer}.
+;; @var{writer} is a proc that takes one entry.
+;; If @var{output-file} is #f, write to stdout.
+;;-ttn-mod: new proc
+(define (write-output entries output-file writer)
+ (with-output-to-port (cond (output-file (open-output-file output-file))
+ (else (current-output-port)))
+ (lambda () (for-each writer entries))))
+
+;; Write an @var{entry} using texinfo format.
+;;-ttn-mod: renamed from `texinfo-output', distilled
+(define (format-texinfo entry)
+ (display "\n\f")
+ (display (entry-symbol entry))
+ (newline)
+ (display "@c snarfed from ")
+ (display (entry-filename entry))
+ (display ":")
+ (display (entry-line entry))
+ (newline)
+ (display "@deffn procedure ")
+ (display (entry-signature entry))
+ (newline)
+ (for-each (lambda (s) (write-line s))
+ (entry-docstrings entry))
+ (for-each (lambda (s) (display "@c ") (write-line s))
+ (entry-options entry))
+ (write-line "@end deffn"))
+
+;; Write an @var{entry} using plain format.
+;;-ttn-mod: renamed from `texinfo-output', distilled
+(define (format-plain entry)
+ (display "Procedure: ")
+ (display (entry-signature entry))
+ (newline)
+ (for-each (lambda (s) (write-line s))
+ (entry-docstrings entry))
+ (for-each (lambda (s) (display ";; ") (write-line s))
+ (entry-options entry))
+ (display "Snarfed from ")
+ (display (entry-filename entry))
+ (display ":")
+ (display (entry-line entry))
+ (newline)
+ (write-line "\f"))
+
+;;; doc-snarf ends here
projects / lilypond.git / blobdiff