[Top][All Lists]
[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
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- module commentary,
thi <=