[usocket-cvs] r434 - usocket/branches/0.4.x/backend

[Erik Huelsmann]

Author: ehuelsmann
Date: Mon Oct 20 22:14:12 2008
New Revision: 434

Log:
Merge c428 from trunk: WAIT-FOR-INPUT without timeout (non-Win32).

Modified:
   usocket/branches/0.4.x/backend/lispworks.lisp

Modified: usocket/branches/0.4.x/backend/lispworks.lisp
==============================================================================
--- usocket/branches/0.4.x/backend/lispworks.lisp	(original)
+++ usocket/branches/0.4.x/backend/lispworks.lisp	Mon Oct 20 22:14:12 2008
@@ -216,15 +216,20 @@
       ;; Can we have a sane -pref. complete [UDP!?]- API next time, please?
       (dolist (x (wait-list-waiters wait-list))
         (mp:notice-fd (os-socket-handle x)))
-      (mp:process-wait-with-timeout "Waiting for a socket to become active"
-                                    (truncate timeout)
-                                    #'(lambda (socks)
-                                        (let (rv)
-                                          (dolist (x socks rv)
-                                            (when (usocket-listen x)
-                                              (setf (state x) :READ
-                                                    rv t)))))
-                                    (wait-list-waiters wait-list))
+      (labels ((wait-function (socks)
+		 (let (rv)
+		   (dolist (x socks rv)
+		     (when (usocket-listen x)
+		       (setf (state x) :READ
+			     rv t))))))
+	(if timeout
+	    (mp:process-wait-with-timeout "Waiting for a socket to become active"
+					(truncate timeout)
+					#'wait-function
+					(wait-list-waiters wait-list))
+	    (mp:process-wait "Waiting for a socket to become active"
+			     #'wait-function
+			     (wait-list-waiters wait-list))))
       (dolist (x (wait-list-waiters wait-list))
         (mp:unnotice-fd (os-socket-handle x)))
       wait-list)))