[elpa] externals/xelb 1fafa29: Correct the detection of modifier keys

[Chris Feng]

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

    Correct the detection of modifier keys
    
    * xcb-keysyms.el (xcb:keysyms:-update-modkeys): Detect modifier keys
    with the core protocol request 'GetModifierMapping'; also detect
    shift-lock and num-lock modifiers.
    (xcb:keysyms:keysym->event): Use the detected shift-lock modifier.
---
 xcb-keysyms.el |  114 +++++++++++++++++++++++++++-----------------------------
 1 file changed, 54 insertions(+), 60 deletions(-)

diff --git a/xcb-keysyms.el b/xcb-keysyms.el
index 5db181d..8287f0d 100644
--- a/xcb-keysyms.el
+++ b/xcb-keysyms.el
@@ -45,18 +45,19 @@
 
 ;; These variables are shared by all connections.
 (defvar xcb:keysyms:meta-mask 0 "META key mask.")
-(defvar xcb:keysyms:control-mask 0 "CONTROL key mask.")
-(defvar xcb:keysyms:shift-mask 0 "SHIFT key mask.")
+(defvar xcb:keysyms:control-mask xcb:ModMask:Control "CONTROL key mask.")
+(defvar xcb:keysyms:shift-mask xcb:ModMask:Shift "SHIFT key mask.")
 (defvar xcb:keysyms:hyper-mask 0 "HYPER key mask.")
 (defvar xcb:keysyms:super-mask 0 "SUPER key mask.")
 (defvar xcb:keysyms:alt-mask 0 "ALT key mask.")
-(defvar xcb:keysyms:lock-mask 0 "LOCK key mask.")
+(defvar xcb:keysyms:lock-mask xcb:ModMask:Lock "LOCK key mask.")
+(defvar xcb:keysyms:shift-lock-mask 0 "SHIFT-LOCK key mask.")
+(defvar xcb:keysyms:num-lock-mask 0 "NUM-LOCK key mask.")
 ;; Internal state / local data.
 (defvar xcb:keysyms:-opcode nil)
 (defvar xcb:keysyms:-device nil)
 (defvar xcb:keysyms:-keytypes nil)
 (defvar xcb:keysyms:-keycodes nil)
-(defvar xcb:keysyms:-modkeys nil)
 (defvar xcb:keysyms:-min-keycode nil)
 (defvar xcb:keysyms:-max-keycode nil)
 
@@ -272,63 +273,55 @@ FIRST-KEYCODE and COUNT specify the keycode range to 
update."
                                 xcb:keysyms:-max-keycode)
                            xcb:keysyms:-min-keycode)))))))
 
