guile-devel
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

module commentary


From: thi
Subject: module commentary
Date: Mon, 11 Sep 2000 10:29:56 -0700

ah, source...
ah, reflection...

please find below a modified `help' and two new support procs, allowing

        guile> (help (thud impl com))

to display the text between ";;; Commentary:" and ";;; Code:" in
source file /some/path/to/thud/impl/com.scm (w/ `%search-load-path').

i would have sent a patch, but haven't gotten around to changing over
to the new CVS repo yet...

thi


____________________________
;;; modified `help'
(define-public help
  (procedure->syntax
    (lambda (exp env)
      "(help [NAME])
Prints useful information.  Try `(help)'."
      (cond ((not (= (length exp) 2))
             (help-usage))
            ((not (feature? 'regex))
             (display "`help' depends on the `regex' feature.
You don't seem to have regular expressions installed.\n"))
            (else
             (let ((name (cadr exp)))
               (cond ((symbol? name)
                      (help-doc name
                                (string-append "^"
                                               (regexp-quote
                                                (symbol->string name))
                                               "$")))
                     ((string? name)
                      (help-doc name name))
                     ((and (list? name)
                           (= (length name) 2)
                           (eq? (car name) 'unquote))
                      (let ((doc (object-documentation (local-eval (cadr name)
                                                                   env))))
                        (if (not doc)
                            (simple-format #t "No documentation found for ~S\n"
                                           (cadr name))
                            (write-line doc))))
                     ((list? name)
                      (let ((doc (module-commentary name)))
                        (if (not doc)
                            (simple-format
                             #t "No commentary found for module ~S\n" name)
                            (begin
                              (display name) (write-line " commentary:")
                              (write-line doc)))))
                     (else
                      (help-usage)))
               *unspecified*))))))

;;; two new procs -- maybe these should go into (ice-9 documentation)?
(define (module-commentary name)
  (let* ((reverse-name (reverse name))
         (leaf (car reverse-name))
         (dir-hint-module-name (reverse (cdr reverse-name)))
         (dir-hint (apply symbol-append
                          (map (lambda (elt)
                                 (symbol-append elt "/"))
                               dir-hint-module-name)))
         (full (%search-load-path (in-vicinity dir-hint leaf))))
    (and full (commentary-cat full))))

(define (commentary-cat filename)
  (let* ((starts-with? (lambda (s line)
                         (let ((slen (string-length s)))
                           (and (<= slen (string-length line))
                                (string=? s (substring line 0 slen))))))
         (dirt (make-regexp "^;+*"))    ; preserve bol whitespace
         (scrub (lambda (line)
                  (let ((m (regexp-exec dirt line)))
                    (if m (match:suffix m) line))))
         (port (open-input-file filename)))
    (let loop ((line (read-delimited "\n" port))
               (doc "")
               (parse-state 'before))
      (if (eof-object? line)
          doc
          (let ((new-state
                 (cond ((starts-with? ";;; Commentary:" line) 'in)
                       ((starts-with? ";;; Code:"       line) 'after)
                       (else parse-state))))
            (if (eq? 'after new-state)
                doc
                (loop (read-delimited "\n" port)
                      (if (and (eq? 'in new-state) (eq? 'in parse-state))
                          (string-append doc (scrub line) "\n")
                          doc)
                      new-state)))))))

;;; code ends here


reply via email to

[Prev in Thread] Current Thread [Next in Thread]