[elpa] externals/xelb b75641b 2/2: Split connection filter

[Chris Feng]

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

    Split connection filter
    
    * xcb.el (xcb:-connection-filter, xcb:-connection-setup-filter): Split
    out connection setup code from the former into the latter.
    (xcb:-connect): Set process filter to `xcb:-connection-setup-filter'.
---
 xcb.el |   79 +++++++++++++++++++++++++++++++++++-----------------------------
 1 file changed, 43 insertions(+), 36 deletions(-)

diff --git a/xcb.el b/xcb.el
index b4e3474..5a75714 100644
--- a/xcb.el
+++ b/xcb.el
@@ -200,7 +200,7 @@
     (set-process-plist process
                        (plist-put (process-plist process) 'connection obj))
     (set-process-coding-system process 'binary 'binary)
-    (set-process-filter process 'xcb:-connection-filter)
+    (set-process-filter process #'xcb:-connection-setup-filter)
     (process-send-string                ;send setup packet
      process
      (apply #'unibyte-string
@@ -223,6 +223,47 @@
 
 (defconst xcb:-SEQUENCE-SEGMENT-MASK (lognot #xFFFF))
 
+(defun xcb:-connection-setup-filter (process message)
+  "Process filter used during connection setup."
+  (let* ((connection (plist-get (process-plist process) 'connection))
+         (cache (vconcat (slot-value connection 'message-cache) message)))
+    (setf (slot-value connection 'message-cache) cache)
+    (unless (or (slot-value connection 'lock)
+                ;; Shorter than the setup header.
+                (> 8 (length cache)))
+      (setf (slot-value connection 'lock) t)
+      (let ((data-len (+ 8 (* 4 (if xcb:lsb
+                                    (xcb:-unpack-u2-lsb cache 6)
+                                  (xcb:-unpack-u2 cache 6)))))
+            obj)
+        (when (>= (length cache) data-len)
+          (xcb:-log "Setup response: %s" cache)
+          (pcase (aref cache 0)
+            (0
+             ;; Connection failed.
+             (setq obj (make-instance 'xcb:SetupFailed))
+             (xcb:unmarshal obj cache)
+             (setq cache (substring cache data-len))
+             (error "[XELB] Connection failed: %s" (slot-value obj 'reason)))
+            (1
+             ;; Connection established.
+             (setf (slot-value connection 'message-cache) [])
+             (set-process-filter process #'xcb:-connection-filter)
+             (setq obj (make-instance 'xcb:Setup))
+             (xcb:unmarshal obj cache)
+             (setq cache (substring cache data-len))
+             (setf (slot-value connection 'setup-data) obj)
+             (setf (slot-value connection 'connected) t))
+            (2
+             ;; Authentication required.
+             (setq obj (make-instance 'xcb:SetupAuthenticate))
+             (xcb:unmarshal obj cache)
+             (setq cache (substring cache data-len))
+             (error "[XELB] Authentication not supported: %s"
+                    (slot-value obj 'reason)))
+            (x (error "Unrecognized setup status: %d" x)))))
+      (setf (slot-value connection 'lock) nil))))
+
 (cl-defmethod xcb:-convert-sequence ((obj xcb:connection) sequence16)
   "Convert 16-bit sequence number SEQUENCE16 (read from a packet).
 
@@ -249,43 +290,9 @@ Concurrency is disabled as it breaks the orders of errors, 
replies and events."
          (cache (vconcat (slot-value connection 'message-cache) message))
          (cache-length (length cache)))
     (setf (slot-value connection 'message-cache) cache)
-    (catch 'return
-      ;; Queue message when locked
-      (when (slot-value connection 'lock)
-        (throw 'return 'lock))
+    (unless (slot-value connection 'lock)
       ;; Start parsing message
       (setf (slot-value connection 'lock) t)
-      ;; Connection setup
-      (unless (slot-value connection 'connected)
-        (when (<= 8 (length cache)) ;at least setup header is available
-          (let ((data-len (+ 8 (* 4 (funcall (if xcb:lsb #'xcb:-unpack-u2-lsb
-                                               #'xcb:-unpack-u2)
-                                             cache 6))))
-                obj)
-            (when (>= (length cache) data-len)
-              (xcb:-log "Setup response: %s" cache)
-              (pcase (aref cache 0)
-                (0                      ;failed
-                 (setq obj (make-instance 'xcb:SetupFailed))
-                 (xcb:unmarshal obj cache)
-                 (setq cache (substring cache data-len))
-                 (error "[XELB] Connection failed: %s"
-                        (slot-value obj 'reason)))
-                (1                      ;success
-                 (setq obj (make-instance 'xcb:Setup))
-                 (xcb:unmarshal obj cache)
-                 (setq cache (substring cache data-len))
-                 (setf (slot-value connection 'setup-data) obj)
-                 (setf (slot-value connection 'connected) t))
-                (2                      ;authentication
-                 (setq obj (make-instance 'xcb:SetupAuthenticate))
-                 (xcb:unmarshal obj cache)
-                 (setq cache (substring cache data-len))
-                 (error "[XELB] Authentication not supported: %s"
-                        (slot-value obj 'reason)))
-                (x (error "Unrecognized setup status: %d" x))))))
-        (setf (slot-value connection 'lock) nil)
-        (throw 'return 'setup))
       ;; Process error/reply/event
       (catch 'break
         (while (<= 32 (length cache))