[mcclim-cvs] CVS update: mcclim/input.lisp

[Timothy Moore]

Update of /project/mcclim/cvsroot/mcclim
In directory common-lisp.net:/tmp/cvs-serv25618

Modified Files:
	input.lisp 
Log Message:

In condition-wait, pass through return value of OpenMCL function.

Date: Fri Jul  1 14:59:39 2005
Author: tmoore

Index: mcclim/input.lisp
diff -u mcclim/input.lisp:1.32 mcclim/input.lisp:1.33
--- mcclim/input.lisp:1.32	Sun Oct 31 02:46:31 2004
+++ mcclim/input.lisp	Fri Jul  1 14:59:39 2005
@@ -228,33 +228,33 @@
   (check-schedule eq)
   (let ((lock (event-queue-lock eq)))
     (with-lock-held (lock)
-  (with-slots (schedule-time) eq
-    (flet ((pred ()
-             (not (null (event-queue-head eq)))))
-      (cond
-        (timeout
-         (loop as    timeout-time = (+ now timeout)
-               with  now = (now)
-               do    (when (pred)
-                       (return t))
-               do    (when (>= now timeout-time)
-                       (return nil))
-               do    (let ((timeout (if schedule-time
-                                        (min (- schedule-time now)
-                                             (- timeout-time now))
-                                        (- timeout-time now))))
-			   (condition-wait (event-queue-processes eq)
-					   lock timeout))
-               do    (check-schedule eq)))
-        (schedule-time
-         (loop do (when (pred)
-                    (return t))
-		   do (condition-wait
-		       (event-queue-processes eq) lock (- schedule-time (now)))
-               do (check-schedule eq)))
-        (t
-          (or (pred)
-              (progn
+      (with-slots (schedule-time) eq
+	(flet ((pred ()
+		 (not (null (event-queue-head eq)))))
+	  (cond
+	    (timeout
+	     (loop as    timeout-time = (+ now timeout)
+		with  now = (now)
+		do    (when (pred)
+			(return t))
+		do    (when (>= now timeout-time)
+			(return nil))
+		do    (let ((timeout (if schedule-time
+					 (min (- schedule-time now)
+					      (- timeout-time now))
+					 (- timeout-time now))))
+			(condition-wait (event-queue-processes eq)
+					lock timeout))
+		do    (check-schedule eq)))
+	    (schedule-time
+	     (loop do (when (pred)
+			(return t))
+		do (condition-wait
+		    (event-queue-processes eq) lock (- schedule-time (now)))
+		do (check-schedule eq)))
+	    (t
+	     (or (pred)
+		 (progn
 		   (condition-wait (event-queue-processes eq) lock)
 		   t)))))))))