* Enhancements to online help presentation.

ice-9/ChangeLog

@@ -1,3 +1,15 @@
+2000-09-29  Neil Jerram  <neil@ossau.uklinux.net>
+
+	* 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  <mdj@mdj.nada.kth.se>
 
 	* boot-9.scm: Removed comment.  (Thanks to Brad Knotwell.)

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

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)