From 77a5b696bbb4f70e23e94c8a731168a6673c8cd9 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Wed, 2 Sep 2020 22:54:47 +0200 Subject: [PATCH] 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 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 -- 2.39.2