procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Add customization option for using UTF-8 coordinates in xt-mouse

Browse source 
* 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.
This commit is contained in:
Philipp Stephani 2016-03-25 13:17:38 +03:00 • committed by Eli Zaretskii
parent f14d463661
commit 90fb9b38dd
2 changed files with 207 additions and 29 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

126
lisp/xt-mouse.el
View file

@ -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.
(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)
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))))
(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
;; <EVENT-CODE> <X> <Y> 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."

110
test/automated/xt-mouse-tests.el Normal file
View file

@ -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 <phst@google.com>
;; 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 <http://www.gnu.org/licenses/>.
;;; 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