[slime-cvs] CVS slime
trittweiler
trittweiler at common-lisp.net
Tue Sep 9 23:26:18 UTC 2008
Update of /project/slime/cvsroot/slime
In directory clnet:/tmp/cvs-serv12973
Modified Files:
swank.lisp ChangeLog
Log Message:
* swank.lisp (eval-for-emacs): Remove WITH-RETRY-RESTART again for
simplicity reasons.
(interactive-eval): Add WITH-RETRY-RESTART.
(eval-and-grab-output): Ditto.
(interactive-eval-region): Ditto.
(re-evaluate-defvar): Ditto.
(pprint-eval): Ditto.
(repl-eval): Ditto.
(eval-string-in-frame): Ditto.
(pprint-eval-string-in-frame): Ditto.
(init-inspector): Ditto.
(inspect-in-frame): Ditto.
--- /project/slime/cvsroot/slime/swank.lisp 2008/09/09 12:35:46 1.583
+++ /project/slime/cvsroot/slime/swank.lisp 2008/09/09 23:26:18 1.584
@@ -400,6 +400,24 @@
(with-io-redirection (*emacs-connection*)
(call-with-debugger-hook #'swank-debugger-hook function))))))
+(defun call-with-retry-restart (msg thunk)
+ (let ((%ok (gensym "OK+"))
+ (%retry (gensym "RETRY+")))
+ (restart-bind
+ ((retry
+ (lambda () (throw %retry nil))
+ :report-function
+ (lambda (stream)
+ (write msg :stream stream))))
+ (catch %ok
+ (loop (catch %retry (throw %ok (funcall thunk))))))))
+
+(defmacro with-retry-restart ((&key (msg "Retry.")) &body body)
+ (check-type msg string)
+ `(call-with-retry-restart ,msg #'(lambda () , at body)))
+
+;;; FIXME: Can this be removed with the introduction of
+;;; WITH/WITHOUT-SLIME-INTERRUPTS.
(defmacro without-interrupts (&body body)
`(call-without-interrupts (lambda () , at body)))
@@ -461,6 +479,7 @@
(defun current-thread-id ()
(thread-id (current-thread)))
+
;;;;; Logging
@@ -1795,22 +1814,6 @@
;;;; Evaluation
-(defun call-with-retry-restart (msg thunk)
- (let ((%ok (gensym "OK+"))
- (%retry (gensym "RETRY+")))
- (restart-bind
- ((retry
- (lambda () (throw %retry nil))
- :report-function
- (lambda (stream)
- (write msg :stream stream))))
- (catch %ok
- (loop (catch %retry (throw %ok (funcall thunk))))))))
-
-(defmacro with-retry-restart ((&key (msg "Retry.")) &body body)
- (check-type msg string)
- `(call-with-retry-restart ,msg #'(lambda () , at body)))
-
(defvar *pending-continuations* '()
"List of continuations for Emacs. (thread local)")
@@ -1831,11 +1834,9 @@
(*pending-continuations* (cons id *pending-continuations*)))
(check-type *buffer-package* package)
(check-type *buffer-readtable* readtable)
- ;; We provide a general RETRY restart because RESTART-FRAME
- ;; works only on functions compiled with high debug settings,
- ;; and most aren't.
- (with-retry-restart (:msg "Retry SLIME evaluation request.")
- (setq result (with-slime-interrupts (eval form))))
+ ;; APPLY would be cleaner than EVAL.
+ ;;(setq result (apply (car form) (cdr form)))
+ (setq result (with-slime-interrupts (eval form)))
(run-hook *pre-reply-hook*)
(setq ok t))
(send-to-emacs `(:return ,(current-thread)
@@ -1859,18 +1860,20 @@
(defslimefun interactive-eval (string)
(with-buffer-syntax ()
- (let ((values (multiple-value-list (eval (from-string string)))))
- (fresh-line)
- (finish-output)
- (format-values-for-echo-area values))))
+ (with-retry-restart (:msg "Retry SLIME interactive evaluation request.")
+ (let ((values (multiple-value-list (eval (from-string string)))))
+ (fresh-line)
+ (finish-output)
+ (format-values-for-echo-area values)))))
(defslimefun eval-and-grab-output (string)
(with-buffer-syntax ()
- (let* ((s (make-string-output-stream))
- (*standard-output* s)
- (values (multiple-value-list (eval (from-string string)))))
- (list (get-output-stream-string s)
- (format nil "~{~S~^~%~}" values)))))
+ (with-retry-restart (:msg "Retry SLIME evaluation request.")
+ (let* ((s (make-string-output-stream))
+ (*standard-output* s)
+ (values (multiple-value-list (eval (from-string string)))))
+ (list (get-output-stream-string s)
+ (format nil "~{~S~^~%~}" values))))))
(defun eval-region (string)
"Evaluate STRING.
@@ -1888,16 +1891,18 @@
(defslimefun interactive-eval-region (string)
(with-buffer-syntax ()
- (format-values-for-echo-area (eval-region string))))
+ (with-retry-restart (:msg "Retry SLIME interactive evaluation request.")
+ (format-values-for-echo-area (eval-region string)))))
(defslimefun re-evaluate-defvar (form)
(with-buffer-syntax ()
- (let ((form (read-from-string form)))
- (destructuring-bind (dv name &optional value doc) form
- (declare (ignore value doc))
- (assert (eq dv 'defvar))
- (makunbound name)
- (prin1-to-string (eval form))))))
+ (with-retry-restart (:msg "Retry SLIME evaluation request.")
+ (let ((form (read-from-string form)))
+ (destructuring-bind (dv name &optional value doc) form
+ (declare (ignore value doc))
+ (assert (eq dv 'defvar))
+ (makunbound name)
+ (prin1-to-string (eval form)))))))
(defvar *swank-pprint-bindings*
`((*print-pretty* . t)
@@ -1921,7 +1926,8 @@
(defslimefun pprint-eval (string)
(with-buffer-syntax ()
- (swank-pprint (multiple-value-list (eval (read-from-string string))))))
+ (with-retry-restart (:msg "Retry SLIME evaluation request.")
+ (swank-pprint (multiple-value-list (eval (read-from-string string)))))))
(defslimefun set-package (name)
"Set *package* to the package named NAME.
@@ -1943,13 +1949,14 @@
(defun repl-eval (string)
(clear-user-input)
(with-buffer-syntax ()
- (track-package
- (lambda ()
- (multiple-value-bind (values last-form) (eval-region string)
- (setq *** ** ** * * (car values)
- /// // // / / values
- +++ ++ ++ + + last-form)
- (funcall *send-repl-results-function* values)))))
+ (with-retry-restart (:msg "Retry SLIME REPL evaluation request.")
+ (track-package
+ (lambda ()
+ (multiple-value-bind (values last-form) (eval-region string)
+ (setq *** ** ** * * (car values)
+ /// // // / / values
+ +++ ++ ++ + + last-form)
+ (funcall *send-repl-results-function* values))))))
nil)
(defun track-package (fun)
@@ -2322,13 +2329,16 @@
,form))
(defslimefun eval-string-in-frame (string index)
- (to-string (eval-in-frame (wrap-sldb-vars (from-string string))
- index)))
+ (to-string
+ (with-retry-restart (:msg "Retry SLIME evaluation request.")
+ (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))))
+ (with-retry-restart (:msg "Retry SLIME evaluation request.")
+ (multiple-value-list
+ (eval-in-frame (wrap-sldb-vars (from-string string)) index)))))
(defslimefun frame-locals-for-emacs (index)
"Return a property list ((&key NAME ID VALUE) ...) describing
@@ -2883,8 +2893,9 @@
(defslimefun init-inspector (string)
(with-buffer-syntax ()
- (reset-inspector)
- (inspect-object (eval (read-from-string string)))))
+ (with-retry-restart (:msg "Retry SLIME inspection request.")
+ (reset-inspector)
+ (inspect-object (eval (read-from-string string))))))
(defun inspect-object (o)
(let ((previous *istate*)
@@ -3025,8 +3036,9 @@
(defslimefun inspect-in-frame (string index)
(with-buffer-syntax ()
- (reset-inspector)
- (inspect-object (eval-in-frame (from-string string) index))))
+ (with-retry-restart (:msg "Retry SLIME inspection request.")
+ (reset-inspector)
+ (inspect-object (eval-in-frame (from-string string) index)))))
(defslimefun inspect-current-condition ()
(with-buffer-syntax ()
--- /project/slime/cvsroot/slime/ChangeLog 2008/09/09 12:35:46 1.1493
+++ /project/slime/cvsroot/slime/ChangeLog 2008/09/09 23:26:18 1.1494
@@ -1,3 +1,19 @@
+2008-09-10 Tobias C. Rittweiler <tcr at freebits.de>
+
+ * swank.lisp (eval-for-emacs): Remove WITH-RETRY-RESTART again for
+ simplicity reasons.
+
+ (interactive-eval): Add WITH-RETRY-RESTART.
+ (eval-and-grab-output): Ditto.
+ (interactive-eval-region): Ditto.
+ (re-evaluate-defvar): Ditto.
+ (pprint-eval): Ditto.
+ (repl-eval): Ditto.
+ (eval-string-in-frame): Ditto.
+ (pprint-eval-string-in-frame): Ditto.
+ (init-inspector): Ditto.
+ (inspect-in-frame): Ditto.
+
2008-09-09 Tobias C. Rittweiler <tcr at freebits.de>
A RETRY restart is provided for all Slime evaluation requests.
More information about the slime-cvs
mailing list