Re: Scheme file docstring format

[Martin Grabmueller]

Hello list,

I couldn't resist and have implemented a docstring snarfing script
which uses Neil's docstring formatting.  It currently supports plain
text and texinfo output.  I have attached it for examination.  A few
TODO's are listed in the file, and the output format will probably
have to change.

If we want to use something like that, we would have to implement some
Makefile magic to first build Guile, use the new Guile interpreter for
creating the docstring files and then install the whole stuff.

Or we decide to distribute pre-snarfed docstring files.

Feel free to comment on this one.

Regards,
  'martin
-- 
Martin Grabmueller              address@hidden
http://www.pintus.de/mgrabmue/  address@hidden on EFnet

===File ~/guile/snarf/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:
#!
@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:
;;
;; * Write proper data abstraction for entries (write accessors, a
;;   constructor etc.)
;; * Use regular expressions for matching the docstrings, options and 
;;   define lines.
;; * Convert option line to alist.
;; * Maybe add source file name and line number information to entries.

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

(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))))

;; 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, -o     Specify output file [default=snarf-out.txt]\n")
  (display "  --texinfo, -t    Format output as texinfo"))

;; 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)))
      (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)
              (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?)
  (let ((data (snarf input)))
    (if texinfo?
        (output-texinfo data output)
        (output-plain data output))))

;; 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)
  (let ((i-p (open-input-file input-file)))
    (let lp ((line (read-line i-p)) (state 'neutral) (doc-strings '())
             (options '()) (entries '()))
      (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)
        (if (and (> (string-length line) 2)
                 (string=? (substring line 0 3) ";; "))
            (lp (read-line i-p) 'doc-string 
                (list (substring line 3)) '() entries)
            (lp (read-line i-p) state '() '() entries)))
       
       ;; State 'doc-string: we have started reading a docstring and
       ;; are waiting for more, for options or for a define.
       ((eq? state 'doc-string)
        (cond ((and (> (string-length line) 2)
                    (string=? (substring line 0 3) ";; "))
               (lp (read-line i-p) 'doc-string
                   (cons (substring line 3) doc-strings) '() entries))
              ((and (> (string-length line) 2)
                    (string=? (substring line 0 3) ";;-"))
               (lp (read-line i-p) 'options 
                   doc-strings (cons (substring line 3) options) entries))
              ((and (> (string-length line) 7)
                    (string=? (substring line 0 7) "(define"))
               (lp (read-line i-p) 'neutral '() '()
                   (cons (parse-entry doc-strings options line) entries)))
              (else
               (lp (read-line i-p) 'neutral '() '() entries))))

       ;; State 'options: We're waiting for more options or for a
       ;; define.
       ((eq? state 'options)
        (cond ((and (> (string-length line) 2)
                    (string=? (substring line 0 3) ";;-"))
               (lp (read-line i-p) 'options 
                   doc-strings (cons (substring line 3) options) entries))
              ((and (> (string-length line) 7)
                    (string=? (substring line 0 7) "(define"))
               (lp (read-line i-p) 'neutral '() '()
                   (cons (parse-entry doc-strings options line) entries)))
              (else
               (lp (read-line i-p) 'neutral '() '() entries))))))))

;; 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 doc-strings options def-line)
  (vector 'entry (reverse doc-strings) (reverse options)
          (make-prototype def-line)))

;; 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-strings (map symbol->string tmp)))
        ((symbol? tmp)
         "")
        (else
         ""))))))

;; Append the strings in the string list @var{s}, separated with a
;; space character.
(define (join-strings s)
  (cond ((null? s)
         "")
        ((null? (cdr s))
         (car s))
        (else
         (string-append (car s) " " (join-strings (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 "@deffn procedure " o-p)
       (display (vector-ref entry 3) o-p)
       (newline o-p)
       (for-each (lambda (s) (write-line s o-p))
                 (vector-ref entry 1))
       (for-each (lambda (s) (display "@c " o-p) (write-line s o-p))
                 (vector-ref entry 2))
       (write-line "@end deffn" o-p)
       (write-line "\f" 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 (vector-ref entry 3) o-p)
       (newline o-p)
       (for-each (lambda (s) (write-line s o-p))
                 (vector-ref entry 1))
       (for-each (lambda (s) (display ";; " o-p) (write-line s o-p))
                 (vector-ref entry 2))
       (write-line "\f" o-p))
     data)))
============================================================