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#68213: 30.0.50; completion-preview-tests failure in --without-x build Date: Sun, 07 Jan 2024 22:19:06 -0500 Message-ID: References: <87ttnvr7x7.fsf@pub.pink> <83plyjzmlv.fsf@gnu.org> <87bka3r4sg.fsf@pub.pink> <83plyixr73.fsf@gnu.org> <87v884619q.fsf@yahoo.com> 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="35809"; mail-complaints-to="usenet@ciao.gmane.io" User-Agent: Gnus/5.13 (Gnus v5.13) Cc: Eli Zaretskii , jm@pub.pink, Eshel Yaron , 68213@debbugs.gnu.org To: Po Lu Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Mon Jan 08 04:20:23 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 1rMgBb-00099I-K6 for geb-bug-gnu-emacs@m.gmane-mx.org; Mon, 08 Jan 2024 04:20:23 +0100 Original-Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1rMgBC-0007Bk-Hb; Sun, 07 Jan 2024 22:19:58 -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 1rMgBA-0007As-Vg for bug-gnu-emacs@gnu.org; Sun, 07 Jan 2024 22:19:57 -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 1rMgBA-0000ca-NW for bug-gnu-emacs@gnu.org; Sun, 07 Jan 2024 22:19:56 -0500 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1rMgBG-0001NV-Jt for bug-gnu-emacs@gnu.org; Sun, 07 Jan 2024 22:20:02 -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, 08 Jan 2024 03:20:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 68213 X-GNU-PR-Package: emacs Original-Received: via spool by 68213-submit@debbugs.gnu.org id=B68213.17046839645220 (code B ref 68213); Mon, 08 Jan 2024 03:20:02 +0000 Original-Received: (at 68213) by debbugs.gnu.org; 8 Jan 2024 03:19:24 +0000 Original-Received: from localhost ([127.0.0.1]:34782 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1rMgAe-0001M5-59 for submit@debbugs.gnu.org; Sun, 07 Jan 2024 22:19:24 -0500 Original-Received: from mailscanner.iro.umontreal.ca ([132.204.25.50]:7739) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1rMgAc-0001Lt-1v for 68213@debbugs.gnu.org; Sun, 07 Jan 2024 22:19:22 -0500 Original-Received: from pmg3.iro.umontreal.ca (localhost [127.0.0.1]) by pmg3.iro.umontreal.ca (Proxmox) with ESMTP id B6854442539; Sun, 7 Jan 2024 22:19:10 -0500 (EST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=iro.umontreal.ca; s=mail; t=1704683948; bh=+v3VQHOKLSzrAzk5HqrdyMR3MvYNIDQ+zPMbfutyZjI=; h=From:To:Cc:Subject:In-Reply-To:References:Date:From; b=Yk0Pb0KWdt+m/ic20DUbRkWsUolSiYEFRtXxFnvdYqslsOSUtTca24GFbVnn/vOSY aeMmdsdB+eSm0XM8wcKhs6bDMTFsdlCL9g4thNbtct4PImv9bWs2TSlit0+wJUNwwU 0Vm1dqSEB6WLzfljF9sncgpbJqeVtF8TDfvx6e+5PjaK2n4gxQNiTOa8l5xcjpSWpW uepOsAxFhWK1aYpTxx2Tezc8hUG0r+hjrRpdJpi/4XxCDaEK002JEWacMKzrk1SUSy gcEEL2tFWZMoDOt9y/NuNlnLZSZff0AvxFWIxDkYgoX/UWYnPhHmldJ74FfPumEnrx dRf9AefnxS0ww== Original-Received: from mail01.iro.umontreal.ca (unknown [172.31.2.1]) by pmg3.iro.umontreal.ca (Proxmox) with ESMTP id 285084424C8; Sun, 7 Jan 2024 22:19:08 -0500 (EST) Original-Received: from pastel (65-110-221-238.cpe.pppoe.ca [65.110.221.238]) by mail01.iro.umontreal.ca (Postfix) with ESMTPSA id E5A071208E2; Sun, 7 Jan 2024 22:19:07 -0500 (EST) In-Reply-To: <87v884619q.fsf@yahoo.com> (Po Lu's message of "Mon, 08 Jan 2024 09:51:13 +0800") 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:277529 Archived-At: --=-=-= Content-Type: text/plain >>> The definition of `completion-preview--mouse-map` binds the events >>> specified by both `mouse-wheel-up-event` and >>> `mouse-wheel-up-alternate-event` to `completion-preview-prev-candidate` >>> (using `defvar-keymap`). >> >> Hmm... I don't understand the purpose of >> `mouse-wheel-up/down/left/right-alternate-event` (nor why they're >> `defcustom`s). >> >> Po Lu? >> >> >> Stefan > > The events generated for mouse wheel events vary by window system, and > at times Emacs's choice is incorrect, such as when mouse-4 through > mouse-7 are true mouse buttons rather than representations of the mouse > wheel. But why is `mouse-4` sometimes on `mouse-wheel-down-event` and sometimes on `mouse-wheel-down-alternate-event`? What difference does it make? But, AFAICT the `wheel-up/down` events always mean the same, so I think `mwheel.el` should just always bind `wheel-DIR` events and then the `mouse-wheel-DIR-event` vars are used only for those cases where other events also need to be bound, like in the patch below, WDYT? Stefan --=-=-= Content-Type: text/x-diff Content-Disposition: inline; filename=mwheel.patch diff --git a/lisp/mwheel.el b/lisp/mwheel.el index b75b6f27d53..50ac632b4eb 100644 --- a/lisp/mwheel.el +++ b/lisp/mwheel.el @@ -60,46 +60,24 @@ mouse-wheel-down-event (if (or (featurep 'w32-win) (featurep 'ns-win) (featurep 'haiku-win) (featurep 'pgtk-win) (featurep 'android-win)) - 'wheel-up + nil 'mouse-4) - "Event used for scrolling down." + "Event used for scrolling down, beside `wheel-down', if any." :group 'mouse :type 'symbol :set 'mouse-wheel-change-button) -(defcustom mouse-wheel-down-alternate-event - (if (featurep 'xinput2) - 'wheel-up - (unless (featurep 'x) - 'mouse-4)) - "Alternative wheel down event to consider." - :group 'mouse - :type 'symbol - :version "29.1" - :set 'mouse-wheel-change-button) - (defcustom mouse-wheel-up-event (if (or (featurep 'w32-win) (featurep 'ns-win) (featurep 'haiku-win) (featurep 'pgtk-win) (featurep 'android-win)) - 'wheel-down + nil 'mouse-5) - "Event used for scrolling up." + "Event used for scrolling up, beside `wheel-up', if any." :group 'mouse :type 'symbol :set 'mouse-wheel-change-button) -(defcustom mouse-wheel-up-alternate-event - (if (featurep 'xinput2) - 'wheel-down - (unless (featurep 'x) - 'mouse-5)) - "Alternative wheel up event to consider." - :group 'mouse - :type 'symbol - :version "29.1" - :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 @@ -222,8 +200,8 @@ mwheel-event-button (if (eq 'mouse-wheel x) (let ((amount (car (cdr (cdr (cdr event)))))) (if (< amount 0) - mouse-wheel-up-event - mouse-wheel-down-event)) + 'wheel-up + 'wheel-down)) x))) (defun mwheel-event-window (event) @@ -258,31 +236,17 @@ mouse-wheel-left-event (if (or (featurep 'w32-win) (featurep 'ns-win) (featurep 'haiku-win) (featurep 'pgtk-win) (featurep 'android-win)) - 'wheel-left + nil 'mouse-6) - "Event used for scrolling left.") - -(defvar mouse-wheel-left-alternate-event - (if (featurep 'xinput2) - 'wheel-left - (unless (featurep 'x) - 'mouse-6)) - "Alternative wheel left event to consider.") + "Event used for scrolling left, beside `wheel-left', if any.") (defvar mouse-wheel-right-event (if (or (featurep 'w32-win) (featurep 'ns-win) (featurep 'haiku-win) (featurep 'pgtk-win) (featurep 'android-win)) - 'wheel-right + nil 'mouse-7) - "Event used for scrolling right.") - -(defvar mouse-wheel-right-alternate-event - (if (featurep 'xinput2) - 'wheel-right - (unless (featurep 'x) - 'mouse-7)) - "Alternative wheel right event to consider.") + "Event used for scrolling right, beside `wheel-right', if any.") (defun mouse-wheel--get-scroll-window (event) "Return window for mouse wheel event EVENT. @@ -311,6 +275,15 @@ mouse-wheel--get-scroll-window frame nil t))))) (mwheel-event-window event))) +(defmacro mwheel--is-dir-p (dir button) + (declare (debug (sexp form))) + (let ((custom-var (intern (format "mouse-wheel-%s-event" dir))) + (event (intern (format "wheel-%s" dir)))) + (macroexp-let2 nil butsym button + `(or (eq ,butsym ',event) + ;; We presume here `button' is never nil. + (eq ,butsym ,custom-var))))) + (defun mwheel-scroll (event &optional arg) "Scroll up or down according to the EVENT. This should be bound only to mouse buttons 4, 5, 6, and 7 on @@ -348,17 +321,17 @@ mwheel-scroll (condition-case nil (unwind-protect (let ((button (mwheel-event-button event))) - (cond ((and (eq amt 'hscroll) (memq button (list mouse-wheel-down-event - mouse-wheel-down-alternate-event))) + (cond ((and (eq amt 'hscroll) + (mwheel--is-dir-p down button)) (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)) - ((memq button (list mouse-wheel-down-event - mouse-wheel-down-alternate-event)) - (condition-case nil (funcall mwheel-scroll-down-function amt) + ((mwheel--is-dir-p down button) + (condition-case nil + (funcall mwheel-scroll-down-function amt) ;; Make sure we do indeed scroll to the beginning of ;; the buffer. (beginning-of-buffer @@ -372,31 +345,32 @@ mwheel-scroll ;; 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) (memq button (list mouse-wheel-up-event - mouse-wheel-up-alternate-event))) + ((and (eq amt 'hscroll) + (mwheel--is-dir-p up button)) (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)) - ((memq button (list mouse-wheel-up-event - mouse-wheel-up-alternate-event)) - (condition-case nil (funcall mwheel-scroll-up-function amt) + ((mwheel--is-dir-p up button) + (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))))) - ((memq button (list mouse-wheel-left-event - mouse-wheel-left-alternate-event)) ; for tilt scroll + (end-of-buffer + (while t (funcall mwheel-scroll-up-function))))) + ((mwheel--is-dir-p left button) ; for tilt scroll (when mouse-wheel-tilt-scroll (funcall (if mouse-wheel-flip-direction mwheel-scroll-right-function - mwheel-scroll-left-function) amt))) - ((memq button (list mouse-wheel-right-event - mouse-wheel-right-alternate-event)) ; for tilt scroll + mwheel-scroll-left-function) + amt))) + ((mwheel--is-dir-p right button) ; for tilt scroll (when mouse-wheel-tilt-scroll (funcall (if mouse-wheel-flip-direction mwheel-scroll-left-function - mwheel-scroll-right-function) amt))) + mwheel-scroll-right-function) + amt))) (t (error "Bad binding in mwheel-scroll")))) (if (eq scroll-window selected-window) ;; If there is a temporarily active region, deactivate it if @@ -437,11 +411,9 @@ mouse-wheel-text-scale (button (mwheel-event-button event))) (select-window scroll-window 'mark-for-redisplay) (unwind-protect - (cond ((memq button (list mouse-wheel-down-event - mouse-wheel-down-alternate-event)) + (cond ((mwheel--is-dir-p down button) (text-scale-increase 1)) - ((memq button (list mouse-wheel-up-event - mouse-wheel-up-alternate-event)) + ((mwheel--is-dir-p up button) (text-scale-decrease 1))) (select-window selected-window)))) @@ -451,11 +423,9 @@ mouse-wheel-global-text-scale This invokes `global-text-scale-adjust', which see." (interactive (list last-input-event)) (let ((button (mwheel-event-button event))) - (cond ((memq button (list mouse-wheel-down-event - mouse-wheel-down-alternate-event)) + (cond ((mwheel--is-dir-p down button) (global-text-scale-adjust 1)) - ((memq button (list mouse-wheel-up-event - mouse-wheel-up-alternate-event)) + ((mwheel--is-dir-p up button) (global-text-scale-adjust -1))))) (defun mouse-wheel--add-binding (key fun) @@ -507,15 +477,13 @@ mouse-wheel--setup-bindings ;; 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-down-alternate-event - mouse-wheel-up-alternate-event)) + 'wheel-down 'wheel-up)) (when event (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 - mouse-wheel-down-alternate-event - mouse-wheel-up-alternate-event)) + 'wheel-down 'wheel-up)) (when event (mouse-wheel--add-binding `[,(append (car binding) (list event))] 'mouse-wheel-global-text-scale)))) @@ -523,10 +491,7 @@ mouse-wheel--setup-bindings (t (dolist (event (list mouse-wheel-down-event mouse-wheel-up-event 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)) + '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)))))))) --=-=-=--