aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--lisp/xt-mouse.el74
1 files changed, 51 insertions, 23 deletions
diff --git a/lisp/xt-mouse.el b/lisp/xt-mouse.el
index a0ea223af81..f7f0aaa4633 100644
--- a/lisp/xt-mouse.el
+++ b/lisp/xt-mouse.el
@@ -36,15 +36,6 @@
36 36
37;;; Code: 37;;; Code:
38 38
39;; Emacs only generates down events when needed.
40;; This is too hard to emulate, so we cheat instead.
41(or (lookup-key global-map [ down-mouse-1 ])
42 (define-key global-map [ down-mouse-1 ] 'ignore))
43(or (lookup-key global-map [ down-mouse-2 ])
44 (define-key global-map [ down-mouse-2 ] 'ignore))
45(or (lookup-key global-map [ down-mouse-3 ])
46 (define-key global-map [ down-mouse-3 ] 'ignore))
47
48(define-key function-key-map "\e[M" 'xterm-mouse-translate) 39(define-key function-key-map "\e[M" 'xterm-mouse-translate)
49 40
50(defun xterm-mouse-translate (event) 41(defun xterm-mouse-translate (event)
@@ -53,23 +44,56 @@
53 (save-window-excursion 44 (save-window-excursion
54 (deactivate-mark) 45 (deactivate-mark)
55 (let* ((last) 46 (let* ((last)
56 (down (xterm-mouse-event))) 47 (down (xterm-mouse-event))
48 (down-command (nth 0 down))
49 (down-data (nth 1 down))
50 (down-where (nth 1 down-data))
51 (down-binding (key-binding (if (symbolp down-where)
52 (vector down-where down-command)
53 (vector down-command)))))
57 (or (and (eq (read-char) ?\e) 54 (or (and (eq (read-char) ?\e)
58 (eq (read-char) ?\[) 55 (eq (read-char) ?\[)
59 (eq (read-char) ?M)) 56 (eq (read-char) ?M))
60 (error "Unexpected escape sequence from XTerm")) 57 (error "Unexpected escape sequence from XTerm"))
61 (let ((click (xterm-mouse-event))) 58 (let* ((click (xterm-mouse-event))
62 (setq unread-command-events 59 (click-command (nth 0 click))
63 (append unread-command-events 60 (click-data (nth 1 click))
64 (if (eq (nth 1 (nth 1 down)) (nth 1 (nth 1 click))) 61 (click-where (nth 1 click-data)))
65 (list click) 62 (if (memq down-binding '(nil ignore))
66 (list 63 (if (and (symbolp click-where)
67 ;; Generate move event to cheat `mouse-drag-region'. 64 (not (eq 'menu-bar click-where)))
68 (list 'mouse-movement (nth 1 click)) 65 (vector (list click-where click-data) click)
69 ;; Generate a drag event. 66 (vector click))
70 (list (intern (concat "drag-mouse-" (+ 1 last))) 67 (setq unread-command-events
71 (nth 1 down) (nth 1 click))))))) 68 (if (eq down-where click-where)
72 (vector down))))) 69 (list click)
70 (list
71 ;; Cheat `mouse-drag-region' with move event.
72 (list 'mouse-movement click-data)
73 ;; Generate a drag event.
74 (if (symbolp down-where)
75 0
76 (list (intern (concat "drag-mouse-" (+ 1 last)))
77 down-data click-data))
78 )))
79 (if (and (symbolp down-where)
80 (not (eq 'menu-bar down-where)))
81 (vector (list down-where down-data) down)
82 (vector down))))))))
83
84(defvar xterm-mouse-x 0
85 "Position of last xterm mouse event relative to the frame.")
86
87(defvar xterm-mouse-y 0
88 "Position of last xterm mouse event relative to the frame.")
89
90(defadvice mouse-position (around xterm-mouse activate)
91 "Use last key from xterm-mouse-mode if available."
92 (let ((answer ad-do-it))
93 (setq ad-return-value
94 (if xterm-mouse-mode
95 (cons (car answer) (cons xterm-mouse-x xterm-mouse-y))
96 answer))))
73 97
74(defun xterm-mouse-event () 98(defun xterm-mouse-event ()
75 ;; Convert XTerm mouse event to Emacs mouse event. 99 ;; Convert XTerm mouse event to Emacs mouse event.
@@ -78,7 +102,9 @@
78 (y (- (read-char) ? 1)) 102 (y (- (read-char) ? 1))
79 (point (cons x y)) 103 (point (cons x y))
80 (window (window-at x y)) 104 (window (window-at x y))
81 (where (coordinates-in-window-p point window)) 105 (where (if window
106 (coordinates-in-window-p point window)
107 'menu-bar))
82 (pos (if (consp where) 108 (pos (if (consp where)
83 (progn 109 (progn
84 (select-window window) 110 (select-window window)
@@ -92,6 +118,8 @@
92 (concat "mouse-" (+ 1 last)) 118 (concat "mouse-" (+ 1 last))
93 (setq last type) 119 (setq last type)
94 (concat "down-mouse-" (+ 1 type)))))) 120 (concat "down-mouse-" (+ 1 type))))))
121 (setq xterm-mouse-x x
122 xterm-mouse-y y)
95 (list mouse 123 (list mouse
96 (list window pos point 124 (list window pos point
97 (/ (nth 2 (current-time)) 1000))))) 125 (/ (nth 2 (current-time)) 1000)))))