[slime-cvs] CVS slime

[mkoeppe]

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

Modified Files:
	slime.el 
Log Message:
(slime-goto-definition): If all definitions of a name have the same
location, go there directly rather than presenting an xref buffer.


--- /project/slime/cvsroot/slime/slime.el	2006/05/29 23:39:47	1.625
+++ /project/slime/cvsroot/slime/slime.el	2006/06/14 14:58:26	1.626
@@ -6331,23 +6331,31 @@
 
 (defun slime-goto-definition (name definitions &optional where)
   (slime-push-definition-stack)
-  (if (slime-length> definitions 1)
-      (slime-show-definitions name definitions)
-    (let ((def (car definitions)))
-      (destructure-case (slime-definition.location def)
-        ;; Take care of errors before switching any windows/buffers.
-        ((:error message)
-         (error "%s" message))
-        (t
-         (cond ((equal where 'window)
-                (slime-goto-definition-other-window (car definitions)))
-               ((equal where 'frame)
-                (let ((pop-up-frames t))
-                  (slime-goto-definition-other-window (car definitions))))
-               (t
-                (slime-goto-source-location (slime-definition.location
-                                             (car definitions)))
-                (switch-to-buffer (current-buffer)))))))))
+  (let ((all-locations-equal
+         (or (null definitions)
+             (let ((first-location (slime-definition.location (first definitions))))
+               (every (lambda (definition)
+                        (equal (slime-definition.location definition)
+                               first-location))
+                      (rest definitions))))))
+    (if (and (slime-length> definitions 1)
+             (not all-locations-equal))
+        (slime-show-definitions name definitions)
+      (let ((def (car definitions)))
+        (destructure-case (slime-definition.location def)
+          ;; Take care of errors before switching any windows/buffers.
+          ((:error message)
+           (error "%s" message))
+          (t
+           (cond ((equal where 'window)
+                  (slime-goto-definition-other-window (car definitions)))
+                 ((equal where 'frame)
+                  (let ((pop-up-frames t))
+                    (slime-goto-definition-other-window (car definitions))))
+                 (t
+                  (slime-goto-source-location (slime-definition.location
+                                               (car definitions)))
+                  (switch-to-buffer (current-buffer))))))))))
 
 (defun slime-goto-definition-other-window (definition)
   (slime-pop-to-other-window)