scheme-only doc snarfer useful w/ (ice-9 documentation)

[thi]

please see below for a scheme-only doc snarfer that produces output
compatible w/ that used by `(ice-9 documentation)'.  to use, do
something like:

$ snarf-docs *.scm > /tmp/my-docs.txt

then, make sure `find-documentation' is exported (cvs guile EOW IAGW)
and put in your program:

(use-modules (ice-9 documentation))
(or (member "/tmp/my-docs.txt" documentation-files)
    (set! documentation-files (cons "/tmp/my-docs.txt"
                                    documentation-files)))
(write-line (find-documentation 'my-proc))

improvements and other feedback very much welcome!  (particularly, it
would be nice to receive a patch that modifies this program to be able
to understand stylized top-level comments -- see recent guile mailing
lists discussions.)

thi


______________________________
#!/bin/sh
exec guile -s $0 "$@"                                   # -*- scheme -*-
!#
;;; snarf-docs --- extract documentation from source

;; Exp:
;;
;; Copyright (C) 2001 Thien-Thi Nguyen
;; This file is part of ttn's personal scheme library, released under GNU
;; GPL with ABSOLUTELY NO WARRANTY.  See the file COPYING for details.

;;; Commentary:

;; Usage: snarf-docs SOURCE [...]

;; Output format:
;;
;; display-docs
;;
;; (display-docs file)
;;
;; Display docstring of procedures defined in FILE.
;;
;; (snarf-docs:53)
;;
;; main
;;
;; (main ls)
;;
;; DTRT!
;;
;; (snarf-docs:80)

;;; Code:

(use-modules (ttn echo) (ttn eformat))

(read-enable 'positions)

(activate-eformat)

(define (display-doc invocation doc file line)  ; todo: parameterize
  (echo-n "\f")
  (echo (car invocation))
  (echo)
  (echo invocation)
  (echo)
  (echo doc)
  (echo)
  (echo #[(${file}:${line})])
  (echo))

(define (display-docs file)
  "Display docstring of procedures defined in FILE."
  (let ((p (open-input-file file)))
    (let loop ((form (read p)))
      (or (eof-object? form)
          (let ((line (1+ (source-property form 'line))))
            ;; todo: use some table-driven pattern matcher...
            (cond ((and (list? form)
                        (< 3 (length form))
                        (eq? 'define (car form))
                        (pair? (cadr form))
                        (symbol? (caadr form))
                        (string? (caddr form)))
                   (display-doc (cadr form) (caddr form) file line))
                  ((and (list? form)
                        (< 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))))
                   (display-doc (cons (cadr form) (cadr (caddr form)))
                                (caddr (caddr form))
                                file line)))
            (loop (read p)))))))

(define main (lambda (ls) "DTRT!" (for-each display-docs ls)))

(exit (main (cdr (command-line))))

(deactivate-eformat)                    ; hmm, never reached

;;; snarf-docs ends here