[slime-cvs] CVS slime
CVS User heller
heller at common-lisp.net
Mon Nov 21 16:34:12 UTC 2011
Update of /project/slime/cvsroot/slime
In directory tiger.common-lisp.net:/tmp/cvs-serv10973
Modified Files:
ChangeLog slime.el swank-backend.lisp swank-cmucl.lisp
swank.lisp
Log Message:
* slime.el (sldb-eval-in-frame): Try to figure the package out.
Ask Lisp if the function for frame was defined in a particular
package and use it to read the form.
(sldb-read-form-for-frame): New helper.
* swank-backend (frame-package): New.
* swank-cmucl (frame-package): Implement it.
* swank.lisp (frame-package-name, eval-in-frame-aux): New.
(eval-string-in-frame, pprint-eval-string-in-frame): Use package
argument.
--- /project/slime/cvsroot/slime/ChangeLog 2011/11/19 16:35:58 1.2243
+++ /project/slime/cvsroot/slime/ChangeLog 2011/11/21 16:34:12 1.2244
@@ -3,6 +3,20 @@
* swank-sbcl.lisp (restart-frame): Make it possible to restart
frames of anonymous functions -- at least some of the time.
+2011-11-21 Helmut Eller <heller at common-lisp.net>
+
+ * slime.el (sldb-eval-in-frame): Try to figure the package out.
+ Ask Lisp if the function for frame was defined in a particular
+ package and use it to read the form.
+ (sldb-read-form-for-frame): New helper.
+
+ * swank-backend (frame-package): New.
+ * swank-cmucl (frame-package): Implement it.
+
+ * swank.lisp (frame-package-name, eval-in-frame-aux): New.
+ (eval-string-in-frame, pprint-eval-string-in-frame): Use package
+ argument.
+
2011-11-16 Stas Boukarev <stassats at gmail.com>
* swank.lisp (open-dedicated-output-stream): Open a stream with
--- /project/slime/cvsroot/slime/slime.el 2011/11/12 14:43:01 1.1380
+++ /project/slime/cvsroot/slime/slime.el 2011/11/21 16:34:12 1.1381
@@ -5891,22 +5891,29 @@
;;;;;; SLDB eval and inspect
-(defun sldb-eval-in-frame (string)
+(defun sldb-eval-in-frame (frame string package)
"Prompt for an expression and evaluate it in the selected frame."
- (interactive (list (slime-read-from-minibuffer "Eval in frame: ")))
- (let* ((number (sldb-frame-number-at-point)))
- (slime-eval-async `(swank:eval-string-in-frame ,string ,number)
- (if current-prefix-arg
- 'slime-write-string
- 'slime-display-eval-result))))
+ (interactive (sldb-read-form-for-frame "Eval in frame (%s)> "))
+ (slime-eval-async `(swank:eval-string-in-frame ,string ,frame ,package)
+ (if current-prefix-arg
+ 'slime-write-string
+ 'slime-display-eval-result)))
-(defun sldb-pprint-eval-in-frame (string)
+(defun sldb-pprint-eval-in-frame (frame string package)
"Prompt for an expression, evaluate in selected frame, pretty-print result."
- (interactive (list (slime-read-from-minibuffer "Eval in frame: ")))
- (let* ((number (sldb-frame-number-at-point)))
- (slime-eval-async `(swank:pprint-eval-string-in-frame ,string ,number)
- (lambda (result)
- (slime-show-description result nil)))))
+ (interactive (sldb-read-form-for-frame "Eval in frame (%s)> "))
+ (slime-eval-async
+ `(swank:pprint-eval-string-in-frame ,string ,frame ,package)
+ (lambda (result)
+ (slime-show-description result nil))))
+
+(defun sldb-read-form-for-frame (fstring)
+ (let* ((frame (sldb-frame-number-at-point))
+ (pkg (slime-eval `(swank:frame-package-name ,frame))))
+ (list frame
+ (let ((slime-buffer-package pkg))
+ (slime-read-from-minibuffer (format fstring pkg)))
+ pkg)))
(defun sldb-inspect-in-frame (string)
"Prompt for an expression and inspect it in the selected frame."
--- /project/slime/cvsroot/slime/swank-backend.lisp 2011/11/06 17:06:35 1.211
+++ /project/slime/cvsroot/slime/swank-backend.lisp 2011/11/21 16:34:12 1.212
@@ -949,6 +949,12 @@
The return value is the result of evaulating FORM in the
appropriate context.")
+(definterface frame-package (frame-number)
+ "Return the package corresponding to the frame at FRAME-NUMBER.
+Return nil if the backend can't figure it out."
+ (declare (ignore frame-number))
+ nil)
+
(definterface frame-call (frame-number)
"Return a string representing a call to the entry point of a frame.")
--- /project/slime/cvsroot/slime/swank-cmucl.lisp 2011/11/06 17:39:29 1.235
+++ /project/slime/cvsroot/slime/swank-cmucl.lisp 2011/11/21 16:34:12 1.236
@@ -1641,6 +1641,17 @@
(defimplementation frame-catch-tags (index)
(mapcar #'car (di:frame-catches (nth-frame index))))
+(defimplementation frame-package (frame-number)
+ (let* ((frame (nth-frame frame-number))
+ (dbg-fun (di:frame-debug-function frame)))
+ (typecase dbg-fun
+ (di::compiled-debug-function
+ (let* ((comp (di::compiled-debug-function-component dbg-fun))
+ (dbg-info (kernel:%code-debug-info comp)))
+ (typecase dbg-info
+ (c::compiled-debug-info
+ (find-package (c::compiled-debug-info-package dbg-info)))))))))
+
(defimplementation return-from-frame (index form)
(let ((sym (find-symbol (string 'find-debug-tag-for-frame)
:debug-internals)))
--- /project/slime/cvsroot/slime/swank.lisp 2011/11/16 10:01:18 1.759
+++ /project/slime/cvsroot/slime/swank.lisp 2011/11/21 16:34:12 1.760
@@ -1919,8 +1919,8 @@
`(call-with-buffer-syntax ,package (lambda () , at body)))
(defun call-with-buffer-syntax (package fun)
- (let ((*package* (if package
- (guess-buffer-package package)
+ (let ((*package* (if package
+ (guess-buffer-package package)
*buffer-package*)))
;; Don't shadow *readtable* unnecessarily because that prevents
;; the user from assigning to it.
@@ -2727,15 +2727,21 @@
`(let ((*sldb-level* ,*sldb-level*))
,form))
-(defslimefun eval-string-in-frame (string index)
- (values-to-string
- (eval-in-frame (wrap-sldb-vars (from-string string))
- index)))
-
-(defslimefun pprint-eval-string-in-frame (string index)
- (swank-pprint
- (multiple-value-list
- (eval-in-frame (wrap-sldb-vars (from-string string)) index))))
+(defun eval-in-frame-aux (frame string package print)
+ (with-buffer-syntax (package)
+ (let ((form (wrap-sldb-vars (parse-string string package))))
+ (funcall print (multiple-value-list (eval-in-frame form frame))))))
+
+(defslimefun eval-string-in-frame (string frame package)
+ (eval-in-frame-aux frame string package #'format-values-for-echo-area))
+
+(defslimefun pprint-eval-string-in-frame (string frame package)
+ (eval-in-frame-aux frame string package #'swank-pprint))
+
+(defslimefun frame-package-name (frame)
+ (let ((pkg (frame-package frame)))
+ (cond (pkg (package-name pkg))
+ (t (with-buffer-syntax () (package-name *package*))))))
(defslimefun frame-locals-and-catch-tags (index)
"Return a list (LOCALS TAGS) for vars and catch tags in the frame INDEX.
More information about the slime-cvs
mailing list