Grab & Replay key events with XI2 and XTEST

; A change has been made in Xorg server 1.20 that replaying a key
; event with keyboard grabbed would generate extra focus change and
; enter/leave events.  This basically breaks line-mode for apps like
; Firefox.  This commit reimplements the grab & replay functionality
; with XI2 and XTEST.

* exwm-input.el (exwm-input--devices): New variable for caching slave
keyboards.
(exwm-input--update-devices): Update it and re-grab keys if necessary.
(exwm-input--on-Hierarchy): Event listener for the Hierarchy event
that would in turn call `exwm-input--update-devices' to update the
cache.

* exwm-input.el (exwm-input--on-KeyPress): Use XI2 KeyPress events.
(exwm-input--on-KeyRelease): Event listener for the KeyRelease events.
(exwm-input--grab-global-prefix-keys): Use XI2 and also select
KeyRelease events.
(exwm-input--on-KeyPress-line-mode): Use XI2 KeyPress events and
replay key events with XTEST.
(exwm-input--on-KeyPress-char-mode, exwm-input--grab-keyboard)
(exwm-input--release-keyboard): Use XI2 KeyPress events.

* exwm-input.el (exwm-input--init): Initialize the XI2 and XTEST
extensions; add listeners for XI2 KeyPress, KeyRelease and Hierarchy
events.

1 files changed, 222 insertions, 85 deletions

diff --git a/exwm-input.el b/exwm-input.el
index 153410828f00..9bb6444808c0 100644
--- a/exwm-input.el
+++ b/exwm-input.el
@@ -36,6 +36,9 @@
 ;;; Code:
 
 (require 'xcb-keysyms)
+(require 'xcb-xinput)
+(require 'xcb-xtest)
+
 (require 'exwm-core)
 
 (defgroup exwm-input nil
@@ -102,6 +105,8 @@ defined in `exwm-mode-map' here."
 (defconst exwm-input--update-focus-interval 0.01
   "Time interval (in seconds) for accumulating input focus update requests.")
 
+(defvar exwm-input--devices nil "List of slave keyboard devices.")
+
 (defvar exwm-input--during-command nil
   "Indicate whether between `pre-command-hook' and `post-command-hook'.")
 
@@ -364,6 +369,44 @@ ARGS are additional arguments to CALLBACK."
                      :window exwm--root
                      :data (or id xcb:Window:None))))
 
