From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: Stefan Monnier via "Bug reports for GNU Emacs, the Swiss army knife of text editors" Newsgroups: gmane.emacs.bugs Subject: bug#68796: xterm.c: Convert mouse-4/5/6/7 to wheel-up/down/left/right Date: Mon, 29 Jan 2024 09:45:01 -0500 Message-ID: Reply-To: Stefan Monnier Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="10004"; mail-complaints-to="usenet@ciao.gmane.io" To: 68796@debbugs.gnu.org Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Mon Jan 29 15:46:10 2024 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1rUStl-0002KY-Ns for geb-bug-gnu-emacs@m.gmane-mx.org; Mon, 29 Jan 2024 15:46:10 +0100 Original-Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1rUStY-00013L-4m; Mon, 29 Jan 2024 09:45:56 -0500 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1rUStW-00010E-My for bug-gnu-emacs@gnu.org; Mon, 29 Jan 2024 09:45:54 -0500 Original-Received: from debbugs.gnu.org ([2001:470:142:5::43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1rUStV-0000Ur-Ti for bug-gnu-emacs@gnu.org; Mon, 29 Jan 2024 09:45:54 -0500 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1rUStd-0008Vh-Tc for bug-gnu-emacs@gnu.org; Mon, 29 Jan 2024 09:46:01 -0500 X-Loop: help-debbugs@gnu.org Resent-From: Stefan Monnier Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Mon, 29 Jan 2024 14:46:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: report 68796 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: patch X-Debbugs-Original-To: bug-gnu-emacs@gnu.org Original-Received: via spool by submit@debbugs.gnu.org id=B.170653954732691 (code B ref -1); Mon, 29 Jan 2024 14:46:01 +0000 Original-Received: (at submit) by debbugs.gnu.org; 29 Jan 2024 14:45:47 +0000 Original-Received: from localhost ([127.0.0.1]:59372 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1rUStO-0008VB-GE for submit@debbugs.gnu.org; Mon, 29 Jan 2024 09:45:47 -0500 Original-Received: from lists.gnu.org ([2001:470:142::17]:34822) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1rUStM-0008Ux-4f for submit@debbugs.gnu.org; Mon, 29 Jan 2024 09:45:45 -0500 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1rUSt5-0000hZ-80 for bug-gnu-emacs@gnu.org; Mon, 29 Jan 2024 09:45:30 -0500 Original-Received: from mailscanner.iro.umontreal.ca ([132.204.25.50]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1rUSt2-0000RM-C9 for bug-gnu-emacs@gnu.org; Mon, 29 Jan 2024 09:45:26 -0500 Original-Received: from pmg3.iro.umontreal.ca (localhost [127.0.0.1]) by pmg3.iro.umontreal.ca (Proxmox) with ESMTP id 3CCB4440976 for ; Mon, 29 Jan 2024 09:45:22 -0500 (EST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=iro.umontreal.ca; s=mail; t=1706539517; bh=xixryesPc0jyKV6gaBPu7LC/WGmhuV5g0W2ImPSjdek=; h=From:To:Subject:Date:From; b=g75fjC/U61TWXGsEmjtHmxt1agHNFYBwC7/6jPpA7z58DBuLDMqaS3VLXU3ycHjXh uQoyMt+3W26rmNsX/NjOiXXzvjIQgk7712K0pZyuu0i70q4wD3igmznHUQES4bpHB1 Z6aczg9Z59IZG9q/F/tz+k30KQ/9OMK98tij8/fkgAKN7+jdE5DivuCgV2mPka+mYK bZaravxRfRvClzQ4KYBljVELCbOAXFj/ob0+R6IpB994b/Kz9W2bhZXmOM2/bq4LBi GfCtP3iCGOylShyEPJHf2/t/lHFReOIjgCIYM5UbPCclXVB5tMwlzxRohaoKrzSq5N emYsgmRc2RjpQ== Original-Received: from mail01.iro.umontreal.ca (unknown [172.31.2.1]) by pmg3.iro.umontreal.ca (Proxmox) with ESMTP id C187C442415 for ; Mon, 29 Jan 2024 09:45:17 -0500 (EST) Original-Received: from pastel (unknown [45.72.206.68]) by mail01.iro.umontreal.ca (Postfix) with ESMTPSA id A43BB120C8F for ; Mon, 29 Jan 2024 09:45:17 -0500 (EST) Received-SPF: pass client-ip=132.204.25.50; envelope-from=monnier@iro.umontreal.ca; helo=mailscanner.iro.umontreal.ca X-Spam_score_int: -42 X-Spam_score: -4.3 X-Spam_bar: ---- X-Spam_report: (-4.3 / 5.0 requ) BAYES_00=-1.9, DKIM_SIGNED=0.1, DKIM_VALID=-0.1, DKIM_VALID_AU=-0.1, RCVD_IN_DNSWL_MED=-2.3, SPF_HELO_NONE=0.001, SPF_PASS=-0.001, T_SCC_BODY_TEXT_LINE=-0.01 autolearn=ham autolearn_force=no X-Spam_action: no action X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Original-Sender: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Xref: news.gmane.io gmane.emacs.bugs:279132 Archived-At: --=-=-= Content-Type: text/plain Tags: patch Following up on the `xt-mouse.el` patch (bug#68698), I now propose we do the same for those `mouse-4/5/6/7` events generated by old-style X11 input. IIUC Po Lu wasn't favorable to the idea, but maybe seeing the code will make a convert? Beside that, the patch has 2 remaining issues: - Lack of corresponding updates to `etc/NEWS` and `doc/lispref/commands.texi`. - Lack of testing for the left/right remapping. This is *really* necessary because even after (re)reading the various parts of the code that handle horizontal scrolling, I'm still very much unsure if I got the direction right[left?], so if you have a mouse with a horizontal wheel, please compare the `wheel-left/right` events generated with and without building `--without-xinput2`. Stefan In GNU Emacs 30.0.50 (build 2, x86_64-pc-linux-gnu, X toolkit, cairo version 1.16.0, Xaw3d scroll bars) of 2024-01-25 built on pastel Repository revision: 5945fab9af0b52cc55f06b2c7e911d51e34a9cdf Repository branch: work Windowing system distributor 'The X.Org Foundation', version 11.0.12101007 System Description: Debian GNU/Linux 12 (bookworm) Configured using: 'configure -C --enable-checking --enable-check-lisp-object-type --with-modules --with-cairo --with-tiff=ifavailable 'CFLAGS=-Wall -g3 -Og -Wno-pointer-sign' --without-native-compilation PKG_CONFIG_PATH=/home/monnier/lib/pkgconfig' --=-=-= Content-Type: text/patch Content-Disposition: attachment; filename=0001-xterm.c-Map-old-style-wheel-buttons-to-actual-wheel-.patch >From 60e6903ae12546db93f149b1f184ffc7ccdc30c2 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 29 Jan 2024 09:35:09 -0500 Subject: [PATCH] xterm.c: Map old-style wheel buttons to actual wheel events Change the handling of the old X11 convention to use mouse-4/5/6/7 events to represent wheel events: instead of asking downstream packages to use the `mouse-wheel-*-event` variables to know which events represent wheel events, use those variables in `xterm.c` to directly convert those events into the standard `wheel-up/down/left/right` events used everywhere else. This simplifies the work of packages which can now just bind their commands to `wheel-up/down/left/right`. * src/keyboard.c (base_mouse_symbol): New function. * src/keyboard.h (base_mouse_symbol): Declare. * src/xterm.c (x_construct_mouse_click): Obey `mouse-wheel-*-event` vars. (syms_of_xterm): Define the `mouse-wheel-*-event` symbols. * lisp/completion-preview.el (completion-preview--mouse-map): Don't bind to `mouse-wheel-*-event`s any more. * lisp/edmacro.el (edmacro-fix-menu-commands): Remove special casing of `mouse-wheel-*-event`s. * lisp/mwheel.el (mouse-wheel-down-event, mouse-wheel-up-event): Remove :set. (mouse-wheel--setup-bindings): Don't bind to `mouse-wheel-*-event`s any more. * lisp/progmodes/flymake.el (flymake--mode-line-counter-map): Don't bind to `mouse-wheel-*-event`s any more if Emacs is recent enough. --- lisp/completion-preview.el | 10 +--------- lisp/edmacro.el | 8 +------- lisp/mwheel.el | 31 +++++++++++-------------------- lisp/progmodes/flymake.el | 19 +++++++++---------- src/fns.c | 1 + src/keyboard.c | 9 +++++++++ src/keyboard.h | 2 +- src/xterm.c | 31 +++++++++++++++++++++++++++++-- 8 files changed, 62 insertions(+), 49 deletions(-) diff --git a/lisp/completion-preview.el b/lisp/completion-preview.el index 6fd60f3c416..6bbf1246a9a 100644 --- a/lisp/completion-preview.el +++ b/lisp/completion-preview.el @@ -52,8 +52,6 @@ ;;; Code: -(require 'mwheel) - (defgroup completion-preview nil "In-buffer completion preview." :group 'completion) @@ -135,14 +133,8 @@ completion-preview--mouse-map "" #'completion-preview-insert "C-" #'completion-at-point "" #'completion-at-point - ;; BEWARE: `mouse-wheel-UP-event' corresponds to `wheel-DOWN' events - ;; and vice versa!! "" #'completion-preview-prev-candidate - "" #'completion-preview-next-candidate - (key-description (vector mouse-wheel-up-event)) - #'completion-preview-next-candidate - (key-description (vector mouse-wheel-down-event)) - #'completion-preview-prev-candidate) + "" #'completion-preview-next-candidate) (defvar-local completion-preview--overlay nil) diff --git a/lisp/edmacro.el b/lisp/edmacro.el index abfc380d154..a80fe973240 100644 --- a/lisp/edmacro.el +++ b/lisp/edmacro.el @@ -725,10 +725,6 @@ edmacro-fix-menu-commands (let (result) ;; Not preloaded in a --without-x build. (require 'mwheel) - (defvar mouse-wheel-down-event) - (defvar mouse-wheel-up-event) - (defvar mouse-wheel-right-event) - (defvar mouse-wheel-left-event) ;; Make a list of the elements. (setq macro (append macro nil)) (dolist (ev macro) @@ -744,9 +740,7 @@ edmacro-fix-menu-commands ;; info is recorded in macros to make this possible. ((or (mouse-event-p ev) (mouse-movement-p ev) (memq (event-basic-type ev) - `( ,mouse-wheel-down-event ,mouse-wheel-up-event - ,mouse-wheel-right-event ,mouse-wheel-left-event - wheel-down wheel-up wheel-left wheel-right))) + '(wheel-down wheel-up wheel-left wheel-right))) nil) (noerror nil) (t diff --git a/lisp/mwheel.el b/lisp/mwheel.el index 66a1fa1a706..82a2c48fd5d 100644 --- a/lisp/mwheel.el +++ b/lisp/mwheel.el @@ -65,15 +65,13 @@ mouse-wheel-down-event (if mouse-wheel-obey-old-style-wheel-buttons 'mouse-4) "Event used for scrolling down, beside `wheel-up', if any." :group 'mouse - :type 'symbol - :set #'mouse-wheel-change-button) + :type 'symbol) (defcustom mouse-wheel-up-event (if mouse-wheel-obey-old-style-wheel-buttons 'mouse-5) "Event used for scrolling up, beside `wheel-down', if any." :group 'mouse - :type 'symbol - :set #'mouse-wheel-change-button) + :type 'symbol) (defcustom mouse-wheel-click-event 'mouse-2 "Event that should be temporarily inhibited after mouse scrolling. @@ -464,25 +462,18 @@ mouse-wheel--setup-bindings (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 - 'wheel-down 'wheel-up)) - (when event - (mouse-wheel--add-binding `[,(append (car binding) (list event))] - 'mouse-wheel-text-scale)))) + (dolist (event '(wheel-down wheel-up)) + (mouse-wheel--add-binding `[,(append (car binding) (list event))] + 'mouse-wheel-text-scale))) ((and (consp binding) (eq (cdr binding) 'global-text-scale)) - (dolist (event (list mouse-wheel-down-event mouse-wheel-up-event - 'wheel-down 'wheel-up)) - (when event - (mouse-wheel--add-binding `[,(append (car binding) (list event))] - 'mouse-wheel-global-text-scale)))) + (dolist (event '(wheel-down wheel-up)) + (mouse-wheel--add-binding `[,(append (car binding) (list event))] + 'mouse-wheel-global-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 - 'wheel-down 'wheel-up 'wheel-left 'wheel-right)) - (when event - (dolist (key (mouse-wheel--create-scroll-keys binding event)) - (mouse-wheel--add-binding key 'mwheel-scroll)))))))) + (dolist (event '(wheel-down wheel-up wheel-left wheel-right)) + (dolist (key (mouse-wheel--create-scroll-keys binding event)) + (mouse-wheel--add-binding key 'mwheel-scroll))))))) (when mouse-wheel-mode (mouse-wheel--setup-bindings)) diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el index 5974f076556..1411a669891 100644 --- a/lisp/progmodes/flymake.el +++ b/lisp/progmodes/flymake.el @@ -114,10 +114,6 @@ (require 'thingatpt) ; end-of-thing (require 'warnings) ; warning-numeric-level, display-warning (require 'compile) ; for some faces -;; We need the next `require' to avoid compiler warnings and run-time -;; errors about mouse-wheel-up/down-event in builds --without-x, where -;; mwheel is not preloaded. -(require 'mwheel) ;; when-let*, if-let*, hash-table-keys, hash-table-values: (eval-when-compile (require 'subr-x)) (require 'project) @@ -1637,16 +1633,19 @@ flymake--mode-line-counter-scroll-next (defvar flymake--mode-line-counter-map (let ((map (make-sparse-keymap))) - ;; BEWARE: `mouse-wheel-UP-event' corresponds to `wheel-DOWN' events - ;; and vice versa!! - (define-key map (vector 'mode-line mouse-wheel-down-event) - #'flymake--mode-line-counter-scroll-prev) (define-key map [mode-line wheel-down] #'flymake--mode-line-counter-scroll-next) - (define-key map (vector 'mode-line mouse-wheel-up-event) - #'flymake--mode-line-counter-scroll-next) (define-key map [mode-line wheel-up] #'flymake--mode-line-counter-scroll-prev) + (when (< emacs-major-version 30) + (require 'mwheel) + (defvar mouse-wheel-down-event) (defvar mouse-wheel-up-event) + ;; BEWARE: `mouse-wheel-UP-event' corresponds to `wheel-DOWN' events + ;; and vice versa!! + (define-key map (vector 'mode-line mouse-wheel-down-event) + #'flymake--mode-line-counter-scroll-prev) + (define-key map (vector 'mode-line mouse-wheel-up-event) + #'flymake--mode-line-counter-scroll-next)) map)) (defun flymake--mode-line-counter-1 (type) diff --git a/src/fns.c b/src/fns.c index e4fa8157000..48d7b217cb6 100644 --- a/src/fns.c +++ b/src/fns.c @@ -4855,6 +4855,7 @@ check_mutable_hash_table (Lisp_Object obj, struct Lisp_Hash_Table *h) HASH is a previously computed hash code of KEY. Value is the index of the entry in H matching KEY. */ +/* FIXME: Callers shouldn't care about the return value! */ ptrdiff_t hash_put (struct Lisp_Hash_Table *h, Lisp_Object key, Lisp_Object value, hash_hash_t hash) diff --git a/src/keyboard.c b/src/keyboard.c index 1f7253a7da1..7c1822b3423 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -7597,6 +7597,15 @@ modify_event_symbol (ptrdiff_t symbol_num, int modifiers, Lisp_Object symbol_kin /* Apply modifiers to that symbol. */ return apply_modifiers (modifiers, value); } + +Lisp_Object +base_mouse_symbol (int button) +{ + return modify_event_symbol (button, 0, + Qmouse_click, Vlispy_mouse_stem, + NULL, &mouse_syms, ASIZE (mouse_syms)); +} + /* Convert a list that represents an event type, such as (ctrl meta backspace), into the usual representation of that diff --git a/src/keyboard.h b/src/keyboard.h index 68e68bc2ae3..083b16e4896 100644 --- a/src/keyboard.h +++ b/src/keyboard.h @@ -456,7 +456,7 @@ #define EVENT_HEAD_KIND(event_head) \ extern Lisp_Object read_char (int, Lisp_Object, Lisp_Object, bool *, struct timespec *); extern int parse_solitary_modifier (Lisp_Object symbol); - +extern Lisp_Object base_mouse_symbol (int button); /* This is like Vthis_command, except that commands never set it. */ extern Lisp_Object real_this_command; diff --git a/src/xterm.c b/src/xterm.c index c8a43785564..fcbe7a1ec4f 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -14553,8 +14553,6 @@ x_construct_mouse_click (struct input_event *result, int x = event->x; int y = event->y; - /* Make the event type NO_EVENT; we'll change that when we decide - otherwise. */ result->kind = MOUSE_CLICK_EVENT; result->code = event->button - Button1; result->timestamp = event->time; @@ -14564,6 +14562,30 @@ x_construct_mouse_click (struct input_event *result, ? up_modifier : down_modifier)); + /* Convert pre-XInput2 wheel events represented as mouse-clicks. */ +#ifdef HAVE_XINPUT2 + if (!dpyinfo->supports_xi2) +#endif + { + Lisp_Object base = base_mouse_symbol (result->code); + int wheel + /* BEWARE: `mouse-wheel-UP-event' corresponds to + `wheel-DOWN' events and vice versa!! */ + = BASE_EQ (base, find_symbol_value (Qmouse_wheel_up_event)) ? 0 + : BASE_EQ (base, find_symbol_value (Qmouse_wheel_down_event)) ? 1 + : BASE_EQ (base, find_symbol_value (Qmouse_wheel_left_event)) ? 2 + : BASE_EQ (base, find_symbol_value (Qmouse_wheel_right_event)) ? 3 + : -1; + if (wheel >= 0) + { + result->kind = (event->type != ButtonRelease ? NO_EVENT + : wheel & 2 ? HORIZ_WHEEL_EVENT : WHEEL_EVENT); + result->code = 0; /* Not used. */ + result->modifiers &= ~(up_modifier || down_modifier); + result->modifiers |= wheel & 1 ? up_modifier : down_modifier; + } + } + /* If result->window is not the frame's edit widget (which can happen with GTK+ scroll bars, for example), translate the coordinates so they appear at the correct position. */ @@ -32444,6 +32466,11 @@ syms_of_xterm (void) DEFSYM (Qexpose, "expose"); DEFSYM (Qdont_save, "dont-save"); + DEFSYM (Qmouse_wheel_down_event, "mouse-wheel-down-event"); + DEFSYM (Qmouse_wheel_up_event, "mouse-wheel-up-event"); + DEFSYM (Qmouse_wheel_left_event, "mouse-wheel-left-event"); + DEFSYM (Qmouse_wheel_right_event, "mouse-wheel-right-event"); + #ifdef USE_GTK xg_default_icon_file = build_pure_c_string ("icons/hicolor/scalable/apps/emacs.svg"); staticpro (&xg_default_icon_file); -- 2.43.0 --=-=-=--