lisp/xt-mouse.el

   1 ;;; xt-mouse.el --- support the mouse when emacs run in an xterm
   2
   3 ;; Copyright (C) 1994, 2000-2014 Free Software Foundation, Inc.
   4
   5 ;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
   6 ;; Keywords: mouse, terminals
   7
   8 ;; This file is part of GNU Emacs.
   9
  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.
  14
  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.
  19
  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/>.
  22
  23 ;;; Commentary:
  24
  25 ;; Enable mouse support when running inside an xterm.
  26
  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.
  29
  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.
  32
  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.
  36
  37 ;;; Todo:
  38
  39 ;; Support multi-click -- somehow.
  40
  41 ;;; Code:
  42
  43 (defvar xterm-mouse-debug-buffer nil)
  44
  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)))
  51
  52 (defun xterm-mouse-translate (_event)
  53   "Read a click and release event from XTerm."
  54   (xterm-mouse-translate-1))
  55
  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))
  62
  63 (defun xterm-mouse-translate-1 (&optional extension)
  64   (save-excursion
  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)
  74                     (vector event)))
  75              (is-down (string-match "down-" (symbol-name ev-command))))
  76
  77           (cond
  78          ((null event) nil)           ;Unknown/bogus byte sequence!
  79          (is-down
  80           (setf (terminal-parameter nil 'xterm-mouse-last-down) event)
  81           vec)
  82          (t
  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)
  87             (cond
  88              ((null down)
  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))
  95                             (cdr event))))
  96              ((equal ev-where down-where) vec)
  97            (t
  98               (let ((drag (if (symbolp ev-where)
  99                                  0      ;FIXME: Why?!?
 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)
 105                     (vector drag)
 106                   (push drag unread-command-events)
 107                   (vector (list 'mouse-movement ev-data)))))))))))))
 108
 109 ;; These two variables have been converted to terminal parameters.
 110 ;;
 111 ;;(defvar xterm-mouse-x 0
 112 ;;  "Position of last xterm mouse event relative to the frame.")
 113 ;;
 114 ;;(defvar xterm-mouse-y 0
 115 ;;  "Position of last xterm mouse event relative to the frame.")
 116
 117 (defvar xt-mouse-epoch nil)
 118
 119 ;; Indicator for the xterm-mouse mode.
 120
 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))))
 126   pos)
 127
 128 (defun xterm-mouse-truncate-wrap (f)
 129   "Truncate with wrap-around."
 130   (condition-case nil
 131       ;; First try the built-in truncate, in case there's no overflow.
 132       (truncate f)
 133     ;; In case of overflow, do wraparound by hand.
 134     (range-error
 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))))))
 142
 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))
 147          (type
 148           (intern
 149            ;; For buttons > 3, the release-event looks differently
 150            ;; (see xc/programs/xterm/button.c, function EditorButton),
 151            ;; and come in a release-event only, no down-event.
 152            (cond ((>= code 64)
 153                   (format "mouse-%d" (- code 60)))
 154                  ((memq code '(8 9 10))
 155                   (format "M-down-mouse-%d" (- code 7)))
 156                  ((memq code '(3 11))
 157                   (let ((down (car (terminal-parameter
 158                                     nil 'xterm-mouse-last-down))))
 159                     (when (and down (string-match "[0-9]" (symbol-name down)))
 160                       (format (if (eq code 3) "mouse-%s" "M-mouse-%s")
 161                               (match-string 0 (symbol-name down))))))
 162                  ((memq code '(0 1 2))
 163                   (format "down-mouse-%d" (+ 1 code))))))
 164          (x (- (read-event) 33))
 165          (y (- (read-event) 33)))
 166     (and type (wholenump x) (wholenump y)
 167          (list type x y))))
 168
 169 ;; XTerm's 1006-mode terminal mouse click reporting has the form
 170 ;; <BUTTON> ; <X> ; <Y> <M or m>, where the button and ordinates are
 171 ;; in encoded (decimal) form.  Return a list (EVENT-TYPE X Y).
 172 (defun xterm-mouse--read-event-sequence-1006 ()
 173   (let (button-bytes x-bytes y-bytes c)
 174     (while (not (eq (setq c (read-event)) ?\;))
 175       (push c button-bytes))
 176     (while (not (eq (setq c (read-event)) ?\;))
 177       (push c x-bytes))
 178     (while (not (memq (setq c (read-event)) '(?m ?M)))
 179       (push c y-bytes))
 180     (list (let* ((code (string-to-number
 181                         (apply 'string (nreverse button-bytes))))
 182                  (wheel (>= code 64))
 183                  (down (and (not wheel)
 184                             (eq c ?M))))
 185             (intern (format "%s%smouse-%d"
 186                             (cond (wheel "")
 187                                   ((< code 4)  "")
 188                                   ((< code 8)  "S-")
 189                                   ((< code 12) "M-")
 190                                   ((< code 16) "M-S-")
 191                                   ((< code 20) "C-")
 192                                   ((< code 24) "C-S-")
 193                                   ((< code 28) "C-M-")
 194                                   ((< code 32) "C-M-S-")
 195                                   (t
 196                                    (error "Unexpected escape sequence from XTerm")))
 197                             (if down "down-" "")
 198                             (if wheel
 199                                 (- code 60)
 200                               (1+ (mod code 4))))))
 201           (1- (string-to-number (apply 'string (nreverse x-bytes))))
 202           (1- (string-to-number (apply 'string (nreverse y-bytes)))))))
 203
 204 (defun xterm-mouse--set-click-count (event click-count)
 205   (setcdr (cdr event) (list click-count))
 206   (let ((name (symbol-name (car event))))
 207     (when (string-match "\\(.*?\\)\\(\\(?:down-\\)?mouse-.*\\)" name)
 208       (setcar event
 209               (intern (concat (match-string 1 name)
 210                               (if (= click-count 2)
 211                                   "double-" "triple-")
 212                               (match-string 2 name)))))))
 213
 214 (defun xterm-mouse-event (&optional extension)
 215   "Convert XTerm mouse event to Emacs mouse event.
 216 EXTENSION, if non-nil, means to use an extension to the usual
 217 terminal mouse protocol; we currently support the value 1006,
 218 which is the \"1006\" extension implemented in Xterm >= 277."
 219   (let* ((click (cond ((null extension)
 220                        (xterm-mouse--read-event-sequence-1000))
 221                       ((eq extension 1006)
 222                        (xterm-mouse--read-event-sequence-1006))
 223                       (t
 224                        (error "Unsupported XTerm mouse protocol")))))
 225     (when click
 226       (let* ((type (nth 0 click))
 227              (x    (nth 1 click))
 228              (y    (nth 2 click))
 229              ;; Emulate timestamp information.  This is accurate enough
 230              ;; for default value of mouse-1-click-follows-link (450msec).
 231              (timestamp (xterm-mouse-truncate-wrap
 232                          (* 1000
 233                             (- (float-time)
 234                                (or xt-mouse-epoch
 235                                    (setq xt-mouse-epoch (float-time)))))))
 236              (w (window-at x y))
 237              (ltrb (window-edges w))
 238              (left (nth 0 ltrb))
 239              (top (nth 1 ltrb))
 240              (posn (if w
 241                                 (posn-at-x-y (- x left) (- y top) w t)
 242                               (append (list nil 'menu-bar)
 243                              (nthcdr 2 (posn-at-x-y x y)))))
 244              (event (list type posn)))
 245         (setcar (nthcdr 3 posn) timestamp)
 246
 247         ;; Try to handle double/triple clicks.
 248         (let* ((last-click (terminal-parameter nil 'xterm-mouse-last-click))
 249                (last-type (nth 0 last-click))
 250                (last-name (symbol-name last-type))
 251                (last-time (nth 1 last-click))
 252                (click-count (nth 2 last-click))
 253                (this-time (float-time))
 254                (name (symbol-name type)))
 255           (cond
 256            ((not (string-match "down-" name))
 257             ;; For up events, make the up side match the down side.
 258             (setq this-time last-time)
 259             (when (and (> click-count 1)
 260                        (string-match "down-" last-name)
 261                        (equal name (replace-match "" t t last-name)))
 262               (xterm-mouse--set-click-count event click-count)))
 263            ((not last-time) nil)
 264            ((and (> double-click-time (* 1000 (- this-time last-time)))
 265                  (equal last-name (replace-match "" t t name)))
 266             (setq click-count (1+ click-count))
 267             (xterm-mouse--set-click-count event click-count))
 268            (t (setq click-count 1)))
 269           (set-terminal-parameter nil 'xterm-mouse-last-click
 270                                   (list type this-time click-count)))
 271
 272         (set-terminal-parameter nil 'xterm-mouse-x x)
 273         (set-terminal-parameter nil 'xterm-mouse-y y)
 274         (setq last-input-event event)))))
 275
 276 ;;;###autoload
 277 (define-minor-mode xterm-mouse-mode
 278   "Toggle XTerm mouse mode.
 279 With a prefix argument ARG, enable XTerm mouse mode if ARG is
 280 positive, and disable it otherwise.  If called from Lisp, enable
 281 the mode if ARG is omitted or nil.
 282
 283 Turn it on to use Emacs mouse commands, and off to use xterm mouse commands.
 284 This works in terminal emulators compatible with xterm.  It only
 285 works for simple uses of the mouse.  Basically, only non-modified
 286 single clicks are supported.  When turned on, the normal xterm
 287 mouse functionality for such clicks is still available by holding
 288 down the SHIFT key while pressing the mouse button."
 289   :global t :group 'mouse
 290   (funcall (if xterm-mouse-mode 'add-hook 'remove-hook)
 291            'terminal-init-xterm-hook
 292            'turn-on-xterm-mouse-tracking-on-terminal)
 293   (if xterm-mouse-mode
 294       ;; Turn it on
 295       (progn
 296         (setq mouse-position-function #'xterm-mouse-position-function)
 297         (mapc #'turn-on-xterm-mouse-tracking-on-terminal (terminal-list)))
 298     ;; Turn it off
 299     (mapc #'turn-off-xterm-mouse-tracking-on-terminal (terminal-list))
 300     (setq mouse-position-function nil)))
 301
 302 (defconst xterm-mouse-tracking-enable-sequence
 303   "\e[?1000h\e[?1006h"
 304   "Control sequence to enable xterm mouse tracking.
 305 Enables basic tracking, then extended tracking on
 306 terminals that support it.")
 307
 308 (defconst xterm-mouse-tracking-disable-sequence
 309   "\e[?1006l\e[?1000l"
 310   "Reset the modes set by `xterm-mouse-tracking-enable-sequence'.")
 311
 312 (defun turn-on-xterm-mouse-tracking-on-terminal (&optional terminal)
 313   "Enable xterm mouse tracking on TERMINAL."
 314   (when (and xterm-mouse-mode (eq t (terminal-live-p terminal))
 315              ;; Avoid the initial terminal which is not a termcap device.
 316              ;; FIXME: is there more elegant way to detect the initial terminal?
 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))
 324       (send-string-to-terminal xterm-mouse-tracking-enable-sequence terminal)
 325       (push xterm-mouse-tracking-enable-sequence
 326             (terminal-parameter nil 'tty-mode-set-strings))
 327       (push xterm-mouse-tracking-disable-sequence
 328             (terminal-parameter nil 'tty-mode-reset-strings))
 329       (set-terminal-parameter terminal 'xterm-mouse-mode t))))
 330
 331 (defun turn-off-xterm-mouse-tracking-on-terminal (terminal)
 332   "Disable xterm mouse tracking on TERMINAL."
 333   ;; Only send the disable command to those terminals to which we've already
 334   ;; sent the enable command.
 335   (when (and (terminal-parameter terminal 'xterm-mouse-mode)
 336              (eq t (terminal-live-p terminal)))
 337     ;; We could remove the key-binding and unset the `xterm-mouse-mode'
 338     ;; terminal parameter, but it seems less harmful to send this escape
 339     ;; command too many times (or to catch an unintended key sequence), than
 340     ;; to send it too few times (or to fail to let xterm-mouse events
 341     ;; pass by untranslated).
 342     (send-string-to-terminal xterm-mouse-tracking-disable-sequence terminal)
 343     (setf (terminal-parameter nil 'tty-mode-set-strings)
 344           (remq xterm-mouse-tracking-enable-sequence
 345                 (terminal-parameter nil 'tty-mode-set-strings)))
 346     (setf (terminal-parameter nil 'tty-mode-reset-strings)
 347           (remq xterm-mouse-tracking-disable-sequence
 348                 (terminal-parameter nil 'tty-mode-reset-strings)))
 349     (set-terminal-parameter terminal 'xterm-mouse-mode nil)))
 350
 351 (provide 'xt-mouse)
 352
 353 ;;; xt-mouse.el ends here