From: Philipp Stephani Date: Fri, 25 Mar 2016 10:17:38 +0000 (+0300) Subject: Add customization option for using UTF-8 coordinates in xt-mouse X-Git-Tag: emacs-25.0.93~89^2~16 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=90fb9b38dd4a386a71cdf7c3bf6b42292db43c42;p=emacs.git Add customization option for using UTF-8 coordinates in xt-mouse * lisp/xt-mouse.el (xterm-mouse-utf-8): New customization option. (xterm-mouse--read-coordinate): New function to replace `xterm-mouse--read-utf8-char'; uses UTF-8 only if enabled. (xterm-mouse--read-number-from-terminal): Adapt to new name. (xterm-mouse-tracking-enable-sequence) (xterm-mouse-tracking-disable-sequence): Replace constants with functions, mark constants as obsolete. (xterm-mouse--tracking-sequence): New helper function. (turn-on-xterm-mouse-tracking-on-terminal): Use new functions; enable UTF-8 only if customization option says so; store UTF-8 flag in terminal parameter. (Bug#23009) * test/automated/xt-mouse-tests.el: Add tests for xt-mouse.el. --- diff --git a/lisp/xt-mouse.el b/lisp/xt-mouse.el index 5975e60272f..b6738b21cb0 100644 --- a/lisp/xt-mouse.el +++ b/lisp/xt-mouse.el @@ -134,23 +134,34 @@ http://invisible-island.net/xterm/ctlseqs/ctlseqs.html)." (fdiff (- f (* 1.0 maxwrap dbig)))) (+ (truncate fdiff) (* maxwrap dbig)))))) -(defun xterm-mouse--read-utf8-char (&optional prompt seconds) - "Read an utf-8 encoded character from the current terminal. -This function reads and returns an utf-8 encoded character of -command input. If the user generates an event which is not a -character (i.e., a mouse click or function key event), read-char -signals an error. - -The returned event may come directly from the user, or from a -keyboard macro. It is not decoded by the keyboard's input coding -system and always treated with an utf-8 input encoding. - -The optional arguments PROMPT and SECONDS work like in -`read-event'." - (let ((tmp (keyboard-coding-system))) - (set-keyboard-coding-system 'utf-8) - (prog1 (read-event prompt t seconds) - (set-keyboard-coding-system tmp)))) +(defcustom xterm-mouse-utf-8 nil + "Non-nil if UTF-8 coordinates should be used to read mouse coordinates. +Set this to non-nil if you are sure that your terminal +understands UTF-8 coordinates, but not SGR coordinates." + :type 'boolean + :risky t + :group 'xterm) + +(defun xterm-mouse--read-coordinate () + "Read a mouse coordinate from the current terminal. +If `xterm-mouse-utf-8' was non-nil when +`turn-on-xterm-mouse-tracking-on-terminal' was called, reads the +coordinate as an UTF-8 code unit sequence; otherwise, reads a +single byte." + (let ((previous-keyboard-coding-system (keyboard-coding-system))) + (unwind-protect + (progn + (set-keyboard-coding-system + (if (terminal-parameter nil 'xterm-mouse-utf-8) + 'utf-8-unix + ;; Use Latin-1 instead of no-conversion to avoid flicker + ;; due to `set-keyboard-coding-system' changing the meta + ;; mode. + 'latin-1)) + ;; Wait only a little; we assume that the entire escape sequence + ;; has already been sent when this function is called. + (read-char nil nil 0.1)) + (set-keyboard-coding-system previous-keyboard-coding-system)))) ;; In default mode, each numeric parameter of XTerm's mouse report is ;; a single char, possibly encoded as utf-8. The actual numeric @@ -170,7 +181,7 @@ The optional arguments PROMPT and SECONDS work like in (<= ?0 c ?9)) (setq n (+ (* 10 n) c (- ?0)))) (cons n c)) - (cons (- (setq c (xterm-mouse--read-utf8-char)) 32) c)))) + (cons (- (setq c (xterm-mouse--read-coordinate)) 32) c)))) ;; XTerm reports mouse events as ;; in default mode, and @@ -314,6 +325,38 @@ down the SHIFT key while pressing the mouse button." (mapc #'turn-off-xterm-mouse-tracking-on-terminal (terminal-list)) (setq mouse-position-function nil))) +(defun xterm-mouse-tracking-enable-sequence () + "Return a control sequence to enable XTerm mouse tracking. +The returned control sequence enables basic mouse tracking, mouse +motion events and finally extended tracking on terminals that +support it. The following escape sequences are understood by +modern xterms: + +\"\\e[?1000h\" \"Basic mouse mode\": Enables reports for mouse + clicks. There is a limit to the maximum row/column + position (<= 223), which can be reported in this + basic mode. + +\"\\e[?1002h\" \"Mouse motion mode\": Enables reports for mouse + motion events during dragging operations. + +\"\\e[?1005h\" \"UTF-8 coordinate extension\": Enables an + extension to the basic mouse mode, which uses UTF-8 + characters to overcome the 223 row/column limit. + This extension may conflict with non UTF-8 + applications or non UTF-8 locales. It is only + enabled when the option `xterm-mouse-utf-8' is + non-nil. + +\"\\e[?1006h\" \"SGR coordinate extension\": Enables a newer + alternative extension to the basic mouse mode, which + overcomes the 223 row/column limit without the + drawbacks of the UTF-8 coordinate extension. + +The two extension modes are mutually exclusive, where the last +given escape sequence takes precedence over the former." + (apply #'concat (xterm-mouse--tracking-sequence ?h))) + (defconst xterm-mouse-tracking-enable-sequence "\e[?1000h\e[?1002h\e[?1005h\e[?1006h" "Control sequence to enable xterm mouse tracking. @@ -343,10 +386,34 @@ escape sequences are understood by modern xterms: The two extension modes are mutually exclusive, where the last given escape sequence takes precedence over the former.") +(make-obsolete-variable + 'xterm-mouse-tracking-enable-sequence + "use the function `xterm-mouse-tracking-enable-sequence' instead." + "25.1") + +(defun xterm-mouse-tracking-disable-sequence () + "Return a control sequence to disable XTerm mouse tracking. +The control sequence resets the modes set by +`xterm-mouse-tracking-enable-sequence'." + (apply #'concat (nreverse (xterm-mouse--tracking-sequence ?l)))) + (defconst xterm-mouse-tracking-disable-sequence "\e[?1006l\e[?1005l\e[?1002l\e[?1000l" "Reset the modes set by `xterm-mouse-tracking-enable-sequence'.") +(make-obsolete-variable + 'xterm-mouse-tracking-disable-sequence + "use the function `xterm-mouse-tracking-disable-sequence' instead." + "25.1") + +(defun xterm-mouse--tracking-sequence (suffix) + "Return a control sequence to enable or disable mouse tracking. +SUFFIX is the last character of each escape sequence (?h to +enable, ?l to disable)." + (mapcar + (lambda (code) (format "\e[?%d%c" code suffix)) + `(1000 1002 ,@(when xterm-mouse-utf-8 '(1005)) 1006))) + (defun turn-on-xterm-mouse-tracking-on-terminal (&optional terminal) "Enable xterm mouse tracking on TERMINAL." (when (and xterm-mouse-mode (eq t (terminal-live-p terminal)) @@ -360,18 +427,19 @@ given escape sequence takes precedence over the former.") (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)) - (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 - (terminal-parameter nil 'tty-mode-reset-strings)) - (set-terminal-parameter terminal 'xterm-mouse-mode t)))) + (let ((enable (xterm-mouse-tracking-enable-sequence)) + (disable (xterm-mouse-tracking-disable-sequence))) + (condition-case err + (send-string-to-terminal enable 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 enable (terminal-parameter nil 'tty-mode-set-strings)) + (push disable (terminal-parameter nil 'tty-mode-reset-strings)) + (set-terminal-parameter terminal 'xterm-mouse-mode t) + (set-terminal-parameter terminal 'xterm-mouse-utf-8 + xterm-mouse-utf-8))))) (defun turn-off-xterm-mouse-tracking-on-terminal (terminal) "Disable xterm mouse tracking on TERMINAL." diff --git a/test/automated/xt-mouse-tests.el b/test/automated/xt-mouse-tests.el new file mode 100644 index 00000000000..c7e835c0311 --- /dev/null +++ b/test/automated/xt-mouse-tests.el @@ -0,0 +1,110 @@ +;;; xt-mouse-tests.el --- Test suite for xt-mouse. -*- lexical-binding: t; -*- + +;; Copyright (C) 2016 Free Software Foundation, Inc. + +;; Author: Philipp Stephani + +;; 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: + +;;; Code: + +(require 'xt-mouse) + +(defmacro with-xterm-mouse-mode (&rest body) + "Run BODY with `xterm-mouse-mode' temporarily enabled." + (declare (indent 0)) + ;; Make the frame huge so that the test input events below don't hit + ;; the menu bar. + `(cl-letf (((frame-width nil) 2000) + ((frame-height nil) 2000) + ;; Reset XTerm parameters so that the tests don't get + ;; confused. + ((terminal-parameter nil 'xterm-mouse-x) nil) + ((terminal-parameter nil 'xterm-mouse-y) nil) + ((terminal-parameter nil 'xterm-mouse-last-down) nil) + ((terminal-parameter nil 'xterm-mouse-last-click) nil)) + (if xterm-mouse-mode + (progn ,@body) + (unwind-protect + (progn + ;; `xterm-mouse-mode' doesn't work in the initial + ;; terminal. Since we can't create a second terminal in + ;; batch mode, fake it temporarily. + (cl-letf (((symbol-function 'terminal-name) + (lambda (&optional _terminal) "fake-terminal"))) + (xterm-mouse-mode)) + ,@body) + (xterm-mouse-mode 0))))) + +(ert-deftest xt-mouse-tracking-basic () + (should (equal (xterm-mouse-tracking-enable-sequence) + "\e[?1000h\e[?1002h\e[?1006h")) + (should (equal (xterm-mouse-tracking-disable-sequence) + "\e[?1006l\e[?1002l\e[?1000l")) + (with-xterm-mouse-mode + (should xterm-mouse-mode) + (should (terminal-parameter nil 'xterm-mouse-mode)) + (should-not (terminal-parameter nil 'xterm-mouse-utf-8)) + (let* ((unread-command-events (append "\e[M%\xD9\x81" + "\e[M'\xD9\x81" nil)) + (key (read-key))) + (should (consp key)) + (cl-destructuring-bind (event-type position . rest) key + (should (equal event-type 'S-mouse-2)) + (should (consp position)) + (cl-destructuring-bind (_ _ xy . rest) position + (should (equal xy '(184 . 95)))))))) + +(ert-deftest xt-mouse-tracking-utf-8 () + (let ((xterm-mouse-utf-8 t)) + (should (equal (xterm-mouse-tracking-enable-sequence) + "\e[?1000h\e[?1002h\e[?1005h\e[?1006h")) + (should (equal (xterm-mouse-tracking-disable-sequence) + "\e[?1006l\e[?1005l\e[?1002l\e[?1000l")) + (with-xterm-mouse-mode + (should xterm-mouse-mode) + (should (terminal-parameter nil 'xterm-mouse-mode)) + (should (terminal-parameter nil 'xterm-mouse-utf-8)) + ;; The keyboard driver doesn't decode bytes in + ;; `unread-command-events'. + (let* ((unread-command-events (append "\e[M%\u0640\u0131" + "\e[M'\u0640\u0131" nil)) + (key (read-key))) + (should (consp key)) + (cl-destructuring-bind (event-type position . rest) key + (should (equal event-type 'S-mouse-2)) + (should (consp position)) + (cl-destructuring-bind (_ _ xy . rest) position + (should (equal xy '(1567 . 271))))))))) + +(ert-deftest xt-mouse-tracking-sgr () + (with-xterm-mouse-mode + (should xterm-mouse-mode) + (should (terminal-parameter nil 'xterm-mouse-mode)) + (should-not (terminal-parameter nil 'xterm-mouse-utf-8)) + (let* ((unread-command-events (append "\e[<5;1569;273;M" + "\e[<5;1569;273;m" nil)) + (key (read-key))) + (should (consp key)) + (cl-destructuring-bind (event-type position . rest) key + (should (equal event-type 'S-mouse-2)) + (should (consp position)) + (cl-destructuring-bind (_ _ xy . rest) position + (should (equal xy '(1568 . 271)))))))) + +;;; xt-mouse-tests.el ends here