;;; xt-mouse.el --- support the mouse when emacs run in an xterm
-;; Copyright (C) 1994, 2000-2014 Free Software Foundation, Inc.
+;; Copyright (C) 1994, 2000-2015 Free Software Foundation, Inc.
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
;; Keywords: mouse, terminals
(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-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)
+ (let* ((event (xterm-mouse-event extension))
+ (ev-command (nth 0 event))
+ (ev-data (nth 1 event))
+ (ev-where (nth 1 ev-data))
+ (vec (vector event))
+ (is-down (string-match "down-" (symbol-name ev-command))))
+
+ ;; Mouse events symbols must have an 'event-kind property with
+ ;; the value 'mouse-click.
+ (when ev-command (put ev-command 'event-kind 'mouse-click))
+
+ (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)))))))))))))
+ (let ((drag (if (symbolp ev-where)
+ 0 ;FIXME: Why?!?
+ (list (intern (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.
;;
((not (string-match "down-" name))
;; For up events, make the up side match the down side.
(setq this-time last-time)
- (when (and (> click-count 1)
+ (when (and click-count (> click-count 1)
(string-match "down-" last-name)
(equal name (replace-match "" t t last-name)))
(xterm-mouse--set-click-count event click-count)))
"Enable xterm mouse tracking on TERMINAL."
(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?
+ ;; FIXME: is there more elegant way to detect the initial
+ ;; terminal?
(not (string= (terminal-name terminal) "initial_terminal")))
(unless (terminal-parameter terminal 'xterm-mouse-mode)
;; Simulate selecting a terminal by selecting one of its frames
(with-selected-frame (car (frames-on-display-list terminal))
(define-key input-decode-map "\e[M" 'xterm-mouse-translate)
(define-key input-decode-map "\e[<" 'xterm-mouse-translate-extended))
- (send-string-to-terminal xterm-mouse-tracking-enable-sequence terminal)
+ (condition-case err
+ (send-string-to-terminal xterm-mouse-tracking-enable-sequence
+ terminal)
+ ;; FIXME: This should use a dedicated error signal.
+ (error (if (equal (cadr err) "Terminal is currently suspended")
+ nil ;The sequence will be sent upon resume.
+ (signal (car err) (cdr err)))))
(push xterm-mouse-tracking-enable-sequence
(terminal-parameter nil 'tty-mode-set-strings))
(push xterm-mouse-tracking-disable-sequence
;; 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).
- (send-string-to-terminal xterm-mouse-tracking-disable-sequence terminal)
+ (condition-case err
+ (send-string-to-terminal xterm-mouse-tracking-disable-sequence
+ terminal)
+ ;; FIXME: This should use a dedicated error signal.
+ (error (if (equal (cadr err) "Terminal is currently suspended")
+ nil
+ (signal (car err) (cdr err)))))
(setf (terminal-parameter nil 'tty-mode-set-strings)
(remq xterm-mouse-tracking-enable-sequence
(terminal-parameter nil 'tty-mode-set-strings)))