xt-mouse.el 12.6 KB
Newer Older
1
;;; xt-mouse.el --- support the mouse when emacs run in an xterm
Erik Naggum's avatar
Erik Naggum committed
2

3
;; Copyright (C) 1994, 2000-2013 Free Software Foundation, Inc.
Richard M. Stallman's avatar
Richard M. Stallman committed
4

Per Abrahamsen's avatar
Per Abrahamsen committed
5
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
Richard M. Stallman's avatar
Richard M. Stallman committed
6 7
;; Keywords: mouse, terminals

Erik Naggum's avatar
Erik Naggum committed
8 9
;; This file is part of GNU Emacs.

10
;; GNU Emacs is free software: you can redistribute it and/or modify
Richard M. Stallman's avatar
Richard M. Stallman committed
11
;; it under the terms of the GNU General Public License as published by
12 13
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
Erik Naggum's avatar
Erik Naggum committed
14 15

;; GNU Emacs is distributed in the hope that it will be useful,
Richard M. Stallman's avatar
Richard M. Stallman committed
16 17 18
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.
Erik Naggum's avatar
Erik Naggum committed
19

Richard M. Stallman's avatar
Richard M. Stallman committed
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/>.
Richard M. Stallman's avatar
Richard M. Stallman committed
22

Dave Love's avatar
Dave Love committed
23
;;; Commentary:
Richard M. Stallman's avatar
Richard M. Stallman committed
24

25
;; Enable mouse support when running inside an xterm.
Richard M. Stallman's avatar
Richard M. Stallman committed
26 27 28 29 30 31 32

;; This is actually useful when you are running X11 locally, but is
;; working on remote machine over a modem line or through a gateway.

;; It works by translating xterm escape codes into generic emacs mouse
;; events so it should work with any package that uses the mouse.

Richard M. Stallman's avatar
Richard M. Stallman committed
33 34 35 36
;; You don't have to turn off xterm mode to use the normal xterm mouse
;; functionality, it is still available by holding down the SHIFT key
;; when you press the mouse button.

Richard M. Stallman's avatar
Richard M. Stallman committed
37 38 39 40
;;; Todo:

;; Support multi-click -- somehow.

Dave Love's avatar
Dave Love committed
41
;;; Code:
Richard M. Stallman's avatar
Richard M. Stallman committed
42

43 44
(defvar xterm-mouse-debug-buffer nil)

45 46
(defvar xterm-mouse-last)

47 48
;; Mouse events symbols must have an 'event-kind property with
;; the value 'mouse-click.
49
(dolist (event-type '(mouse-1 mouse-2 mouse-3
50
		      M-down-mouse-1 M-down-mouse-2 M-down-mouse-3))
51 52
  (put event-type 'event-kind 'mouse-click))

53
(defun xterm-mouse-translate (_event)
Dave Love's avatar
Dave Love committed
54
  "Read a click and release event from XTerm."
55 56 57 58 59 60 61 62 63 64
  (xterm-mouse-translate-1))

(defun xterm-mouse-translate-extended (_event)
  "Read a click and release event from XTerm.
Similar to `xterm-mouse-translate', but using the \"1006\"
extension, which supports coordinates >= 231 (see
http://invisible-island.net/xterm/ctlseqs/ctlseqs.html)."
  (xterm-mouse-translate-1 1006))

(defun xterm-mouse-translate-1 (&optional extension)
Richard M. Stallman's avatar
Richard M. Stallman committed
65 66 67
  (save-excursion
    (save-window-excursion
      (deactivate-mark)
68 69
      (let* ((xterm-mouse-last nil)
	     (down (xterm-mouse-event extension))
70
	     (down-command (nth 0 down))
71 72
	     (down-data    (nth 1 down))
	     (down-where   (nth 1 down-data))
73 74
	     (down-binding (key-binding (if (symbolp down-where)
					    (vector down-where down-command)
75 76
					  (vector down-command))))
	     (is-click (string-match "^mouse" (symbol-name (car down)))))
77

78
	;; Retrieve the expected preface for the up-event.
79
	(unless is-click
80
	  (unless (cond ((null extension)
Stefan Monnier's avatar
Stefan Monnier committed
81 82 83
			 (and (eq (read-event) ?\e)
			      (eq (read-event) ?\[)
			      (eq (read-event) ?M)))
84
			((eq extension 1006)
Stefan Monnier's avatar
Stefan Monnier committed
85 86 87
			 (and (eq (read-event) ?\e)
			      (eq (read-event) ?\[)
			      (eq (read-event) ?<))))
88 89
	    (error "Unexpected escape sequence from XTerm")))

90 91 92
	;; Process the up-event.
	(let* ((click (if is-click down (xterm-mouse-event extension)))
	       (click-data  (nth 1 click))
93 94 95
	       (click-where (nth 1 click-data)))
	  (if (memq down-binding '(nil ignore))
	      (if (and (symbolp click-where)
96
		       (consp click-where))
97 98 99
		  (vector (list click-where click-data) click)
		(vector click))
	    (setq unread-command-events
100 101 102 103 104 105 106 107 108 109 110 111
		  (append (if (eq down-where click-where)
			      (list click)
			    (list
			     ;; Cheat `mouse-drag-region' with move event.
			     (list 'mouse-movement click-data)
			     ;; Generate a drag event.
			     (if (symbolp down-where)
				 0
			       (list (intern (format "drag-mouse-%d"
						     (1+ xterm-mouse-last)))
				     down-data click-data))))
			  unread-command-events))
