diff --git a/ice-9/ChangeLog b/ice-9/ChangeLog index 64c04bc1b..c727ec59b 100644 --- a/ice-9/ChangeLog +++ b/ice-9/ChangeLog @@ -1,3 +1,15 @@ +2000-09-29 Neil Jerram + + * documentation.scm (find-documentation-in-file): Modified + according to changed format of guile-procedures.txt caused by my + snarfing/makeinfo changes in libguile. + + * session.scm (help-doc): Improvements to (help) output: (i) a + friendlier Emacs-style introduction line; (ii) where the help arg + matches multiple documented entries, print an initial list of the + entries for which documentation is found, before printing the + actual documentation entries themselves. + 2000-09-20 Mikael Djurfeldt * boot-9.scm: Removed comment. (Thanks to Brad Knotwell.) diff --git a/ice-9/documentation.scm b/ice-9/documentation.scm index 46d6b2720..3a7f1c24f 100644 --- a/ice-9/documentation.scm +++ b/ice-9/documentation.scm @@ -38,28 +38,24 @@ documentation-files)) (define entry-delimiter "\f") -(define entry-start 2) (define (find-documentation-in-file name file) (and (file-exists? file) (let ((port (open-input-file file)) (name (symbol->string name))) - (let* ((len (string-length name)) - (min-size (+ entry-start len)) - (end (+ entry-start len))) + (let ((len (string-length name))) (read-delimited entry-delimiter port) ;skip to first entry (let loop ((entry (read-delimited entry-delimiter port))) (cond ((eof-object? entry) #f) ;; match? ((and ;; large enough? - (>= (string-length entry) min-size) + (>= (string-length entry) len) ;; matching name? - (string=? (substring entry entry-start end) - name) + (string=? (substring entry 0 len) name) ;; terminated? - (memq (string-ref entry end) '(#\space #\)))) - ;; cut away starting and ending newline - (substring entry 1 (- (string-length entry) 1))) + (memq (string-ref entry len) '(#\newline))) + ;; cut away name tag and extra surrounding newlines + (substring entry (+ len 2) (- (string-length entry) 2))) (else (loop (read-delimited entry-delimiter port))))))))) ;; helper until the procedure documentation property is cleaned up diff --git a/ice-9/session.scm b/ice-9/session.scm index a03edcc7e..a49fc5fed 100644 --- a/ice-9/session.scm +++ b/ice-9/session.scm @@ -63,14 +63,21 @@ You don't seem to have regular expressions installed.\n")) (let ((entries (apropos-fold (lambda (module name object data) (cons (list module name - (object-documentation object)) + (object-documentation object) + (cond ((closure? object) + "a procedure") + ((procedure? object) + "a primitive procedure") + (else + "an object"))) data)) '() regexp apropos-fold-exported)) (module car) (name cadr) - (doc caddr)) + (doc caddr) + (type cadddr)) (if (null? entries) ;; no matches (begin @@ -80,32 +87,55 @@ You don't seem to have regular expressions installed.\n")) "named `~A'\n" "matching regexp \"~A\"\n") term)) - (let ((first? #t)) - (if (or-map doc entries) - ;; entries with documentation - (for-each (lambda (entry) - ;; *fixme*: Use `describe' when we have GOOPS? - (if (doc entry) - (begin - (if first? - (set! first? #f) - (newline)) - (simple-format #t "~S: ~S\n~A\n" - (module-name (module entry)) - (name entry) - (doc entry))))) - entries)) - (if (or-map (lambda (x) (not (doc x))) entries) - ;; entries without documentation + (let ((first? #t) + (undocumented-entries '()) + (documented-entries '()) + (documentations '())) + + (for-each (lambda (entry) + (let ((entry-summary (simple-format #f + "~S: ~S\n" + (module-name (module entry)) + (name entry)))) + (if (doc entry) + (begin + (set! documented-entries + (cons entry-summary documented-entries)) + ;; *fixme*: Use `describe' when we have GOOPS? + (set! documentations + (cons (simple-format #f + "`~S' is ~A in the ~S module.\n\n~A\n" + (name entry) + (type entry) + (module-name (module entry)) + (doc entry)) + documentations))) + (set! undocumented-entries + (cons entry-summary undocumented-entries))))) + entries) + + (if (and (not (null? documented-entries)) + (or (> (length documented-entries) 1) + (not (null? undocumented-entries)))) (begin - (if (not first?) - (display "\nNo documentation found for:\n")) - (for-each (lambda (entry) - (if (not (doc entry)) - (simple-format #t "~S: ~S\n" - (module-name (module entry)) - (name entry)))) - entries))))))) + (display "Documentation found for:\n") + (for-each (lambda (entry) (display entry)) documented-entries) + (set! first? #f))) + + (for-each (lambda (entry) + (if first? + (set! first? #f) + (newline)) + (display entry)) + documentations) + + (if (not (null? undocumented-entries)) + (begin + (if first? + (set! first? #f) + (newline)) + (display "No documentation found for:\n") + (for-each (lambda (entry) (display entry)) undocumented-entries))))))) (define (help-usage) (display "Usage: (help NAME) gives documentation about objects named NAME (a symbol)