[slime-cvs] CVS slime

[CVS User sboukarev]

Update of /project/slime/cvsroot/slime
In directory cl-net:/tmp/cvs-serv18408

Modified Files:
	ChangeLog slime.el swank.lisp 
Log Message:
* slime.el (sldb-insert-condition): Don't create a mouse tooltip
for long error message, tooltip shows the same text and doesn't
add any value.
(slime-definition-at-point): factor out of `slime-inspect-definition'.
(slime-disassemble-definition): New, similar to `slime-inspect-definition'.

* swank.lisp (disassemble-form): rename from disassemble-symbol,
do the same as before but evaluate the argument.


--- /project/slime/cvsroot/slime/ChangeLog	2010/05/16 04:15:18	1.2093
+++ /project/slime/cvsroot/slime/ChangeLog	2010/05/18 09:12:46	1.2094
@@ -1,3 +1,15 @@
+2010-05-18  Stas Boukarev  <stassats at gmail.com>
+
+	* slime.el (sldb-insert-condition): Don't create a mouse tooltip
+	for long error message, tooltip shows the same text and doesn't
+	add any value.
+	(slime-definition-at-point): factor out of `slime-inspect-definition'.
+	(slime-disassemble-definition): New, similar to `slime-inspect-definition'.
+
+	* swank.lisp (disassemble-form): rename from disassemble-symbol,
+	do the same as before but evaluate the argument.
+
+
 2010-05-16  Stas Boukarev  <stassats at gmail.com>
 
 	* slime.el (slime-close-popup-window): Don't kill
--- /project/slime/cvsroot/slime/slime.el	2010/05/16 04:15:18	1.1318
+++ /project/slime/cvsroot/slime/slime.el	2010/05/18 09:12:47	1.1319
@@ -4440,7 +4440,7 @@
 (defun slime-disassemble-symbol (symbol-name)
   "Display the disassembly for SYMBOL-NAME."
   (interactive (list (slime-read-symbol-name "Disassemble: ")))
-  (slime-eval-describe `(swank:disassemble-symbol ,symbol-name)))
+  (slime-eval-describe `(swank:disassemble-form ,(concat "'" symbol-name))))
 
 (defun slime-undefine-function (symbol-name)
   "Unbind the function slot of SYMBOL-NAME."
@@ -5563,9 +5563,6 @@
 CONDITION should be a list (MESSAGE TYPE EXTRAS).
 EXTRAS is currently used for the stepper."
   (destructuring-bind (message type extras) condition
-    (when (> (length message) 70)
-      (add-text-properties 0 (length message) (list 'help-echo message)
-                           message))
     (slime-insert-propertized '(sldb-default-action sldb-inspect-condition)
                               (in-sldb-face topline message)
                               "\n"
@@ -6535,33 +6532,45 @@
 				     (slime-sexp-at-point))))
   (slime-eval-async `(swank:init-inspector ,string) 'slime-open-inspector))
 
+(defun slime-definition-at-point (&optional only-functional)
+  "Return object corresponding to the definition at point."
+  (let ((toplevel (slime-parse-toplevel-form)))
+    (if (or (symbolp toplevel)
+            (and only-functional
+                 (not (member (car toplevel)
+                              '(:defun :defgeneric :defmethod
+                                :defmacro :define-compiler-macro)))))
+        (error "Not in a definition")
+        (destructure-case toplevel
+          (((:defun :defgeneric) symbol)
+           (format "#'%s" symbol))
+          (((:defmacro :define-modify-macro) symbol)
+           (format "(macro-function '%s)" symbol))
+          ((:define-compiler-macro symbol)
+           (format "(compiler-macro-function '%s)" symbol))
+          ((:defmethod symbol &rest args)
+           (declare (ignore args))
+           (format "#'%s" symbol))
+          (((:defparameter :defvar :defconstant) symbol)
+           (format "'%s" symbol))
+          (((:defclass :defstruct) symbol)
+           (format "(find-class '%s)" symbol))
+          ((:defpackage symbol)
+           (format "(or (find-package '%s) (error \"Package %s not found\"))"
+                   symbol symbol))
+          (t
+           (error "Not in a definition"))))))
+
 (defun slime-inspect-definition ()
   "Inspect definition at point"
   (interactive)
-  (let* ((toplevel (slime-parse-toplevel-form))
-         (form
-          (if (symbolp toplevel)
-              (error "Not in a definition")
-              (destructure-case toplevel
-                (((:defun :defgeneric) symbol)
-                 (format "#'%s" symbol))
-                (((:defmacro :define-modify-macro) symbol)
-                 (format "(macro-function '%s)" symbol))
-                ((:define-compiler-macro symbol)
-                 (format "(compiler-macro-function '%s)" symbol))
-                ((:defmethod symbol &rest args)
-                 (declare (ignore args))
-                 (format "#'%s" symbol))
-                (((:defparameter :defvar :defconstant) symbol)
-                 (format "'%s" symbol))
-                (((:defclass :defstruct) symbol)
-                 (format "(find-class '%s)" symbol))
-                ((:defpackage symbol)
-                 (format "(or (find-package '%s) (error \"Package %s not found\"))"
-                         symbol symbol))
-                (t
-                 (error "Not in a definition"))))))
-    (slime-eval-async `(swank:init-inspector ,form) 'slime-open-inspector)))
+  (slime-inspect (slime-definition-at-point)))
+
+(defun slime-disassemble-definition ()
+  "Disassemble definition at point"
+  (interactive)
+  (slime-eval-describe `(swank:disassemble-form
+                         ,(slime-definition-at-point t))))
 
 (define-derived-mode slime-inspector-mode fundamental-mode
   "Slime-Inspector"
--- /project/slime/cvsroot/slime/swank.lisp	2010/05/13 04:59:11	1.714
+++ /project/slime/cvsroot/slime/swank.lisp	2010/05/18 09:12:47	1.715
@@ -2993,11 +2993,11 @@
 (defslimefun swank-format-string-expand (string)
   (apply-macro-expander #'format-string-expand string))
 
-(defslimefun disassemble-symbol (name)
+(defslimefun disassemble-form (form)
   (with-buffer-syntax ()
     (with-output-to-string (*standard-output*)
       (let ((*print-readably* nil))
-        (disassemble (fdefinition (from-string name)))))))
+        (disassemble (eval (read-from-string form)))))))
 
 
 ;;;; Simple completion
@@ -3948,4 +3948,4 @@
 (defun init ()
   (run-hook *after-init-hook*))
 
-;;; swank.lisp ends here
\ No newline at end of file
+;;; swank.lisp ends here