branch: externals/xelb
commit 6656f4de9c75001b66c273f026c483ccf6599d57
Author: Chris Feng <chris.w.f...@gmail.com>
Commit: Chris Feng <chris.w.f...@gmail.com>
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)))
