[slime-cvs] CVS slime

[CVS User heller]

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

Modified Files:
	ChangeLog swank-backend.lisp swank-cmucl.lisp swank.lisp 
Log Message:
Don't signal conditions in the interrupt handler to
avoid problems with naive code like
 (handler-case foo (condition bar))

* swank-backend.lisp (*interrupt-queued-handler*): Use a dynamic
variable instead.
(slime-interrupt-queued): Deleted.
* swank-cmucl.lisp, swank.lisp: Ditto.

--- /project/slime/cvsroot/slime/ChangeLog	2009/02/14 12:33:16	1.1679
+++ /project/slime/cvsroot/slime/ChangeLog	2009/02/14 12:33:27	1.1680
@@ -51,6 +51,17 @@
 
 	Patch by Stas Boukarev.
 
+2009-02-14  Helmut Eller  <heller at common-lisp.net>
+
+	Don't signal conditions in interrupt handler to
+	avoid problems with naive code like
+	 (handler-case foo (condition bar))
+
+	* swank-backend.lisp (*interrupt-queued-handler*): Use a dynamic
+	variable instead.
+	(slime-interrupt-queued): Deleted.
+	* swank-cmucl.lisp, swank.lisp: Ditto.
+
 2009-01-30  Helmut Eller  <heller at common-lisp.net>
 
 	* slime.el (slime-restart-or-init-modeline-update-timer): Don't
--- /project/slime/cvsroot/slime/swank-backend.lisp	2009/01/27 14:56:14	1.171
+++ /project/slime/cvsroot/slime/swank-backend.lisp	2009/02/14 12:33:28	1.172
@@ -35,7 +35,7 @@
            ;; interrupt macro for the backend
            #:*pending-slime-interrupts*
            #:check-slime-interrupts
-           #:slime-interrupt-queued
+           #:*interrupt-queued-handler*
            ;; inspector related symbols
            #:emacs-inspect
            #:label-value-line
@@ -1065,11 +1065,12 @@
     (funcall (pop *pending-slime-interrupts*))
     t))
 
-(define-condition slime-interrupt-queued () ()
-  (:documentation 
-   "Non-serious condition signalled when an interrupt
-occurs while interrupt handling is disabled.
-Backends can use this to abort blocking operations."))
+(defvar *interrupt-queued-handler* nil
+  "Function to call on queued interrupts.
+Interrupts get queued when an interrupt occurs while interrupt
+handling is disabled.
+
+Backends can use this function to abort slow operations.")
 
 (definterface wait-for-input (streams &optional timeout)
   "Wait for input on a list of streams.  Return those that are ready.
--- /project/slime/cvsroot/slime/swank-cmucl.lisp	2009/01/10 12:25:16	1.210
+++ /project/slime/cvsroot/slime/swank-cmucl.lisp	2009/02/14 12:33:28	1.211
@@ -203,8 +203,8 @@
             (handlers (loop for s in (cons in (mapcar #'to-fd-stream streams))
                             collect (add-one-shot-handler s f))))
        (unwind-protect
-            (handler-bind ((slime-interrupt-queued 
-                            (lambda (c) c (write-char #\! out))))
+            (let ((*interrupt-queued-handler* (lambda () 
+                                                (write-char #\! out))))
               (when (check-slime-interrupts) (return :interrupt))
               (sys:serve-event))
          (mapc #'sys:remove-fd-handler handlers)
--- /project/slime/cvsroot/slime/swank.lisp	2009/01/16 15:49:48	1.633
+++ /project/slime/cvsroot/slime/swank.lisp	2009/02/14 12:33:28	1.634
@@ -427,7 +427,8 @@
                 (check-slime-interrupts))
                (t
                 (log-event "queue-interrupt: ~a" function)
-                (signal 'slime-interrupt-queued))))))
+                (when *interrupt-queued-handler*
+                  (funcall *interrupt-queued-handler*)))))))
 
 (defslimefun simple-break (&optional (datum "Interrupt from Emacs") &rest args)
   (with-simple-restart (continue "Continue from break.")
@@ -2366,7 +2367,9 @@
 FORM is expected, but not required, to be SETF'able."
   ;; FIXME: Can we check FORM for setfability? -luke (12/Mar/2005)
   (with-buffer-syntax ()
-    (prin1-to-string (eval (read-from-string form)))))
+    (let* ((value (eval (read-from-string form)))
+           (*print-length* nil))
+      (prin1-to-string value))))
 
 (defslimefun commit-edited-value (form value)
   "Set the value of a setf'able FORM to VALUE.
@@ -2488,7 +2491,7 @@
                                   `(or (:emacs-rex . _)
                                        (:sldb-return ,(1+ level))))
                  ((:emacs-rex &rest args) (apply #'eval-for-emacs args))
-                 ((:sldb-return _) (declare (ignore _)) (return nil))) 
+                 ((:sldb-return _) (declare (ignore _)) (return nil)))
              (sldb-condition (c) 
                (handle-sldb-condition c))))))
     (send-to-emacs `(:debug-return