Index: ChangeLog
===================================================================
RCS file: /project/slime/cvsroot/slime/ChangeLog,v
retrieving revision 1.490
diff -u -r1.490 ChangeLog
--- ChangeLog	30 Jul 2004 03:48:36 -0000	1.490
+++ ChangeLog	30 Jul 2004 17:59:58 -0000
@@ -1,3 +1,39 @@
+2004-07-30  Thomas Schilling  <tjs_ng@yahoo.de>
+
+	* FEATURE: In the xref buffer invoked by slime-find-definition one
+	can now press C-k on a method to remove it. I currently only
+	implemented it for Allegro and--untested--SBCL. Removing methods
+	with EQL-specializers currently doesn't work for Allegro (6.2)
+	since it cannot find the corresponding method.
+	
+	* swank.lisp (remove-method-by-signature) This new function
+	takes a method signature, ie. a string, and tries to find and
+	remove the method that is described by this signature.
+	(find-definition-for-emacs): Each returned list may now contain a
+	method description as its third item.
+
+	* swank-allegro.lisp (fspec-definition-locations) Each returned
+	list now can contain a third argument being a method description.
+
+	* swank-sbcl.lisp (method-definitions) UNTESTED. Now returns and
+	additional parameter for each sublist being the method
+	description.
+
+	* slime.el (locationp) Added this predicate to test if an object
+	is a location.
+	(slime-insert-xrefs) Had change the syntax for the
+	XREFS parameter--without introducing incompatibilites. It
+	worked. The LOCATION part can now be a simple source location or a
+	cons of a location and a method definition. Could be extended
+	further, I think.
+	(slime-show-definitions) Adjusted list format.
+	(slime-remove-method, slime-xref-method-definition-at-point)
+	Just some helper functions for the actual command:
+	(slime-xref-remove-method) Takes the SLIME-METHOD-DEFINITION text
+	property and removes the method at point.
+
+	* TODO: We need backend support for other implementations and testing.
+
 2004-07-30  Luke Gorrie  <luke@bluetail.com>
 
 	* slime.el (slime-choose-overlay-region): Tweaked the
Index: slime.el
===================================================================
RCS file: /project/slime/cvsroot/slime/slime.el,v
retrieving revision 1.382
diff -u -r1.382 slime.el
--- slime.el	30 Jul 2004 03:48:18 -0000	1.382
+++ slime.el	30 Jul 2004 17:57:19 -0000
@@ -3646,6 +3646,11 @@
            (t
             (slime-forward-source-path source-path))))))
 
+(defun locationp (object)
+  "Return non-NIL if the specified object is a location (or an error)."
+  (and (consp object) (or (eq (car object) :location)
+                          (eq (car object) :error))))
+ 
 (defun slime-goto-source-location (location &optional noerror)
   "Move to the source location LOCATION.  Several kinds of locations
 are supported:
@@ -4678,8 +4683,10 @@
 
 (defun slime-show-definitions (name definitions)
   (slime-show-xrefs 
-   `((,name . ,(loop for (dspec location) in definitions
-                     collect (cons dspec location))))
+   `((,name . ,(loop for (dspec location mspec) in definitions
+                 collect (cons dspec (if mspec 
+                                         (cons location mspec)
+                                       location)))))
    'definition
    name
    (slime-current-package)))
@@ -5139,6 +5146,7 @@
   ("q" 'slime-xref-quit)
   ("n" 'slime-next-line/not-add-newlines)
   ("p" 'previous-line)
+  ("\C-k" 'slime-xref-remove-method)
   )
 
 (defun slime-next-line/not-add-newlines ()
@@ -5210,10 +5218,16 @@
         (progn
           (slime-insert-propertized '(face bold) group "\n")
           (loop for (label . location) in refs do
-                (slime-insert-propertized 
-                 (list 'slime-location location
-                       'face 'font-lock-keyword-face)
-                 "  " label "\n"))))
+                (if (locationp location)
+                    (slime-insert-propertized
+                     (list 'slime-location location
+                           'face 'font-lock-keyword-face)
+                     "  " label "\n")
+                    (slime-insert-propertized
+                     (list 'slime-location (car location)
+                           'slime-method-definition (cdr location)
+                           'face 'font-lock-keyword-face)
+                           "  " label "\n")))))
   ;; Remove the final newline to prevent accidental window-scrolling
   (backward-char 1)
   (delete-char 1))
@@ -5347,6 +5361,33 @@
   (let ((buffer (current-buffer)))
     (delete-windows-on buffer)
     (kill-buffer buffer)))