112 113
	    (if xterm-mouse-debug-buffer
		(print unread-command-events xterm-mouse-debug-buffer))
114
	    (if (and (symbolp down-where)
115
		     (consp down-where))
116 117 118
		(vector (list down-where down-data) down)
	      (vector down))))))))

119 120 121 122 123 124 125
;; These two variables have been converted to terminal parameters.
;;
;;(defvar xterm-mouse-x 0
;;  "Position of last xterm mouse event relative to the frame.")
;;
;;(defvar xterm-mouse-y 0
;;  "Position of last xterm mouse event relative to the frame.")
126

Nick Roberts's avatar
Nick Roberts committed
127 128
(defvar xt-mouse-epoch nil)

129 130
;; Indicator for the xterm-mouse mode.

Dave Love's avatar
Dave Love committed
131 132
(defun xterm-mouse-position-function (pos)
  "Bound to `mouse-position-function' in XTerm mouse mode."
133 134 135
  (when (terminal-parameter nil 'xterm-mouse-x)
    (setcdr pos (cons (terminal-parameter nil 'xterm-mouse-x)
		      (terminal-parameter nil 'xterm-mouse-y))))
Dave Love's avatar
Dave Love committed
136
  pos)
Richard M. Stallman's avatar
Richard M. Stallman committed
137

138 139 140 141 142 143 144 145 146 147 148 149 150 151 152
(defun xterm-mouse-truncate-wrap (f)
  "Truncate with wrap-around."
  (condition-case nil
      ;; First try the built-in truncate, in case there's no overflow.
      (truncate f)
    ;; In case of overflow, do wraparound by hand.
    (range-error
     ;; In our case, we wrap around every 3 days or so, so if we assume
     ;; a maximum of 65536 wraparounds, we're safe for a couple years.
     ;; Using a power of 2 makes rounding errors less likely.
     (let* ((maxwrap (* 65536 2048))
            (dbig (truncate (/ f maxwrap)))
            (fdiff (- f (* 1.0 maxwrap dbig))))
       (+ (truncate fdiff) (* maxwrap dbig))))))

153 154 155
;; Normal terminal mouse click reporting: expect three bytes, of the
;; form <BUTTON+32> <X+32> <Y+32>.  Return a list (EVENT-TYPE X Y).
(defun xterm-mouse--read-event-sequence-1000 ()
156
  (list (let ((code (- (read-event) 32)))
157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176
	  (intern
	   ;; For buttons > 3, the release-event looks differently
	   ;; (see xc/programs/xterm/button.c, function EditorButton),
	   ;; and come in a release-event only, no down-event.
	   (cond ((>= code 64)
		  (format "mouse-%d" (- code 60)))
		 ((memq code '(8 9 10))
		  (setq xterm-mouse-last code)
		  (format "M-down-mouse-%d" (- code 7)))
		 ((= code 11)
		  (format "M-mouse-%d" (- xterm-mouse-last 7)))
		 ((= code 3)
		  ;; For buttons > 5 xterm only reports a
		  ;; button-release event.  Avoid error by mapping
		  ;; them all to mouse-1.
		  (format "mouse-%d" (+ 1 (or xterm-mouse-last 0))))
		 (t
		  (setq xterm-mouse-last code)
		  (format "down-mouse-%d" (+ 1 code))))))
	;; x and y coordinates
177 178
	(- (read-event) 33)
	(- (read-event) 33)))
179 180 181 182 183 184

;; XTerm's 1006-mode terminal mouse click reporting has the form
;; <BUTTON> ; <X> ; <Y> <M or m>, where the button and ordinates are
;; in encoded (decimal) form.  Return a list (EVENT-TYPE X Y).
(defun xterm-mouse--read-event-sequence-1006 ()
  (let (button-bytes x-bytes y-bytes c)
185
    (while (not (eq (setq c (read-event)) ?\;))
186
      (push c button-bytes))
187
    (while (not (eq (setq c (read-event)) ?\;))
188
      (push c x-bytes))
189
    (while (not (memq (setq c (read-event)) '(?m ?M)))
190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228
      (push c y-bytes))
    (list (let* ((code (string-to-number
			(apply 'string (nreverse button-bytes))))
		 (wheel (>= code 64))
		 (down (and (not wheel)
			    (eq c ?M))))
	    (intern (format "%s%smouse-%d"
			    (cond (wheel "")
				  ((< code 4)  "")
				  ((< code 8)  "S-")
				  ((< code 12) "M-")
				  ((< code 16) "M-S-")
				  ((< code 20) "C-")
				  ((< code 24) "C-S-")
				  ((< code 28) "C-M-")
				  ((< code 32) "C-M-S-")
				  (t
				   (error "Unexpected escape sequence from XTerm")))
			    (if down "down-" "")
			    (if wheel
				(- code 60)
			      (1+ (setq xterm-mouse-last (mod code 4)))))))
	  (1- (string-to-number (apply 'string (nreverse x-bytes))))
	  (1- (string-to-number (apply 'string (nreverse y-bytes)))))))

(defun xterm-mouse-event (&optional extension)
  "Convert XTerm mouse event to Emacs mouse event.
EXTENSION, if non-nil, means to use an extension to the usual
terminal mouse protocol; we currently support the value 1006,
which is the \"1006\" extension implemented in Xterm >= 277."
  (let* ((click (cond ((null extension)
		       (xterm-mouse--read-event-sequence-1000))
		      ((eq extension 1006)
		       (xterm-mouse--read-event-sequence-1006))
		      (t
		       (error "Unsupported XTerm mouse protocol"))))
	 (type (nth 0 click))
	 (x    (nth 1 click))
	 (y    (nth 2 click))
Nick Roberts's avatar
Nick Roberts committed
229 230
	 ;; Emulate timestamp information.  This is accurate enough
	 ;; for default value of mouse-1-click-follows-link (450msec).
231 232 233 234 235
	 (timestamp (xterm-mouse-truncate-wrap
                     (* 1000
                        (- (float-time)
                           (or xt-mouse-epoch
                               (setq xt-mouse-epoch (float-time)))))))
236 237 238 239
	 (w (window-at x y))
         (ltrb (window-edges w))
         (left (nth 0 ltrb))
         (top (nth 1 ltrb)))
240 241
    (set-terminal-parameter nil 'xterm-mouse-x x)
    (set-terminal-parameter nil 'xterm-mouse-y y)
242 243
    (setq
     last-input-event
244
     (list type
245 246 247
	   (let ((event (if w
			    (posn-at-x-y (- x left) (- y top) w t)
			  (append (list nil 'menu-bar)
248
				  (nthcdr 2 (posn-at-x-y x y))))))
249 250
	     (setcar (nthcdr 3 event) timestamp)
	     event)))))
Richard M. Stallman's avatar
Richard M. Stallman committed
251 252

;;;###autoload
253
(define-minor-mode xterm-mouse-mode
Richard M. Stallman's avatar
Richard M. Stallman committed
254
  "Toggle XTerm mouse mode.
255 256 257
With a prefix argument ARG, enable XTerm mouse mode if ARG is
positive, and disable it otherwise.  If called from Lisp, enable
the mode if ARG is omitted or nil.
Richard M. Stallman's avatar
Richard M. Stallman committed
258

259
Turn it on to use Emacs mouse commands, and off to use xterm mouse commands.
260 261 262 263 264 265
This works in terminal emulators compatible with xterm.  It only
works for simple uses of the mouse.  Basically, only non-modified
single clicks are supported.  When turned on, the normal xterm
mouse functionality for such clicks is still available by holding
down the SHIFT key while pressing the mouse button."
  :global t :group 'mouse
266 267 268 269 270 271 272 273 274 275 276 277
  (let ((do-hook (if xterm-mouse-mode 'add-hook 'remove-hook)))
    (funcall do-hook 'terminal-init-xterm-hook
             'turn-on-xterm-mouse-tracking-on-terminal)
    (funcall do-hook 'delete-terminal-functions
             'turn-off-xterm-mouse-tracking-on-terminal)
    (funcall do-hook 'suspend-tty-functions
             'turn-off-xterm-mouse-tracking-on-terminal)
    (funcall do-hook 'resume-tty-functions
             'turn-on-xterm-mouse-tracking-on-terminal)
    (funcall do-hook 'suspend-hook 'turn-off-xterm-mouse-tracking)
    (funcall do-hook 'suspend-resume-hook 'turn-on-xterm-mouse-tracking)
    (funcall do-hook 'kill-emacs-hook 'turn-off-xterm-mouse-tracking))
278 279
  (if xterm-mouse-mode
      ;; Turn it on
280
      (progn
281 282 283 284 285
	(setq mouse-position-function #'xterm-mouse-position-function)
	(turn-on-xterm-mouse-tracking))
    ;; Turn it off
    (turn-off-xterm-mouse-tracking 'force)
    (setq mouse-position-function nil)))
Richard M. Stallman's avatar
Richard M. Stallman committed
286 287

(defun turn-on-xterm-mouse-tracking ()
Dave Love's avatar
Dave Love committed
288
  "Enable Emacs mouse tracking in xterm."
289
  (dolist (terminal (terminal-list))
290
    (turn-on-xterm-mouse-tracking-on-terminal terminal)))
Richard M. Stallman's avatar
Richard M. Stallman committed
291

292
(defun turn-off-xterm-mouse-tracking (&optional _force)
293
  "Disable Emacs mouse tracking in xterm."
294
  (dolist (terminal (terminal-list))
295
    (turn-off-xterm-mouse-tracking-on-terminal terminal)))
296

297
(defun turn-on-xterm-mouse-tracking-on-terminal (&optional terminal)
298
  "Enable xterm mouse tracking on TERMINAL."
299 300 301 302
  (when (and xterm-mouse-mode (eq t (terminal-live-p terminal))
	     ;; Avoid the initial terminal which is not a termcap device.
	     ;; FIXME: is there more elegant way to detect the initial terminal?
	     (not (string= (terminal-name terminal) "initial_terminal")))
303
    (unless (terminal-parameter terminal 'xterm-mouse-mode)
304
      ;; Simulate selecting a terminal by selecting one of its frames
305
      (with-selected-frame (car (frames-on-display-list terminal))
306 307
        (define-key input-decode-map "\e[M" 'xterm-mouse-translate)
        (define-key input-decode-map "\e[<" 'xterm-mouse-translate-extended))
308
      (set-terminal-parameter terminal 'xterm-mouse-mode t))
309 310 311
    (send-string-to-terminal "\e[?1000h" terminal)
    ;; Request extended mouse support, if available (xterm >= 277).
    (send-string-to-terminal "\e[?1006h" terminal)))
312 313 314

(defun turn-off-xterm-mouse-tracking-on-terminal (terminal)
  "Disable xterm mouse tracking on TERMINAL."
315 316 317
  ;; Only send the disable command to those terminals to which we've already
  ;; sent the enable command.
  (when (and (terminal-parameter terminal 'xterm-mouse-mode)
318 319 320 321
             (eq t (terminal-live-p terminal))
	     ;; Avoid the initial terminal which is not a termcap device.
	     ;; FIXME: is there more elegant way to detect the initial terminal?
	     (not (string= (terminal-name terminal) "initial_terminal")))
322 323 324 325 326
    ;; We could remove the key-binding and unset the `xterm-mouse-mode'
    ;; terminal parameter, but it seems less harmful to send this escape
    ;; command too many times (or to catch an unintended key sequence), than
    ;; to send it too few times (or to fail to let xterm-mouse events
    ;; pass by untranslated).
327 328
    (send-string-to-terminal "\e[?1000l" terminal)
    (send-string-to-terminal "\e[?1006l" terminal)))
329

Richard M. Stallman's avatar
Richard M. Stallman committed
330 331 332
(provide 'xt-mouse)

;;; xt-mouse.el ends here