xt-mouse.el 9.22 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, 2001, 2002, 2003,
Glenn Morris's avatar
Glenn Morris committed
4
;;   2004, 2005, 2006, 2007 Free Software Foundation, Inc.
Richard M. Stallman's avatar
Richard M. Stallman committed
5

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

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

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

;; GNU Emacs is distributed in the hope that it will be useful,
Richard M. Stallman's avatar
Richard M. Stallman committed
17 18 19
;; 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
20

Richard M. Stallman's avatar
Richard M. Stallman committed
21
;; You should have received a copy of the GNU General Public License
Erik Naggum's avatar
Erik Naggum committed
22
;; along with GNU Emacs; see the file COPYING.  If not, write to the
Lute Kamstra's avatar
Lute Kamstra committed
23 24
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
Richard M. Stallman's avatar
Richard M. Stallman committed
25

Dave Love's avatar
Dave Love committed
26
;;; Commentary:
Richard M. Stallman's avatar
Richard M. Stallman committed
27

28
;; Enable mouse support when running inside an xterm.
Richard M. Stallman's avatar
Richard M. Stallman committed
29 30 31 32 33 34 35

;; 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
36 37 38 39
;; 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
40 41 42 43
;;; Todo:

;; Support multi-click -- somehow.

Dave Love's avatar
Dave Love committed
44
;;; Code:
Richard M. Stallman's avatar
Richard M. Stallman committed
45

46 47
(defvar xterm-mouse-debug-buffer nil)

48
;; XXX Perhaps this should be terminal-local instead. --lorentey
Richard M. Stallman's avatar
Richard M. Stallman committed
49 50
(define-key function-key-map "\e[M" 'xterm-mouse-translate)

51 52
(defvar xterm-mouse-last)

53 54
;; Mouse events symbols must have an 'event-kind property with
;; the value 'mouse-click.
55 56
(dolist (event-type '(mouse-1 mouse-2 mouse-3
			      M-down-mouse-1 M-down-mouse-2 M-down-mouse-3))
57 58
  (put event-type 'event-kind 'mouse-click))

Richard M. Stallman's avatar
Richard M. Stallman committed
59
(defun xterm-mouse-translate (event)
Dave Love's avatar
Dave Love committed
60
  "Read a click and release event from XTerm."
Richard M. Stallman's avatar
Richard M. Stallman committed
61 62 63
  (save-excursion
    (save-window-excursion
      (deactivate-mark)
64
      (let* ((xterm-mouse-last)
65 66 67 68 69 70
	     (down (xterm-mouse-event))
	     (down-command (nth 0 down))
	     (down-data (nth 1 down))
	     (down-where (nth 1 down-data))
	     (down-binding (key-binding (if (symbolp down-where)
					    (vector down-where down-command)
71 72
					  (vector down-command))))
	     (is-click (string-match "^mouse" (symbol-name (car down)))))
73

74 75 76 77 78 79 80
	(unless is-click
	  (unless (and (eq (read-char) ?\e)
		       (eq (read-char) ?\[)
		       (eq (read-char) ?M))
	    (error "Unexpected escape sequence from XTerm")))

	(let* ((click (if is-click down (xterm-mouse-event)))
81 82 83 84 85
	       (click-command (nth 0 click))
	       (click-data (nth 1 click))
	       (click-where (nth 1 click-data)))
	  (if (memq down-binding '(nil ignore))
	      (if (and (symbolp click-where)
86
		       (consp click-where))
87 88 89 90 91 92 93 94 95 96 97
		  (vector (list click-where click-data) click)
		(vector click))
	    (setq unread-command-events
		  (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
Dave Love's avatar
Dave Love committed
98 99
		       (list (intern (format "drag-mouse-%d"
					     (+ 1 xterm-mouse-last)))
100
			     down-data click-data)))))
101 102
	    (if xterm-mouse-debug-buffer
		(print unread-command-events xterm-mouse-debug-buffer))
103
	    (if (and (symbolp down-where)
104
		     (consp down-where))
105 106 107
		(vector (list down-where down-data) down)
	      (vector down))))))))

108 109 110 111 112 113 114
;; 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.")
115

Nick Roberts's avatar
Nick Roberts committed
116 117
(defvar xt-mouse-epoch nil)

118 119
;; Indicator for the xterm-mouse mode.

Dave Love's avatar
Dave Love committed
120 121
(defun xterm-mouse-position-function (pos)
  "Bound to `mouse-position-function' in XTerm mouse mode."
122 123 124
  (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
125
  pos)
Richard M. Stallman's avatar
Richard M. Stallman committed
126

127 128 129 130 131 132 133
;; read xterm sequences above ascii 127 (#x7f)
(defun xterm-mouse-event-read ()
  (let ((c (read-char)))
    (if (< c 0)
        (+ c #x8000000 128)
      c)))

134 135 136 137 138 139 140 141 142 143 144 145 146 147 148
(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))))))

