[slime-cvs] CVS slime

CVS User heller heller at common-lisp.net
Sun May 17 14:31:23 UTC 2009


Update of /project/slime/cvsroot/slime
In directory cl-net:/tmp/cvs-serv25556

Modified Files:
	swank-openmcl.lisp 
Log Message:
Minor changes

--- /project/slime/cvsroot/slime/swank-openmcl.lisp	2009/05/17 14:21:55	1.169
+++ /project/slime/cvsroot/slime/swank-openmcl.lisp	2009/05/17 14:31:23	1.170
@@ -286,14 +286,11 @@
 
 ;;; Cross-referencing
 
-(defun xref-locations (relation name &optional (inverse nil))
-  (loop for xref in (if inverse 
-                        (ccl::get-relation relation name
-                                           :wild :exhaustive t)
-                        (ccl::get-relation relation
-                                           :wild name :exhaustive t))
-        append (loop for (loc . name) in (source-locations xref)
-                     collect `(,name ,loc))))
+(defun xref-locations (relation name &optional inverse)
+  (mapcan #'find-definitions
+          (if inverse 
+              (ccl::get-relation relation name :wild :exhaustive t)
+              (ccl::get-relation relation :wild name :exhaustive t))))
 
 (defimplementation who-binds (name)
   (xref-locations :binds name))
@@ -320,9 +317,8 @@
    :test 'equal))
 
 (defimplementation who-specializes (class)
-  (mapcar (lambda (m)
-            (destructuring-bind ((loc . name)) (source-locations m)
-              (list name loc)))
+  (mapcar (lambda (m) 
+            (car (find-definitions m)))
           (ccl::%class.direct-methods (find-class class))))
 
 (defimplementation list-callees (name)
@@ -613,8 +609,8 @@
                `(:error ,(princ-to-string c)))))
           (t `(:error ,(funcall if-nil-thunk))))))
 
-(defimplementation find-definitions (symbol)
-  (loop for (loc . name) in (source-locations symbol)
+(defimplementation find-definitions (obj)
+  (loop for (loc . name) in (source-locations obj)
         collect (list name loc)))
 
 ;; Return a list ((LOC . NAME) ...) of possible src-locs.





More information about the slime-cvs mailing list