From b203c061ddf0c50d1f61e3af9ee80f9c3dbab623 Mon Sep 17 00:00:00 2001
From: ram <ram>
Date: Thu, 23 May 1991 16:30:20 +0000
Subject: [PATCH] Tweaked serve-event some more.  Handling of queued X events
 in not inhibited by FD handlers whose handler function is
 CALL-DISPLAY-EVENT-HANDLER.

---
 code/serve-event.lisp | 20 +++++++++-----------
 1 file changed, 9 insertions(+), 11 deletions(-)

diff --git a/code/serve-event.lisp b/code/serve-event.lisp
index 31a67384a..420f864ca 100644
--- a/code/serve-event.lisp
+++ b/code/serve-event.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/serve-event.lisp,v 1.10 1991/05/23 15:01:57 ram Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/serve-event.lisp,v 1.11 1991/05/23 16:30:20 ram Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -268,14 +268,17 @@
   ;; First, check any X displays for any pending events.
   #+clx
   (dolist (d/h *display-event-handlers*)
-    (let ((d (car d/h)))
+    (let* ((d (car d/h))
+	   (disp-fd (fd-stream-fd (xlib::display-input-stream d))))
       (declare (inline member))
       ;;
       ;; If in the *descriptor-handlers*, then we are already waiting for input
       ;; on that display, and we don't want to do it recursively.
-      (when (and (not (member (fd-stream-fd (xlib::display-input-stream d))
-			      *descriptor-handlers*
-			      :key #'handler-descriptor))
+      (when (and (dolist (hand *descriptor-handlers* t)
+		   (when (and (eql (handler-descriptor hand) disp-fd)
+			      (not (eq (handler-function hand)
+				       #'ext::call-display-event-handler)))
+		     (return nil)))
 		 (xlib::event-listen d))
 	(handler-bind ((error #'(lambda (condx)
 				  (declare (ignore condx))
@@ -288,12 +291,7 @@
       (wait-for-event timeout)
     (declare (type (unsigned-byte 32) readable writeable))
     ;; Now see what it was (if anything)
-    (cond #+nil
-	  ((eq value server-unique-object)
-	   ;; The interrupt handler fired.
-	   (grab-message-loop)
-	   t)
-	  ((fixnump value)
+    (cond ((fixnump value)
 	   (unless (zerop value)
 	     ;; Check the descriptors.
 	     (let ((result nil))
-- 
GitLab