xt-mouse.el 6.52 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 Free Software Foundation
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 10
;; 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
11 12 13
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, 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
Erik Naggum's avatar
Erik Naggum committed
21 22 23
;; along with GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
Richard M. Stallman's avatar
Richard M. Stallman committed
24

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

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

;; 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
35 36 37 38 39 40 41
;; The xterm mouse escape codes are supposedly also supported by the
;; Linux console, but I have not been able to verify this.

;; 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
42 43 44 45 46 47
;;; Todo:

;; Support multi-click -- somehow.

;; Clicking on the mode-line does not work, although it should.

Dave Love's avatar
Dave Love committed
48
;;; Code:
Richard M. Stallman's avatar
Richard M. Stallman committed
49 50 51

(define-key function-key-map "\e[M" 'xterm-mouse-translate)

52 53
(defvar xterm-mouse-last)

Richard M. Stallman's avatar
Richard M. Stallman committed
54
(defun xterm-mouse-translate (event)
Dave Love's avatar
Dave Love committed
55
  "Read a click and release event from XTerm."
Richard M. Stallman's avatar
Richard M. Stallman committed
56 57 58
  (save-excursion
    (save-window-excursion
      (deactivate-mark)
59
      (let* ((xterm-mouse-last)
60 61 62 63 64 65
	     (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)
66 67 68 69 70 71 72 73 74 75
					  (vector down-command))))
	     (is-click (string-match "^mouse" (symbol-name (car down)))))
	    
	(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)))
76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92
	       (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)
		       (not (eq 'menu-bar click-where)))
		  (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
93 94
		       (list (intern (format "drag-mouse-%d"
					     (+ 1 xterm-mouse-last)))
95 96 97 98 99 100 101 102 103 104 105 106 107
			     down-data click-data))
		     )))
	    (if (and (symbolp down-where)
		     (not (eq 'menu-bar down-where)))
		(vector (list down-where down-data) down)
	      (vector down))))))))

(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.")

108 109 110
;; Indicator for the xterm-mouse mode.
(defvar xterm-mouse-mode nil)

Dave Love's avatar
Dave Love committed
111 112 113 114
(defun xterm-mouse-position-function (pos)
  "Bound to `mouse-position-function' in XTerm mouse mode."
  (setcdr pos (cons xterm-mouse-x xterm-mouse-y))
  pos)
Richard M. Stallman's avatar
Richard M. Stallman committed
115 116

(defun xterm-mouse-event ()
Dave Love's avatar
Dave Love committed
117
  "Convert XTerm mouse event to Emacs mouse event."
118 119 120
  (let* ((type (- (read-char) #o40))
	 (x (- (read-char) #o40 1))
	 (y (- (read-char) #o40 1))
Richard M. Stallman's avatar
Richard M. Stallman committed
121 122
	 (point (cons x y))
	 (window (window-at x y))
Dave Love's avatar
Dave Love committed
123
	 (where (if window
124 125
		    (coordinates-in-window-p point window)
		  'menu-bar))
Richard M. Stallman's avatar
Richard M. Stallman committed
126 127 128 129
	 (pos (if (consp where)
		  (progn
		    (select-window window)
		    (goto-char (window-start window))
130 131 132 133 134 135
		    (move-to-window-line (-
					  (cdr where)
					  (if (or header-line-format
						  default-header-line-format)
					      1
					    0)))
Richard M. Stallman's avatar
Richard M. Stallman committed
136
		    (move-to-column (+ (car where) (current-column)
137 138 139 140
				       (if (string-match "\\` \\*Minibuf"
							 (buffer-name))
					   (- (minibuffer-prompt-width))
					 0)
Richard M. Stallman's avatar
Richard M. Stallman committed
141 142 143
				       (max 0 (1- (window-hscroll)))))
		    (point))
		where))
144 145 146 147 148 149 150 151 152 153 154 155
	 (mouse (intern 
		 ;; 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)))
		       ((= type 3)
			(format "mouse-%d" (+ 1 xterm-mouse-last)))
		       (t
			(setq xterm-mouse-last type)
			(format "down-mouse-%d" (+ 1 type)))))))
156 157
    (setq xterm-mouse-x x
	  xterm-mouse-y y)
Richard M. Stallman's avatar
Richard M. Stallman committed
158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178
    (list mouse
	  (list window pos point
		(/ (nth 2 (current-time)) 1000)))))

(or (assq 'xterm-mouse-mode minor-mode-alist)
    (setq minor-mode-alist
	  (cons '(xterm-mouse-mode (" Mouse")) minor-mode-alist)))

;;;###autoload
(defun xterm-mouse-mode (arg)
  "Toggle XTerm mouse mode.
With prefix arg, turn XTerm mouse mode on iff arg is positive.

Turn it on to use emacs mouse commands, and off to use xterm mouse commands."
  (interactive "P")
  (if (or (and (null arg) xterm-mouse-mode)
	  (<= (prefix-numeric-value arg) 0))
      ;; Turn it off
      (if xterm-mouse-mode
	  (progn
	    (turn-off-xterm-mouse-tracking)
Dave Love's avatar
Dave Love committed
179 180
	    (setq xterm-mouse-mode nil
		  mouse-position-function nil)
Richard M. Stallman's avatar
Richard M. Stallman committed
181 182
	    (set-buffer-modified-p (buffer-modified-p))))
    ;;Turn it on
Dave Love's avatar
Dave Love committed
183
    (unless (or window-system xterm-mouse-mode)
Dave Love's avatar
Dave Love committed
184 185
      (setq xterm-mouse-mode t
	    mouse-position-function #'xterm-mouse-position-function)
Richard M. Stallman's avatar
Richard M. Stallman committed
186 187 188 189
      (turn-on-xterm-mouse-tracking)
      (set-buffer-modified-p (buffer-modified-p)))))

(defun turn-on-xterm-mouse-tracking ()
Dave Love's avatar
Dave Love committed
190
  "Enable Emacs mouse tracking in xterm."
Richard M. Stallman's avatar
Richard M. Stallman committed
191 192 193 194
  (if xterm-mouse-mode
      (send-string-to-terminal "\e[?1000h")))

(defun turn-off-xterm-mouse-tracking ()
195
  "Disable Emacs mouse tracking in xterm."
Richard M. Stallman's avatar
Richard M. Stallman committed
196 197 198 199 200 201 202 203 204 205 206
  (if xterm-mouse-mode
      (send-string-to-terminal "\e[?1000l")))

;; Restore normal mouse behaviour outside Emacs.
(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)

;;; xt-mouse.el ends here