;;; xt-mouse.el --- support the mouse when emacs run in an xterm ;; Copyright (C) 1994, 2000-2014 Free Software Foundation, Inc. ;; Author: Per Abrahamsen ;; Keywords: mouse, terminals ;; This file is part of GNU Emacs. ;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; 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. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs. If not, see . ;;; Commentary: ;; Enable mouse support when running inside an xterm. ;; 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. ;; 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. ;;; Todo: ;; Support multi-click -- somehow. ;;; Code: (defvar xterm-mouse-debug-buffer nil) ;; Mouse events symbols must have an 'event-kind property with ;; the value 'mouse-click. (dolist (event '(mouse-1 mouse-2 mouse-3 mouse-4 mouse-5)) (let ((M-event (intern (concat "M-" (symbol-name event))))) (put event 'event-kind 'mouse-click) (put M-event 'event-kind 'mouse-click))) (defun xterm-mouse-translate (_event) "Read a click and release event from XTerm." (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) (save-excursion (save-window-excursion ;FIXME: Why? (deactivate-mark) ;FIXME: Why? (let* ((event (xterm-mouse-event extension)) (ev-command (nth 0 event)) (ev-data (nth 1 event)) (ev-where (nth 1 ev-data)) (vec (if (and (symbolp ev-where) (consp ev-where)) ;; FIXME: This condition can *never* be non-nil!?! (vector (list ev-where ev-data) event) (vector event))) (is-down (string-match "down-" (symbol-name ev-command)))) (cond ((null event) nil) ;Unknown/bogus byte sequence! (is-down (setf (terminal-parameter nil 'xterm-mouse-last-down) event) vec) (t (let* ((down (terminal-parameter nil 'xterm-mouse-last-down)) (down-data (nth 1 down)) (down-where (nth 1 down-data))) (setf (terminal-parameter nil 'xterm-mouse-last-down) nil) (cond ((null down) ;; This is an "up-only" event. Pretend there was an up-event ;; right before and keep the up-event for later. (push event unread-command-events) (vector (cons (intern (replace-regexp-in-string "\\`\\([ACMHSs]-\\)*" "\\&down-" (symbol-name ev-command) t)) (cdr event)))) ((equal ev-where down-where) vec) (t (let ((drag (if (symbolp ev-where) 0 ;FIXME: Why?!? (list (replace-regexp-in-string "\\`\\([ACMHSs]-\\)*" "\\&drag-" (symbol-name ev-command) t) down-data ev-data)))) (if (null track-mouse) (vector drag) (push drag unread-command-events) (vector (list 'mouse-movement ev-data))))))))))))) ;; 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.") (defvar xt-mouse-epoch nil) ;; Indicator for the xterm-mouse mode. (defun xterm-mouse-position-function (pos) "Bound to `mouse-position-function' in XTerm mouse mode." (when (terminal-parameter nil 'xterm-mouse-x) (setcdr pos (cons (terminal-parameter nil 'xterm-mouse-x) (terminal-parameter nil 'xterm-mouse-y)))) pos) (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)))))) ;; Normal terminal mouse click reporting: expect three bytes, of the ;; form . Return a list (EVENT-TYPE X Y). (defun xterm-mouse--read-event-sequence-1000 () (let* ((code (- (read-event) 32)) (type ;; 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)) (format "M-down-mouse-%d" (- code 7))) ((memq code '(3 11)) (let ((down (car (terminal-parameter nil 'xterm-mouse-last-down)))) (when (and down (string-match "[0-9]" (symbol-name down))) (format (if (eq code 3) "mouse-%s" "M-mouse-%s") (match-string 0 (symbol-name down)))))) ((memq code '(0 1 2)) (format "down-mouse-%d" (+ 1 code))))) (x (- (read-event) 33)) (y (- (read-event) 33))) (and type (wholenump x) (wholenump y) (list (intern type) x y)))) ;; XTerm's 1006-mode terminal mouse click reporting has the form ;;