[elpa] externals/xelb 6656f4d: Revisit event cache timely

[Chris Feng]

branch: externals/xelb
commit 6656f4de9c75001b66c273f026c483ccf6599d57
Author: Chris Feng <address@hidden>
Commit: Chris Feng <address@hidden>

    Revisit event cache timely
    
    ; Previously events are only sent to listeners in
    ; `xcb:-connection-filter'.  But with `event-lock' this process can be
    ; skipped when `event-lock' is hold elsewhere.  With such non-blocking
    ; lock this process should get rechecked whenever `event-lock' is
    ; released.
    
    * xcb.el (xcb:-process-events): New method for processing cached
    events.
    (xcb:-connection-filter, xcb:flush, xcb:-+reply, xcb:aux:sync): Use
    it.
---
 xcb.el | 35 +++++++++++++++++++++--------------
 1 file changed, 21 insertions(+), 14 deletions(-)

diff --git a/xcb.el b/xcb.el
index 466945e..f633d6b 100644
--- a/xcb.el
+++ b/xcb.el
@@ -395,18 +395,22 @@ Concurrency is disabled as it breaks the orders of 
errors, replies and events."
                 (substring message-cache (- cache-length (length cache))))
           (when (/= current-cache-length cache-length)
             (xcb:-connection-filter process []))))
-      (with-slots (event-lock event-queue) connection
-        (unless (< 0 event-lock)
-          (cl-incf event-lock)
-          (unwind-protect
-              (let (event data synthetic)
-                (while (setq event (pop event-queue))
-                  (setq data (aref event 1)
-                        synthetic (aref event 2))
-                  (dolist (listener (aref event 0))
-                    (with-demoted-errors "[XELB ERROR] %S"
-                      (funcall listener data synthetic)))))
-            (cl-decf event-lock)))))))
+      (xcb:-process-events connection))))
+
+(cl-defmethod xcb:-process-events ((conn xcb:connection))
+  "Process cached events."
+  (with-slots (event-lock event-queue) conn
+    (unless (< 0 event-lock)
+      (cl-incf event-lock)
+      (unwind-protect
+          (let (event data synthetic)
+            (while (setq event (pop event-queue))
+              (setq data (aref event 1)
+                    synthetic (aref event 2))
+              (dolist (listener (aref event 0))
+                (with-demoted-errors "[XELB ERROR] %S"
+                  (funcall listener data synthetic)))))
+        (cl-decf event-lock)))))
 
 (cl-defmethod xcb:disconnect ((obj xcb:connection))
   "Disconnect from X server."
@@ -464,7 +468,8 @@ classes of EVENT (since they have the same event number)."
       (unwind-protect
           (process-send-string (slot-value obj 'process)
                                (apply #'unibyte-string (append cache nil)))
-        (cl-decf (slot-value obj 'event-lock))))))
+        (cl-decf (slot-value obj 'event-lock)))
+      (xcb:-process-events obj))))
 
 (cl-defmethod xcb:get-extension-data ((obj xcb:connection) namespace)
   "Fetch the extension data from X server (block until data is retrieved)."
@@ -627,7 +632,8 @@ Otherwise no error will ever be reported."
             (while (and (> sequence (slot-value obj 'last-seen-sequence))
                         (<= sequence (slot-value obj 'request-sequence)))
               (accept-process-output process 1 nil 1)))
-        (cl-decf (slot-value obj 'event-lock)))))
+        (cl-decf (slot-value obj 'event-lock)))
+      (xcb:-process-events obj)))
   (let* ((reply-plist (slot-value obj 'reply-plist))
          (reply-data (plist-get reply-plist sequence))
          (error-plist (slot-value obj 'error-plist))
@@ -742,6 +748,7 @@ Sync by sending a GetInputFocus request and waiting until 
it's processed."
                       (<= sequence (slot-value obj 'request-sequence)))
             (accept-process-output process 1 nil 1)))
       (cl-decf (slot-value obj 'event-lock)))
+    (xcb:-process-events obj)
     ;; Discard any reply or error.
     (cl-remf (slot-value obj 'reply-plist) sequence)
     (cl-remf (slot-value obj 'error-plist) sequence)))