diff options
author | Sean Whitton <spwhitton@spwhitton.name> | 2024-04-01 18:50:20 +0800 |
---|---|---|
committer | Sean Whitton <spwhitton@spwhitton.name> | 2024-04-01 18:50:20 +0800 |
commit | 0fef2018445b257bf26814e6659bc2ff5b270d77 (patch) | |
tree | 2310ce1fd8781a6203ec56e2f985f6adfcc2278d /lisp/xt-mouse.el | |
parent | 3a8546615a38337dc991f6546ade63a372edc2ca (diff) | |
parent | 49f76dcc17055e60569b6096e8ea3c9961ebbf63 (diff) | |
download | emacs-0fef2018445b257bf26814e6659bc2ff5b270d77.tar.gz |
Merge branch 'athena/unstable' into athena/bookworm-backports
Diffstat (limited to 'lisp/xt-mouse.el')
-rw-r--r-- | lisp/xt-mouse.el | 31 |
1 files changed, 24 insertions, 7 deletions
diff --git a/lisp/xt-mouse.el b/lisp/xt-mouse.el index cd00467f14f..081b8f32456 100644 --- a/lisp/xt-mouse.el +++ b/lisp/xt-mouse.el @@ -40,6 +40,8 @@ ;;; Code: +(require 'mwheel) + (defvar xterm-mouse-debug-buffer nil) (defun xterm-mouse-translate (_event) @@ -193,6 +195,12 @@ single byte." (cons n c)) (cons (- (setq c (xterm-mouse--read-coordinate)) 32) c)))) +(defun xterm-mouse--button-p (event btn) + (and (symbolp event) + (string-prefix-p "mouse-" (symbol-name event)) + (eq btn (car (read-from-string (symbol-name event) + (length "mouse-")))))) + ;; XTerm reports mouse events as ;; <EVENT-CODE> <X> <Y> in default mode, and ;; <EVENT-CODE> ";" <X> ";" <Y> <"M" or "m"> in extended mode. @@ -230,13 +238,22 @@ single byte." ;; Spurious release event without previous button-down ;; event: assume, that the last button was button 1. (t 1))) - (sym (if move 'mouse-movement - (intern (concat (if ctrl "C-" "") - (if meta "M-" "") - (if shift "S-" "") - (if down "down-" "") - "mouse-" - (number-to-string btn)))))) + (sym + (if move 'mouse-movement + (intern + (concat + (if ctrl "C-" "") + (if meta "M-" "") + (if shift "S-" "") + (if down "down-" "") + (cond + ;; BEWARE: `mouse-wheel-UP-event' corresponds to + ;; `wheel-DOWN' events and vice versa!! + ((xterm-mouse--button-p mouse-wheel-down-event btn) "wheel-up") + ((xterm-mouse--button-p mouse-wheel-up-event btn) "wheel-down") + ((xterm-mouse--button-p mouse-wheel-left-event btn) "wheel-left") + ((xterm-mouse--button-p mouse-wheel-right-event btn) "wheel-right") + (t (format "mouse-%d" btn)))))))) (list sym (1- x) (1- y)))) (defun xterm-mouse--set-click-count (event click-count) |