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.

2 files changed, 16 insertions, 11 deletions

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