1 ;;; xt-mouse.el --- support the mouse when emacs run in an xterm
3 ;; Copyright (C) 1994, 2000-2014 Free Software Foundation, Inc.
5 ;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
6 ;; Keywords: mouse, terminals
8 ;; This file is part of GNU Emacs.
10 ;; GNU Emacs is free software: you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation, either version 3 of the License, or
13 ;; (at your option) any later version.
15 ;; GNU Emacs is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
25 ;; Enable mouse support when running inside an xterm.
27 ;; This is actually useful when you are running X11 locally, but is
28 ;; working on remote machine over a modem line or through a gateway.
30 ;; It works by translating xterm escape codes into generic emacs mouse
31 ;; events so it should work with any package that uses the mouse.
33 ;; You don't have to turn off xterm mode to use the normal xterm mouse
34 ;; functionality, it is still available by holding down the SHIFT key
35 ;; when you press the mouse button.
39 ;; Support multi-click -- somehow.
43 (defvar xterm-mouse-debug-buffer nil
)
45 ;; Mouse events symbols must have an 'event-kind property with
46 ;; the value 'mouse-click.
47 (dolist (event '(mouse-1 mouse-2 mouse-3 mouse-4 mouse-5
))
48 (let ((M-event (intern (concat "M-" (symbol-name event
)))))
49 (put event
'event-kind
'mouse-click
)
50 (put M-event
'event-kind
'mouse-click
)))
52 (defun xterm-mouse-translate (_event)
53 "Read a click and release event from XTerm."
54 (xterm-mouse-translate-1))
56 (defun xterm-mouse-translate-extended (_event)
57 "Read a click and release event from XTerm.
58 Similar to `xterm-mouse-translate', but using the \"1006\"
59 extension, which supports coordinates >= 231 (see
60 http://invisible-island.net/xterm/ctlseqs/ctlseqs.html)."
61 (xterm-mouse-translate-1 1006))
63 (defun xterm-mouse-translate-1 (&optional extension
)
65 (save-window-excursion ;FIXME: Why?
66 (deactivate-mark) ;FIXME: Why?
67 (let* ((event (xterm-mouse-event extension
))
68 (ev-command (nth 0 event
))
69 (ev-data (nth 1 event
))
70 (ev-where (nth 1 ev-data
))
71 (vec (if (and (symbolp ev-where
) (consp ev-where
))
72 ;; FIXME: This condition can *never* be non-nil!?!
73 (vector (list ev-where ev-data
) event
)
75 (is-down (string-match "down-" (symbol-name ev-command
))))
78 ((null event
) nil
) ;Unknown/bogus byte sequence!
80 (setf (terminal-parameter nil
'xterm-mouse-last-down
) event
)
83 (let* ((down (terminal-parameter nil
'xterm-mouse-last-down
))
84 (down-data (nth 1 down
))
85 (down-where (nth 1 down-data
)))
86 (setf (terminal-parameter nil
'xterm-mouse-last-down
) nil
)
89 ;; This is an "up-only" event. Pretend there was an up-event
90 ;; right before and keep the up-event for later.
91 (push event unread-command-events
)
92 (vector (cons (intern (replace-regexp-in-string
93 "\\`\\([ACMHSs]-\\)*" "\\&down-"
94 (symbol-name ev-command
) t
))
96 ((equal ev-where down-where
) vec
)
98 (let ((drag (if (symbolp ev-where
)
100 (list (replace-regexp-in-string
101 "\\`\\([ACMHSs]-\\)*" "\\&drag-"
102 (symbol-name ev-command
) t
)
103 down-data ev-data
))))
104 (if (null track-mouse
)
106 (push drag unread-command-events
)
107 (vector (list 'mouse-movement ev-data
)))))))))))))
109 ;; These two variables have been converted to terminal parameters.
111 ;;(defvar xterm-mouse-x 0
112 ;; "Position of last xterm mouse event relative to the frame.")
114 ;;(defvar xterm-mouse-y 0
115 ;; "Position of last xterm mouse event relative to the frame.")
117 (defvar xt-mouse-epoch nil
)
119 ;; Indicator for the xterm-mouse mode.
121 (defun xterm-mouse-position-function (pos)
122 "Bound to `mouse-position-function' in XTerm mouse mode."
123 (when (terminal-parameter nil
'xterm-mouse-x
)
124 (setcdr pos
(cons (terminal-parameter nil
'xterm-mouse-x
)
125 (terminal-parameter nil
'xterm-mouse-y
))))
128 (defun xterm-mouse-truncate-wrap (f)
129 "Truncate with wrap-around."
131 ;; First try the built-in truncate, in case there's no overflow.
133 ;; In case of overflow, do wraparound by hand.
135 ;; In our case, we wrap around every 3 days or so, so if we assume
136 ;; a maximum of 65536 wraparounds, we're safe for a couple years.
137 ;; Using a power of 2 makes rounding errors less likely.
138 (let* ((maxwrap (* 65536 2048))
139 (dbig (truncate (/ f maxwrap
)))
140 (fdiff (- f
(* 1.0 maxwrap dbig
))))
141 (+ (truncate fdiff
) (* maxwrap dbig
))))))
143 ;; Normal terminal mouse click reporting: expect three bytes, of the
144 ;; form <BUTTON+32> <X+32> <Y+32>. Return a list (EVENT-TYPE X Y).
145 (defun xterm-mouse--read-event-sequence-1000 ()
146 (let* ((code (- (read-event) 32))
148 ;; For buttons > 3, the release-event looks differently
149 ;; (see xc/programs/xterm/button.c, function EditorButton),
150 ;; and come in a release-event only, no down-event.
152 (format "mouse-%d" (- code
60)))
153 ((memq code
'(8 9 10))
154 (format "M-down-mouse-%d" (- code
7)))
156 (let ((down (car (terminal-parameter
157 nil
'xterm-mouse-last-down
))))
158 (when (and down
(string-match "[0-9]" (symbol-name down
)))
159 (format (if (eq code
3) "mouse-%s" "M-mouse-%s")
160 (match-string 0 (symbol-name down
))))))
161 ((memq code
'(0 1 2))
162 (format "down-mouse-%d" (+ 1 code
)))))
163 (x (- (read-event) 33))
164 (y (- (read-event) 33)))
165 (and type
(wholenump x
) (wholenump y
)
166 (list (intern type
) x y
))))
168 ;; XTerm's 1006-mode terminal mouse click reporting has the form
169 ;; <BUTTON> ; <X> ; <Y> <M or m>, where the button and ordinates are
170 ;; in encoded (decimal) form. Return a list (EVENT-TYPE X Y).
171 (defun xterm-mouse--read-event-sequence-1006 ()
172 (let (button-bytes x-bytes y-bytes c
)
173 (while (not (eq (setq c
(read-event)) ?\
;))
174 (push c button-bytes
))
175 (while (not (eq (setq c
(read-event)) ?\
;))
177 (while (not (memq (setq c
(read-event)) '(?m ?M
)))
179 (list (let* ((code (string-to-number
180 (apply 'string
(nreverse button-bytes
))))
182 (down (and (not wheel
)
184 (intern (format "%s%smouse-%d"
193 ((< code
32) "C-M-S-")
195 (error "Unexpected escape sequence from XTerm")))
199 (1+ (mod code
4))))))
200 (1- (string-to-number (apply 'string
(nreverse x-bytes
))))
201 (1- (string-to-number (apply 'string
(nreverse y-bytes
)))))))
203 (defun xterm-mouse--set-click-count (event click-count
)
204 (setcdr (cdr event
) (list click-count
))
205 (let ((name (symbol-name (car event
))))
206 (when (string-match "\\(.*?\\)\\(\\(?:down-\\)?mouse-.*\\)" name
)
208 (intern (concat (match-string 1 name
)
209 (if (= click-count
2)
211 (match-string 2 name
)))))))
213 (defun xterm-mouse-event (&optional extension
)
214 "Convert XTerm mouse event to Emacs mouse event.
215 EXTENSION, if non-nil, means to use an extension to the usual
216 terminal mouse protocol; we currently support the value 1006,
217 which is the \"1006\" extension implemented in Xterm >= 277."
218 (let* ((click (cond ((null extension
)
219 (xterm-mouse--read-event-sequence-1000))
221 (xterm-mouse--read-event-sequence-1006))
223 (error "Unsupported XTerm mouse protocol")))))
225 (let* ((type (nth 0 click
))
228 ;; Emulate timestamp information. This is accurate enough
229 ;; for default value of mouse-1-click-follows-link (450msec).
230 (timestamp (xterm-mouse-truncate-wrap
234 (setq xt-mouse-epoch
(float-time)))))))
236 (ltrb (window-edges w
))
240 (posn-at-x-y (- x left
) (- y top
) w t
)
241 (append (list nil
'menu-bar
)
242 (nthcdr 2 (posn-at-x-y x y
)))))
243 (event (list type posn
)))
244 (setcar (nthcdr 3 posn
) timestamp
)
246 ;; Try to handle double/triple clicks.
247 (let* ((last-click (terminal-parameter nil
'xterm-mouse-last-click
))
248 (last-type (nth 0 last-click
))
249 (last-name (symbol-name last-type
))
250 (last-time (nth 1 last-click
))
251 (click-count (nth 2 last-click
))
252 (this-time (float-time))
253 (name (symbol-name type
)))
255 ((not (string-match "down-" name
))
256 ;; For up events, make the up side match the down side.
257 (setq this-time last-time
)
258 (when (and (> click-count
1)
259 (string-match "down-" last-name
)
260 (equal name
(replace-match "" t t last-name
)))
261 (xterm-mouse--set-click-count event click-count
)))
262 ((not last-time
) nil
)
263 ((and (> double-click-time
(* 1000 (- this-time last-time
)))
264 (equal last-name
(replace-match "" t t name
)))
265 (setq click-count
(1+ click-count
))
266 (xterm-mouse--set-click-count event click-count
))
267 (t (setq click-count
1)))
268 (set-terminal-parameter nil
'xterm-mouse-last-click
269 (list type this-time click-count
)))
271 (set-terminal-parameter nil
'xterm-mouse-x x
)
272 (set-terminal-parameter nil
'xterm-mouse-y y
)
273 (setq last-input-event event
)))))
276 (define-minor-mode xterm-mouse-mode
277 "Toggle XTerm mouse mode.
278 With a prefix argument ARG, enable XTerm mouse mode if ARG is
279 positive, and disable it otherwise. If called from Lisp, enable
280 the mode if ARG is omitted or nil.
282 Turn it on to use Emacs mouse commands, and off to use xterm mouse commands.
283 This works in terminal emulators compatible with xterm. It only
284 works for simple uses of the mouse. Basically, only non-modified
285 single clicks are supported. When turned on, the normal xterm
286 mouse functionality for such clicks is still available by holding
287 down the SHIFT key while pressing the mouse button."
288 :global t
:group
'mouse
289 (funcall (if xterm-mouse-mode
'add-hook
'remove-hook
)
290 'terminal-init-xterm-hook
291 'turn-on-xterm-mouse-tracking-on-terminal
)
295 (setq mouse-position-function
#'xterm-mouse-position-function
)
296 (mapc #'turn-on-xterm-mouse-tracking-on-terminal
(terminal-list)))
298 (mapc #'turn-off-xterm-mouse-tracking-on-terminal
(terminal-list))
299 (setq mouse-position-function nil
)))
301 (defconst xterm-mouse-tracking-enable-sequence
303 "Control sequence to enable xterm mouse tracking.
304 Enables basic tracking, then extended tracking on
305 terminals that support it.")
307 (defconst xterm-mouse-tracking-disable-sequence
309 "Reset the modes set by `xterm-mouse-tracking-enable-sequence'.")
311 (defun turn-on-xterm-mouse-tracking-on-terminal (&optional terminal
)
312 "Enable xterm mouse tracking on TERMINAL."
313 (when (and xterm-mouse-mode
(eq t
(terminal-live-p terminal
))
314 ;; Avoid the initial terminal which is not a termcap device.
315 ;; FIXME: is there more elegant way to detect the initial
317 (not (string= (terminal-name terminal
) "initial_terminal")))
318 (unless (terminal-parameter terminal
'xterm-mouse-mode
)
319 ;; Simulate selecting a terminal by selecting one of its frames
320 ;; so that we can set the terminal-local `input-decode-map'.
321 (with-selected-frame (car (frames-on-display-list terminal
))
322 (define-key input-decode-map
"\e[M" 'xterm-mouse-translate
)
323 (define-key input-decode-map
"\e[<" 'xterm-mouse-translate-extended
))
325 (send-string-to-terminal xterm-mouse-tracking-enable-sequence
327 ;; FIXME: This should use a dedicated error signal.
328 (error (if (equal (cadr err
) "Terminal is currently suspended")
329 nil
;The sequence will be sent upon resume.
330 (signal (car err
) (cdr err
)))))
331 (push xterm-mouse-tracking-enable-sequence
332 (terminal-parameter nil
'tty-mode-set-strings
))
333 (push xterm-mouse-tracking-disable-sequence
334 (terminal-parameter nil
'tty-mode-reset-strings
))
335 (set-terminal-parameter terminal
'xterm-mouse-mode t
))))
337 (defun turn-off-xterm-mouse-tracking-on-terminal (terminal)
338 "Disable xterm mouse tracking on TERMINAL."
339 ;; Only send the disable command to those terminals to which we've already
340 ;; sent the enable command.
341 (when (and (terminal-parameter terminal
'xterm-mouse-mode
)
342 (eq t
(terminal-live-p terminal
)))
343 ;; We could remove the key-binding and unset the `xterm-mouse-mode'
344 ;; terminal parameter, but it seems less harmful to send this escape
345 ;; command too many times (or to catch an unintended key sequence), than
346 ;; to send it too few times (or to fail to let xterm-mouse events
347 ;; pass by untranslated).
349 (send-string-to-terminal xterm-mouse-tracking-disable-sequence
351 ;; FIXME: This should use a dedicated error signal.
352 (error (if (equal (cadr err
) "Terminal is currently suspended")
354 (signal (car err
) (cdr err
)))))
355 (setf (terminal-parameter nil
'tty-mode-set-strings
)
356 (remq xterm-mouse-tracking-enable-sequence
357 (terminal-parameter nil
'tty-mode-set-strings
)))
358 (setf (terminal-parameter nil
'tty-mode-reset-strings
)
359 (remq xterm-mouse-tracking-disable-sequence
360 (terminal-parameter nil
'tty-mode-reset-strings
)))
361 (set-terminal-parameter terminal
'xterm-mouse-mode nil
)))
365 ;;; xt-mouse.el ends here