Add support for event processing via XInput 2

* configure.ac: Add an option to use XInput 2 if available.
* src/Makefile.in (XINPUT_LIBS, XINPUT_CFLAGS): New variables.
(EMACS_CFLAGS): Add Xinput CFLAGS.
(LIBES): Add XInput libs.
* src/xmenu.c (popup_activated_flag): Expose flag if
XInput 2 is available.
* src/xfns.c (x_window): Set XInput 2 event mask.
(setup_xi_event_mask): New function.
(syms_of_xfns): Provide XInput 2 feature.
* src/xterm.c (x_detect_focus_change): Handle XInput 2
GenericEvents.
(handle_one_xevent): Handle XInput 2 events.
(x_term_init): Ask the server for XInput 2 support and set
xkb_desc if available.
(x_delete_terminal): Free XKB kb desc if it exists, and free
XI2 devices if they exist.
(xi_grab_or_ungrab_device)
(xi_reset_scroll_valuators_for_device_id)
(x_free_xi_devices, x_init_master_valuators): New functions.
(x_get_scroll_valuator_delta): New function.
(init_xterm): Don't tell GTK to only use Core Input when built
with XInput 2 support.
* src/xterm.h (struct x_display_info): Add fields for XKB
and XI2 support.
* src/gtkutil.c (xg_event_is_for_menubar): Handle
XIDeviceEvents.
(xg_is_menu_window): New function.
(xg_event_is_for_scrollbar): Handle XIDeviceEvents.
* etc/NEWS: Document changes.

* lisp/mwheel.el (mouse-wheel-down-alternate-event)
(mouse-wheel-up-alternate-event)
(mouse-wheel-left-alternate-event)
(mouse-wheel-right-alternate-event): New user options.

(mouse-wheel-text-scale)
(mwheel-scroll): Test for alternate events.
(mouse-wheel--setup-bindings): Set up bindings for alternate
buttons.

1 files changed, 52 insertions, 14 deletions

diff --git a/lisp/mwheel.el b/lisp/mwheel.el
index 51410e3ef4c..3d0b8f07cb7 100644
--- a/lisp/mwheel.el
+++ b/lisp/mwheel.el
@@ -63,6 +63,13 @@
   :type 'symbol
   :set 'mouse-wheel-change-button)
 
