[slime-cvs] CVS slime

[mbaringer]

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

Modified Files:
	swank.lisp 
Log Message:
(find-definitions-for-emacs): Don't return locations
whose CAR is :error.
(xref): Process whatever is returned by the various xref functions
with the new sanitize-xrefs functions.
(sanitize-xrefs): Clean up the list of xrefs to remove duplicates.
Patch by Dan Weinreb <dlw at itasoftware.com>


--- /project/slime/cvsroot/slime/swank.lisp	2006/09/18 21:56:13	1.400
+++ /project/slime/cvsroot/slime/swank.lisp	2006/09/21 16:56:07	1.401
@@ -3874,7 +3874,8 @@
       (ignore-errors (values (from-string name)))
     (cond (error '())
           (t (loop for (dspec loc) in (find-definitions sexp)
-                   collect (list (to-string dspec) loc))))))
+                   unless (eql :error (first loc))
+                     collect (list (to-string dspec) loc))))))
 
 (defun alistify (list key test)
   "Partition the elements of LIST into an alist.  KEY extracts the key
@@ -3939,16 +3940,27 @@
 (defslimefun xref (type symbol-name)
   (let ((symbol (parse-symbol-or-lose symbol-name *buffer-package*)))
     (group-xrefs
-     (ecase type
-       (:calls (who-calls symbol))
-       (:calls-who (calls-who symbol))
-       (:references (who-references symbol))
-       (:binds (who-binds symbol))
-       (:sets (who-sets symbol))
-       (:macroexpands (who-macroexpands symbol))
-       (:specializes (who-specializes symbol))
-       (:callers (list-callers symbol))
-       (:callees (list-callees symbol))))))
+     (sanitize-xrefs
+      (ecase type
+        (:calls (who-calls symbol))
+        (:calls-who (calls-who symbol))
+        (:references (who-references symbol))
+        (:binds (who-binds symbol))
+        (:sets (who-sets symbol))
+        (:macroexpands (who-macroexpands symbol))
+        (:specializes (who-specializes symbol))
+        (:callers (list-callers symbol))
+        (:callees (list-callees symbol)))))))
+
+(defun sanitize-xrefs (x)
+  (remove-duplicates
+   (remove-if (lambda (f)
+                (member f '(nil #+sbcl sb-c::step-form)))
+              x
+              :key #'car)
+   :test (lambda (a b)
+           (and (eq (first a) (first b))
+                (equal (second a) (second b))))))
 
 
 ;;;; Inspecting