[nongnu] elpa/slime 86f0dc306f 33/44: disassemble/inspect-definition: use the method of DEFMETHOD.

[ELPA Syncer]

branch: elpa/slime
commit 86f0dc306fc943f2effc08babdef7e2565c4b701
Author: Stas Boukarev <stassats@gmail.com>
Commit: Stas Boukarev <stassats@gmail.com>

    disassemble/inspect-definition: use the method of DEFMETHOD.
    
    Not the generic function.
---
 contrib/slime-parse.el |  4 ++--
 slime.el               |  4 ++--
 swank.lisp             | 34 +++++++++++++++++++++++++++++-----
 3 files changed, 33 insertions(+), 9 deletions(-)

diff --git a/contrib/slime-parse.el b/contrib/slime-parse.el
index 89ebc5b619..848d468200 100644
--- a/contrib/slime-parse.el
+++ b/contrib/slime-parse.el
@@ -310,9 +310,9 @@ Point is placed before the first expression in the list."
          (format "(macro-function '%s)" symbol))
         ((:define-compiler-macro symbol)
          (format "(compiler-macro-function '%s)" symbol))
-        ((:defmethod symbol &rest args)
+        ((:defmethod &rest args)
          (declare (ignore args))
-         (format "#'%s" symbol))
+         (format "%s" toplevel))
         (((:defparameter :defvar :defconstant) symbol)
          (format "'%s" symbol))
         (((:defclass :defstruct) symbol)
diff --git a/slime.el b/slime.el
index f1bd8da721..cafb85d7a0 100644
--- a/slime.el
+++ b/slime.el
@@ -6415,12 +6415,12 @@ was called originally."
 
 (defvar slime-inspector-mark-stack '())
 
-(defun slime-inspect (string)
+(defun slime-inspect (string &optional definition)
   "Eval an expression and inspect the result."
   (interactive
    (list (slime-read-from-minibuffer "Inspect value (evaluated): "
                                     (slime-sexp-at-point))))
-  (slime-eval-async `(swank:init-inspector ,string) 'slime-open-inspector))
+  (slime-eval-async `(swank:init-inspector ,string ,definition) 
'slime-open-inspector))
 
 (define-derived-mode slime-inspector-mode fundamental-mode
   "Slime-Inspector"
diff --git a/swank.lisp b/swank.lisp
index 97cc8749de..112a399cd3 100644
--- a/swank.lisp
+++ b/swank.lisp
@@ -2622,8 +2622,12 @@ the filename of the module (or nil if the file doesn't 
exist).")
 (defslimefun disassemble-form (form)
   (with-buffer-syntax ()
     (with-output-to-string (*standard-output*)
-      (let ((*print-readably* nil))
-        (disassemble (eval (read-from-string form)))))))
+      (let ((definition (find-definition form)))
+        (disassemble (if (typep definition 'method)
+                         (or #+#.(swank/backend:with-symbol 
'%method-function-fast-function 'sb-pcl)
+                             (sb-pcl::%method-function-fast-function 
(swank-mop:method-function definition))
+                             (sb-mop:method-generic-function definition))
+                         definition))))))
 
 
 ;;;; Simple completion
@@ -3107,12 +3111,32 @@ DSPEC is a string and LOCATION a source location. NAME 
is a string."
 (defun reset-inspector ()
   (setq *istate* nil
         *inspector-history* (make-array 10 :adjustable t :fill-pointer 0)))
-  
-(defslimefun init-inspector (string)
+
+(defun find-definition (string)
+  (let ((sexp (read-from-string string)))
+    (typecase sexp
+      ((cons (eql :defmethod))
+       (pop sexp)
+       (let ((gf (pop sexp))
+             (qualifiers)
+             (specializers))
+         (loop for x = (pop sexp)
+               when (consp x)
+               do (setf specializers x)
+                  (return)
+               else do (push x qualifiers)
+               while sexp)
+         (find-method (fdefinition gf) qualifiers (mapcar #'find-class 
specializers))))
+      (t
+       (eval sexp)))))
+
+(defslimefun init-inspector (string &optional definition)
   (with-buffer-syntax ()
     (with-retry-restart (:msg "Retry SLIME inspection request.")
       (reset-inspector)
-      (inspect-object (eval (read-from-string string))))))
+      (inspect-object (if definition
+                          (find-definition string)
+                          (eval (read-from-string string)))))))
 
 (defun ensure-istate-metadata (o indicator default)
   (with-struct (istate. object metadata-plist) *istate*