ice-9/session.scm `apropos-internal' patch

[thi <ttn@netcom.com>]

hello,

please find below a patch to `apropos-internal' in ice-9/session.scm.

it modifies the procedure compatibly (current users need not change)
to allow optional specification of a predicate and a modules list to
use in the obarray walk.  the docstring has been modified to reflect
the new behavior.

the predicate, if non-`#f', is given two args, MODULE and SYMBOL.  if
it returns `#f', the symbol is not returned by `apropos-internal'.

thi


-------------------------
Index: session.scm
===================================================================
RCS file: /egcs/carton/cvsfiles/guile/guile-core/ice-9/session.scm,v
retrieving revision 1.5
diff -c -c -r1.5 session.scm
*** session.scm	1997/09/11 08:59:30	1.5
--- session.scm	1998/08/03 03:12:59
***************
*** 82,93 ****
  	      obarrays get-refs)))
  	 modules))))
  
! (define-public (apropos-internal rgx)
!   "Return a list of accessible variable names."
    (let ((match (make-regexp rgx))
! 	(modules (cons (current-module)
! 		       (module-uses (current-module))))
  	(recorded (make-vector 61 '()))
  	(vars (cons '() '())))
      (let ((last vars))
        (for-each
--- 82,101 ----
  	      obarrays get-refs)))
  	 modules))))
  
! (define-public (apropos-internal rgx . options)
!   "Return a list of accessible variable names matching regexp RGX.
! If first optional arg PREDICATE is not #f, use it as a filter
!   procedure taking two arguments, MODULE and SYMBOL, with a return
!   value #f rejecting its candidate.
! Look for names in the current module and its `module-uses' list.
! If optional args MODULE1 MODULE2 ... are given, look there instead."
    (let ((match (make-regexp rgx))
! 	(modules (if (or (eq? '() options) (eq? '() (cdr options)))
! 		     (cons (current-module)
! 			   (module-uses (current-module)))
! 		     (cdr options)))
  	(recorded (make-vector 61 '()))
+ 	(predicate (and (not (eq? '() options)) (car options)))
  	(vars (cons '() '())))
      (let ((last vars))
        (for-each
***************
*** 99,105 ****
  	       (for-each
  		(lambda (x)
  		  (if (and (regexp-exec match (car x))
! 			   (not (hashq-get-handle recorded (car x))))
  		      (begin
  			(set-cdr! last (cons (car x) '()))
  			(set! last (cdr last))
--- 107,115 ----
  	       (for-each
  		(lambda (x)
  		  (if (and (regexp-exec match (car x))
! 			   (not (hashq-get-handle recorded (car x)))
! 			   (or (eq? #f predicate)
! 			       (predicate module (car x))))
  		      (begin
  			(set-cdr! last (cons (car x) '()))
  			(set! last (cdr last))