master 77a5b69 1/3: Fix binding mouse wheel with modifiers in buffer area

[Stefan Kangas]

branch: master
commit 77a5b696bbb4f70e23e94c8a731168a6673c8cd9
Author: Stefan Kangas <stefankangas@gmail.com>
Commit: Stefan Kangas <stefankangas@gmail.com>

    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.
---
 lisp/mwheel.el            |  7 +++++--
 test/lisp/mwheel-tests.el | 20 +++++++++++---------
 2 files changed, 16 insertions(+), 11 deletions(-)

diff --git a/lisp/mwheel.el b/lisp/mwheel.el
index d5172ba..53a5a50 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 f2989d6..0e45b76 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