mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +02:00
Code Activity

add an apropos-hook to ice-9 session

Browse source 
* module/ice-9/session.scm: #:keyword-ify the define-module form, and
  export apropos-hook.
  (apropos-hook): New hook.
  (apropos, apropos-fold): Run the apropos-hook.
This commit is contained in:
Andy Wingo 2011-12-12 23:42:04 +01:00
parent 9670f238d4
commit ac16263bc1
1 changed files with 17 additions and 10 deletions
Download patch file Download diff file Expand all files Collapse all files

15
module/ice-9/session.scm
View file

@ -17,12 +17,13 @@
(define-module (ice-9 session)
:use-module (ice-9 documentation)
:use-module (ice-9 regex)
:use-module (ice-9 rdelim)
:export (help
#:use-module (ice-9 documentation)
#:use-module (ice-9 regex)
#:use-module (ice-9 rdelim)
#:export (help
add-value-help-handler! remove-value-help-handler!
add-name-help-handler! remove-name-help-handler!
apropos-hook
apropos apropos-internal apropos-fold apropos-fold-accessible
apropos-fold-exported apropos-fold-all source arity
procedure-arguments
@ -284,8 +285,13 @@ where OPTIONSET is one of debug, read, eval, print
;;; Author: Roland Orre <orre@nada.kth.se>
;;;
;; Two arguments: the module, and the pattern, as a string.
;;
(define apropos-hook (make-hook 2))
(define (apropos rgx . options)
"Search for bindings: apropos regexp {options= 'full 'shadow 'value}"
(run-hook apropos-hook (current-module) rgx)
(if (zero? (string-length rgx))
"Empty string not allowed"
(let* ((match (make-regexp rgx))
@ -354,6 +360,7 @@ Fourth arg FOLDER is one of
(apropos-fold-accessible MODULE) ;fold over bindings accessible in MODULE
apropos-fold-exported ;fold over all exported bindings
apropos-fold-all ;fold over all bindings"
(run-hook apropos-hook (current-module) rgx)
(let ((match (make-regexp rgx))
(recorded (make-hash-table)))
(let ((fold-module