From 47b218ed15acd00c18cbc3bef604c4f2e0050a08 Mon Sep 17 00:00:00 2001 From: Craig Jennings Date: Thu, 7 May 2026 19:25:18 -0500 Subject: feat(ai-vterm): add Claude launcher with vertical-split vterm The new module picks a Claude-template project from a filtered completing-read list. It scans the same roots the `ai` shell launcher uses, then opens or reuses a vterm buffer named `claude []` on the right. F9 launches it. The prior `cj/toggle-gptel` binding moves from F9 to C-F9 so both AI tools share the same physical key. The display rule chains reuse-window -> use-some-window -> in-direction (right). The resulting window isn't dedicated. That matters because side-window dedication was breaking `buffer-move` (C-M-arrows) and `switch-to-buffer` replacement on the claude buffer. I also narrowed `vterm-toggle`'s display rule to skip `claude [` buffers. Otherwise it claimed them first with its bottom-split + dedicated treatment. I added 23 tests across 5 files: the buffer-name transform, candidate walker, show-or-create dispatch, picker, and display rule. Design lives at docs/design/ai-vterm.org. --- tests/test-ai-vterm--buffer-name.el | 42 ++++++++++ tests/test-ai-vterm--candidates.el | 139 +++++++++++++++++++++++++++++++++ tests/test-ai-vterm--display-rule.el | 74 ++++++++++++++++++ tests/test-ai-vterm--pick-project.el | 48 ++++++++++++ tests/test-ai-vterm--show-or-create.el | 119 ++++++++++++++++++++++++++++ 5 files changed, 422 insertions(+) create mode 100644 tests/test-ai-vterm--buffer-name.el create mode 100644 tests/test-ai-vterm--candidates.el create mode 100644 tests/test-ai-vterm--display-rule.el create mode 100644 tests/test-ai-vterm--pick-project.el create mode 100644 tests/test-ai-vterm--show-or-create.el (limited to 'tests') diff --git a/tests/test-ai-vterm--buffer-name.el b/tests/test-ai-vterm--buffer-name.el new file mode 100644 index 00000000..95c673ba --- /dev/null +++ b/tests/test-ai-vterm--buffer-name.el @@ -0,0 +1,42 @@ +;;; test-ai-vterm--buffer-name.el --- Tests for cj/--ai-vterm-buffer-name -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for the buffer-name transform. Given an absolute project +;; directory, the helper returns "claude []". The naming pattern +;; is what the display-buffer-alist rule keys on, so a regression here +;; silently breaks routing to the right side-window. + +;;; Code: + +(require 'ert) + +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'ai-vterm) + +(ert-deftest test-ai-vterm--buffer-name-normal-project () + "Normal: a typical project path yields claude []." + (should (equal (cj/--ai-vterm-buffer-name "/home/cjennings/projects/foo") + "claude [foo]"))) + +(ert-deftest test-ai-vterm--buffer-name-trailing-slash () + "Boundary: trailing slash collapses before basename extraction." + (should (equal (cj/--ai-vterm-buffer-name "/home/cjennings/projects/foo/") + "claude [foo]"))) + +(ert-deftest test-ai-vterm--buffer-name-dot-prefix-dir () + "Boundary: dot-prefix dirs (.emacs.d) preserve the dot in the basename." + (should (equal (cj/--ai-vterm-buffer-name "/home/cjennings/.emacs.d") + "claude [.emacs.d]"))) + +(ert-deftest test-ai-vterm--buffer-name-space-in-basename () + "Boundary: a space in the basename round-trips into the buffer name." + (should (equal (cj/--ai-vterm-buffer-name "/tmp/my work") + "claude [my work]"))) + +(ert-deftest test-ai-vterm--buffer-name-deeply-nested () + "Normal: only the last path component is used." + (should (equal (cj/--ai-vterm-buffer-name "/a/b/c/d/e/leaf") + "claude [leaf]"))) + +(provide 'test-ai-vterm--buffer-name) +;;; test-ai-vterm--buffer-name.el ends here diff --git a/tests/test-ai-vterm--candidates.el b/tests/test-ai-vterm--candidates.el new file mode 100644 index 00000000..b45888cc --- /dev/null +++ b/tests/test-ai-vterm--candidates.el @@ -0,0 +1,139 @@ +;;; test-ai-vterm--candidates.el --- Tests for cj/--ai-vterm-candidates -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for the project-candidate walker. Two kinds of search root: +;; +;; - project root (a single project dir, e.g. ~/.emacs.d) -- include if it +;; itself contains .ai/protocols.org +;; - container root (e.g. ~/code, ~/projects) -- scan immediate children; +;; include each child that contains .ai/protocols.org +;; +;; Tests build a temp directory tree with fake .ai/protocols.org markers +;; and let-bind the search-root customs at it. + +;;; Code: + +(require 'ert) + +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'ai-vterm) + +(defun test-ai-vterm--make-marker (dir) + "Create DIR/.ai/protocols.org so DIR registers as a Claude project." + (let ((ai-dir (expand-file-name ".ai" dir))) + (make-directory ai-dir t) + (write-region "" nil (expand-file-name "protocols.org" ai-dir)))) + +(defmacro test-ai-vterm--with-fixture (root &rest body) + "Bind ROOT to a fresh temp directory; remove on exit; run BODY." + (declare (indent 1) (debug t)) + `(let ((,root (make-temp-file "ai-vterm-test-" t))) + (unwind-protect + (progn ,@body) + (delete-directory ,root t)))) + +(ert-deftest test-ai-vterm--candidates-project-root-with-marker () + "Normal: a project root containing .ai/protocols.org is included." + (test-ai-vterm--with-fixture root + (let ((proj (expand-file-name "emacs-d-fake" root))) + (make-directory proj) + (test-ai-vterm--make-marker proj) + (let ((cj/ai-vterm-project-roots (list proj)) + (cj/ai-vterm-container-roots nil)) + (should (equal (cj/--ai-vterm-candidates) + (list (expand-file-name proj)))))))) + +(ert-deftest test-ai-vterm--candidates-project-root-without-marker () + "Boundary: a project root without .ai/protocols.org is excluded." + (test-ai-vterm--with-fixture root + (let ((proj (expand-file-name "no-ai" root))) + (make-directory proj) + (let ((cj/ai-vterm-project-roots (list proj)) + (cj/ai-vterm-container-roots nil)) + (should (null (cj/--ai-vterm-candidates))))))) + +(ert-deftest test-ai-vterm--candidates-container-includes-children-with-marker () + "Normal: a container's children with .ai/protocols.org are included." + (test-ai-vterm--with-fixture root + (let ((container (expand-file-name "code" root)) + (foo (expand-file-name "code/foo" root)) + (bar (expand-file-name "code/bar" root))) + (make-directory container) + (make-directory foo) + (make-directory bar) + (test-ai-vterm--make-marker foo) + (test-ai-vterm--make-marker bar) + (let* ((cj/ai-vterm-project-roots nil) + (cj/ai-vterm-container-roots (list container)) + (got (sort (cj/--ai-vterm-candidates) #'string<))) + (should (equal got + (sort (list (expand-file-name foo) + (expand-file-name bar)) + #'string<))))))) + +(ert-deftest test-ai-vterm--candidates-container-skips-children-without-marker () + "Boundary: a container's children without .ai/protocols.org are skipped." + (test-ai-vterm--with-fixture root + (let ((container (expand-file-name "code" root)) + (foo (expand-file-name "code/foo" root)) + (bare (expand-file-name "code/bare" root))) + (make-directory container) + (make-directory foo) + (make-directory bare) + (test-ai-vterm--make-marker foo) + (let ((cj/ai-vterm-project-roots nil) + (cj/ai-vterm-container-roots (list container))) + (should (equal (cj/--ai-vterm-candidates) + (list (expand-file-name foo)))))))) + +(ert-deftest test-ai-vterm--candidates-container-skips-non-directory-entries () + "Boundary: a container's non-directory entries are ignored." + (test-ai-vterm--with-fixture root + (let ((container (expand-file-name "code" root)) + (foo (expand-file-name "code/foo" root)) + (stray (expand-file-name "code/README.txt" root))) + (make-directory container) + (make-directory foo) + (test-ai-vterm--make-marker foo) + (write-region "" nil stray) + (let ((cj/ai-vterm-project-roots nil) + (cj/ai-vterm-container-roots (list container))) + (should (equal (cj/--ai-vterm-candidates) + (list (expand-file-name foo)))))))) + +(ert-deftest test-ai-vterm--candidates-nonexistent-root-is-skipped () + "Error: a nonexistent search root is skipped silently, no error raised." + (test-ai-vterm--with-fixture root + (let ((cj/ai-vterm-project-roots + (list (expand-file-name "does-not-exist" root))) + (cj/ai-vterm-container-roots + (list (expand-file-name "also-missing" root)))) + (should (null (cj/--ai-vterm-candidates)))))) + +(ert-deftest test-ai-vterm--candidates-empty-roots-yield-empty-list () + "Boundary: nil roots yield nil." + (let ((cj/ai-vterm-project-roots nil) + (cj/ai-vterm-container-roots nil)) + (should (null (cj/--ai-vterm-candidates))))) + +(ert-deftest test-ai-vterm--candidates-mixed-roots () + "Normal: project + container roots combine in one result list." + (test-ai-vterm--with-fixture root + (let ((emacs-d (expand-file-name "emacs-d" root)) + (container (expand-file-name "code" root)) + (foo (expand-file-name "code/foo" root))) + (make-directory emacs-d) + (make-directory container) + (make-directory foo) + (test-ai-vterm--make-marker emacs-d) + (test-ai-vterm--make-marker foo) + (let* ((cj/ai-vterm-project-roots (list emacs-d)) + (cj/ai-vterm-container-roots (list container)) + (got (sort (cj/--ai-vterm-candidates) #'string<))) + (should (equal got + (sort (list (expand-file-name emacs-d) + (expand-file-name foo)) + #'string<))))))) + +(provide 'test-ai-vterm--candidates) +;;; test-ai-vterm--candidates.el ends here diff --git a/tests/test-ai-vterm--display-rule.el b/tests/test-ai-vterm--display-rule.el new file mode 100644 index 00000000..af481eb3 --- /dev/null +++ b/tests/test-ai-vterm--display-rule.el @@ -0,0 +1,74 @@ +;;; test-ai-vterm--display-rule.el --- Tests for the AI-vterm display-buffer rule -*- lexical-binding: t; -*- + +;;; Commentary: +;; The module installs a `display-buffer-alist' entry routing buffers +;; whose names match "\\`claude \\[" to a right-side window. These +;; tests verify the rule reaches the right side and ignores buffers +;; that don't match the prefix. + +;;; Code: + +(require 'ert) + +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'ai-vterm) + +(defun test-ai-vterm--cleanup (name) + "Kill buffer NAME if it exists." + (when (get-buffer name) + (kill-buffer name))) + +(defmacro test-ai-vterm--with-clean-frame (&rest body) + "Run BODY in a context with one window and the AI-vterm rule loaded." + (declare (indent 0) (debug t)) + `(save-window-excursion + (delete-other-windows) + (let ((display-buffer-alist (cj/--ai-vterm-display-rule-list))) + ,@body))) + +(ert-deftest test-ai-vterm--display-rule-routes-claude-buffer-to-right () + "Normal: a buffer named \"claude [foo]\" lands in a window to the right. + +The rule uses `display-buffer-in-direction' with `(direction . right)', +which splits the current window so the new window's left edge sits at +a positive column. The buffer winds up in that new window." + (let ((name "claude [display-rule-test]")) + (test-ai-vterm--cleanup name) + (unwind-protect + (test-ai-vterm--with-clean-frame + (let* ((buf (get-buffer-create name)) + (win (display-buffer buf))) + (should (windowp win)) + (should (> (window-left-column win) 0)))) + (test-ai-vterm--cleanup name)))) + +(ert-deftest test-ai-vterm--display-rule-skips-non-matching-buffer () + "Boundary: a buffer not named \"claude [...]\" does not match the rule. + +The rule's regex doesn't fire, so `display-buffer' falls back to the +default action -- reuse the current window -- and no rightward split +occurs." + (let ((name "scratch-buffer-no-match")) + (test-ai-vterm--cleanup name) + (unwind-protect + (test-ai-vterm--with-clean-frame + (let* ((buf (get-buffer-create name)) + (win (display-buffer buf))) + (should (windowp win)) + (should (= (window-left-column win) 0)))) + (test-ai-vterm--cleanup name)))) + +(ert-deftest test-ai-vterm--display-rule-prefix-not-substring () + "Boundary: \"foo claude [bar]\" does not match -- the rule anchors at start." + (let ((name "foo claude [substring-test]")) + (test-ai-vterm--cleanup name) + (unwind-protect + (test-ai-vterm--with-clean-frame + (let* ((buf (get-buffer-create name)) + (win (display-buffer buf))) + (should (windowp win)) + (should (= (window-left-column win) 0)))) + (test-ai-vterm--cleanup name)))) + +(provide 'test-ai-vterm--display-rule) +;;; test-ai-vterm--display-rule.el ends here diff --git a/tests/test-ai-vterm--pick-project.el b/tests/test-ai-vterm--pick-project.el new file mode 100644 index 00000000..6fa2d185 --- /dev/null +++ b/tests/test-ai-vterm--pick-project.el @@ -0,0 +1,48 @@ +;;; test-ai-vterm--pick-project.el --- Tests for cj/--ai-vterm-pick-project -*- lexical-binding: t; -*- + +;;; Commentary: +;; The picker presents abbreviated paths to `completing-read', then +;; returns the absolute path corresponding to the user's choice. Empty +;; candidate set raises a `user-error' rather than offering an empty +;; prompt. + +;;; Code: + +(require 'ert) +(require 'cl-lib) + +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'ai-vterm) + +(ert-deftest test-ai-vterm--pick-project-returns-absolute-path-of-choice () + "Normal: user picks a candidate, picker returns its absolute path." + (cl-letf (((symbol-function 'cj/--ai-vterm-candidates) + (lambda () '("/home/u/code/foo" "/home/u/code/bar"))) + ((symbol-function 'completing-read) + (lambda (_p collection &rest _) + ;; Pick the one whose display form matches ~/code/bar + ;; (collection is alist of display . abs) + (car (cl-find-if + (lambda (cell) (string-match-p "bar" (car cell))) + collection))))) + (should (equal (cj/--ai-vterm-pick-project) "/home/u/code/bar")))) + +(ert-deftest test-ai-vterm--pick-project-empty-candidates-raises-user-error () + "Error: no candidates -> user-error rather than empty prompt." + (cl-letf (((symbol-function 'cj/--ai-vterm-candidates) (lambda () nil))) + (should-error (cj/--ai-vterm-pick-project) :type 'user-error))) + +(ert-deftest test-ai-vterm--pick-project-presents-abbreviated-paths () + "Normal: the completing-read collection holds abbreviated display forms." + (let (received-collection) + (cl-letf (((symbol-function 'cj/--ai-vterm-candidates) + (lambda () (list (expand-file-name "~/code/foo")))) + ((symbol-function 'completing-read) + (lambda (_p collection &rest _) + (setq received-collection collection) + (caar collection)))) + (cj/--ai-vterm-pick-project) + (should (equal (caar received-collection) "~/code/foo"))))) + +(provide 'test-ai-vterm--pick-project) +;;; test-ai-vterm--pick-project.el ends here diff --git a/tests/test-ai-vterm--show-or-create.el b/tests/test-ai-vterm--show-or-create.el new file mode 100644 index 00000000..28e0faeb --- /dev/null +++ b/tests/test-ai-vterm--show-or-create.el @@ -0,0 +1,119 @@ +;;; test-ai-vterm--show-or-create.el --- Tests for cj/--ai-vterm-show-or-create -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests the show-or-create branching: +;; +;; - buffer absent -> vterm called, claude command sent +;; - buffer present, live -> vterm not called, buffer displayed +;; - buffer present, dead -> old buffer killed, vterm recreates +;; +;; vterm functions are stubbed so the test does no process spawning. + +;;; Code: + +(require 'ert) +(require 'cl-lib) + +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'ai-vterm) + +;; vterm isn't loaded in batch -- provide stubs so cl-letf has overrides. +(unless (fboundp 'vterm) + (defun vterm (&optional _name) nil)) +(unless (fboundp 'vterm-send-string) + (defun vterm-send-string (_s &optional _) nil)) +(unless (fboundp 'vterm-send-return) + (defun vterm-send-return () nil)) + +(defmacro test-ai-vterm--with-mock-vterm (vars &rest body) + "Run BODY with vterm + send-string + send-return mocked. + +VARS is a plist of capture variable names: :calls, :strings, :returns, +:default-dir. The test references these names directly inside BODY." + (declare (indent 1) (debug t)) + (let ((calls (plist-get vars :calls)) + (strings (plist-get vars :strings)) + (returns (plist-get vars :returns)) + (ddir (plist-get vars :default-dir))) + `(let ((,calls '()) + (,strings '()) + (,returns 0) + (,ddir nil)) + (cl-letf (((symbol-function 'vterm) + (lambda (&optional name) + (push name ,calls) + (setq ,ddir default-directory) + (with-current-buffer (get-buffer-create name) + (current-buffer)))) + ((symbol-function 'vterm-send-string) + (lambda (s &optional _) (push s ,strings))) + ((symbol-function 'vterm-send-return) + (lambda () (cl-incf ,returns)))) + ,@body)))) + +(defun test-ai-vterm--cleanup (name) + "Kill buffer NAME if it exists." + (when (get-buffer name) + (kill-buffer name))) + +(ert-deftest test-ai-vterm--show-or-create-creates-when-buffer-missing () + "Normal: no existing buffer -> vterm called once, claude cmd sent." + (let ((name "claude [normal-create-test]")) + (test-ai-vterm--cleanup name) + (unwind-protect + (test-ai-vterm--with-mock-vterm (:calls calls :strings strings + :returns returns :default-dir ddir) + (cj/--ai-vterm-show-or-create "/tmp/some-project" name) + (should (equal calls (list name))) + (should (equal strings (list cj/ai-vterm-claude-command))) + (should (= returns 1)) + (should (equal ddir "/tmp/some-project"))) + (test-ai-vterm--cleanup name)))) + +(ert-deftest test-ai-vterm--show-or-create-displays-existing-when-process-live () + "Normal: buffer exists with live process -> vterm not called." + (let ((name "claude [reuse-test]")) + (test-ai-vterm--cleanup name) + (unwind-protect + (let ((buf (get-buffer-create name))) + (cl-letf (((symbol-function 'cj/--ai-vterm-process-live-p) + (lambda (b) (and (eq b buf) t)))) + (test-ai-vterm--with-mock-vterm (:calls calls :strings strings + :returns returns :default-dir _ddir) + (cj/--ai-vterm-show-or-create "/tmp/reuse" name) + (should (null calls)) + (should (null strings)) + (should (= returns 0))))) + (test-ai-vterm--cleanup name)))) + +(ert-deftest test-ai-vterm--show-or-create-recreates-when-process-dead () + "Boundary: buffer exists with dead process -> killed and recreated." + (let ((name "claude [dead-test]")) + (test-ai-vterm--cleanup name) + (unwind-protect + (let ((stale (get-buffer-create name))) + (cl-letf (((symbol-function 'cj/--ai-vterm-process-live-p) + (lambda (_b) nil))) + (test-ai-vterm--with-mock-vterm (:calls calls :strings strings + :returns returns :default-dir _ddir) + (cj/--ai-vterm-show-or-create "/tmp/dead" name) + (should (equal calls (list name))) + (should (equal strings (list cj/ai-vterm-claude-command))) + (should (= returns 1)) + (should-not (buffer-live-p stale))))) + (test-ai-vterm--cleanup name)))) + +(ert-deftest test-ai-vterm--show-or-create-returns-buffer () + "Normal: return value is the vterm buffer." + (let ((name "claude [return-test]")) + (test-ai-vterm--cleanup name) + (unwind-protect + (test-ai-vterm--with-mock-vterm (:calls _c :strings _s + :returns _r :default-dir _d) + (let ((result (cj/--ai-vterm-show-or-create "/tmp/return" name))) + (should (bufferp result)) + (should (equal (buffer-name result) name)))) + (test-ai-vterm--cleanup name)))) + +(provide 'test-ai-vterm--show-or-create) +;;; test-ai-vterm--show-or-create.el ends here -- cgit v1.2.3