Merge commit '53d81399bef1d9396665e79fb6b9c25eb8e2a6ad' into vm-check

Also cherry-picks the changes from 1405f1b60fa178303484cd428068ecd01ff6d322

Conflicts:

	module/ice-9/session.scm

1 files changed, 60 insertions, 8 deletions

diff --git a/module/ice-9/session.scm b/module/ice-9/session.scm
index f4768cc52..aaa4f0761 100644
--- a/module/ice-9/session.scm
+++ b/module/ice-9/session.scm
@@ -20,12 +20,59 @@
   :use-module (ice-9 documentation)
   :use-module (ice-9 regex)
   :use-module (ice-9 rdelim)
-  :export (help apropos apropos-internal apropos-fold
-	   apropos-fold-accessible apropos-fold-exported apropos-fold-all
-	   source arity procedure-arguments))
+  :export (help
+           add-value-help-handler! remove-value-help-handler!
+           add-name-help-handler! remove-name-help-handler!
+           apropos apropos-internal apropos-fold apropos-fold-accessible
+           apropos-fold-exported apropos-fold-all source arity
+           procedure-arguments
+           module-commentary))
 
 
 
+(define *value-help-handlers*
+  `(,(lambda (name value)
+       (object-documentation value))))
+
+(define (add-value-help-handler! proc)
+  "Adds a handler for performing `help' on a value.
+
+`proc' will be called as (PROC NAME VALUE). `proc' should return #t to
+indicate that it has performed help, a string to override the default
+object documentation, or #f to try the other handlers, potentially
+falling back on the normal behavior for `help'."
+  (set! *value-help-handlers* (cons proc *value-help-handlers*)))
+
+(define (remove-value-help-handler! proc)
+  "Removes a handler for performing `help' on a value."
+  (set! *value-help-handlers* (delete! proc *value-help-handlers*)))
+
+(define (try-value-help name value)
+  (or-map (lambda (proc) (proc name value)) *value-help-handlers*))
+
+
+(define *name-help-handlers* '())
+
+(define (add-name-help-handler! proc)
+  "Adds a handler for performing `help' on a name.
+
+`proc' will be called with the unevaluated name as its argument. That is
+to say, when the user calls `(help FOO)', the name is FOO, exactly as
+the user types it.
+
+`proc' should return #t to indicate that it has performed help, a string
+to override the default object documentation, or #f to try the other
+handlers, potentially falling back on the normal behavior for `help'."
+  (set! *name-help-handlers* (cons proc *name-help-handlers*)))
+
+(define (remove-name-help-handler! proc)
+  "Removes a handler for performing `help' on a name."
+  (set! *name-help-handlers* (delete! proc *name-help-handlers*)))
+
+(define (try-name-help name)
+  (or-map (lambda (proc) (proc name)) *name-help-handlers*))
+
+
 ;;; Documentation
 ;;;
 (define-macro (help . exp)
@@ -45,6 +92,10 @@ You don't seem to have regular expressions installed.\n")
                                            type x))))
            (cond
             
+            ;; User-specified
+            ((try-name-help name)
+             => (lambda (x) (if (not (eq? x #t)) (display x))))
+
             ;; SYMBOL
             ((symbol? name)
              (help-doc name
@@ -60,10 +111,11 @@ You don't seem to have regular expressions installed.\n")
             ((and (list? name)
                   (= (length name) 2)
                   (eq? (car name) 'unquote))
-             (cond ((object-documentation
-                     (eval (cadr name) (current-module)))
-                    => write-line)
-                   (else (not-found 'documentation (cadr name)))))
+             (let ((doc (try-value-help (cadr name)
+                                        (local-eval (cadr name) env))))
+               (cond ((not doc) (not-found 'documentation (cadr name)))
+                     ((eq? doc #t)) ;; pass
+                     (else (write-line doc)))))
 
             ;; (quote SYMBOL)
             ((and (list? name)
@@ -109,7 +161,7 @@ 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)
+					     (try-value-help name object)
 					     (cond ((closure? object)
 						    "a procedure")
 						   ((procedure? object)