[elpa] externals/xelb e7b471e: Protect the event lock

[Chris Feng]

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

    Protect the event lock
    
    ; It's observed the event lock can occasionally fail to be decreased,
    ; though the cause is unclear.
    
    * xcb.el (xcb:flush, xcb:-+reply, xcb:aux:sync): Protect the event lock.
---
 xcb.el |   33 ++++++++++++++++++---------------
 1 file changed, 18 insertions(+), 15 deletions(-)

diff --git a/xcb.el b/xcb.el
index f372bd6..992d528 100644
--- a/xcb.el
+++ b/xcb.el
@@ -453,9 +453,10 @@ classes of EVENT (since they have the same event number)."
     (when (< 0 (length cache))
       (setf (slot-value obj 'request-cache) []) ;should be cleared ASAP
       (cl-incf (slot-value obj 'event-lock))
-      (process-send-string (slot-value obj 'process)
-                           (apply #'unibyte-string (append cache nil)))
-      (cl-decf (slot-value obj 'event-lock)))))
+      (unwind-protect
+          (process-send-string (slot-value obj 'process)
+                               (apply #'unibyte-string (append cache nil)))
+        (cl-decf (slot-value obj 'event-lock))))))
 
 (cl-defmethod xcb:get-extension-data ((obj xcb:connection) namespace)
   "Fetch the extension data from X server (block until data is retrieved)."
@@ -612,12 +613,13 @@ Otherwise no error will ever be reported."
     (let ((process (slot-value obj 'process)))
       ;; Wait until the request processed
       (cl-incf (slot-value obj 'event-lock))
-      (with-timeout (xcb:connection-timeout
-                     (warn "[XELB] Retrieve reply timeout"))
-        (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))))
+      (unwind-protect
+          (with-timeout (xcb:connection-timeout
+                         (warn "[XELB] Retrieve reply timeout"))
+            (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)))))
   (let* ((reply-plist (slot-value obj 'reply-plist))
          (reply-data (plist-get reply-plist sequence))
          (error-plist (slot-value obj 'error-plist))
@@ -725,12 +727,13 @@ Sync by sending a GetInputFocus request and waiting until 
it's processed."
     (xcb:flush obj)
     ;; Wait until request processed
     (cl-incf (slot-value obj 'event-lock))
-    (with-timeout (xcb:connection-timeout (warn "[XELB] Sync timeout"))
-      (while (and (> sequence (slot-value obj 'last-seen-sequence))
-                  ;; In case the sequence number has been wrapped.
-                  (<= sequence (slot-value obj 'request-sequence)))
-        (accept-process-output process 1 nil 1)))
-    (cl-decf (slot-value obj 'event-lock))
+    (unwind-protect
+        (with-timeout (xcb:connection-timeout (warn "[XELB] Sync timeout"))
+          (while (and (> sequence (slot-value obj 'last-seen-sequence))
+                      ;; In case the sequence number has been wrapped.
+                      (<= sequence (slot-value obj 'request-sequence)))
+            (accept-process-output process 1 nil 1)))
+      (cl-decf (slot-value obj 'event-lock)))
     ;; Discard any reply or error.
     (cl-remf (slot-value obj 'reply-plist) sequence)
     (cl-remf (slot-value obj 'error-plist) sequence)))