[slime-cvs] CVS update: slime/swank-sbcl.lisp

[Dan Barlow]

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv16176

Modified Files:
	swank-sbcl.lisp 
Log Message:
	* swank-sbcl.lisp (function-source-location-for-emacs): return a
	list of source locations (one per method) when the request is
	for a GF.  This seems to make the elisp side popup a window
	to let the user select one.  Cool.

Date: Mon Dec  1 19:56:26 2003
Author: dbarlow

Index: slime/swank-sbcl.lisp
diff -u slime/swank-sbcl.lisp:1.33 slime/swank-sbcl.lisp:1.34
--- slime/swank-sbcl.lisp:1.33	Mon Dec  1 17:30:34 2003
+++ slime/swank-sbcl.lisp	Mon Dec  1 19:56:26 2003
@@ -296,22 +296,22 @@
              (t (list :function-name fname)))))))
                                 
 (defmethod function-source-location-for-emacs (fname-string)
-  "Return the source-location of FNAME's definition."
+  "Return the source-location(s) of FNAME's definition(s)."
   (let* ((fname (from-string fname-string)))
     (labels ((finder (fname)
                (cond ((and (symbolp fname) (macro-function fname))
                       (function-source-location (macro-function fname) 
                                                 fname-string))
                      ((typep fname 'sb-mop:generic-function)
-                      (function-source-location
-                       ;; FIXME really we should do something to present 
-                       ;; all methods instead of just presenting the first
-                       (car (sb-mop:generic-function-methods fname))
-                       fname-string))
-                     ((sb-introspect:valid-function-name-p fname)
-                      (finder (fdefinition fname)))
+                      (list*
+                       (function-source-location fname fname-string)
+                       (mapcar 
+                        (lambda (x) (function-source-location x fname-string))
+                        (sb-mop:generic-function-methods fname))))
                      ((functionp fname) 
-                      (function-source-location fname fname-string)))))
+                      (function-source-location fname fname-string))
+                     ((sb-introspect:valid-function-name-p fname)
+                      (finder (fdefinition fname))) )))
       (if *debug-definition-finding*
           (finder fname)
           (handler-case (finder fname)
@@ -319,7 +319,10 @@
               (list :error (format nil "Error: ~A" e))))))))
 
 (defslimefun find-function-locations (name)
-  (list (function-source-location-for-emacs name)))
+  (let ((loc (function-source-location-for-emacs name)))
+    (if (listp loc)
+        loc
+        (list loc))))
 
 (defmethod describe-symbol-for-emacs (symbol)
   "Return a plist describing SYMBOL.