From: Stefan Kangas <stefankangas@gmail.com>
Date: Wed, 2 Sep 2020 20:54:47 +0000 (+0200)
Subject: Fix binding mouse wheel with modifiers in buffer area
X-Git-Tag: emacs-28.0.90~6277
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=77a5b696bbb4f70e23e94c8a731168a6673c8cd9;p=emacs.git

Fix binding mouse wheel with modifiers in buffer area

* test/lisp/mwheel-tests.el (mwheel-test--create-scroll-keys): Fix
binding mouse wheel with modifiers in buffer area, while ignoring them
for fringes, margins, etc.  My previous change mistakenly ignored all
modifiers in `mouse-wheel-scroll-amount'.
* lisp/mwheel.el (mouse-wheel--create-scroll-keys): Fix test to
reflect the above.
---

diff --git a/lisp/mwheel.el b/lisp/mwheel.el
index d5172ba0bf5..53a5a50bada 100644
--- a/lisp/mwheel.el
+++ b/lisp/mwheel.el
@@ -363,8 +363,11 @@ an event used for scrolling, such as `mouse-wheel-down-event'."
                         'left-fringe 'right-fringe
                         'vertical-scroll-bar 'horizontal-scroll-bar
                         'mode-line 'header-line)))
-    (cons (vector event)                  ; default case: no prefix.
-          (when (not (consp binding))
+    (if (consp binding)
+        ;; With modifiers, bind only the buffer area (no prefix).
+        (list `[(,@(car binding) ,event)])
+      ;; No modifier: bind also some non-buffer areas of the screen.
+      (cons (vector event)
             (mapcar (lambda (prefix) (vector prefix event)) prefixes)))))
 
 (define-minor-mode mouse-wheel-mode
diff --git a/test/lisp/mwheel-tests.el b/test/lisp/mwheel-tests.el
index f2989d608b4..0e45b76c06e 100644
--- a/test/lisp/mwheel-tests.el
+++ b/test/lisp/mwheel-tests.el
@@ -23,16 +23,18 @@
 (require 'mwheel)
 
 (ert-deftest mwheel-test--create-scroll-keys ()
-  (should (equal (mouse-wheel--create-scroll-keys 10 'mouse-1)
-                 '([mouse-1]
-                   [left-margin mouse-1] [right-margin mouse-1]
-                   [left-fringe mouse-1] [right-fringe mouse-1]
-                   [vertical-scroll-bar mouse-1] [horizontal-scroll-bar mouse-1]
-                   [mode-line mouse-1] [header-line mouse-1])))
+  (should (equal (mouse-wheel--create-scroll-keys 10 'mouse-4)
+                 '([mouse-4]
+                   [left-margin mouse-4] [right-margin mouse-4]
+                   [left-fringe mouse-4] [right-fringe mouse-4]
+                   [vertical-scroll-bar mouse-4] [horizontal-scroll-bar mouse-4]
+                   [mode-line mouse-4] [header-line mouse-4])))
   ;; Don't bind modifiers outside of buffer area (e.g. for fringes).
-  (should (equal (mouse-wheel--create-scroll-keys '((shift) . 1) 'mouse-1)
-                 '([mouse-1])))
+  (should (equal (mouse-wheel--create-scroll-keys '((shift) . 1) 'mouse-4)
+                 '([(shift mouse-4)])))
   (should (equal (mouse-wheel--create-scroll-keys '((control) . 9) 'mouse-7)
-                 '([mouse-7]))))
+                 '([(control mouse-7)])))
+  (should (equal (mouse-wheel--create-scroll-keys '((meta) . 5) 'mouse-5)
+                 '([(meta mouse-5)]))))
 
 ;;; mwheel-tests.el ends here