more about docstring snarfing

[Martin Grabmueller]

Hello all,

I have thought some more about snarfing docstrings from Scheme files
and came up with the following:

After copying my doc-snarf.scm script (enhanced version attached
below) to ice-9/ and adding the following to ice-9/Makefile.am

=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
DOT_DOC_FILES = posix.doc boot-9.doc popen.doc

SUFFIXES = .scm .doc

.scm.doc:
        ../libguile/guile -e main -s ./doc-snarf.scm --texinfo --output $@ $<

ice-9.texi: $(DOT_DOC_FILES)
        echo "@paragraphindent 0" > $@
        cat *.doc >> $@

ice-9-docstrings.txt: ice-9.texi
        rm -f $@
        makeinfo --force -o $@ $< || test -f $@
=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-

I was able to extract some documentation from the ice-9 sources.  Of
course, snarfing is not perfect yet, but the resulting file
ice-9-docstrings.txt is in a format compatible with Guile's `help'
macro.

If we want to go that way, there are some decisions to be made.  The
first is the bootstrap problem.  This could be solved by calling the
Makefile rules above from libguile/Makefile, after building Guile, or
possibly from the installation rules.

Then there is the module problem. Should docstrings be grouped by
modules, or should they go in just one file (if we do that, we could
also append the docstrings from the ice-9 directory to the docstring
file in libguile after the guile executable is built).

Consider this a RFC, if you don't want this kind of snarfing, we can
come up with another proposal.

Best regards,
  'martin 

===File ~/cvs/guile/guile-core/ice-9/doc-snarf.scm==========
#! /usr/local/bin/guile \
-e main -s
!#
;;; This program reads in Scheme source files 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.
;;;
;;; 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.

(use-modules (ice-9 getopt-long) (ice-9 regex))

(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))
    (source  (single-char #\s) (value #t))))

;; Display version information and exit.
(define (display-version)
  (display "doc-snarf.scm 0.0.1\n"))

;; Display the usage help message and exit.
(define (display-help)
  (display "Usage: doc-snarf.scm [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=snarf-out.txt]\n")
  (display "  --texinfo, -t           Format output as texinfo\n")
  (display "  --source=[c,scheme], -s Specify the input language\n"))

;; Main program.
(define (main cmd-line)
  (let ((options (getopt-long cmd-line command-synopsis)))
    (let ((help-wanted (option-ref options 'help #f))
          (version-wanted (option-ref options 'version #f))
          (texinfo-wanted (option-ref options 'texinfo #f))
          (source (option-ref options 'source "scheme")))
      (cond
       ((or version-wanted help-wanted)
        (if version-wanted
            (display-version))
        (if help-wanted
            (display-help)))
       (else
        (let ((input (option-ref options '() #f))
              (output (option-ref options 'output "snarf-out.txt")))
          (if (and input (pair? input))
              (snarf-file (car input) output texinfo-wanted source)
              (display-help))))))))

;; Snarf all docstrings from the file @var{input} and write them to
;; the file @var{output}.  Use texinfo format for the output if
;; @var{texinfo?} is true.
(define (snarf-file input output texinfo? source)
  (if (or (string-ci=? source "c") (string-ci=? source "scheme"))
      (let ((data (snarf input source)))
        (if texinfo?
            (output-texinfo data output)
            (output-plain data output)))
      (error "doc-snarf: input language must be c or scheme.")))

;; snarf input-file output-file
;; Extract docstrings from the input file @var{input} and write them
;; to @var{output}.
;;-Author: Martin Grabmueller <address@hidden>
;;-Created: 2001-02-17
(define (snarf input-file source)
  (let ((i-p (open-input-file input-file))
        (docstring-start  (cond ((string-ci=? source "c")
                                 (make-regexp "^/\\*(.*)"))
                                ((string-ci=? source "scheme")
                                 (make-regexp "^;; (.*)"))))
        (docstring-end    (cond ((string-ci=? source "c")
                                 (make-regexp "^ \\*/"))
                                ((string-ci=? source "scheme")
                                 (make-regexp "^;;\\."))))
        (docstring-prefix (cond ((string-ci=? source "c")
                                 (make-regexp "^ \\* (.*)"))
                                ((string-ci=? source "scheme")
                                 (make-regexp "^;; (.*)"))))
        (option-prefix     (cond ((string-ci=? source "c")
                                 (make-regexp "^ \\*-(.*)"))
                                ((string-ci=? source "scheme")
                                 (make-regexp "^;;-(.*)"))))
        (signature-start  (make-regexp "^\\(define")))

    (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
            (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
            (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)
  (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 the documentation entries from the list @var{data} in texinfo
;; format to the file @var{output-file}.
(define (output-texinfo data output-file)
  (let ((o-p (open-output-file output-file)))
    (for-each
     (lambda (entry)
       (display "\n\f" o-p)
       (display (entry-symbol entry) o-p)
       (newline o-p)
       (display "@c snarfed from " o-p)
       (display (entry-filename entry) o-p)
       (display ":" o-p)
       (display (entry-line entry) o-p)
       (newline o-p)
       (display "@deffn procedure " o-p)
       (display (entry-signature entry) o-p)
       (newline o-p)
       (for-each (lambda (s) (write-line s o-p))
                 (entry-docstrings entry))
       (for-each (lambda (s) (display "@c " o-p) (write-line s o-p))
                 (entry-options entry))
       (write-line "@end deffn" o-p))
     data)))

;; Write the documentation entries from the list @var{data} in plain
;; text format to the file @var{output-file}.
(define (output-plain data output-file)
  (let ((o-p (open-output-file output-file)))
    (for-each
     (lambda (entry)
       (display "Procedure: " o-p)
       (display (entry-signature entry) o-p)
       (newline o-p)
       (for-each (lambda (s) (write-line s o-p))
                 (entry-docstrings entry))
       (for-each (lambda (s) (display ";; " o-p) (write-line s o-p))
                 (entry-options entry))
       (display "Snarfed from " o-p)
       (display (entry-filename entry) o-p)
       (display ":" o-p)
       (display (entry-line entry) o-p)
       (newline o-p)
       (write-line "\f" o-p))
     data)))

============================================================