Index: ChangeLog =================================================================== RCS file: /project/slime/cvsroot/slime/ChangeLog,v retrieving revision 1.483 diff -u -r1.483 ChangeLog --- ChangeLog 21 Jul 2004 19:56:54 -0000 1.483 +++ ChangeLog 23 Jul 2004 00:25:08 -0000 @@ -1,3 +1,39 @@ +2004-07-22 Thomas Schilling + + * FEATURE: In the xref buffer invoked by slime-find-definition one + can now press C-r 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 it's 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-21 Luke Gorrie * slime.el (slime-sync-package-and-default-directory): Sync Index: slime.el =================================================================== RCS file: /project/slime/cvsroot/slime/slime.el,v retrieving revision 1.376 diff -u -r1.376 slime.el --- slime.el 21 Jul 2004 19:53:53 -0000 1.376 +++ slime.el 23 Jul 2004 00:44:45 -0000 @@ -3609,6 +3609,10 @@ (t (slime-forward-source-path source-path)))))) +(defun locationp (object) + "Return non-NIL if the specified object is a location." + (and (consp object) (eq (car object) ':location))) + (defun slime-goto-source-location (location &optional noerror) "Move to the source location LOCATION. Several kinds of locations are supported: @@ -4641,8 +4645,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))) @@ -5097,6 +5103,7 @@ ("q" 'slime-xref-quit) ("n" 'slime-next-line/not-add-newlines) ("p" 'previous-line) + ("\C-r" 'slime-xref-remove-method) ) (defun slime-next-line/not-add-newlines () @@ -5162,16 +5169,24 @@ (defun slime-insert-xrefs (xrefs) "Insert XREFS in the current-buffer. XREFS is a list of the form ((GROUP . ((LABEL . LOCATION) ...)) ...) -GROUP and LABEL are for decoration purposes. LOCATION is a source-location." +GROUP and LABEL are for decoration purposes. LOCATION is a source-location +or a cons (LOCATION . MDEF) where MDEF is NIL or a string of the method +definition." (unless (bobp) (insert "\n")) (loop for (group . refs) in xrefs do (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)) @@ -5187,6 +5202,8 @@ (forward-line) (skip-chars-forward " \t")))) + + ;;;;; XREF commands @@ -5264,7 +5281,7 @@ (interactive) (let ((location (slime-xref-location-at-point))) (slime-show-source-location location))) - + (defun slime-goto-next-xref () "Goto the next cross-reference location." (let ((location (with-current-buffer (slime-xref-buffer) @@ -5305,6 +5322,31 @@ (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)) + ;;FIXME: if successful remove the current line + ) ;;;; 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 22 Jul 2004 20:08:10 -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.96 diff -u -r1.96 swank-sbcl.lisp --- swank-sbcl.lisp 20 Jul 2004 00:42:14 -0000 1.96 +++ swank-sbcl.lisp 22 Jul 2004 23:58:01 -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.219 diff -u -r1.219 swank.lisp --- swank.lisp 21 Jul 2004 12:31:04 -0000 1.219 +++ swank.lisp 23 Jul 2004 00:50:09 -0000 @@ -2330,7 +2330,38 @@ (defslimefun undefine-function (fname-string) (let ((fname (from-string fname-string))) - (format nil "~S" (fmakunbound fname)))) + (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 @@ -2351,13 +2382,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