+(defun exwm-input--update-devices (update)
+  "Update the cache of slave keyboards."
+  (with-slots (infos)
+      (xcb:+request-unchecked+reply exwm--connection
+          (make-instance 'xcb:xinput:XIQueryDevice
+                         :deviceid xcb:xinput:Device:All))
+    (setq exwm-input--devices
+          (delq nil
+                (mapcar (lambda (info)
+                          (with-slots (deviceid type enabled name) info
+                            (setq name (downcase name))
+                            (when (and (= xcb:xinput:DeviceType:SlaveKeyboard
+                                          type)
+                                       (string-match-p "keyboard" name)
+                                       ;; Exclude XTEST keyboard.
+                                       (not (string-match-p "xtest" name)))
+                              deviceid)))
+                        infos)))
+    (unless exwm-input--devices
+      (error "Failed to retrieve keyboards"))
+    (when update
+      ;; Try to re-grab all keys.
+      (exwm-input--update-global-prefix-keys)
+      (dolist (pair exwm--id-buffer-alist)
+        (with-current-buffer (cdr pair)
+          (when exwm--keyboard-grabbed
+            (exwm-input--grab-keyboard (car pair))))))))
+
+(defun exwm-input--on-Hierarchy (data _synthetic)
+  "Handle Hierarchy events."
+  (let ((evt (make-instance 'xcb:xinput:Hierarchy)))
+    (xcb:unmarshal evt data)
+    (with-slots (flags infos) evt
+      (when (/= 0 (logand flags
+                          (logior xcb:xinput:HierarchyMask:SlaveAdded
+                                  xcb:xinput:HierarchyMask:SlaveRemoved)))
+        (exwm-input--update-devices t)))))
+
 (defun exwm-input--on-ButtonPress (data _synthetic)
   "Handle ButtonPress event."
   (let ((obj (make-instance 'xcb:ButtonPress))
@@ -417,12 +460,30 @@ ARGS are additional arguments to CALLBACK."
 
 (defun exwm-input--on-KeyPress (data _synthetic)
   "Handle KeyPress event."
-  (let ((obj (make-instance 'xcb:KeyPress)))
+  (let ((obj (make-instance 'xcb:xinput:KeyPress)))
     (xcb:unmarshal obj data)
     (if (eq major-mode 'exwm-mode)
         (funcall exwm--on-KeyPress obj data)
       (exwm-input--on-KeyPress-char-mode obj))))
 
+(defun exwm-input--on-KeyRelease (data _synthetic)
+  "Handle KeyRelease event."
+  ;; TODO: For simplicity every KeyRelease event is replayed which is likely
+  ;; to cause overheads and perhaps problems.
+  (let ((evt (make-instance 'xcb:xinput:KeyRelease)))
+    (xcb:unmarshal evt data)            ;FIXME: optimize.
+    (with-slots (deviceid detail root-x root-y) evt
+      (xcb:+request exwm--connection
+          (make-instance 'xcb:xtest:FakeInput
+                         :type 3      ;KeyRelease
+                         :detail detail
+                         :time xcb:Time:CurrentTime
+                         :root exwm--root
+                         :rootX root-x
+                         :rootY root-y
+                         :deviceid deviceid))
+      (xcb:flush exwm--connection))))
+
 (defun exwm-input--on-CreateNotify (data _synthetic)
   "Handle CreateNotify events."
   (let ((evt (make-instance 'xcb:CreateNotify)))
@@ -445,29 +506,44 @@ ARGS are additional arguments to CALLBACK."
                            'children))))))
 
 (defun exwm-input--grab-global-prefix-keys (&rest xwins)
-  (let ((req (make-instance 'xcb:GrabKey
-                            :owner-events 0
+  (let ((req (make-instance 'xcb:xinput:XIPassiveGrabDevice
+                            :time xcb:Time:CurrentTime
                             :grab-window nil
-                            :modifiers nil
-                            :key nil
-                            :pointer-mode xcb:GrabMode:Async
-                            :keyboard-mode xcb:GrabMode:Async))
-        keysym keycode)
+                            :cursor 0
+                            :detail nil
+                            :deviceid nil
+                            :num-modifiers 1
+                            :mask-len 1
+                            :grab-type xcb:xinput:GrabType:Keycode
+                            :grab-mode xcb:xinput:GrabMode22:Sync
+                            :paired-device-mode 0
+                            :owner-events xcb:xinput:GrabOwner:NoOwner
+                            :mask (list
+                                   (logior xcb:xinput:XIEventMask:KeyPress
+                                           xcb:xinput:XIEventMask:KeyRelease))
+                            :modifiers nil))
+        keysym keycode sequences)
     (dolist (k exwm-input--global-prefix-keys)
       (setq keysym (xcb:keysyms:event->keysym exwm--connection k)
             keycode (xcb:keysyms:keysym->keycode exwm--connection
                                                  (car keysym)))
-      (setf (slot-value req 'modifiers) (cdr keysym)
-            (slot-value req 'key) keycode)
-      (dolist (xwin xwins)
-        (setf (slot-value req 'grab-window) xwin)
-        (xcb:+request exwm--connection req)
-        ;; Also grab this key with num-lock mask set.
-        (when (/= 0 xcb:keysyms:num-lock-mask)
-          (setf (slot-value req 'modifiers)
-                (logior (cdr keysym) xcb:keysyms:num-lock-mask))
-          (xcb:+request exwm--connection req))))
-    (xcb:flush exwm--connection)))
+      (setf (slot-value req 'modifiers) (list (cdr keysym))
+            (slot-value req 'detail) keycode)
+      (dolist (device exwm-input--devices)
+        (setf (slot-value req 'deviceid) device)
+        (dolist (xwin xwins)
+          (setf (slot-value req 'grab-window) xwin)
+          (setq sequences (append sequences
+                                  (list (xcb:+request exwm--connection req))))
+          ;; Also grab this key with num-lock mask set.
+          (when (/= 0 xcb:keysyms:num-lock-mask)
+            (setf (slot-value req 'modifiers)
+                  (list (logior (cdr keysym) xcb:keysyms:num-lock-mask)))
+            (setq sequences (append sequences
+                                    (list (xcb:+request exwm--connection
+                                              req))))))))
+    (dolist (sequence sequences)
+      (xcb:+reply exwm--connection sequence))))
 
 (defun exwm-input--set-key (key command)
   (global-set-key key command)
@@ -563,60 +639,71 @@ instead."
 
 (defun exwm-input--on-KeyPress-line-mode (key-press raw-data)
   "Parse X KeyPress event to Emacs key event and then feed the command loop."
-  (with-slots (detail state) key-press
-    (let ((keysym (xcb:keysyms:keycode->keysym exwm--connection detail state))
-          event raw-event mode)
-      (when (and (/= 0 (car keysym))
-                 (setq raw-event (xcb:keysyms:keysym->event
-                                  exwm--connection (car keysym)
-                                  (logand state (lognot (cdr keysym)))))
-                 (setq event (exwm-input--mimic-read-event raw-event))
-                 (or exwm-input-line-mode-passthrough
-                     exwm-input--during-command
-                     ;; Forward the event when there is an incomplete key
-                     ;; sequence or when the minibuffer is active.
-                     exwm-input--line-mode-cache
-                     (eq (active-minibuffer-window) (selected-window))
-                     ;;
-                     (memq event exwm-input--global-prefix-keys)
-                     (memq event exwm-input-prefix-keys)
-                     (when overriding-terminal-local-map
-                       (lookup-key overriding-terminal-local-map
-                                   (vector event)))
-                     (lookup-key (current-local-map) (vector event))
-                     (gethash event exwm-input--simulation-keys)))
-        (setq mode xcb:Allow:AsyncKeyboard)
-        (exwm-input--cache-event event)
-        (exwm-input--unread-event raw-event))
-      (unless mode
-        (if (= 0 (logand #x6000 state)) ;Check the 13~14 bits.
-            ;; Not an XKB state; just replay it.
-            (setq mode xcb:Allow:ReplayKeyboard)
-          ;; An XKB state; sent it with SendEvent.
-          ;; FIXME: Can this also be replayed?
-          ;; FIXME: KeyRelease events are lost.
-          (setq mode xcb:Allow:AsyncKeyboard)
+  (with-slots (deviceid detail root-x root-y mods) key-press
+    (let* ((state (slot-value mods 'effective))
+           (keysym (xcb:keysyms:keycode->keysym exwm--connection detail state))
+           event raw-event)
+      (if (and (/= 0 (car keysym))
+               (setq raw-event (xcb:keysyms:keysym->event
+                                exwm--connection (car keysym)
+                                (logand state (lognot (cdr keysym)))))
+               (setq event (exwm-input--mimic-read-event raw-event))
+               (or exwm-input-line-mode-passthrough
+                   exwm-input--during-command
+                   ;; Forward the event when there is an incomplete key
+                   ;; sequence or when the minibuffer is active.
+                   exwm-input--line-mode-cache
+                   (eq (active-minibuffer-window) (selected-window))
+                   ;;
+                   (memq event exwm-input--global-prefix-keys)
+                   (memq event exwm-input-prefix-keys)
+                   (when overriding-terminal-local-map
+                     (lookup-key overriding-terminal-local-map
+                                 (vector event)))
+                   (lookup-key (current-local-map) (vector event))
+                   (gethash event exwm-input--simulation-keys)))
+          (progn
+            (exwm-input--cache-event event)
+            (exwm-input--unread-event raw-event))
+        (if (/= 0 (logand #x6000 state)) ;Check the 13~14 bits.
+            ;; An XKB state; sent it with SendEvent.
+            ;; FIXME: Can this also be replayed?
+            ;; FIXME: KeyRelease events are lost.
+            (xcb:+request exwm--connection
+                (make-instance 'xcb:SendEvent
+                               :propagate 0
+                               :destination (slot-value key-press 'event)
+                               :event-mask xcb:EventMask:NoEvent
+                               :event raw-data))
+          ;; Replay the key.
           (xcb:+request exwm--connection
-              (make-instance 'xcb:SendEvent
-                             :propagate 0
-                             :destination (slot-value key-press 'event)
-                             :event-mask xcb:EventMask:NoEvent
-                             :event raw-data)))
+              (make-instance 'xcb:xtest:FakeInput
+                             :type 2    ;KeyPress
+                             :detail detail
+                             :time xcb:Time:CurrentTime
+                             :root exwm--root
+                             :rootX root-x
+                             :rootY root-y
+                             :deviceid deviceid)))
         ;; Make Emacs aware of this event when defining keyboard macros.
         (when (and defining-kbd-macro event)
           (set-transient-map '(keymap (t . (lambda () (interactive)))))
           (exwm-input--unread-event event)))
       (xcb:+request exwm--connection
-          (make-instance 'xcb:AllowEvents
-                         :mode mode
-                         :time xcb:Time:CurrentTime))
+          (make-instance 'xcb:xinput:XIAllowEvents
+                         :time xcb:Time:CurrentTime
+                         :deviceid deviceid
+                         :event-mode xcb:xinput:EventMode:AsyncDevice
+                         :touchid 0
+                         :grab-window 0))
       (xcb:flush exwm--connection))))
 
 (defun exwm-input--on-KeyPress-char-mode (key-press &optional _raw-data)
   "Handle KeyPress event in char-mode."
-  (with-slots (detail state) key-press
-    (let ((keysym (xcb:keysyms:keycode->keysym exwm--connection detail state))
-          event raw-event)
+  (with-slots (deviceid detail mods) key-press
+    (let* ((state (slot-value mods 'effective))
+           (keysym (xcb:keysyms:keycode->keysym exwm--connection detail state))
+           event raw-event)
       (when (and (/= 0 (car keysym))
                  (setq raw-event (xcb:keysyms:keysym->event
                                   exwm--connection (car keysym)
@@ -628,12 +715,15 @@ instead."
           (setq exwm-input--temp-line-mode t)
           (exwm-input--grab-keyboard)
           (exwm-input--cache-event event)
-          (exwm-input--unread-event raw-event)))))
-  (xcb:+request exwm--connection
-      (make-instance 'xcb:AllowEvents
-                     :mode xcb:Allow:AsyncKeyboard
-                     :time xcb:Time:CurrentTime))
-  (xcb:flush exwm--connection))
+          (exwm-input--unread-event raw-event))))
+    (xcb:+request exwm--connection
+        (make-instance 'xcb:xinput:XIAllowEvents
+                       :time xcb:Time:CurrentTime
+                       :deviceid deviceid
+                       :event-mode xcb:xinput:EventMode:AsyncDevice
+                       :touchid 0
+                       :grab-window 0))
+    (xcb:flush exwm--connection)))
 
 (defun exwm-input--update-mode-line (id)
   "Update the propertized `mode-line-process' for window ID."
@@ -667,15 +757,30 @@ instead."
   "Grab all key events on window ID."
   (unless id (setq id (exwm--buffer->id (window-buffer))))
   (when id
-    (when (xcb:+request-checked+request-check exwm--connection
-              (make-instance 'xcb:GrabKey
-                             :owner-events 0
-                             :grab-window id
-                             :modifiers xcb:ModMask:Any
-                             :key xcb:Grab:Any
-                             :pointer-mode xcb:GrabMode:Async
-                             :keyboard-mode xcb:GrabMode:Sync))
-      (exwm--log "Failed to grab keyboard for #x%x" id))
+    (let ((sequences
+           (mapcar
+            (lambda (device)
+              (xcb:+request exwm--connection
+                  (make-instance 'xcb:xinput:XIPassiveGrabDevice
+                                 :time xcb:Time:CurrentTime
+                                 :grab-window id
+                                 :cursor 0
+                                 :detail xcb:Grab:Any
+                                 :deviceid device
+                                 :num-modifiers 1
+                                 :mask-len 1
+                                 :grab-type xcb:xinput:GrabType:Keycode
+                                 :grab-mode xcb:xinput:GrabMode22:Sync
+                                 :paired-device-mode 0
+                                 :owner-events xcb:xinput:GrabOwner:NoOwner
+                                 :mask
+                                 (list
+                                  (logior xcb:xinput:XIEventMask:KeyPress
+                                          xcb:xinput:XIEventMask:KeyRelease))
+                                 :modifiers (list 2147483648.))))
+            exwm-input--devices)))
+      (dolist (sequence sequences)
+        (xcb:+reply exwm--connection sequence)))
     (with-current-buffer (exwm--id->buffer id)
       (setq exwm--on-KeyPress #'exwm-input--on-KeyPress-line-mode))))
 
@@ -683,12 +788,16 @@ instead."
   "Ungrab all key events on window ID."
   (unless id (setq id (exwm--buffer->id (window-buffer))))
   (when id
-    (when (xcb:+request-checked+request-check exwm--connection
-              (make-instance 'xcb:UngrabKey
-                             :key xcb:Grab:Any
-                             :grab-window id
-                             :modifiers xcb:ModMask:Any))
-      (exwm--log "Failed to release keyboard for #x%x" id))
+    (dolist (device exwm-input--devices)
+      (xcb:+request exwm--connection
+          (make-instance 'xcb:xinput:XIPassiveUngrabDevice
+                         :grab-window id
+                         :detail xcb:Grab:Any
+                         :deviceid device
+                         :num-modifiers 1
+                         :grab-type xcb:xinput:GrabType:Keycode
+                         :modifiers (list 2147483648.)))) ;1 << 31
+    (xcb:flush exwm--connection)
     (exwm-input--grab-global-prefix-keys id)
     (with-current-buffer (exwm--id->buffer id)
       (setq exwm--on-KeyPress #'exwm-input--on-KeyPress-char-mode))))
@@ -930,6 +1039,30 @@ where both ORIGINAL-KEY and SIMULATED-KEY are key sequences."
 
 (defun exwm-input--init ()
   "Initialize the keyboard module."
+  ;; Initialize the XI2 extension.
+  (if (= 0 (slot-value (xcb:get-extension-data exwm--connection 'xcb:xinput)
+                       'present))
+      (error "[EXWM] XI2 extension is not supported by the server")
+    (with-slots (major-version minor-version)
+        (xcb:+request-unchecked+reply exwm--connection
+            (make-instance 'xcb:xinput:XIQueryVersion
+                           :major-version 2
+                           :minor-version 0))
+      (when (or (/= major-version 2) (/= minor-version 0))
+        (error "[EXWM] XI2 extension 2.0 is not supported by the server"))))
+  (exwm-input--update-devices nil)
+  ;; Initialize the XTEST extension.
+  (if (= 0 (slot-value (xcb:get-extension-data exwm--connection 'xcb:xtest)
+                       'present))
+      (error "[EXWM] XTEST extension is not supported by the server")
+    (with-slots (major-version minor-version)
+        (xcb:+request-unchecked+reply exwm--connection
+            (make-instance 'xcb:xtest:GetVersion
+                           :major-version 2
+                           :minor-version 2))
+      (when (or (/= major-version 2) (/= minor-version 2))
+        (error "[EXWM] XTEST extension 2.2 is not supported by the server"))))
+
   ;; Refresh keyboard mapping
   (xcb:keysyms:init exwm--connection #'exwm-input--on-keysyms-update)
   ;; Create the X window and intern the atom used to fetch timestamp.
@@ -970,7 +1103,11 @@ where both ORIGINAL-KEY and SIMULATED-KEY are key sequences."
   (xcb:+event exwm--connection 'xcb:PropertyNotify
               #'exwm-input--on-PropertyNotify)
   (xcb:+event exwm--connection 'xcb:CreateNotify #'exwm-input--on-CreateNotify)
-  (xcb:+event exwm--connection 'xcb:KeyPress #'exwm-input--on-KeyPress)
+  (xcb:+event exwm--connection 'xcb:xinput:KeyPress #'exwm-input--on-KeyPress)
+  (xcb:+event exwm--connection 'xcb:xinput:KeyRelease
+              #'exwm-input--on-KeyRelease)
+  (xcb:+event exwm--connection 'xcb:xinput:Hierarchy
+              #'exwm-input--on-Hierarchy)
   (xcb:+event exwm--connection 'xcb:ButtonPress #'exwm-input--on-ButtonPress)
   (xcb:+event exwm--connection 'xcb:ButtonRelease
               #'exwm-floating--stop-moveresize)