diff options
Diffstat (limited to 'scripts/doc-snarf')
-rwxr-xr-x | scripts/doc-snarf | 442 |
1 files changed, 0 insertions, 442 deletions
diff --git a/scripts/doc-snarf b/scripts/doc-snarf deleted file mode 100755 index 5b72fc5f8..000000000 --- a/scripts/doc-snarf +++ /dev/null @@ -1,442 +0,0 @@ -#!/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 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., 59 Temple Place, Suite 330, -;; Boston, MA 02111-1307 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: -#! -foo/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 |