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 d5172ba0bf5f13f9d77a9a5849b5a8f19fc9ff49..53a5a50badaae5fa01f03c6322b6d6bf86645d53 100644 (file)
--- 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 f2989d608b4d5f395c07cf4c3d20dddb8c8dd694..0e45b76c06e337a2ddec250cdd524249d4922e5a 100644 (file)
--- 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