Richard M. Stallman's avatar
Richard M. Stallman committed
149
(defun xterm-mouse-event ()
Dave Love's avatar
Dave Love committed
150
  "Convert XTerm mouse event to Emacs mouse event."
151 152 153
  (let* ((type (- (xterm-mouse-event-read) #o40))
	 (x (- (xterm-mouse-event-read) #o40 1))
	 (y (- (xterm-mouse-event-read) #o40 1))
Nick Roberts's avatar
Nick Roberts committed
154 155
	 ;; Emulate timestamp information.  This is accurate enough
	 ;; for default value of mouse-1-click-follows-link (450msec).
156 157 158 159 160 161
	 (timestamp (xterm-mouse-truncate-wrap
                     (* 1000
                        (- (float-time)
                           (or xt-mouse-epoch
                               (setq xt-mouse-epoch (float-time)))))))
         (mouse (intern
162 163 164 165 166 167
		 ;; For buttons > 3, the release-event looks
		 ;; differently (see xc/programs/xterm/button.c,
		 ;; function EditorButton), and there seems to come in
		 ;; a release-event only, no down-event.
		 (cond ((>= type 64)
			(format "mouse-%d" (- type 60)))
168 169 170 171 172
		       ((memq type '(8 9 10))
			(setq xterm-mouse-last type)
			(format "M-down-mouse-%d" (- type 7)))
		       ((= type 11)
			(format "mouse-%d" (- xterm-mouse-last 7)))
173 174 175 176
		       ((= type 3)
			(format "mouse-%d" (+ 1 xterm-mouse-last)))
		       (t
			(setq xterm-mouse-last type)
177
			(format "down-mouse-%d" (+ 1 type))))))
178 179 180 181 182
	 (w (window-at x y))
         (ltrb (window-edges w))
         (left (nth 0 ltrb))
         (top (nth 1 ltrb)))

183 184
    (set-terminal-parameter nil 'xterm-mouse-x x)
    (set-terminal-parameter nil 'xterm-mouse-y y)
185 186
    (setq
     last-input-event
187
     (list mouse
188 189 190
	   (let ((event (if w
			    (posn-at-x-y (- x left) (- y top) w t)
			  (append (list nil 'menu-bar)
191
				  (nthcdr 2 (posn-at-x-y x y))))))
192 193
	     (setcar (nthcdr 3 event) timestamp)
	     event)))))
Richard M. Stallman's avatar
Richard M. Stallman committed
194 195

;;;###autoload
196
(define-minor-mode xterm-mouse-mode
Richard M. Stallman's avatar
Richard M. Stallman committed
197
  "Toggle XTerm mouse mode.
198 199
With prefix arg, turn XTerm mouse mode on if arg is positive, otherwise turn
it off.
Richard M. Stallman's avatar
Richard M. Stallman committed
200

201
Turn it on to use Emacs mouse commands, and off to use xterm mouse commands.
202 203 204 205 206 207
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
208 209
  (if xterm-mouse-mode
      ;; Turn it on
210
      (progn
211 212 213 214 215
	(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
216 217

(defun turn-on-xterm-mouse-tracking ()
Dave Love's avatar
Dave Love committed
218
  "Enable Emacs mouse tracking in xterm."
219 220 221 222 223
  (dolist (f (frame-list))
    (when (eq t (frame-live-p f))
      (with-selected-frame f
	(when xterm-mouse-mode
	  (send-string-to-terminal "\e[?1000h"))))))
Richard M. Stallman's avatar
Richard M. Stallman committed
224

225
(defun turn-off-xterm-mouse-tracking (&optional force)
226
  "Disable Emacs mouse tracking in xterm."
227 228 229 230 231 232 233 234
  (dolist (f (frame-list))
    (when (eq t (frame-live-p f))
      (with-selected-frame f
	(when (or force xterm-mouse-mode)
	  (send-string-to-terminal "\e[?1000l"))))))

(defun turn-on-xterm-mouse-tracking-on-terminal (terminal)
  "Enable xterm mouse tracking on TERMINAL."
235
  (when (and xterm-mouse-mode (eq t (terminal-live-p terminal)))
236 237 238 239
    (send-string-to-terminal "\e[?1000h" terminal)))

(defun turn-off-xterm-mouse-tracking-on-terminal (terminal)
  "Disable xterm mouse tracking on TERMINAL."
240
  (when (and xterm-mouse-mode (eq t (terminal-live-p terminal)))
241 242 243 244 245
    (send-string-to-terminal "\e[?1000l" terminal)))

(defun xterm-mouse-handle-delete-frame (frame)
  "Turn off xterm mouse tracking if FRAME is the last frame on its device."
  (when (and (eq t (frame-live-p frame))
246
	     (<= 1 (length (frames-on-display-list (frame-terminal frame)))))
247 248 249 250 251
    (turn-off-xterm-mouse-tracking-on-terminal frame)))

;; Frame creation and deletion.
(add-hook 'after-make-frame-functions 'turn-on-xterm-mouse-tracking-on-terminal)
(add-hook 'delete-frame-functions 'xterm-mouse-handle-delete-frame)
Richard M. Stallman's avatar
Richard M. Stallman committed
252 253

;; Restore normal mouse behaviour outside Emacs.
254 255
(add-hook 'suspend-tty-functions 'turn-off-xterm-mouse-tracking-on-terminal)
(add-hook 'resume-tty-functions 'turn-on-xterm-mouse-tracking-on-terminal)
Richard M. Stallman's avatar
Richard M. Stallman committed
256 257 258 259 260 261
(add-hook 'suspend-hook 'turn-off-xterm-mouse-tracking)
(add-hook 'suspend-resume-hook 'turn-on-xterm-mouse-tracking)
(add-hook 'kill-emacs-hook 'turn-off-xterm-mouse-tracking)

(provide 'xt-mouse)

262
;; arch-tag: 84962d4e-fae9-4c13-a9d7-ef4925a4ac03
Richard M. Stallman's avatar
Richard M. Stallman committed
263
;;; xt-mouse.el ends here