blob: 0b644d24d9422e600d1e6f446120b630274d3d6c (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
|
;;; xt-mouse-tests.el --- Test suite for xt-mouse. -*- lexical-binding: t; -*-
;; Copyright (C) 2016-2018 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 <https://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
|
