[slime-cvs] CVS slime

[CVS User heller]

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

Modified Files:
	ChangeLog swank-cmucl.lisp 
Log Message:
* swank-cmucl.lisp (method-location): Special case accessors.

--- /project/slime/cvsroot/slime/ChangeLog	2011/12/01 16:48:21	1.2252
+++ /project/slime/cvsroot/slime/ChangeLog	2011/12/01 16:54:51	1.2253
@@ -1,3 +1,7 @@
+2011-12-01  Helmut Eller  <heller at common-lisp.net>
+
+	* swank-cmucl.lisp (method-location): Special case accessors.
+
 2011-11-29  Helmut Eller  <heller at common-lisp.net>
 
 	* swank.lisp (do-symbols*, classify-symbol)
--- /project/slime/cvsroot/slime/swank-cmucl.lisp	2011/11/27 21:47:15	1.239
+++ /project/slime/cvsroot/slime/swank-cmucl.lisp	2011/12/01 16:54:52	1.240
@@ -1075,10 +1075,19 @@
          (qualifiers (pcl:method-qualifiers method)))
     `(method ,name , at qualifiers ,(pcl::unparse-specializers specializers))))
 
-;; XXX maybe special case setters/getters
 (defun method-location (method)
-  (function-location (or (pcl::method-fast-function method)
-                         (pcl:method-function method))))
+  (typecase method
+    (pcl::standard-accessor-method
+     (definition-source-location
+         (cond ((pcl::definition-source method) 
+                method)
+               (t
+                (pcl::slot-definition-class
+                 (pcl::accessor-method-slot-definition method))))
+         (pcl::accessor-method-slot-name method)))
+    (t
+     (function-location (or (pcl::method-fast-function method)
+                            (pcl:method-function method))))))
 
 (defun genericp (fn)
   (typep fn 'generic-function))