From 4f7a0504aac215832e99290e31c9944795c5d206 Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Tue, 27 Jan 2009 13:43:07 +0100 Subject: [PATCH 1/2] merge in from guile-lib: add some extensibility to `help' * ice-9/session.scm (add-value-help-handler!) (remove-value-help-handler!, add-name-help-handler!) (remove-name-help-handler!): New public interfaces, to allow some basic extensibility of the help interface. Merged in from guile-lib's (scheme session). --- ice-9/session.scm | 72 +++++++++++++++++++++++++++++++++++++++++------ 1 file changed, 64 insertions(+), 8 deletions(-) diff --git a/ice-9/session.scm b/ice-9/session.scm index 1c9f48016..6971a7894 100644 --- a/ice-9/session.scm +++ b/ice-9/session.scm @@ -20,12 +20,61 @@ :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 system-module)) + :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 + system-module module-commentary)) +(define *value-help-handlers* '()) + +(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. + +See the documentation for `add-value-help-handler' for more +information." + (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. + +The return value of `proc' is as specified in +`add-value-help-handler!'." + (set! *name-help-handlers* (cons proc *name-help-handlers*))) + +(define (remove-name-help-handler! proc) + "Removes a handler for performing `help' on a name. + +See the documentation for `add-name-help-handler' for more +information." + (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 help @@ -45,6 +94,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 +113,12 @@ You don't seem to have regular expressions installed.\n")) ((and (list? name) (= (length name) 2) (eq? (car name) 'unquote)) - (cond ((object-documentation - (local-eval (cadr name) env)) - => write-line) - (else (not-found 'documentation (cadr name))))) + (let ((value (local-eval (cadr name) env))) + (cond ((try-value-help (cadr name) value) + => noop) + ((object-documentation value) + => write-line) + (else (not-found 'documentation (cadr name)))))) ;; (quote SYMBOL) ((and (list? name) @@ -109,7 +164,8 @@ 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) + (or (try-value-help name object) + (object-documentation object)) (cond ((closure? object) "a procedure") ((procedure? object) From 53d81399bef1d9396665e79fb6b9c25eb8e2a6ad Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Wed, 28 Jan 2009 11:56:21 +0100 Subject: [PATCH 2/2] cleanups to value and help help handlers * ice-9/session.scm (*value-help-handlers*): Define object-documentation as the default value help handler. (remove-value-help-handler!, add-name-help-handler!) (remove-name-help-handler!): Fix docs. (help, help-doc): Fix so that we try object-documentation through try-value-help, and we obey the docs regarding what happens with return values. --- ice-9/session.scm | 33 ++++++++++++++------------------- 1 file changed, 14 insertions(+), 19 deletions(-) diff --git a/ice-9/session.scm b/ice-9/session.scm index 6971a7894..c1bbab206 100644 --- a/ice-9/session.scm +++ b/ice-9/session.scm @@ -29,7 +29,9 @@ -(define *value-help-handlers* '()) +(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. @@ -41,10 +43,7 @@ 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. - -See the documentation for `add-value-help-handler' for more -information." + "Removes a handler for performing `help' on a value." (set! *value-help-handlers* (delete! proc *value-help-handlers*))) (define (try-value-help name value) @@ -60,15 +59,13 @@ information." to say, when the user calls `(help FOO)', the name is FOO, exactly as the user types it. -The return value of `proc' is as specified in -`add-value-help-handler!'." +`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. - -See the documentation for `add-name-help-handler' for more -information." + "Removes a handler for performing `help' on a name." (set! *name-help-handlers* (delete! proc *name-help-handlers*))) (define (try-name-help name) @@ -113,12 +110,11 @@ You don't seem to have regular expressions installed.\n")) ((and (list? name) (= (length name) 2) (eq? (car name) 'unquote)) - (let ((value (local-eval (cadr name) env))) - (cond ((try-value-help (cadr name) value) - => noop) - ((object-documentation value) - => 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) @@ -164,8 +160,7 @@ You don't seem to have regular expressions installed.\n")) (let ((entries (apropos-fold (lambda (module name object data) (cons (list module name - (or (try-value-help name object) - (object-documentation object)) + (try-value-help name object) (cond ((closure? object) "a procedure") ((procedure? object)