+(defcustom mouse-wheel-down-alternate-event
+  (when (featurep 'xinput2) 'wheel-up)
+  "Alternative wheel down event to consider."
+  :group 'mouse
+  :type 'symbol
+  :set 'mouse-wheel-change-button)
+
 (defcustom mouse-wheel-up-event
   (if (or (featurep 'w32-win) (featurep 'ns-win))
       'wheel-down
@@ -72,6 +79,13 @@
   :type 'symbol
   :set 'mouse-wheel-change-button)
 
+(defcustom mouse-wheel-up-alternate-event
+  (when (featurep 'xinput2) 'wheel-down)
+  "Alternative wheel up event to consider."
+  :group 'mouse
+  :type 'symbol
+  :set 'mouse-wheel-change-button)
+
 (defcustom mouse-wheel-click-event 'mouse-2
   "Event that should be temporarily inhibited after mouse scrolling.
 The mouse wheel is typically on the mouse-2 button, so it may easily
@@ -226,12 +240,20 @@ Also see `mouse-wheel-tilt-scroll'."
     'mouse-6)
   "Event used for scrolling left.")
 
+(defvar mouse-wheel-left-alternate-event
+  (when (featurep 'xinput2) 'wheel-left)
+  "Alternative wheel left event to consider.")
+
 (defvar mouse-wheel-right-event
   (if (or (featurep 'w32-win) (featurep 'ns-win))
       'wheel-right
     'mouse-7)
   "Event used for scrolling right.")
 
+(defvar mouse-wheel-right-alternate-event
+  (when (featurep 'xinput2) 'wheel-right)
+  "Alternative wheel right event to consider.")
+
 (defun mouse-wheel--get-scroll-window (event)
   "Return window for mouse wheel event EVENT.
 If `mouse-wheel-follow-mouse' is non-nil, return the window that
@@ -296,14 +318,16 @@ value of ARG, and the command uses it in subsequent scrolls."
     (condition-case nil
         (unwind-protect
 	    (let ((button (mwheel-event-button event)))
-              (cond ((and (eq amt 'hscroll) (eq button mouse-wheel-down-event))
+              (cond ((and (eq amt 'hscroll) (memq button (list mouse-wheel-down-event
+                                                               mouse-wheel-down-alternate-event)))
                      (when (and (natnump arg) (> arg 0))
                        (setq mouse-wheel-scroll-amount-horizontal arg))
                      (funcall (if mouse-wheel-flip-direction
                                   mwheel-scroll-left-function
                                 mwheel-scroll-right-function)
                               mouse-wheel-scroll-amount-horizontal))
-                    ((eq button mouse-wheel-down-event)
+                    ((memq button (list mouse-wheel-down-event
+                                        mouse-wheel-down-alternate-event))
                      (condition-case nil (funcall mwheel-scroll-down-function amt)
                        ;; Make sure we do indeed scroll to the beginning of
                        ;; the buffer.
@@ -318,23 +342,27 @@ value of ARG, and the command uses it in subsequent scrolls."
                           ;; for a reason that escapes me.  This problem seems
                           ;; to only affect scroll-down.  --Stef
                           (set-window-start (selected-window) (point-min))))))
-                    ((and (eq amt 'hscroll) (eq button mouse-wheel-up-event))
+                    ((and (eq amt 'hscroll) (memq button (list mouse-wheel-up-event
+                                                               mouse-wheel-up-alternate-event)))
                      (when (and (natnump arg) (> arg 0))
                        (setq mouse-wheel-scroll-amount-horizontal arg))
                      (funcall (if mouse-wheel-flip-direction
                                   mwheel-scroll-right-function
                                 mwheel-scroll-left-function)
                               mouse-wheel-scroll-amount-horizontal))
-                    ((eq button mouse-wheel-up-event)
+                    ((memq button (list mouse-wheel-up-event
+                                        mouse-wheel-up-alternate-event))
                      (condition-case nil (funcall mwheel-scroll-up-function amt)
                        ;; Make sure we do indeed scroll to the end of the buffer.
                        (end-of-buffer (while t (funcall mwheel-scroll-up-function)))))
-                    ((eq button mouse-wheel-left-event) ; for tilt scroll
+                    ((memq button (list mouse-wheel-left-event
+                                        mouse-wheel-left-alternate-event)) ; for tilt scroll
                      (when mouse-wheel-tilt-scroll
                        (funcall (if mouse-wheel-flip-direction
                                     mwheel-scroll-right-function
                                   mwheel-scroll-left-function) amt)))
-                    ((eq button mouse-wheel-right-event) ; for tilt scroll
+                    ((memq button (list mouse-wheel-right-event
+                                        mouse-wheel-right-alternate-event)) ; for tilt scroll
                      (when mouse-wheel-tilt-scroll
                        (funcall (if mouse-wheel-flip-direction
                                     mwheel-scroll-left-function
@@ -378,9 +406,11 @@ value of ARG, and the command uses it in subsequent scrolls."
         (button (mwheel-event-button event)))
     (select-window scroll-window 'mark-for-redisplay)
     (unwind-protect
-        (cond ((eq button mouse-wheel-down-event)
+        (cond ((memq button (list mouse-wheel-down-event
+                                  mouse-wheel-down-alternate-event))
                (text-scale-increase 1))
-              ((eq button mouse-wheel-up-event)
+              ((eq button (list mouse-wheel-up-event
+                                mouse-wheel-up-alternate-event))
                (text-scale-decrease 1)))
       (select-window selected-window))))
 
@@ -432,15 +462,23 @@ an event used for scrolling, such as `mouse-wheel-down-event'."
     (cond
      ;; Bindings for changing font size.
      ((and (consp binding) (eq (cdr binding) 'text-scale))
-      (dolist (event (list mouse-wheel-down-event mouse-wheel-up-event))
-        (mouse-wheel--add-binding `[,(list (caar binding) event)]
-                                  'mouse-wheel-text-scale)))
+      (dolist (event (list mouse-wheel-down-event mouse-wheel-up-event
+                           mouse-wheel-down-alternate-event
+                           mouse-wheel-up-alternate-event))
+        (when event
+          (mouse-wheel--add-binding `[,(list (caar binding) event)]
+                                    'mouse-wheel-text-scale))))
      ;; Bindings for scrolling.
      (t
       (dolist (event (list mouse-wheel-down-event mouse-wheel-up-event
-                           mouse-wheel-left-event mouse-wheel-right-event))
-        (dolist (key (mouse-wheel--create-scroll-keys binding event))
-          (mouse-wheel--add-binding key 'mwheel-scroll)))))))
+                           mouse-wheel-left-event mouse-wheel-right-event
+                           mouse-wheel-down-alternate-event
+                           mouse-wheel-up-alternate-event
+                           mouse-wheel-left-alternate-event
+                           mouse-wheel-right-alternate-event))
+        (when event
+          (dolist (key (mouse-wheel--create-scroll-keys binding event))
+            (mouse-wheel--add-binding key 'mwheel-scroll))))))))
 
 (when mouse-wheel-mode
   (mouse-wheel--setup-bindings))