[slime-cvs] CVS slime

[heller]

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

Modified Files:
	ChangeLog swank-sbcl.lisp 
Log Message:
* swank-sbcl.lisp (wait-for-input): Implement this in backend,
since read-char-no-hang doesn't work in fd-handlers.
(install-sigint-handler): Go through invoke-interruption and
with-interrupts to support nested interrupts.

--- /project/slime/cvsroot/slime/ChangeLog	2008/09/22 17:49:41	1.1537
+++ /project/slime/cvsroot/slime/ChangeLog	2008/09/22 17:49:53	1.1538
@@ -1,3 +1,13 @@
+2008-09-22  Helmut Eller  <heller at common-lisp.net>
+
+	* swank-sbcl.lisp (wait-for-input): Implement this in backend,
+	since read-char-no-hang doesn't work in fd-handlers.
+	(install-sigint-handler): Go through invoke-interruption and
+	with-interrupts to support nested interrupts.
+
+	* slime.el (slime-lisp-implementations): Mention :env keyword
+	in docstring.
+
 2008-09-21  Helmut Eller  <heller at common-lisp.net>
 
 	* slime.el (slime-repl-input-end-mark): Deleted. It was always at
--- /project/slime/cvsroot/slime/swank-sbcl.lisp	2008/09/17 17:48:08	1.220
+++ /project/slime/cvsroot/slime/swank-sbcl.lisp	2008/09/22 17:49:53	1.221
@@ -117,7 +117,10 @@
   (sb-sys:enable-interrupt sb-unix:sigint 
                            (lambda (&rest args)
                              (declare (ignore args))
-                             (funcall function))))
+                             (sb-sys:invoke-interruption 
+                              (lambda ()
+                                (sb-sys:with-interrupts 
+                                  (funcall function)))))))
 
 (defvar *sigio-handlers* '()
   "List of (key . fn) pairs to be called on SIGIO.")
@@ -165,6 +168,35 @@
     (sb-bsd-sockets:socket (sb-bsd-sockets:socket-file-descriptor socket))
     (file-stream (sb-sys:fd-stream-fd socket))))
 
+(defvar *wait-for-input-called*)
+
+(defimplementation wait-for-input (streams &optional timeout)
+  (assert (member timeout '(nil t)))
+  (when (boundp '*wait-for-input-called*)
+    (setq *wait-for-input-called* t))
+  (let ((*wait-for-input-called* nil))
+    (loop
+     (let ((ready (remove-if-not #'listen streams)))
+       (when ready (return ready)))
+     (when timeout (return nil))
+     (when (check-slime-interrupts) (return :interrupt))
+     (when *wait-for-input-called* (return :interrupt))
+     (let* ((f (constantly t))
+            (handlers (loop for s in streams
+                            collect (add-one-shot-handler s f))))
+       (unwind-protect
+            (sb-sys:serve-event 0.2)
+         (mapc #'sb-sys:remove-fd-handler handlers))))))
+
+(defun add-one-shot-handler (stream function)
+  (let (handler)
+    (setq handler 
+          (sb-sys:add-fd-handler (sb-sys:fd-stream-fd stream) :input
+                                 (lambda (fd)
+                                   (declare (ignore fd))
+                                   (sb-sys:remove-fd-handler handler)
+                                   (funcall function stream))))))
+
 (defvar *external-format-to-coding-system*
   '((:iso-8859-1 
      "latin-1" "latin-1-unix" "iso-latin-1-unix"