mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 11:50:28 +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) (define-module (ice-9 session)
:use-module (ice-9 documentation) #:use-module (ice-9 documentation)
:use-module (ice-9 regex) #:use-module (ice-9 regex)
:use-module (ice-9 rdelim) #:use-module (ice-9 rdelim)
:export (help #:export (help
add-value-help-handler! remove-value-help-handler! add-value-help-handler! remove-value-help-handler!
add-name-help-handler! remove-name-help-handler! add-name-help-handler! remove-name-help-handler!
apropos-hook
apropos apropos-internal apropos-fold apropos-fold-accessible apropos apropos-internal apropos-fold apropos-fold-accessible
apropos-fold-exported apropos-fold-all source arity apropos-fold-exported apropos-fold-all source arity
procedure-arguments procedure-arguments
@ -284,8 +285,13 @@ where OPTIONSET is one of debug, read, eval, print
;;; Author: Roland Orre <orre@nada.kth.se> ;;; 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) (define (apropos rgx . options)
"Search for bindings: apropos regexp {options= 'full 'shadow 'value}" "Search for bindings: apropos regexp {options= 'full 'shadow 'value}"
(run-hook apropos-hook (current-module) rgx)
(if (zero? (string-length rgx)) (if (zero? (string-length rgx))
"Empty string not allowed" "Empty string not allowed"
(let* ((match (make-regexp rgx)) (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-accessible MODULE) ;fold over bindings accessible in MODULE
apropos-fold-exported ;fold over all exported bindings apropos-fold-exported ;fold over all exported bindings
apropos-fold-all ;fold over all bindings" apropos-fold-all ;fold over all bindings"
(run-hook apropos-hook (current-module) rgx)
(let ((match (make-regexp rgx)) (let ((match (make-regexp rgx))
(recorded (make-hash-table))) (recorded (make-hash-table)))
(let ((fold-module (let ((fold-module