[slime-cvs] CVS slime

[heller]

Update of /project/slime/cvsroot/slime
In directory clnet:/tmp/cvs-serv5819

Modified Files:
	ChangeLog slime.el swank.lisp 
Log Message:
Let SIGINT create a synthetic event.

* swank.lisp (install-fd-handler,simple-serve-requests): Dispatch
a :emacs-interrupt event in the SIGINT handler.

* slime.el (slime-interrupt): Send nothing over the wire when
SIGINT is used.

--- /project/slime/cvsroot/slime/ChangeLog	2008/08/12 12:56:51	1.1443
+++ /project/slime/cvsroot/slime/ChangeLog	2008/08/12 12:56:57	1.1444
@@ -1,3 +1,13 @@
+2008-08-12  Helmut Eller  <heller at common-lisp.net>
+
+	Let SIGINT create a synthetic event.
+
+	* swank.lisp (install-fd-handler,simple-serve-requests): Dispatch
+	a :emacs-interrupt event in the SIGINT handler.
+
+	* slime.el (slime-interrupt): Send nothing over the wire when
+	SIGINT is used.
+
 2008-08-11  Helmut Eller  <heller at common-lisp.net>
 
 	* test.sh: Use batch mode by default.
--- /project/slime/cvsroot/slime/slime.el	2008/08/11 17:41:55	1.988
+++ /project/slime/cvsroot/slime/slime.el	2008/08/12 12:56:57	1.989
@@ -6454,9 +6454,8 @@
 (defun slime-interrupt ()
   "Interrupt Lisp."
   (interactive)
-  (slime-dispatch-event `(:emacs-interrupt ,slime-current-thread))
-  (when (slime-use-sigint-for-interrupt)
-    (slime-send-sigint)))
+  (cond ((slime-use-sigint-for-interrupt) (slime-send-sigint))
+        (t (slime-dispatch-event `(:emacs-interrupt ,slime-current-thread)))))
 
 (defun slime-quit ()
   (error "Not implemented properly.  Use `slime-interrupt' instead."))
--- /project/slime/cvsroot/slime/swank.lisp	2008/08/11 17:41:55	1.566
+++ /project/slime/cvsroot/slime/swank.lisp	2008/08/12 12:56:57	1.567
@@ -1159,7 +1159,11 @@
   (add-fd-handler (connection.socket-io connection)
                   (lambda () (handle-or-process-requests connection)))
   (setf (connection.saved-sigint-handler connection)
-        (install-sigint-handler (lambda () (process-io-interrupt connection))))
+        (install-sigint-handler 
+         (lambda () 
+           (invoke-or-queue-interrupt
+            (lambda () 
+              (dispatch-event `(:emacs-interrupt ,(current-thread-id))))))))
   (handle-or-process-requests connection))
 
 (defun deinstall-fd-handler (connection)
@@ -1171,7 +1175,10 @@
 (defun simple-serve-requests (connection)
   (unwind-protect 
        (call-with-user-break-handler
-        (lambda () (process-io-interrupt connection))
+        (lambda () 
+          (invoke-or-queue-interrupt 
+           (lambda () 
+             (dispatch-event `(:emacs-interrupt ,(current-thread-id))))))
         (lambda ()
           (with-simple-restart (close-connection "Close SLIME connection")
             (handle-requests connection))))
@@ -1762,26 +1769,23 @@
   "Bind *BUFFER-PACKAGE* to BUFFER-PACKAGE and evaluate FORM.
 Return the result to the continuation ID.
 Errors are trapped and invoke our debugger."
-  (call-with-debugger-hook
-   #'swank-debugger-hook
-   (lambda ()
-     (let (ok result)
-       (unwind-protect
-            (let ((*buffer-package* (guess-buffer-package buffer-package))
-                  (*buffer-readtable* (guess-buffer-readtable buffer-package))
-                  (*pending-continuations* (cons id *pending-continuations*)))
-              (check-type *buffer-package* package)
-              (check-type *buffer-readtable* readtable)
-              ;; 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)
-                                  ,(if ok
-                                       `(:ok ,result)
-                                       `(:abort))
-                                  ,id)))))))
+  (let (ok result)
+    (unwind-protect
+         (let ((*buffer-package* (guess-buffer-package buffer-package))
+               (*buffer-readtable* (guess-buffer-readtable buffer-package))
+               (*pending-continuations* (cons id *pending-continuations*)))
+           (check-type *buffer-package* package)
+           (check-type *buffer-readtable* readtable)
+           ;; 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)
+                               ,(if ok
+                                    `(:ok ,result)
+                                    `(:abort))
+                               ,id)))))
 
 (defvar *echo-area-prefix* "=> "
   "A prefix that `format-values-for-echo-area' should use.")
@@ -2027,8 +2031,9 @@
 
 (defun swank-debugger-hook (condition hook)
   "Debugger function for binding *DEBUGGER-HOOK*."
-  (declare (ignore hook))
-  (restart-case (invoke-slime-debugger condition)
+  (restart-case 
+      (call-with-debugger-hook 
+       hook (lambda () (invoke-slime-debugger condition)))
     (default-debugger (&optional v)
       :report "Use default debugger." (declare (ignore v))
       (invoke-default-debugger condition))))