blob: 754ddc9c158e565ac0f8e4ab8958dd56c49b163d (
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
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
|
;;; test-vterm-tmux-history.el --- Tests for tmux history capture UX -*- lexical-binding: t; -*-
;;; Commentary:
;; Exercises the Emacs-owned history buffer used to copy text from the
;; current tmux pane without entering tmux copy-mode.
;;; Code:
(require 'ert)
(require 'cl-lib)
(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory))
(add-to-list 'load-path (expand-file-name "tests" user-emacs-directory))
(setq load-prefer-newer t)
(defvar vterm-mode-map (make-sparse-keymap))
(defvar vterm-copy-mode-map (make-sparse-keymap))
(keymap-set vterm-mode-map "C-c C-t" #'ignore)
(require 'vterm-config)
(require 'testutil-vterm-buffers)
(defmacro test-vterm-tmux-history--with-tmux-mock (responses &rest body)
"Run BODY with `process-file' mocked for tmux RESPONSES.
RESPONSES is an alist of (ARGS EXIT-CODE OUTPUT)."
(declare (indent 1))
`(let ((calls nil))
(cl-letf (((symbol-function 'process-file)
(lambda (program _infile destination _display &rest args)
(push (cons program args) calls)
(let* ((entry (seq-find
(lambda (candidate)
(equal (car candidate) args))
,responses))
(exit-code (or (cadr entry) 1))
(output (or (caddr entry) "")))
(when destination
(let ((buffer (cond
((eq destination t) (current-buffer))
((bufferp destination) destination)
((consp destination) (car destination)))))
(when (bufferp buffer)
(with-current-buffer buffer
(insert output)))))
exit-code))))
,@body)))
(ert-deftest test-vterm-tmux-history--pane-id-for-tty-matches-client ()
"Normal: current vterm pty maps to the active pane for that tmux client."
(test-vterm-tmux-history--with-tmux-mock
'((("list-clients" "-F" "#{client_tty}\t#{pane_id}") 0
"/dev/pts/1\t%1\n/dev/pts/8\t%8\n"))
(should (equal (cj/vterm--tmux-pane-id-for-tty "/dev/pts/8") "%8"))))
(ert-deftest test-vterm-tmux-history--capture-pane-uses-full-history ()
"Normal: capture asks tmux for joined full pane history."
(test-vterm-tmux-history--with-tmux-mock
'((("capture-pane" "-p" "-J" "-S" "-" "-E" "-" "-t" "%8") 0
"first line\nsecond line\n"))
(should (equal (cj/vterm--tmux-capture-pane "%8")
"first line\nsecond line\n"))))
(ert-deftest test-vterm-tmux-history-open-renders-read-only-history-buffer ()
"Normal: command renders tmux history in a normal Emacs buffer."
(let ((origin (cj/test--make-fake-vterm-buffer "*test-vterm-history-origin*")))
(unwind-protect
(with-current-buffer origin
(cl-letf (((symbol-function 'get-buffer-process)
(lambda (_buffer) 'fake-process))
((symbol-function 'process-tty-name)
(lambda (_process) "/dev/pts/8"))
((symbol-function 'pop-to-buffer)
(lambda (buffer &rest _)
(set-buffer buffer)
buffer)))
(test-vterm-tmux-history--with-tmux-mock
'((("list-clients" "-F" "#{client_tty}\t#{pane_id}") 0
"/dev/pts/8\t%8\n")
(("capture-pane" "-p" "-J" "-S" "-" "-E" "-" "-t" "%8") 0
"history http://example.com\n"))
(cj/vterm-tmux-history)
(should (eq major-mode 'cj/vterm-tmux-history-mode))
(should buffer-read-only)
(should (string-match-p "history http://example.com"
(buffer-string)))))))
(cj/test--kill-buffers-matching-prefix "*vterm tmux history")
(when (buffer-live-p origin)
(kill-buffer origin))))
(ert-deftest test-vterm-tmux-history-copy-copies-region-and-returns ()
"Normal: M-w copies the region, kills history buffer, and restores origin."
(let ((origin (get-buffer-create "*test-vterm-history-return*"))
(kill-ring nil))
(unwind-protect
(let ((history (get-buffer-create "*vterm tmux history: test*")))
(with-current-buffer origin
(erase-buffer)
(insert "origin")
(goto-char (point-min)))
(switch-to-buffer origin)
(let ((origin-window (selected-window)))
(with-current-buffer history
(cj/vterm-tmux-history-mode)
(let ((inhibit-read-only t))
(insert "alpha\nbeta\ngamma\n"))
(setq-local cj/vterm-tmux-history--origin-buffer origin)
(setq-local cj/vterm-tmux-history--origin-window origin-window)
(setq-local cj/vterm-tmux-history--origin-point (point-min))
(goto-char (point-min))
(set-mark (point))
(goto-char (point-at-eol 2))
(activate-mark)
(cj/vterm-tmux-history-copy-and-quit))
(should (equal (car kill-ring) "alpha\nbeta"))
(should-not (buffer-live-p history))
(should (eq (current-buffer) origin))
(should (= (point) (point-min)))))
(when (buffer-live-p origin)
(kill-buffer origin)))))
(ert-deftest test-vterm-keymap-includes-history-and-copy-bindings ()
"Normal: personal vterm map owns the high-level vterm UX commands."
(should (member "C-;" vterm-keymap-exceptions))
(should-not (eq (keymap-lookup cj/custom-keymap "v c") #'vterm-copy-mode))
(should (eq (keymap-lookup cj/custom-keymap "V C") #'cj/vterm-tmux-history))
(should (eq (keymap-lookup cj/custom-keymap "V c") #'vterm-copy-mode))
(should (equal (keymap-lookup vterm-mode-map "C-;") cj/custom-keymap))
(should (eq (keymap-lookup vterm-mode-map "C-; V C") #'cj/vterm-tmux-history))
(should (eq (keymap-lookup vterm-mode-map "C-; V c") #'vterm-copy-mode))
(should-not (keymap-lookup vterm-mode-map "C-c C-t")))
(ert-deftest test-vterm-copy-mode-cancel-keys ()
"Normal: copy mode has explicit copy and no-copy exits."
(should (eq (keymap-lookup vterm-copy-mode-map "C-g")
#'cj/vterm-copy-mode-cancel))
(should (eq (keymap-lookup vterm-copy-mode-map "<escape>")
#'cj/vterm-copy-mode-cancel))
(should (eq (keymap-lookup vterm-copy-mode-map "M-w")
#'vterm-copy-mode-done)))
(provide 'test-vterm-tmux-history)
;;; test-vterm-tmux-history.el ends here
|
