[slime-cvs] CVS slime

[trittweiler]

Update of /project/slime/cvsroot/slime
In directory clnet:/tmp/cvs-serv23995

Modified Files:
	swank.lisp 
Log Message:
* swank.lisp: Previously when using SLIME-APROPOS-PACKAGE, only
  those symbols were considered whose home package matched the
  given package; this would, however, prevent all those symbols from
  being listed that are imported from another package, and then
  exported again in the package they got imported into. (As an
  example, SWANK:RESTART-FRAME is actually from SWANK-BACKEND.)

  (apropos-matcher): Renamed to MAKE-REGEXP-MATCHER.
  (make-regexp-matcher): Changed to only match for a given regexp.
  (apropos-symbols): Use MAKE-REGEXP-MATCHER.


--- /project/slime/cvsroot/slime/swank.lisp	2007/04/19 16:36:36	1.479
+++ /project/slime/cvsroot/slime/swank.lisp	2007/05/10 17:54:31	1.480
@@ -4187,6 +4187,8 @@
   (let ((package (if package
                      (or (parse-package package)
                          (error "No such package: ~S" package)))))
+    ;; The MAPCAN will filter all uninteresting symbols, i.e. those
+    ;; who cannot be meaningfully described.
     (mapcan (listify #'briefly-describe-symbol-for-emacs)
             (sort (remove-duplicates
                    (apropos-symbols name external-only case-sensitive package))
@@ -4243,26 +4245,23 @@
                   (lambda (s) (check-type s string) t)
                   (compile nil (slime-nregex:regex-compile regex-string)))))))
 
-(defun apropos-matcher (string case-sensitive package external-only)
+(defun make-regexp-matcher (string case-sensitive)
   (let* ((case-modifier (if case-sensitive #'string #'string-upcase))
          (regex (compiled-regex (funcall case-modifier string))))
     (lambda (symbol)
-      (and (not (keywordp symbol))
-           (if package (eq (symbol-package symbol) package) t)
-           (if external-only (symbol-external-p symbol) t)
-           (funcall regex (funcall case-modifier symbol))))))
+      (funcall regex (funcall case-modifier symbol)))))
 
 (defun apropos-symbols (string external-only case-sensitive package)
-  (let ((result '())
-        (matchp (apropos-matcher string case-sensitive package external-only)))
-    (with-package-iterator (next (or package (list-all-packages))
-                                 :external :internal)
-      (loop
-       (multiple-value-bind (morep symbol) (next)
-         (cond ((not morep)
-                (return))
-               ((funcall matchp symbol)
-                (push symbol result))))))
+  (let ((packages (or package (remove (find-package :keyword)
+                                      (list-all-packages))))
+        (matcher  (make-apropos-matcher string case-sensitive))
+        (result))
+    (with-package-iterator (next packages :external :internal)
+      (loop (multiple-value-bind (morep symbol) (next)
+              (cond ((not morep) (return))
+                    ((and (if external-only (symbol-external-p symbol) t)
+                          (funcall matcher symbol))
+                     (push symbol result))))))
     result))
 
 (defun call-with-describe-settings (fn)