[slime-cvs] CVS slime

[CVS User heller]

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

Modified Files:
	ChangeLog slime.el swank-backend.lisp swank-cmucl.lisp 
	swank.lisp 
Log Message:
Add a command to eval stuff in the inspector.

* slime.el (slime-inspector-eval): New command.
(slime-inspector-mode-map): Bind it to 'e'.
* swank.lisp (inspector-eval): New function.
* swank-backend.lisp (eval-context): New function.
* swank-cmucl.lisp (eval-context): Implement it.

--- /project/slime/cvsroot/slime/ChangeLog	2010/02/17 17:04:33	1.1985
+++ /project/slime/cvsroot/slime/ChangeLog	2010/02/17 17:04:45	1.1986
@@ -1,4 +1,3 @@
-
 2010-02-16  Tobias C. Rittweiler <tcr at freebits.de>
 
 	* swank-loader.lisp: Compile files on ECL, too.
--- /project/slime/cvsroot/slime/slime.el	2010/02/17 17:04:26	1.1275
+++ /project/slime/cvsroot/slime/slime.el	2010/02/17 17:04:46	1.1276
@@ -6529,6 +6529,11 @@
                          (error "No part at point"))))
   (slime-eval-describe `(swank:pprint-inspector-part ,part)))
 
+(defun slime-inspector-eval (string)
+  "Eval an expression in the context of the inspected object."
+  (interactive (list (slime-read-from-minibuffer "Inspector eval: ")))
+  (slime-eval-with-transcript `(swank:inspector-eval ,string)))
+
 (defun slime-inspector-show-source (part)
   (interactive (list (or (get-text-property (point) 'slime-part-number)
                          (error "No part at point"))))
@@ -6621,6 +6626,7 @@
   (" " 'slime-inspector-next)
   ("d" 'slime-inspector-describe)
   ("p" 'slime-inspector-pprint)
+  ("e" 'slime-inspector-eval)
   ("q" 'slime-inspector-quit)
   ("g" 'slime-inspector-reinspect)
   ("v" 'slime-inspector-toggle-verbose)
--- /project/slime/cvsroot/slime/swank-backend.lisp	2010/01/06 14:13:48	1.191
+++ /project/slime/cvsroot/slime/swank-backend.lisp	2010/02/17 17:04:46	1.192
@@ -992,6 +992,10 @@
      (:newline) (:newline)
      ,(with-output-to-string (desc) (describe object desc))))
 
+(definterface eval-context (object)
+  "Return a list of bindings corresponding to OBJECT's slots."
+  (declare (ignore object))
+  '())
 
 ;;; Utilities for inspector methods.
 ;;; 
--- /project/slime/cvsroot/slime/swank-cmucl.lisp	2010/01/05 09:00:30	1.218
+++ /project/slime/cvsroot/slime/swank-cmucl.lisp	2010/02/17 17:04:46	1.219
@@ -2141,6 +2141,19 @@
     (alien::alien-record-type (inspect-alien-record alien))
     (alien::alien-pointer-type (inspect-alien-pointer alien))
     (t (cmucl-inspect alien))))
+
+(defimplementation eval-context (obj)
+  (cond ((typep (class-of obj) 'structure-class)
+         (let* ((dd (kernel:layout-info (kernel:layout-of obj)))
+                (slots (kernel:dd-slots dd)))
+           (list* (cons '*package* 
+                        (symbol-package (if slots 
+                                            (kernel:dsd-name (car slots))
+                                            (kernel:dd-name dd))))
+                  (loop for slot in slots collect 
+                        (cons (kernel:dsd-name slot)
+                              (funcall (kernel:dsd-accessor slot) obj))))))))
+                 
 
 ;;;; Profiling
 (defimplementation profile (fname)
--- /project/slime/cvsroot/slime/swank.lisp	2010/02/07 11:44:41	1.688
+++ /project/slime/cvsroot/slime/swank.lisp	2010/02/17 17:04:46	1.689
@@ -3260,8 +3260,6 @@
         (format nil "#~D=~A" pos string)
         string)))
 
-
-
 (defun content-range (list start end)
   (typecase list
     (list (let ((len (length list)))
@@ -3314,6 +3312,18 @@
   (setf (istate.verbose *istate*) (not (istate.verbose *istate*)))
   (istate>elisp *istate*))
 
+(defslimefun inspector-eval (string)
+  (let* ((obj (istate.object *istate*))
+         (context (eval-context obj))
+         (form (with-buffer-syntax ((cdr (assoc '*package* context)))
+                 (read-from-string string)))
+         (ignorable (remove-if #'boundp (mapcar #'car context))))
+    (to-string (eval `(let ((* ',obj) (- ',form)
+                            . ,(loop for (var . val) in context collect
+                                     `(,var ',val)))
+                        (declare (ignorable . ,ignorable))
+                        ,form)))))
+
 (defslimefun quit-inspector ()
   (reset-inspector)
   nil)