[elpa] externals/xelb 89eeecc: Add support for fast switching between multiple keyboards

[Chris Feng]

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

    Add support for fast switching between multiple keyboards
    
    * xcb-keysyms.el (xcb:keysyms:-device): New class containing the
    properties of a keyboard.
    (xcb:keysyms:-get-current-device): New method for retrieving the
    current keyboard object.
    (xcb:keysyms:-on-NewKeyboardNotify, xcb:keysyms:-on-MapNotify): Cache
    the properties of all keyboards.
    
    * xcb.el (xcb:-get-extra-plist, xcb:-set-extra-plist): New methods for
    getting/setting module-specific properties.
    * xcb-keysyms.el (xcb:keysyms:init, xcb:keysyms:-set-per-client-flags)
    (xcb:keysyms:-on-NewKeyboardNotify, xcb:keysyms:-on-MapNotify)
    (xcb:keysyms:-update-keytypes, xcb:keysyms:-update-keycodes)
    (xcb:keysyms:keycode->keysym, xcb:keysyms:keysym->keycode): Use them.
---
 xcb-keysyms.el | 330 +++++++++++++++++++++++++++++----------------------------
 xcb.el         |  11 ++
 2 files changed, 179 insertions(+), 162 deletions(-)

diff --git a/xcb-keysyms.el b/xcb-keysyms.el
index c719dd6..e912fc7 100644
--- a/xcb-keysyms.el
+++ b/xcb-keysyms.el
@@ -44,6 +44,13 @@
 (require 'xcb)
 (require 'xcb-xkb)
 
+(defclass xcb:keysyms:-device ()
+  ((keytypes :initform nil)
+   (keycodes :initform nil)
+   (min-keycode :initform 0)
+   (max-keycode :initform 0))
+  :documentation "Device (keyboard) properties.")
+
 ;; These variables are shared by all connections.
 (defvar xcb:keysyms:meta-mask 0 "META key mask.")
 (defvar xcb:keysyms:control-mask xcb:ModMask:Control "CONTROL key mask.")
@@ -55,6 +62,12 @@
 (defvar xcb:keysyms:shift-lock-mask 0 "SHIFT-LOCK key mask.")
 (defvar xcb:keysyms:num-lock-mask 0 "NUM-LOCK key mask.")
 
+(cl-defmethod xcb:keysyms:-get-current-device ((conn xcb:connection))
+  "Return the device currently used."
+  (or (xcb:-get-extra-plist conn 'keysyms
+                            (xcb:-get-extra-plist conn 'keysyms 'device-id))
+      (make-instance 'xcb:keysyms:-device)))
+
 (cl-defmethod xcb:keysyms:init ((obj xcb:connection) &optional callback)
   "Initialize keysyms module.
 
@@ -63,7 +76,7 @@ CALLBACK specifies a function to call every time the keyboard 
is updated.
 This method must be called before using any other method in this module."
   (cond
    ;; Avoid duplicated initializations.
-   ((plist-get (plist-get (slot-value obj 'extra-plist) 'keysyms) 'opcode))
+   ((xcb:-get-extra-plist obj 'keysyms 'opcode))
    ((= 0 (slot-value (xcb:get-extension-data obj 'xcb:xkb)
                      'present))
     (error "[XCB] XKB extension is not supported by the server"))
@@ -75,18 +88,17 @@ This method must be called before using any other method in 
this module."
     (error "[XCB] XKB extension version 1.0 is not supported by the server"))
    (t
     ;; Save the major opcode of XKB and callback function.
-    (let ((plist (plist-get (slot-value obj 'extra-plist) 'keysyms)))
-      (setq plist (plist-put plist 'opcode
-                             (slot-value (xcb:get-extension-data obj 'xcb:xkb)
-                                         'major-opcode))
-            plist (plist-put plist 'callback callback))
-      (setf (slot-value obj 'extra-plist)
-            (plist-put (slot-value obj 'extra-plist) 'keysyms plist)))
+    (xcb:-set-extra-plist obj 'keysyms 'opcode
+                          (slot-value (xcb:get-extension-data obj 'xcb:xkb)
+                                      'major-opcode))
+    (xcb:-set-extra-plist obj 'keysyms 'callback callback)
     ;; Set per-client flags.
     (xcb:keysyms:-set-per-client-flags obj xcb:xkb:ID:UseCoreKbd)
     ;; Update data.
     (xcb:keysyms:-update-keytypes obj xcb:xkb:ID:UseCoreKbd)
-    (xcb:keysyms:-update-keycodes obj xcb:xkb:ID:UseCoreKbd)
+    (xcb:-set-extra-plist obj 'keysyms 'device-id
+                          (xcb:keysyms:-update-keycodes obj
+                                                        xcb:xkb:ID:UseCoreKbd))
     (xcb:keysyms:-update-modkeys obj xcb:xkb:ID:UseCoreKbd)
     ;; Attach event listeners.
     (xcb:+event obj 'xcb:xkb:NewKeyboardNotify
@@ -115,7 +127,8 @@ This method must be called before using any other method in 
this module."
                          :newKeyboardDetails new-keyboard)))
     (xcb:flush obj))))
 
-(cl-defmethod xcb:keysyms:-set-per-client-flags ((obj xcb:connection) device)
+(cl-defmethod xcb:keysyms:-set-per-client-flags ((obj xcb:connection)
+                                                 device-id)
   "Set per-client flags."
   (let ((per-client-flags (logior
                            ;; Instead of compatibility state.
@@ -127,7 +140,7 @@ This method must be called before using any other method in 
this module."
     ;; The reply is not used.
     (xcb:+request-unchecked+reply obj
         (make-instance 'xcb:xkb:PerClientFlags
-                       :deviceSpec device
+                       :deviceSpec device-id
                        :change per-client-flags
                        :value per-client-flags
                        :ctrlsToChange 0
@@ -136,19 +149,15 @@ This method must be called before using any other method 
in this module."
 
 (cl-defmethod xcb:keysyms:-on-NewKeyboardNotify ((obj xcb:connection) data)
   "Handle 'NewKeyboardNotify' event."
-  (let* ((plist (plist-get (slot-value obj 'extra-plist) 'keysyms))
-         (device (plist-get plist 'device))
-         (opcode (plist-get plist 'opcode))
-         (callback (plist-get plist 'callback))
-         (obj1 (make-instance 'xcb:xkb:NewKeyboardNotify))
-         updated)
+  (let ((device-id (xcb:-get-extra-plist obj 'keysyms 'device-id))
+        (opcode (xcb:-get-extra-plist obj 'keysyms 'opcode))
+        (callback (xcb:-get-extra-plist obj 'keysyms 'callback))
+        (obj1 (make-instance 'xcb:xkb:NewKeyboardNotify))
+        updated)
     (xcb:unmarshal obj1 data)
     (with-slots (deviceID oldDeviceID requestMajor requestMinor changed) obj1
       (if (= 0 (logand changed xcb:xkb:NKNDetail:DeviceID))
-          ;; Device is not changed; ensure it's a keycode change from
-          ;; this device.
           (when (and (/= 0 (logand changed xcb:xkb:NKNDetail:Keycodes))
-                     (= deviceID device)
                      ;; Also, according to the specification this can
                      ;; only happen when a GetKbdByName request issued.
                      ;; The two checks below avoid false positive caused
@@ -156,53 +165,56 @@ This method must be called before using any other method 
in this module."
                      (= requestMajor opcode)
                      (= requestMinor
                         (eieio-oref-default 'xcb:xkb:GetKbdByName '~opcode)))
-            (setq updated t)
             ;; (xcb:keysyms:-update-keytypes obj deviceID)
             (xcb:keysyms:-update-keycodes obj deviceID)
-            (xcb:keysyms:-update-modkeys obj deviceID))
-        (when (or (= oldDeviceID device)
+            (when (= deviceID device-id)
+              (setq updated t)
+              (xcb:keysyms:-update-modkeys obj deviceID)))
+        (xcb:keysyms:-set-per-client-flags obj deviceID)
+        (xcb:keysyms:-update-keytypes obj deviceID)
+        (xcb:keysyms:-update-keycodes obj deviceID)
+        (when (or (= oldDeviceID device-id)
                   ;; 0 is a special value for servers not supporting
                   ;; the X Input Extension.
                   (= oldDeviceID 0))
           ;; Device changed; update the per-client flags and local data.
           (setq updated t)
-          (xcb:keysyms:-set-per-client-flags obj deviceID)
-          (xcb:keysyms:-update-keytypes obj deviceID)
-          (xcb:keysyms:-update-keycodes obj deviceID)
-          (xcb:keysyms:-update-modkeys obj deviceID))))
+          (xcb:keysyms:-update-modkeys obj deviceID)
+          (xcb:-set-extra-plist obj 'keysyms 'device-id deviceID))))
     (when (and callback updated)
-      (funcall callback))))
+      (with-demoted-errors "[XELB ERROR] %S"
+        (funcall callback)))))
 
 (cl-defmethod xcb:keysyms:-on-MapNotify ((obj xcb:connection) data)
   "Handle 'MapNotify' event."
-  (let* ((plist (plist-get (slot-value obj 'extra-plist) 'keysyms))
-         (device (plist-get plist 'device))
-         (callback (plist-get plist 'callback))
-         (obj1 (make-instance 'xcb:xkb:MapNotify))
-         updated)
+  (let ((device-id (xcb:-get-extra-plist obj 'keysyms 'device-id))
+        (callback (xcb:-get-extra-plist obj 'keysyms 'callback))
+        (obj1 (make-instance 'xcb:xkb:MapNotify))
+        updated)
     (xcb:unmarshal obj1 data)
     (with-slots (deviceID changed firstType nTypes firstKeySym nKeySyms) obj1
       ;; Ensure this event is for the current device.
-      (when (= deviceID device)
-        (when (/= 0 (logand changed xcb:xkb:MapPart:KeyTypes))
-          (setq updated t)
-          (xcb:keysyms:-update-keytypes obj deviceID firstType nTypes))
-        (when (/= 0 (logand changed xcb:xkb:MapPart:KeySyms))
-          (setq updated t)
-          (xcb:keysyms:-update-keycodes obj deviceID firstKeySym nKeySyms))
-        (when (/= 0 (logand changed xcb:xkb:MapPart:ModifierMap))
-          (setq updated t)
-          (xcb:keysyms:-update-modkeys obj deviceID))))
-    (when (and callback updated)
-      (funcall callback))))
-
-(cl-defmethod xcb:keysyms:-update-keytypes ((obj xcb:connection) device
+      (when (/= 0 (logand changed xcb:xkb:MapPart:KeyTypes))
+        (setq updated t)
+        (xcb:keysyms:-update-keytypes obj deviceID firstType nTypes))
+      (when (/= 0 (logand changed xcb:xkb:MapPart:KeySyms))
+        (setq updated t)
+        (xcb:keysyms:-update-keycodes obj deviceID firstKeySym nKeySyms))
+      (when (/= 0 (logand changed xcb:xkb:MapPart:ModifierMap))
+        (setq updated t)
+        (xcb:keysyms:-update-modkeys obj deviceID))
+      (when (and updated
+                 callback
+                 (= deviceID device-id))
+        (with-demoted-errors "[XELB ERROR] %S"
+          (funcall callback))))))
+
+(cl-defmethod xcb:keysyms:-update-keytypes ((obj xcb:connection) device-id
                                             &optional first-keytype count)
   "Update key types.
 
 FIRST-KEYTYPE and count specify the range of key types to update."
-  (let ((plist (plist-get (slot-value obj 'extra-plist) 'keysyms))
-        full partial keytypes)
+  (let (device full partial)
     (if (and first-keytype count)
         (setq full 0
               partial xcb:xkb:MapPart:KeyTypes)
@@ -213,7 +225,7 @@ FIRST-KEYTYPE and count specify the range of key types to 
update."
     (with-slots (deviceID present firstType nTypes totalTypes types-rtrn)
         (xcb:+request-unchecked+reply obj
             (make-instance 'xcb:xkb:GetMap
-                           :deviceSpec device
+                           :deviceSpec device-id
                            :full full
                            :partial partial
                            :firstType first-keytype
@@ -232,27 +244,24 @@ FIRST-KEYTYPE and count specify the range of key types to 
update."
                            :firstVModMapKey 0
                            :nVModMapKeys 0))
       (cl-assert (/= 0 (logand present xcb:xkb:MapPart:KeyTypes)))
-      (when (/= 0 full)
-        (setq plist (plist-put plist 'device deviceID)
-              keytypes (make-vector totalTypes nil)))
-      (setq keytypes (vconcat (substring keytypes 0 firstType)
-                              types-rtrn
-                              (substring keytypes (min (+ firstType nTypes)
-                                                       totalTypes)))
-            plist (plist-put plist 'keytypes keytypes))
-      (setf (slot-value obj 'extra-plist)
-            (plist-put (slot-value obj 'extra-plist) 'keysyms plist)))))
-
-(cl-defmethod xcb:keysyms:-update-keycodes ((obj xcb:connection) device
+      (setq device (or (xcb:-get-extra-plist obj 'keysyms deviceID)
+                       (make-instance 'xcb:keysyms:-device)))
+      (with-slots (keytypes) device
+        (when (/= 0 full)
+          (setf keytypes (make-vector totalTypes nil)))
+        (setf keytypes (vconcat (substring keytypes 0 firstType)
+                                types-rtrn
+                                (substring keytypes (min (+ firstType nTypes)
+                                                         totalTypes)))))
+      (xcb:-set-extra-plist obj 'keysyms deviceID device)
+      deviceID)))
+
+(cl-defmethod xcb:keysyms:-update-keycodes ((obj xcb:connection) device-id
                                             &optional first-keycode count)
   "Update keycode-keysym mapping.
 
 FIRST-KEYCODE and COUNT specify the keycode range to update."
-  (let* ((plist (plist-get (slot-value obj 'extra-plist) 'keysyms))
-         (keycodes (plist-get plist 'keycodes))
-         (min-keycode (plist-get plist 'min-keycode))
-         (max-keycode (plist-get plist 'max-keycode))
-         full partial)
+  (let (device full partial)
     (if (and first-keycode count)
         (setq full 0
               partial xcb:xkb:MapPart:KeySyms)
@@ -264,7 +273,7 @@ FIRST-KEYCODE and COUNT specify the keycode range to 
update."
                           firstKeySym nKeySyms syms-rtrn)
         (xcb:+request-unchecked+reply obj
             (make-instance 'xcb:xkb:GetMap
-                           :deviceSpec device
+                           :deviceSpec device-id
                            :full full
                            :partial partial
                            :firstType 0
@@ -283,26 +292,27 @@ FIRST-KEYCODE and COUNT specify the keycode range to 
update."
                            :firstVModMapKey 0
                            :nVModMapKeys 0))
       (cl-assert (/= 0 (logand present xcb:xkb:MapPart:KeySyms)))
-      (when (or (/= 0 full)
-                ;; Unlikely?
-                (/= min-keycode minKeyCode)
-                (/= max-keycode maxKeyCode))
-        (setq keycodes (make-vector (- maxKeyCode minKeyCode -1) nil)
-              min-keycode minKeyCode
-              max-keycode maxKeyCode
-              plist (plist-put plist 'min-keycode min-keycode)
-              plist (plist-put plist 'max-keycode max-keycode)))
-      (setq keycodes (vconcat
-                      (substring keycodes 0 (- firstKeySym min-keycode))
-                      syms-rtrn
-                      (substring keycodes
-                                 (- (min (+ firstKeySym nKeySyms) max-keycode)
-                                    min-keycode)))
-            plist (plist-put plist 'keycodes keycodes))
-      (setf (slot-value obj 'extra-plist)
-            (plist-put (slot-value obj 'extra-plist) 'keysyms plist)))))
-
-(cl-defmethod xcb:keysyms:-update-modkeys ((obj xcb:connection) _device)
+      (setq device (or (xcb:-get-extra-plist obj 'keysyms deviceID)
+                       (make-instance 'xcb:keysyms:-device)))
+      (with-slots (keycodes min-keycode max-keycode) device
+        (when (or (/= 0 full)
+                  ;; Unlikely?
+                  (/= min-keycode minKeyCode)
+                  (/= max-keycode maxKeyCode))
+          (setf keycodes (make-vector (- maxKeyCode minKeyCode -1) nil)
+                min-keycode minKeyCode
+                max-keycode maxKeyCode))
+        (setf keycodes
+              (vconcat
+               (substring keycodes 0 (- firstKeySym min-keycode))
+               syms-rtrn
+               (substring keycodes
+                          (- (min (+ firstKeySym nKeySyms) max-keycode)
+                             min-keycode)))))
+      (xcb:-set-extra-plist obj 'keysyms deviceID device)
+      deviceID)))
+
+(cl-defmethod xcb:keysyms:-update-modkeys ((obj xcb:connection) _device-id)
   "Update modifier keys."
   ;; Reference: 'x_find_modifier_meanings' in 'xterm.c'.
   (with-slots (keycodes-per-modifier keycodes)
@@ -367,85 +377,81 @@ FIRST-KEYCODE and COUNT specify the keycode range to 
update."
   "Convert keycode to (keysym . mod-mask).
 
 Return (0 . 0) when conversion fails."
-  (let* ((plist (plist-get (slot-value obj 'extra-plist) 'keysyms))
-         (keytypes (plist-get plist 'keytypes))
-         (keycodes (plist-get plist 'keycodes))
-         (min-keycode (plist-get plist 'min-keycode))
-         (max-keycode (plist-get plist 'max-keycode))
-         (preserve 0)
-         group group-info group-number index keytype)
-    ;; Reference: `XkbTranslateKeyCode' in 'XKBBind.c'.
-    (catch 'return
-      ;; Check keycode range.
-      (unless (<= min-keycode keycode max-keycode)
-        (throw 'return '(0 . 0)))
-      ;; Retrieve KeySymMap and group info.
-      (setq keycode (aref keycodes (- keycode min-keycode))
-            group-info (slot-value keycode 'groupInfo)
-            group-number (logand group-info #xF)) ; See <XKBstr.h>.
-      ;; Check group number.
-      (when (= group-number 0)
-        (throw 'return '(0 . 0)))
-      (setq group (logand (lsh modifiers -13) #b11)) ;The 13, 14 bits.
-      ;; Wrap group.
-      (when (>= group group-number)
-        (pcase (logand group-info #xC0) ;See <XKBstr.h>.
-          (`xcb:xkb:GroupsWrap:RedirectIntoRange
-           (setq group (logand #xFF (lsh group-info -4))) ;See <XKBstr.h>.
-           ;; Check if i's also out of range.
-           (when (>= group group-number)
-             (setq group 0)))
-          (`xcb:xkb:GroupsWrap:ClampIntoRange
-           (setq group (1- group-number)))
-          (_
-           (setq group (% group group-number)))))
-      ;; Calculate the index of keysym.
-      (setq index (* group (slot-value keycode 'width)))
-      ;; Get key type.
-      (setq keytype (aref keytypes (elt (slot-value keycode 'kt-index) group)))
-      ;; Find the shift level and preserved modifiers.
-      (with-slots (mods-mask hasPreserve map (preserve* preserve)) keytype
-        (catch 'break
-          (dolist (entry map)
-            (with-slots (active (mods-mask* mods-mask) level) entry
-              (when (and (= 1 active)
-                         (= (logand modifiers mods-mask) mods-mask*))
-                (cl-incf index level)
-                (when (= 1 hasPreserve)
-                  (setq preserve (slot-value (elt preserve*
-                                                  (cl-position entry map))
-                                             'mask)))
-                (throw 'break nil)))))
-        ;; FIXME: Use of preserved modifiers (e.g. capitalize the keysym
-        ;;        when LOCK is preserved)?
-        (cons (elt (slot-value keycode 'syms) index)
-              (logand mods-mask (lognot preserve)))))))
+  (let ((preserve 0)
+        group group-info group-number index keytype)
+    (with-slots (keytypes keycodes min-keycode max-keycode)
+        (xcb:keysyms:-get-current-device obj)
+      ;; Reference: `XkbTranslateKeyCode' in 'XKBBind.c'.
+      (catch 'return
+        ;; Check keycode range.
+        (unless (<= min-keycode keycode max-keycode)
+          (throw 'return '(0 . 0)))
+        ;; Retrieve KeySymMap and group info.
+        (setq keycode (aref keycodes (- keycode min-keycode))
+              group-info (slot-value keycode 'groupInfo)
+              group-number (logand group-info #xF)) ; See <XKBstr.h>.
+        ;; Check group number.
+        (when (= group-number 0)
+          (throw 'return '(0 . 0)))
+        (setq group (logand (lsh modifiers -13) #b11)) ;The 13, 14 bits.
+        ;; Wrap group.
+        (when (>= group group-number)
+          (pcase (logand group-info #xC0) ;See <XKBstr.h>.
+            (`xcb:xkb:GroupsWrap:RedirectIntoRange
+             (setq group (logand #xFF (lsh group-info -4))) ;See <XKBstr.h>.
+             ;; Check if i's also out of range.
+             (when (>= group group-number)
+               (setq group 0)))
+            (`xcb:xkb:GroupsWrap:ClampIntoRange
+             (setq group (1- group-number)))
+            (_
+             (setq group (% group group-number)))))
+        ;; Calculate the index of keysym.
+        (setq index (* group (slot-value keycode 'width)))
+        ;; Get key type.
+        (setq keytype (aref keytypes
+                            (elt (slot-value keycode 'kt-index) group)))
+        ;; Find the shift level and preserved modifiers.
+        (with-slots (mods-mask hasPreserve map (preserve* preserve)) keytype
+          (catch 'break
+            (dolist (entry map)
+              (with-slots (active (mods-mask* mods-mask) level) entry
+                (when (and (= 1 active)
+                           (= (logand modifiers mods-mask) mods-mask*))
+                  (cl-incf index level)
+                  (when (= 1 hasPreserve)
+                    (setq preserve (slot-value (elt preserve*
+                                                    (cl-position entry map))
+                                               'mask)))
+                  (throw 'break nil)))))
+          ;; FIXME: Use of preserved modifiers (e.g. capitalize the keysym
+          ;;        when LOCK is preserved)?
+          (cons (elt (slot-value keycode 'syms) index)
+                (logand mods-mask (lognot preserve))))))))
 
 (cl-defmethod xcb:keysyms:keysym->keycode ((obj xcb:connection) keysym)
   "Convert keysym to (the first matching) keycode.
 
 Return 0 if conversion fails."
-  (let* ((plist (plist-get (slot-value obj 'extra-plist) 'keysyms))
-         (keycodes (plist-get plist 'keycodes))
-         (min-keycode (plist-get plist 'min-keycode))
-         (max-keycode (plist-get plist 'max-keycode))
-         (index 0)
-         (continue t))
-    ;; Traverse all keycodes, column by column.
-    ;; Reference: `XKeysymToKeycode' in 'XKBBind.c'.
-    (catch 'break
-      (when (= 0 keysym)
-        (throw 'break 0))
-      (while continue
-        (setq continue nil)
-        (dotimes (i (- max-keycode min-keycode -1))
-          (with-slots (nSyms syms) (aref keycodes i)
-            (when (< index nSyms)
-              (setq continue t)
-              (when (= keysym (elt syms index))
-                (throw 'break (+ i min-keycode))))))
-        (cl-incf index))
-      0)))
+  (let ((index 0)
+        (continue t))
+    (with-slots (keycodes min-keycode max-keycode)
+        (xcb:keysyms:-get-current-device obj)
+      ;; Traverse all keycodes, column by column.
+      ;; Reference: `XKeysymToKeycode' in 'XKBBind.c'.
+      (catch 'break
+        (when (= 0 keysym)
+          (throw 'break 0))
+        (while continue
+          (setq continue nil)
+          (dotimes (i (- max-keycode min-keycode -1))
+            (with-slots (nSyms syms) (aref keycodes i)
+              (when (< index nSyms)
+                (setq continue t)
+                (when (= keysym (elt syms index))
+                  (throw 'break (+ i min-keycode))))))
+          (cl-incf index))
+        0))))
 
 ;; This list is largely base on 'lispy_function_keys' in 'keyboard.c'.
 (defconst xcb:keysyms:-function-keys
diff --git a/xcb.el b/xcb.el
index 1970b1b..9edaafb 100644
--- a/xcb.el
+++ b/xcb.el
@@ -101,6 +101,17 @@
    (data :initarg :data :initform "" :type string))
   :documentation "X connection authentication info.")
 
+(cl-defmethod xcb:-get-extra-plist ((conn xcb:connection) module prop)
+  "Get the value of PROP from the extra plist for module MODULE."
+  (plist-get (plist-get (slot-value conn 'extra-plist) module) prop))
+
+(cl-defmethod xcb:-set-extra-plist ((conn xcb:connection) module prop val)
+  "Set the value of PROP in the extra plist for module MODULE to VAL."
+  (with-slots (extra-plist) conn
+    (setf extra-plist
+          (plist-put extra-plist module
+                     (plist-put (plist-get extra-plist module) prop val)))))
+
 (defun xcb:connect (&optional display _screen)
   "Connect to X server with display DISPLAY."
   (declare (advertised-calling-convention (&optional display) "25.1"))