-(cl-defmethod xcb:keysyms:-update-modkeys ((obj xcb:connection) device)
+(cl-defmethod xcb:keysyms:-update-modkeys ((obj xcb:connection) _device)
   "Update modifier keys."
-  (with-slots (deviceID present modmap-rtrn)
-      (xcb:+request-unchecked+reply obj
-          (make-instance 'xcb:xkb:GetMap
-                         :deviceSpec device
-                         :full xcb:xkb:MapPart:ModifierMap
-                         :partial 0
-                         :firstType 0
-                         :nTypes 0
-                         :firstKeySym 0
-                         :nKeySyms 0
-                         :firstKeyAction 0
-                         :nKeyActions 0
-                         :firstKeyBehavior 0
-                         :nKeyBehaviors 0
-                         :virtualMods 0
-                         :firstKeyExplicit 0
-                         :nKeyExplicit 0
-                         :firstModMapKey 0
-                         :nModMapKeys 0
-                         :firstVModMapKey 0
-                         :nVModMapKeys 0))
-    (cl-assert (/= 0 (logand present xcb:xkb:MapPart:ModifierMap)))
-    (setq xcb:keysyms:-modkeys modmap-rtrn))
-  (setq xcb:keysyms:meta-mask 0
-        xcb:keysyms:control-mask xcb:ModMask:Control
-        xcb:keysyms:shift-mask xcb:ModMask:Shift
-        xcb:keysyms:hyper-mask 0
-        xcb:keysyms:super-mask 0
-        xcb:keysyms:alt-mask 0
-        xcb:keysyms:lock-mask xcb:ModMask:Lock)
   ;; Reference: 'x_find_modifier_meanings' in 'xterm.c'.
-  (dolist (modkey xcb:keysyms:-modkeys)
-    (with-slots (keycode mods) modkey
-      (let ((keysym (xcb:keysyms:keycode->keysym obj keycode 0)))
-        (when (/= 0 (car keysym))
-          (pcase (xcb:keysyms:keysym->event obj (car keysym) nil t)
-            ((or `lmeta* `rmeta*)
-             (setq xcb:keysyms:meta-mask (logior xcb:keysyms:meta-mask mods)))
-            ((or `lcontrol* `rcontrol*)
-             (setq xcb:keysyms:control-mask (logior xcb:keysyms:control-mask
-                                                    mods)))
-            ((or `lshift* `rshift*)
-             (setq xcb:keysyms:shift-mask (logior xcb:keysyms:shift-mask
-                                                  mods)))
-            ((or `lhyper* `rhyper*)
-             (setq xcb:keysyms:hyper-mask (logior xcb:keysyms:hyper-mask
-                                                  mods)))
-            ((or `lsuper* `rsuper*)
-             (setq xcb:keysyms:super-mask (logior xcb:keysyms:super-mask
-                                                  mods)))
-            ((or `caps-lock `shift-lock*)
-             (setq xcb:keysyms:lock-mask (logior xcb:keysyms:lock-mask mods)))
-            ((or `lalt* `ralt*)
-             (setq xcb:keysyms:alt-mask (logior xcb:keysyms:alt-mask
-                                                mods))))))))
+  (with-slots (keycodes-per-modifier keycodes)
+      (xcb:+request-unchecked+reply obj
+          (make-instance 'xcb:GetModifierMapping))
+    (setq xcb:keysyms:meta-mask 0
+          xcb:keysyms:hyper-mask 0
+          xcb:keysyms:super-mask 0
+          xcb:keysyms:alt-mask 0
+          xcb:keysyms:shift-lock-mask 0
+          xcb:keysyms:num-lock-mask 0)
+    (dolist (row (number-sequence 3 7))
+      (let ((mask (lsh 1 row))
+            (col 0)
+            found-alt-or-meta keycode keysym)
+        (while (< col keycodes-per-modifier)
+          (setq keycode (elt keycodes (+ (* row keycodes-per-modifier) col)))
+          (when (/= keycode 0)
+            (setq keysym (car (xcb:keysyms:keycode->keysym obj keycode 0)))
+            (when (/= keysym 0)
+              (pcase (xcb:keysyms:keysym->event obj keysym nil t)
+                ((or `lmeta* `rmeta*)
+                 (setq found-alt-or-meta t
+                       xcb:keysyms:meta-mask (logior xcb:keysyms:meta-mask
+                                                     mask)))
+                ((or `lalt* `ralt*)
+                 (setq found-alt-or-meta t
+                       xcb:keysyms:alt-mask (logior xcb:keysyms:alt-mask
+                                                    mask)))
+                ((or `lhyper* `rhyper*)
+                 (unless found-alt-or-meta
+                   (setq xcb:keysyms:hyper-mask (logior xcb:keysyms:hyper-mask
+                                                        mask)))
+                 (setq col keycodes-per-modifier))
+                ((or `lsuper* `rsuper*)
+                 (unless found-alt-or-meta
+                   (setq xcb:keysyms:super-mask (logior xcb:keysyms:super-mask
+                                                        mask)))
+                 (setq col keycodes-per-modifier))
+                (`shift-lock*
+                 (unless found-alt-or-meta
+                   (setq xcb:keysyms:lock-mask (logior xcb:keysyms:lock-mask
+                                                       mask)))
+                 (setq col keycodes-per-modifier))
+                (`kp-numlock
+                 (setq xcb:keysyms:num-lock-mask
+                       (logior xcb:keysyms:num-lock-mask mask))))))
+          (cl-incf col)))))
   ;; Meta fallbacks to Alt.
   (unless (/= 0 xcb:keysyms:meta-mask)
     (setq xcb:keysyms:meta-mask xcb:keysyms:alt-mask
@@ -716,7 +709,8 @@ this function will also return symbols for pure modifiers 
keys."
           (push (or mod-meta 'meta) event))
         (when (/= 0 (logand mask xcb:keysyms:control-mask))
           (push 'control event))
-        (when (and (/= 0 (logand mask xcb:keysyms:shift-mask))
+        (when (and (/= 0 (logand mask (logior xcb:keysyms:shift-mask
+                                              xcb:keysyms:shift-lock-mask)))
                    (or (not (<= #x20 keysym #xff)) ;Not a Latin-1 character
                        (<= ?A keysym ?Z)))         ;An uppercase letter
           (push 'shift event))