Github/emacs
2
0
Fork 1
mirror of git://git.sv.gnu.org/emacs.git synced 2026-02-17 10:27:41 +00:00
Code Issues Projects Releases Packages Wiki Activity

Fix binding mouse wheel with modifiers in buffer area

Browse source 
* 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.
This commit is contained in:
Stefan Kangas 2020-09-02 22:54:47 +02:00
parent 5aa5c0372d
commit 77a5b696bb
2 changed files with 16 additions and 11 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

7
lisp/mwheel.el
View file

@ -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

20
test/lisp/mwheel-tests.el
View file

@ -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