[slime-cvs] CVS slime

[CVS User heller]

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

Modified Files:
	ChangeLog swank-sbcl.lisp 
Log Message:
* swank-sbcl.lisp (add-fd-handler): Avoid recursive invocation
of the handler, e.g. when read-sequence blocks.

--- /project/slime/cvsroot/slime/ChangeLog	2009/06/28 08:27:03	1.1795
+++ /project/slime/cvsroot/slime/ChangeLog	2009/06/28 19:14:43	1.1796
@@ -1,3 +1,8 @@
+2009-06-28  Helmut Eller  <heller at common-lisp.net>
+
+	* swank-sbcl.lisp (add-fd-handler): Avoid recursive invocation
+	of the handler, e.g. when read-sequence blocks.
+
 2009-06-28  Stas Boukarev  <stassats at gmail.com>
 
 	* swank-openmcl.lisp (compiler-warning-short-message): In new
@@ -19,12 +24,11 @@
 	SWANK:INSPECT-IN-EMACS.
 
 	* swank.lisp (inspect-in-emacs): added keyword argument :wait.
-	
+
 	* slime.el (slime-dispatch-event): if swank requests response to
 	:inspect, add a hook to the inspector to signal swank once done.
 	(slime-open-inspector): add optional hook argument to be added as
 	local kill-buffer-hook.
-	
 
 2009-06-21  Helmut Eller  <heller at common-lisp.net>
 
@@ -32,6 +36,7 @@
 	contrib/slime-fontifying-fu.el
 
 2009-06-21  Helmut Eller  <heller at common-lisp.net>
+
 	Don't try so hard to get symbol-at-point right.
 	The old implementation was complicated and didn't even pass it's
 	own test suite.  The new version is less ambitious but simpler.
--- /project/slime/cvsroot/slime/swank-sbcl.lisp	2009/06/21 07:22:56	1.243
+++ /project/slime/cvsroot/slime/swank-sbcl.lisp	2009/06/28 19:14:44	1.244
@@ -139,12 +139,18 @@
     (sb-sys:invalidate-descriptor fd))
   (close socket))
 
-(defimplementation add-fd-handler (socket fn)
-  (declare (type function fn))
-  (let ((fd (socket-fd socket)))
-    (sb-sys:add-fd-handler fd :input (lambda (_)
-                                       _
-                                       (funcall fn)))))
+(defimplementation add-fd-handler (socket fun)
+  (let ((fd (socket-fd socket))
+        (handler nil))
+    (labels ((add ()
+               (setq handler (sb-sys:add-fd-handler fd :input #'run)))
+             (run (fd)
+               (sb-sys:remove-fd-handler handler) ; prevent recursion
+               (unwind-protect 
+                    (funcall fun)
+                 (when (sb-unix:unix-fstat fd) ; still open?
+                   (add)))))
+      (add))))
 
 (defimplementation remove-fd-handlers (socket)
   (sb-sys:invalidate-descriptor (socket-fd socket)))