+
+;;;;; XREF Specials
+
+(defun slime-remove-method (mdef)
+  (let ((success (slime-eval
+                  `(swank:remove-method-by-signature ,mdef))))
+    (if (not success)
+        (error "Method could not be removed."))))
+
+(defun slime-xref-method-definition-at-point ()
+  (save-excursion
+    ;; When the end of the last line is at (point-max) we can't find
+    ;; the text property there. Going to bol avoids this problem.
+    (beginning-of-line 1)
+    (or (get-text-property (point) 'slime-method-definition)
+        (error "No method definition at point."))))
+
+;;FIXME: Maybe make it work in modes other than xref.
+(defun slime-xref-remove-method ()
+  "Remove the selected method (if possible)."
+  (interactive)
+  (let ((mdef (slime-xref-method-definition-at-point)))
+    (slime-remove-method mdef))
+  (let ((inhibit-read-only t)
+         (col (current-column)))
+    (kill-entire-line)
+    (move-to-column col))
   
 
 ;;;; Macroexpansion
Index: swank-allegro.lisp
===================================================================
RCS file: /project/slime/cvsroot/slime/swank-allegro.lisp,v
retrieving revision 1.45
diff -u -r1.45 swank-allegro.lisp
--- swank-allegro.lisp	4 Jul 2004 00:36:14 -0000	1.45
+++ swank-allegro.lisp	30 Jul 2004 11:32:24 -0000
@@ -263,7 +263,11 @@
 (defun fspec-definition-locations (fspec)
   (let ((defs (excl::find-multiple-definitions fspec)))
     (loop for (fspec type) in defs 
-          collect (list fspec (find-fspec-location fspec type)))))
+          collect (list fspec
+                        (find-fspec-location fspec type)
+                        (if (and (consp fspec)
+                                 (eq (car fspec) 'method))
+                            fspec)))))
 
 (defimplementation find-definitions (symbol)
   (fspec-definition-locations symbol))
Index: swank-sbcl.lisp
===================================================================
RCS file: /project/slime/cvsroot/slime/swank-sbcl.lisp,v
retrieving revision 1.97
diff -u -r1.97 swank-sbcl.lisp
--- swank-sbcl.lisp	28 Jul 2004 21:07:18 -0000	1.97
+++ swank-sbcl.lisp	30 Jul 2004 11:33:30 -0000
@@ -357,8 +357,10 @@
   (let ((methods (sb-mop:generic-function-methods gf))
         (name (sb-mop:generic-function-name gf)))
     (loop for method in methods 
-          collect (list `(method ,name ,(sb-pcl::unparse-specializers method)) 
-                        (safe-function-source-location method name)))))
+          collect (let ((mdef `(method ,name ,(sb-pcl::unparse-specializers method))))
+                      (list mdef
+                            (safe-function-source-location method name)
+                            mdef)))))
 
 (defun function-definitions (name)
   (flet ((loc (fn name) (safe-function-source-location fn name)))
Index: swank.lisp
===================================================================
RCS file: /project/slime/cvsroot/slime/swank.lisp,v
retrieving revision 1.220
diff -u -r1.220 swank.lisp
--- swank.lisp	22 Jul 2004 16:54:22 -0000	1.220
+++ swank.lisp	30 Jul 2004 11:36:31 -0000
@@ -2334,6 +2334,37 @@
   (let ((fname (from-string fname-string)))
     (format nil "~S" (fmakunbound fname))))
 
+(defslimefun remove-method-by-signature (mspec-string)
+  "Takes a method description and tries to remove this method.
+MSPEC string must be a string representation of a list with the format
+(METHOD NAME {QUALIFIER}* SPECIALIZER-LIST).
+
+Returns non-NIL if successful."
+ (multiple-value-bind (sexp error)  
+     (ignore-errors (values (from-string mspec-string)))
+    (cond
+      (error nil) ;;FIXME: raise an error here?
+      (t (if (and (consp sexp)
+                  (eq (car sexp) 'method)
+                  (fboundp (second sexp)))
+             (let* ((gf (fdefinition (second sexp)))
+                    (qualifiers (loop for q in (cddr sexp)
+                                      while (not (listp q))
+                                      collect q))
+                    (specializers (car (last sexp)))
+                    (method (find-method
+                             gf qualifiers
+                             (mapcar (lambda (x)
+                                       ;;FIXME: is it really a good idea
+                                       ;;to call eval here?
+                                       (if (consp x)
+                                           (list 'eql (eval (cdr x)))
+                                           (find-class x)))
+                                     specializers)
+                             nil)))
+               (if method
+                   (if (remove-method gf method) t))))))))
+
 
 ;;;; Profiling
 
@@ -2353,13 +2384,16 @@
 ;;;; Source Locations
 
 (defslimefun find-definitions-for-emacs (name)
-  "Return a list ((DSPEC LOCATION) ...) of definitions for NAME.
-DSPEC is a string and LOCATION a source location. NAME is a string."
+  "Return a list ((DSPEC LOCATION MSPEC) ...) of definitions for NAME.
+DSPEC is a string and LOCATION a source location. NAME is a string.
+MSPEC is the string representation of a list describing a method, i.e.,
+it is of the format (METHOD NAME {QUALIFIER}* SPECIALIZES-LIST)."
   (multiple-value-bind (sexp error)
       (ignore-errors (values (from-string name)))
     (cond (error '())
-          (t (loop for (dspec loc) in (find-definitions sexp)
-                   collect (list (to-string dspec) loc))))))
+          (t (loop for (dspec loc mspec) in (find-definitions sexp)
+                   collect (list (to-string dspec) loc
+                                 (if mspec (to-string mspec))))))))
 
 (defun alistify (list key test)
   "Partition the elements of LIST into an alist.  KEY extracts the key