Add Emacs-native vterm copy workflows

Add an Emacs-first copy workflow for vterm and tmux. C-; V c enters vterm copy mode, C-; V C captures tmux pane scrollback into a temporary Emacs buffer, M-w copies and returns, and C-g/Escape cancel without copying. This also adds clickable URLs, removes the bad vtermf binding, unbinds C-c C-t, and tests the vterm/tmux keymap behavior.

1 files changed, 141 insertions, 0 deletions

diff --git a/tests/test-vterm-tmux-history.el b/tests/test-vterm-tmux-history.el
new file mode 100644
index 00000000..33fa1330
--- /dev/null
+++ b/tests/test-vterm-tmux-history.el
@@ -0,0 +1,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 'eshell-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