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.

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)
+(defcustom xterm-mouse-utf-8 nil
-  "Read an utf-8 encoded character from the current terminal.
+  "Non-nil if UTF-8 coordinates should be used to read mouse coordinates.
-This function reads and returns an utf-8 encoded character of
+Set this to non-nil if you are sure that your terminal
-command input. If the user generates an event which is not a
+understands UTF-8 coordinates, but not SGR coordinates."
-character (i.e., a mouse click or function key event), read-char
+  :type 'boolean
-signals an error.
+  :risky t
+  :group 'xterm)
 
-The returned event may come directly from the user, or from a
+(defun xterm-mouse--read-coordinate ()
-keyboard macro. It is not decoded by the keyboard's input coding
+  "Read a mouse coordinate from the current terminal.
-system and always treated with an utf-8 input encoding.
+If `xterm-mouse-utf-8' was non-nil when
-
+`turn-on-xterm-mouse-tracking-on-terminal' was called, reads the
-The optional arguments PROMPT and SECONDS work like in
+coordinate as an UTF-8 code unit sequence; otherwise, reads a
-`read-event'."
+single byte."
-  (let ((tmp (keyboard-coding-system)))
+  (let ((previous-keyboard-coding-system (keyboard-coding-system)))
-    (set-keyboard-coding-system 'utf-8)
+    (unwind-protect
-    (prog1 (read-event prompt t seconds)
+        (progn
-      (set-keyboard-coding-system tmp))))
+          (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
+      (let ((enable (xterm-mouse-tracking-enable-sequence))
-          (send-string-to-terminal xterm-mouse-tracking-enable-sequence
+            (disable (xterm-mouse-tracking-disable-sequence)))
-                                   terminal)
+        (condition-case err
-        ;; FIXME: This should use a dedicated error signal.
+            (send-string-to-terminal enable terminal)
-        (error (if (equal (cadr err) "Terminal is currently suspended")
+          ;; FIXME: This should use a dedicated error signal.
-                   nil                  ;The sequence will be sent upon resume.
+          (error (if (equal (cadr err) "Terminal is currently suspended")
-                 (signal (car err) (cdr err)))))
+                     nil ; The sequence will be sent upon resume.
-      (push xterm-mouse-tracking-enable-sequence
+                   (signal (car err) (cdr err)))))
-            (terminal-parameter nil 'tty-mode-set-strings))
+        (push enable (terminal-parameter nil 'tty-mode-set-strings))
-      (push xterm-mouse-tracking-disable-sequence
+        (push disable (terminal-parameter nil 'tty-mode-reset-strings))
-            (terminal-parameter nil 'tty-mode-reset-strings))
+        (set-terminal-parameter terminal 'xterm-mouse-mode t)
-      (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."

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 <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