diff options
Diffstat (limited to 'tests')
57 files changed, 1858 insertions, 613 deletions
diff --git a/tests/test-ai-term--agent-buffers.el b/tests/test-ai-term--agent-buffers.el index 20c661c45..e0d8faa79 100644 --- a/tests/test-ai-term--agent-buffers.el +++ b/tests/test-ai-term--agent-buffers.el @@ -14,7 +14,7 @@ (add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) (add-to-list 'load-path (expand-file-name "tests" user-emacs-directory)) (require 'ai-term) -(require 'testutil-ghostel-buffers) +(require 'testutil-terminal-buffers) (ert-deftest test-ai-term--agent-buffers-empty-when-none-exist () "Boundary: no agent-prefixed buffers anywhere -> empty list." diff --git a/tests/test-ai-term--close.el b/tests/test-ai-term--close.el index 4098c091e..242bfd749 100644 --- a/tests/test-ai-term--close.el +++ b/tests/test-ai-term--close.el @@ -2,7 +2,7 @@ ;;; Commentary: ;; `cj/ai-term-close' tears an agent down gracefully: kill its tmux -;; session (stopping the agent process), kill the ghostel buffer, and +;; session (stopping the agent process), kill the agent buffer, and ;; remove its window. These tests cover the pure pieces -- the ;; tmux-kill helper, the per-buffer teardown, and the target selection -- ;; with `process-file' and the prompt mocked at the boundary. @@ -15,7 +15,7 @@ (add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) (add-to-list 'load-path (expand-file-name "tests" user-emacs-directory)) (require 'ai-term) -(require 'testutil-ghostel-buffers) +(require 'testutil-terminal-buffers) (ert-deftest test-ai-term--kill-tmux-session-runs-kill-session () "Normal: invokes `tmux kill-session -t <session>'." diff --git a/tests/test-ai-term--collapse-split.el b/tests/test-ai-term--collapse-split.el index a09af5598..bae913624 100644 --- a/tests/test-ai-term--collapse-split.el +++ b/tests/test-ai-term--collapse-split.el @@ -23,7 +23,7 @@ (add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) (add-to-list 'load-path (expand-file-name "tests" user-emacs-directory)) (require 'ai-term) -(require 'testutil-ghostel-buffers) +(require 'testutil-terminal-buffers) ;;; cj/--ai-term-most-recent-non-agent-buffer diff --git a/tests/test-ai-term--dispatch.el b/tests/test-ai-term--dispatch.el index 91b5e1bc6..129c53cda 100644 --- a/tests/test-ai-term--dispatch.el +++ b/tests/test-ai-term--dispatch.el @@ -16,7 +16,7 @@ (add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) (add-to-list 'load-path (expand-file-name "tests" user-emacs-directory)) (require 'ai-term) -(require 'testutil-ghostel-buffers) +(require 'testutil-terminal-buffers) (ert-deftest test-ai-term--dispatch-window-displayed-returns-toggle-off () "Normal: displayed agent window -> (toggle-off . WIN)." diff --git a/tests/test-ai-term--display-saved.el b/tests/test-ai-term--display-saved.el index 51c22fde9..5707bea5b 100644 --- a/tests/test-ai-term--display-saved.el +++ b/tests/test-ai-term--display-saved.el @@ -26,7 +26,7 @@ (add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) (add-to-list 'load-path (expand-file-name "tests" user-emacs-directory)) (require 'ai-term) -(require 'testutil-ghostel-buffers) +(require 'testutil-terminal-buffers) (ert-deftest test-ai-term--display-saved-uses-desktop-defaults-when-state-nil () "Normal: nil state on a desktop -> rightmost, size=cj/ai-term-desktop-width. diff --git a/tests/test-ai-term--displayed-agent-window.el b/tests/test-ai-term--displayed-agent-window.el index eeb40ed31..ced3ff414 100644 --- a/tests/test-ai-term--displayed-agent-window.el +++ b/tests/test-ai-term--displayed-agent-window.el @@ -12,7 +12,7 @@ (add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) (add-to-list 'load-path (expand-file-name "tests" user-emacs-directory)) (require 'ai-term) -(require 'testutil-ghostel-buffers) +(require 'testutil-terminal-buffers) (ert-deftest test-ai-term--displayed-agent-window-no-buffers-returns-nil () "Boundary: no agent buffers anywhere -> nil." diff --git a/tests/test-ai-term--keybindings.el b/tests/test-ai-term--keybindings.el index a8b92ffa8..6f7f53a5e 100644 --- a/tests/test-ai-term--keybindings.el +++ b/tests/test-ai-term--keybindings.el @@ -4,12 +4,11 @@ ;; ai-term lives under the C-; a prefix (vacated when gptel was archived), with ;; the frequent "swap to the next agent" also on M-SPC for a fast chord. M-SPC ;; must reach Emacs from inside an agent buffer, so it is bound in -;; `ghostel-mode-map' and added to `ghostel-keymap-exceptions' (the semi-char -;; map otherwise forwards it to the pty). C-; is already an exception via -;; term-config, so the C-; a family resolves through the global prefix. These -;; tests require ghostel (so ai-term's `with-eval-after-load' fires) before -;; ai-term, then confirm the bindings landed and the old F9 family is gone. -;; `(require 'ghostel)' does not load the native module, so this stays light. +;; `eat-semi-char-mode-map' (EAT forwards unbound keys to the pty otherwise). +;; C-; is already bound there via eat-config, so the C-; a family resolves +;; through the global prefix. These tests require eat (so ai-term's +;; `with-eval-after-load' fires) before ai-term, then confirm the bindings +;; landed and the old F9 family is gone. ;;; Code: @@ -19,7 +18,7 @@ (setq package-user-dir (expand-file-name "elpa" user-emacs-directory)) (package-initialize) (add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) -(require 'ghostel) +(require 'eat) (require 'ai-term) (ert-deftest test-ai-term-keymap-leaf-bindings () @@ -37,16 +36,11 @@ "Normal: M-SPC runs `cj/ai-term-next' (the fast swap chord)." (should (eq (lookup-key (current-global-map) (kbd "M-SPC")) #'cj/ai-term-next))) -(ert-deftest test-ai-term-meta-space-bound-in-ghostel-mode-map () - "Normal: M-SPC is bound in `ghostel-mode-map' so swap works inside an agent." - (should (eq (keymap-lookup ghostel-mode-map "M-SPC") #'cj/ai-term-next))) - -(ert-deftest test-ai-term-meta-space-in-keymap-exceptions () - "Regression: M-SPC is in `ghostel-keymap-exceptions' so semi-char mode lets it -reach Emacs instead of forwarding it to the pty." - (should (member "M-SPC" ghostel-keymap-exceptions)) - (should-not (eq (keymap-lookup ghostel-semi-char-mode-map "M-SPC") - 'ghostel--send-event))) +(ert-deftest test-ai-term-meta-space-bound-in-eat-semi-char-mode-map () + "Normal: M-SPC is bound in `eat-semi-char-mode-map' so swap works inside an +agent. EAT forwards unbound keys to the pty, so the bind is what lets it reach +Emacs -- no ghostel-style exception list or rebuild is needed." + (should (eq (keymap-lookup eat-semi-char-mode-map "M-SPC") #'cj/ai-term-next))) (ert-deftest test-ai-term-f9-family-removed-globally () "Regression: the old F9 family no longer binds the ai-term commands globally." diff --git a/tests/test-ai-term--launch-command.el b/tests/test-ai-term--launch-command.el index 246e70a3f..e61c0e579 100644 --- a/tests/test-ai-term--launch-command.el +++ b/tests/test-ai-term--launch-command.el @@ -1,7 +1,7 @@ ;;; test-ai-term--launch-command.el --- Tests for cj/--ai-term-launch-command -*- lexical-binding: t; -*- ;;; Commentary: -;; The launch command is what gets typed into a fresh ghostel shell to bring +;; The launch command is what gets typed into a fresh shell to bring ;; up the agent inside a per-project tmux session. The session is named ;; `cj/ai-term-tmux-session-prefix' + the project basename, so a second ;; F9 on the same project reattaches to the running agent rather than diff --git a/tests/test-ai-term--reuse-edge-window.el b/tests/test-ai-term--reuse-edge-window.el index a9a0529e8..8ba2f759f 100644 --- a/tests/test-ai-term--reuse-edge-window.el +++ b/tests/test-ai-term--reuse-edge-window.el @@ -25,7 +25,7 @@ (add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) (add-to-list 'load-path (expand-file-name "tests" user-emacs-directory)) (require 'ai-term) -(require 'testutil-ghostel-buffers) +(require 'testutil-terminal-buffers) (defun cj/test--displayed-buffer-names () "Return the buffer names shown in the selected frame, left/top to right/bottom." diff --git a/tests/test-ai-term--reuse-existing-agent.el b/tests/test-ai-term--reuse-existing-agent.el index 3f0c64493..361e94be9 100644 --- a/tests/test-ai-term--reuse-existing-agent.el +++ b/tests/test-ai-term--reuse-existing-agent.el @@ -17,7 +17,7 @@ (add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) (add-to-list 'load-path (expand-file-name "tests" user-emacs-directory)) (require 'ai-term) -(require 'testutil-ghostel-buffers) +(require 'testutil-terminal-buffers) (ert-deftest test-ai-term--reuse-existing-agent-swaps-buffer-when-window-exists () "Normal: an agent window exists -> swap its buffer, return the window." diff --git a/tests/test-ai-term--server-display.el b/tests/test-ai-term--server-display.el index b3d32dc83..6db9cf2d3 100644 --- a/tests/test-ai-term--server-display.el +++ b/tests/test-ai-term--server-display.el @@ -16,7 +16,7 @@ (add-to-list 'load-path (expand-file-name "tests" user-emacs-directory)) (require 'ai-term) (require 'server) -(require 'testutil-ghostel-buffers) +(require 'testutil-terminal-buffers) (ert-deftest test-ai-term--non-agent-window-finds-code-window () "Normal: agent on the right, code on the left -> returns the code window." diff --git a/tests/test-ai-term--show-or-create.el b/tests/test-ai-term--show-or-create.el index c6653dcdd..4f5f1f67f 100644 --- a/tests/test-ai-term--show-or-create.el +++ b/tests/test-ai-term--show-or-create.el @@ -3,13 +3,13 @@ ;;; Commentary: ;; Tests the show-or-create branching: ;; -;; - buffer absent -> ghostel called, agent command + newline sent -;; - buffer present, live -> ghostel not called, buffer displayed -;; - buffer present, dead -> old buffer killed, ghostel recreates +;; - buffer absent -> eat called, agent command + newline sent +;; - buffer present, live -> eat not called, buffer displayed +;; - buffer present, dead -> old buffer killed, eat recreates ;; -;; ghostel functions are stubbed so the test does no process spawning and -;; never loads the native module. Production calls (ghostel) with no name and -;; relies on the dynamically bound `ghostel-buffer-name'; the mock honors that. +;; eat + the send helper are stubbed so the test does no process spawning. +;; Production calls (eat) and relies on the dynamically bound `eat-buffer-name'; +;; the mock honors that. ;;; Code: @@ -19,19 +19,17 @@ (add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) (require 'ai-term) -;; ghostel isn't loaded in batch -- provide stubs so cl-letf has overrides. -(unless (fboundp 'ghostel) - (defun ghostel (&optional _arg) nil)) -(unless (fboundp 'ghostel-send-string) - (defun ghostel-send-string (_s) nil)) +;; eat isn't loaded in batch -- provide a stub so cl-letf has an override. +(unless (fboundp 'eat) + (defun eat (&optional _program _arg) nil)) -(defmacro test-ai-term--with-mock-ghostel (vars &rest body) - "Run BODY with ghostel + ghostel-send-string mocked. +(defmacro test-ai-term--with-mock-eat (vars &rest body) + "Run BODY with eat + `cj/--ai-term-send-string' mocked. -VARS is a plist of capture variable names: :calls (buffer names ghostel -was asked to create), :strings (sent strings), :default-dir. The mocked -`ghostel' creates and returns a buffer named after the dynamically bound -`ghostel-buffer-name', mirroring the real entry point." +VARS is a plist of capture variable names: :calls (buffer names eat was asked +to create), :strings (sent strings), :default-dir. The mocked `eat' creates +and returns a buffer named after the dynamically bound `eat-buffer-name', +mirroring the real entry point." (declare (indent 1) (debug t)) (let ((calls (plist-get vars :calls)) (strings (plist-get vars :strings)) @@ -39,14 +37,14 @@ was asked to create), :strings (sent strings), :default-dir. The mocked `(let ((,calls '()) (,strings '()) (,ddir nil)) - (cl-letf (((symbol-function 'ghostel) - (lambda (&optional _arg) + (cl-letf (((symbol-function 'eat) + (lambda (&optional _program _arg) (setq ,ddir default-directory) - (let ((b (get-buffer-create ghostel-buffer-name))) + (let ((b (get-buffer-create eat-buffer-name))) (push (buffer-name b) ,calls) b))) - ((symbol-function 'ghostel-send-string) - (lambda (s) (push s ,strings)))) + ((symbol-function 'cj/--ai-term-send-string) + (lambda (_buf s) (push s ,strings)))) ,@body)))) (defun test-ai-term--cleanup (name) @@ -55,33 +53,33 @@ was asked to create), :strings (sent strings), :default-dir. The mocked (kill-buffer name))) (ert-deftest test-ai-term--show-or-create-creates-when-buffer-missing () - "Normal: no existing buffer -> ghostel called once, launch cmd + newline -sent, the project recorded at the front of the MRU list." + "Normal: no existing buffer -> eat called once, launch cmd + newline sent, +the project recorded at the front of the MRU list." (let ((name "agent [normal-create-test]") (cj/--ai-term-mru nil)) (test-ai-term--cleanup name) (unwind-protect - (test-ai-term--with-mock-ghostel (:calls calls :strings strings - :default-dir ddir) + (test-ai-term--with-mock-eat (:calls calls :strings strings + :default-dir ddir) (cj/--ai-term-show-or-create "/tmp/some-project" name) (should (equal calls (list name))) - (should (equal (reverse strings) - (list (cj/--ai-term-launch-command "/tmp/some-project") - "\n"))) + (should (equal strings + (list (concat (cj/--ai-term-launch-command "/tmp/some-project") + "\n")))) (should (equal ddir "/tmp/some-project")) (should (equal (car cj/--ai-term-mru) "/tmp/some-project"))) (test-ai-term--cleanup name)))) (ert-deftest test-ai-term--show-or-create-displays-existing-when-process-live () - "Normal: buffer exists with live process -> ghostel not called." + "Normal: buffer exists with live process -> eat not called." (let ((name "agent [reuse-test]")) (test-ai-term--cleanup name) (unwind-protect (let ((buf (get-buffer-create name))) (cl-letf (((symbol-function 'cj/--ai-term-process-live-p) (lambda (b) (and (eq b buf) t)))) - (test-ai-term--with-mock-ghostel (:calls calls :strings strings - :default-dir _ddir) + (test-ai-term--with-mock-eat (:calls calls :strings strings + :default-dir _ddir) (cj/--ai-term-show-or-create "/tmp/reuse" name) (should (null calls)) (should (null strings))))) @@ -95,27 +93,27 @@ sent, the project recorded at the front of the MRU list." (let ((stale (get-buffer-create name))) (cl-letf (((symbol-function 'cj/--ai-term-process-live-p) (lambda (_b) nil))) - (test-ai-term--with-mock-ghostel (:calls calls :strings strings - :default-dir _ddir) + (test-ai-term--with-mock-eat (:calls calls :strings strings + :default-dir _ddir) (cj/--ai-term-show-or-create "/tmp/dead" name) (should (equal calls (list name))) - (should (equal (reverse strings) - (list (cj/--ai-term-launch-command "/tmp/dead") - "\n"))) + (should (equal strings + (list (concat (cj/--ai-term-launch-command "/tmp/dead") + "\n")))) (should-not (buffer-live-p stale))))) (test-ai-term--cleanup name)))) (ert-deftest test-ai-term--show-or-create-preserves-selected-window () - "Regression: ghostel's same-window switch must not bury the dashboard. + "Regression: eat's same-window switch must not bury the dashboard. -Real `ghostel' switches the selected window to its buffer as a side-effect of +Real `eat' switches the selected window to its buffer as a side-effect of construction. On a fresh-boot frame (one window showing the dashboard), that side-effect would otherwise leave the original window pointing at the new -agent buffer. The wrapper runs `(ghostel)' inside `save-window-excursion' so -the original window state is restored before `display-buffer' fires, leaving -the dashboard put and letting the alist place agent into a fresh split. +agent buffer. The wrapper runs `(eat)' inside `save-window-excursion' so the +original window state is restored before `display-buffer' fires, leaving the +dashboard put and letting the alist place agent into a fresh split. -This test stubs `ghostel' to mimic the same-window side-effect and asserts the +This test stubs `eat' to mimic the same-window side-effect and asserts the originally-selected window still shows its original buffer afterward." (let ((agent-name "agent [preserve-window-test]") (orig-name "*test-original-buffer*")) @@ -128,24 +126,24 @@ originally-selected window still shows its original buffer afterward." (orig-win (selected-window))) (set-window-buffer orig-win orig-buf) (cl-letf - (((symbol-function 'ghostel) - (lambda (&optional _arg) - (let ((buf (get-buffer-create ghostel-buffer-name))) + (((symbol-function 'eat) + (lambda (&optional _program _arg) + (let ((buf (get-buffer-create eat-buffer-name))) (set-window-buffer (selected-window) buf) buf))) - ((symbol-function 'ghostel-send-string) - (lambda (_s) nil))) + ((symbol-function 'cj/--ai-term-send-string) + (lambda (_buf _s) nil))) (cj/--ai-term-show-or-create "/tmp/preserve" agent-name) (should (eq (window-buffer orig-win) orig-buf))))) (test-ai-term--cleanup agent-name) (when (get-buffer orig-name) (kill-buffer orig-name))))) (ert-deftest test-ai-term--show-or-create-returns-buffer () - "Normal: return value is the ghostel buffer named after the project." + "Normal: return value is the eat buffer named after the project." (let ((name "agent [return-test]")) (test-ai-term--cleanup name) (unwind-protect - (test-ai-term--with-mock-ghostel (:calls _c :strings _s :default-dir _d) + (test-ai-term--with-mock-eat (:calls _c :strings _s :default-dir _d) (let ((result (cj/--ai-term-show-or-create "/tmp/return" name))) (should (bufferp result)) (should (equal (buffer-name result) name)))) diff --git a/tests/test-ai-term--single-window-toggle.el b/tests/test-ai-term--single-window-toggle.el index aa507f032..dd5adbcc3 100644 --- a/tests/test-ai-term--single-window-toggle.el +++ b/tests/test-ai-term--single-window-toggle.el @@ -19,7 +19,7 @@ (add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) (add-to-list 'load-path (expand-file-name "tests" user-emacs-directory)) (require 'ai-term) -(require 'testutil-ghostel-buffers) +(require 'testutil-terminal-buffers) ;;; Normal Cases @@ -182,5 +182,119 @@ the flag nil (no spurious set)." (kill-buffer "*test-sw-untouched-left*")) (cj/test--kill-agent-buffers)))) +;;; Geometry tracking (Approach B: remember the agent's fullscreen state) + +(ert-deftest test-ai-term--track-geometry-sole-sets-fullscreen () + "Normal: an agent window that is the sole window in its frame sets +`cj/--ai-term-last-fullscreen'." + (cj/test--kill-agent-buffers) + (let ((agent-name "agent [track-sole]") + (cj/--ai-term-last-fullscreen nil)) + (unwind-protect + (save-window-excursion + (delete-other-windows) + (let ((agent-buf (get-buffer-create agent-name))) + (set-window-buffer (selected-window) agent-buf) + (should (one-window-p)) + (cj/--ai-term-track-geometry) + (should (eq cj/--ai-term-last-fullscreen t)))) + (cj/test--kill-agent-buffers)))) + +(ert-deftest test-ai-term--track-geometry-split-clears-fullscreen () + "Normal: an agent window shown as a split clears `cj/--ai-term-last-fullscreen'. +The tracker must NOT re-capture dock direction/size here -- doing so on every +window change drifts the dock height per cycle; toggle-off owns that capture." + (cj/test--kill-agent-buffers) + (let ((agent-name "agent [track-split]") + (left-name "*test-track-left*") + (cj/--ai-term-last-fullscreen t) ; pretend it was fullscreen + (cj/--ai-term-last-direction nil) + (cj/--ai-term-last-size nil)) + (unwind-protect + (save-window-excursion + (delete-other-windows) + (let ((agent-buf (get-buffer-create agent-name)) + (left-buf (get-buffer-create left-name))) + (set-window-buffer (selected-window) left-buf) + (let ((agent-win (split-window (selected-window) nil 'right))) + (set-window-buffer agent-win agent-buf) + (should-not (one-window-p)) + (cj/--ai-term-track-geometry) + (should-not cj/--ai-term-last-fullscreen) ; flag cleared + (should-not cj/--ai-term-last-size)))) ; dock size NOT re-captured here + (when (get-buffer left-name) (kill-buffer left-name)) + (cj/test--kill-agent-buffers)))) + +(ert-deftest test-ai-term--track-geometry-no-agent-retains-state () + "Boundary: with no agent window displayed, the tracker leaves the last-seen +fullscreen flag untouched -- that is the just-left state to replay." + (cj/test--kill-agent-buffers) + (let ((cj/--ai-term-last-fullscreen t)) + (unwind-protect + (save-window-excursion + (delete-other-windows) + (set-window-buffer (selected-window) + (get-buffer-create "*test-track-none*")) + (should-not (cj/--ai-term-displayed-agent-window)) + (cj/--ai-term-track-geometry) + (should (eq cj/--ai-term-last-fullscreen t))) ; unchanged + (when (get-buffer "*test-track-none*") (kill-buffer "*test-track-none*")) + (cj/test--kill-agent-buffers)))) + +(ert-deftest test-ai-term--display-saved-restores-fullscreen-when-last-fullscreen () + "Normal: when the agent was last fullscreen and the target frame is a single +window, display-saved restores it in place rather than docking -- Craig's case +of leaving a fullscreen agent, switching to another fullscreen buffer, then +M-SPC. A stale dock size is on record; the split path must NOT run." + (cj/test--kill-agent-buffers) + (let ((agent-name "agent [restore-fullscreen]") + (cj/--ai-term-last-fullscreen t) + (cj/--ai-term-last-was-bury nil) + (cj/--ai-term-last-direction 'right) + (cj/--ai-term-last-size 40)) + (unwind-protect + (save-window-excursion + (delete-other-windows) + (let* ((other-buf (get-buffer-create "*test-rfs-other*")) + (agent-buf (get-buffer-create agent-name)) + (win (selected-window)) + (split-called nil)) + (set-window-buffer win other-buf) + (should (one-window-p)) + (cl-letf (((symbol-function 'display-buffer-in-direction) + (lambda (&rest _) (setq split-called t) (selected-window)))) + (cj/--ai-term-display-saved agent-buf nil)) + (should (one-window-p)) ; no split -- stayed full-frame + (should (eq (window-buffer win) agent-buf)) ; agent took the lone window + (should-not split-called))) ; dock path never ran + (when (get-buffer "*test-rfs-other*") (kill-buffer "*test-rfs-other*")) + (cj/test--kill-agent-buffers)))) + +(ert-deftest test-ai-term--display-saved-docks-when-not-fullscreen () + "Boundary: without the fullscreen flag (or a bury), a single-window summon +docks via the saved-direction split. The discriminator is the remembered +state, not merely `one-window-p', so first-open and ordinary summons still +dock rather than seizing the whole frame." + (cj/test--kill-agent-buffers) + (let ((agent-name "agent [dock-not-fullscreen]") + (cj/--ai-term-last-fullscreen nil) + (cj/--ai-term-last-was-bury nil) + (cj/--ai-term-last-direction 'right) + (cj/--ai-term-last-size 40)) + (unwind-protect + (save-window-excursion + (delete-other-windows) + (let ((agent-buf (get-buffer-create agent-name)) + (split-called nil)) + (set-window-buffer (selected-window) + (get-buffer-create "*test-dock-other*")) + (should (one-window-p)) + (cl-letf (((symbol-function 'display-buffer-in-direction) + (lambda (&rest _) (setq split-called t) (selected-window)))) + (cj/--ai-term-display-saved agent-buf nil)) + (should split-called))) ; dock path ran despite one-window-p + (when (get-buffer "*test-dock-other*") (kill-buffer "*test-dock-other*")) + (cj/test--kill-agent-buffers)))) + (provide 'test-ai-term--single-window-toggle) ;;; test-ai-term--single-window-toggle.el ends here diff --git a/tests/test-auto-dim-config.el b/tests/test-auto-dim-config.el index 532e7dfae..2686b88f3 100644 --- a/tests/test-auto-dim-config.el +++ b/tests/test-auto-dim-config.el @@ -8,8 +8,9 @@ ;; in ~/code and may be absent on a clean checkout. ;; ;; The vterm dim-integration tests were removed when the terminal engine moved -;; to ghostel: ghostel bakes its palette per-terminal (no per-window color -;; hook), so terminal buffers no longer participate in window dimming. +;; off vterm. EAT (the current engine) renders in real Emacs faces and uses the +;; `default' face for its background, so terminal buffers dim like any other +;; buffer with no dedicated integration. ;;; Code: diff --git a/tests/test-calendar-sync--deferred-start.el b/tests/test-calendar-sync--deferred-start.el new file mode 100644 index 000000000..a3a9c0198 --- /dev/null +++ b/tests/test-calendar-sync--deferred-start.el @@ -0,0 +1,43 @@ +;;; test-calendar-sync--deferred-start.el --- Deferred auto-start tests -*- lexical-binding: t; -*- + +;;; Commentary: +;; calendar-sync arms its auto-sync on the first org-agenda use instead of at +;; load, so a cold gpg-agent is not prompted for the authinfo passphrase at +;; startup (the :secret-host feed URLs decrypt authinfo.gpg). These tests cover +;; the one-shot helper: it starts sync once and removes itself, even when the +;; start call errors. + +;;; Code: + +(require 'ert) +(require 'cl-lib) + +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'calendar-sync) + +;; org-agenda need not be loaded under `make test'; declare the hook special so +;; the dynamic `let' bindings below shadow it cleanly. +(defvar org-agenda-mode-hook) + +(ert-deftest test-calendar-sync-deferred-start-fires-once-and-unhooks () + "Normal: the one-shot starts sync once and removes itself from the hook." + (let ((started 0) + (org-agenda-mode-hook (list #'calendar-sync--auto-start-on-first-agenda))) + (cl-letf (((symbol-function 'calendar-sync-start) + (lambda (&rest _) (setq started (1+ started))))) + (calendar-sync--auto-start-on-first-agenda)) + (should (= started 1)) + (should-not (member #'calendar-sync--auto-start-on-first-agenda + org-agenda-mode-hook)))) + +(ert-deftest test-calendar-sync-deferred-start-unhooks-even-when-start-errors () + "Error: a start failure still leaves the hook removed, so it cannot re-fire." + (let ((org-agenda-mode-hook (list #'calendar-sync--auto-start-on-first-agenda))) + (cl-letf (((symbol-function 'calendar-sync-start) + (lambda (&rest _) (error "boom")))) + (should-error (calendar-sync--auto-start-on-first-agenda))) + (should-not (member #'calendar-sync--auto-start-on-first-agenda + org-agenda-mode-hook)))) + +(provide 'test-calendar-sync--deferred-start) +;;; test-calendar-sync--deferred-start.el ends here diff --git a/tests/test-calibredb-epub-config--bookmark-name.el b/tests/test-calibredb-epub-config--bookmark-name.el index 2e1d253e9..7e9ffa345 100644 --- a/tests/test-calibredb-epub-config--bookmark-name.el +++ b/tests/test-calibredb-epub-config--bookmark-name.el @@ -1,10 +1,13 @@ -;;; test-calibredb-epub-config--bookmark-name.el --- Nov bookmark naming tests -*- lexical-binding: t; -*- +;;; test-calibredb-epub-config--bookmark-name.el --- Reading bookmark naming tests -*- lexical-binding: t; -*- ;;; Commentary: -;; Tests for the clean "Author, Title" bookmark naming that replaces nov.el's -;; filename-based default. The name is parsed from the EPUB filename (Calibre's -;; "<Title> - <Author>.epub" convention), restoring colons that Calibre -;; sanitized to underscores and reordering to "Author, Title". +;; Tests for the clean "Author, Title" bookmark naming that replaces the +;; filename-based default for both EPUB (nov) and PDF (pdf-view) bookmarks. +;; The name is parsed from the file's name (Calibre's "<Title> - <Author>.<ext>" +;; convention), restoring colons that Calibre sanitized to underscores and +;; reordering to "Author, Title". The parser is extension-agnostic, so the +;; same advice serves both nov-bookmark-make-record and +;; pdf-view-bookmark-make-record. ;;; Code: @@ -12,76 +15,93 @@ (add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) (require 'calibredb-epub-config) -;;; cj/--nov-clean-title +;;; cj/--reading-clean-title -(ert-deftest test-nov-clean-title-passthrough () +(ert-deftest test-reading-clean-title-passthrough () "Normal: a clean string is returned unchanged." - (should (equal (cj/--nov-clean-title "Agatha Christie") "Agatha Christie")) - (should (equal (cj/--nov-clean-title "The A.B.C. Murders") "The A.B.C. Murders"))) + (should (equal (cj/--reading-clean-title "Agatha Christie") "Agatha Christie")) + (should (equal (cj/--reading-clean-title "The A.B.C. Murders") "The A.B.C. Murders"))) -(ert-deftest test-nov-clean-title-restores-colon () +(ert-deftest test-reading-clean-title-restores-colon () "Boundary: Calibre's \"_ \" colon substitution is restored to \": \"." - (should (equal (cj/--nov-clean-title "Frege_ A Guide for the Perplexed") + (should (equal (cj/--reading-clean-title "Frege_ A Guide for the Perplexed") "Frege: A Guide for the Perplexed")) - (should (equal (cj/--nov-clean-title "The Fool's Progress_ An Honest Novel") + (should (equal (cj/--reading-clean-title "The Fool's Progress_ An Honest Novel") "The Fool's Progress: An Honest Novel"))) -(ert-deftest test-nov-clean-title-stray-underscore-and-whitespace () +(ert-deftest test-reading-clean-title-stray-underscore-and-whitespace () "Boundary: a non-colon underscore becomes a space; whitespace collapses." - (should (equal (cj/--nov-clean-title "a_b") "a b")) - (should (equal (cj/--nov-clean-title " x y ") "x y"))) + (should (equal (cj/--reading-clean-title "a_b") "a b")) + (should (equal (cj/--reading-clean-title " x y ") "x y"))) -(ert-deftest test-nov-clean-title-rejects-blank-and-nonstring () +(ert-deftest test-reading-clean-title-rejects-blank-and-nonstring () "Error: nil, empty, all-whitespace, or non-string yields nil." - (should-not (cj/--nov-clean-title nil)) - (should-not (cj/--nov-clean-title "")) - (should-not (cj/--nov-clean-title " ")) - (should-not (cj/--nov-clean-title 42))) + (should-not (cj/--reading-clean-title nil)) + (should-not (cj/--reading-clean-title "")) + (should-not (cj/--reading-clean-title " ")) + (should-not (cj/--reading-clean-title 42))) -;;; cj/--nov-bookmark-name-from-file +;;; cj/--reading-bookmark-name-from-file -(ert-deftest test-nov-bookmark-name-real-examples () +(ert-deftest test-reading-bookmark-name-real-examples () "Normal: real Calibre filenames become \"Author, Title\" with colons restored." - (should (equal (cj/--nov-bookmark-name-from-file + (should (equal (cj/--reading-bookmark-name-from-file "/books/Frege_ A Guide for the Perplexed - Edward Kanterian.epub") "Edward Kanterian, Frege: A Guide for the Perplexed")) - (should (equal (cj/--nov-bookmark-name-from-file + (should (equal (cj/--reading-bookmark-name-from-file "/books/The A.B.C. Murders - Agatha Christie.epub") "Agatha Christie, The A.B.C. Murders")) - (should (equal (cj/--nov-bookmark-name-from-file + (should (equal (cj/--reading-bookmark-name-from-file "/books/The Fool's Progress_ An Honest Novel - Edward Abbey.epub") "Edward Abbey, The Fool's Progress: An Honest Novel"))) -(ert-deftest test-nov-bookmark-name-splits-on-last-separator () +(ert-deftest test-reading-bookmark-name-pdf-extension () + "Normal: a PDF filename is parsed the same way -- the parser is extension- +agnostic, so PDF bookmarks reformat like EPUB ones." + (should (equal (cj/--reading-bookmark-name-from-file + "/books/Engines of Logic_ Mathematicians and the O - Martin Davis.pdf") + "Martin Davis, Engines of Logic: Mathematicians and the O"))) + +(ert-deftest test-reading-bookmark-name-splits-on-last-separator () "Boundary: a title containing \" - \" splits on the LAST separator." - (should (equal (cj/--nov-bookmark-name-from-file "/b/Title - Part Two - Some Author.epub") + (should (equal (cj/--reading-bookmark-name-from-file "/b/Title - Part Two - Some Author.epub") "Some Author, Title - Part Two"))) -(ert-deftest test-nov-bookmark-name-no-separator () +(ert-deftest test-reading-bookmark-name-no-separator () "Boundary: a filename with no \" - \" falls back to the cleaned whole name." - (should (equal (cj/--nov-bookmark-name-from-file "/b/Untitled_ Draft.epub") + (should (equal (cj/--reading-bookmark-name-from-file "/b/Untitled_ Draft.epub") "Untitled: Draft"))) -(ert-deftest test-nov-bookmark-name-nil-and-empty () +(ert-deftest test-reading-bookmark-name-nil-and-empty () "Error: nil or empty path yields nil." - (should-not (cj/--nov-bookmark-name-from-file nil)) - (should-not (cj/--nov-bookmark-name-from-file ""))) + (should-not (cj/--reading-bookmark-name-from-file nil)) + (should-not (cj/--reading-bookmark-name-from-file ""))) -;;; cj/--nov-bookmark-rename-record +;;; cj/--reading-bookmark-rename-record -(ert-deftest test-nov-bookmark-rename-record-replaces-name () +(ert-deftest test-reading-bookmark-rename-record-replaces-name () "Normal: the record's name is rebuilt from its filename; the alist is kept." (let* ((record (cons "The A.B.C. Murders - Agatha Christie.epub" '((filename . "/b/The A.B.C. Murders - Agatha Christie.epub") (index . 0)))) - (out (cj/--nov-bookmark-rename-record record))) + (out (cj/--reading-bookmark-rename-record record))) (should (equal (car out) "Agatha Christie, The A.B.C. Murders")) (should (equal (cdr out) (cdr record))))) -(ert-deftest test-nov-bookmark-rename-record-keeps-original-without-filename () +(ert-deftest test-reading-bookmark-rename-record-pdf () + "Normal: a PDF-shaped record (filename from `bookmark-make-record-default') +gets the same \"Author, Title\" rename." + (let* ((record (cons "Engines of Logic_ Mathematicians and the O - Martin Davis.pdf" + '((filename . "/b/Engines of Logic_ Mathematicians and the O - Martin Davis.pdf") + (page . 12)))) + (out (cj/--reading-bookmark-rename-record record))) + (should (equal (car out) "Martin Davis, Engines of Logic: Mathematicians and the O")) + (should (equal (cdr out) (cdr record))))) + +(ert-deftest test-reading-bookmark-rename-record-keeps-original-without-filename () "Boundary: a record with no usable filename is returned unchanged." (let ((record (cons "whatever" '((index . 0))))) - (should (equal (cj/--nov-bookmark-rename-record record) record)))) + (should (equal (cj/--reading-bookmark-rename-record record) record)))) (provide 'test-calibredb-epub-config--bookmark-name) ;;; test-calibredb-epub-config--bookmark-name.el ends here diff --git a/tests/test-calibredb-epub-config--open-to-favorites.el b/tests/test-calibredb-epub-config--open-to-favorites.el new file mode 100644 index 000000000..d11618081 --- /dev/null +++ b/tests/test-calibredb-epub-config--open-to-favorites.el @@ -0,0 +1,57 @@ +;;; test-calibredb-epub-config--open-to-favorites.el --- in-progress open filter -*- lexical-binding: t; -*- + +;;; Commentary: +;; `cj/--calibredb-open-to-favorites' advises `calibredb' :after so every launch +;; lands filtered to `calibredb-favorite-keyword' (Craig's "in-progress" books). +;; It scopes the filter to the TAG field (sets `calibredb-tag-filter-p', clears +;; the other filter-p flags) before delegating to `calibredb-search-keyword-filter', +;; so the keyword can't over-match in a book's title or description. It no-ops +;; when no usable keyword is set. + +;;; Code: + +(require 'ert) +(require 'cl-lib) +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'calibredb-epub-config) + +;; calibredb defcustom + internal flags; declared special so `let' binds them +;; dynamically (all unbound under `make test', which never runs the use-package +;; :config or loads calibredb). +(defvar calibredb-favorite-keyword) +(defvar calibredb-tag-filter-p) +(defvar calibredb-favorite-filter-p) +(defvar calibredb-author-filter-p) +(defvar calibredb-date-filter-p) +(defvar calibredb-format-filter-p) + +(ert-deftest test-calibredb-open-to-favorites-applies-keyword-scoped-to-tags () + "Normal: with a favorite keyword set, the filter runs with that keyword and is +scoped to the tag field (so it can't over-match a description); a stale +non-tag filter flag is cleared." + (let ((applied :unset) + (calibredb-favorite-keyword "in-progress") + (calibredb-tag-filter-p nil) + (calibredb-favorite-filter-p t) ; stale, must be cleared + (calibredb-author-filter-p nil) + (calibredb-date-filter-p nil) + (calibredb-format-filter-p nil)) + (cl-letf (((symbol-function 'calibredb-search-keyword-filter) + (lambda (kw) (setq applied kw)))) + (cj/--calibredb-open-to-favorites)) + (should (equal applied "in-progress")) ; keyword applied + (should (eq calibredb-tag-filter-p t)) ; scoped to the tag field + (should-not calibredb-favorite-filter-p))) ; stale flag cleared + +(ert-deftest test-calibredb-open-to-favorites-noop-without-usable-keyword () + "Boundary/Error: nil, empty, or non-string keyword applies no filter." + (dolist (kw (list nil "" 42)) + (let ((applied :unset) + (calibredb-favorite-keyword kw)) + (cl-letf (((symbol-function 'calibredb-search-keyword-filter) + (lambda (k) (setq applied k)))) + (cj/--calibredb-open-to-favorites)) + (should (eq applied :unset))))) + +(provide 'test-calibredb-epub-config--open-to-favorites) +;;; test-calibredb-epub-config--open-to-favorites.el ends here diff --git a/tests/test-calibredb-epub-config.el b/tests/test-calibredb-epub-config.el index cb3a9ba74..71581d4c9 100644 --- a/tests/test-calibredb-epub-config.el +++ b/tests/test-calibredb-epub-config.el @@ -173,12 +173,13 @@ re-render of the document." (should (commandp #'cj/nov-narrow-text))) (ert-deftest test-calibredb-epub-nov-width-commands-bound-in-nov-mode-map () - "Normal: +/= widen and -/_ narrow the text column in `nov-mode-map'." + "Normal: { } adjust the text column in `nov-mode-map' (+/-/= are font size)." (skip-unless (and (require 'nov nil t) (boundp 'nov-mode-map))) - (should (eq (keymap-lookup nov-mode-map "+") #'cj/nov-widen-text)) - (should (eq (keymap-lookup nov-mode-map "=") #'cj/nov-widen-text)) - (should (eq (keymap-lookup nov-mode-map "-") #'cj/nov-narrow-text)) - (should (eq (keymap-lookup nov-mode-map "_") #'cj/nov-narrow-text))) + (should (eq (keymap-lookup nov-mode-map "}") #'cj/nov-widen-text)) + (should (eq (keymap-lookup nov-mode-map "{") #'cj/nov-narrow-text)) + (should (eq (keymap-lookup nov-mode-map "+") #'cj/nov-reading-text-bigger)) + (should (eq (keymap-lookup nov-mode-map "-") #'cj/nov-reading-text-smaller)) + (should (eq (keymap-lookup nov-mode-map "=") #'cj/nov-reading-text-reset))) ;;; -------------------------- cj/nov-apply-preferences ------------------------ diff --git a/tests/test-custom-buffer-file--buffer-differs-prompt.el b/tests/test-custom-buffer-file--buffer-differs-prompt.el new file mode 100644 index 000000000..109ca121f --- /dev/null +++ b/tests/test-custom-buffer-file--buffer-differs-prompt.el @@ -0,0 +1,197 @@ +;;; test-custom-buffer-file--buffer-differs-prompt.el --- disk-changed save prompt pieces -*- lexical-binding: t; -*- + +;;; Commentary: +;; Pure-logic tests for the disk-changed save prompt (the C-x C-s case where the +;; buffer is modified AND the file changed on disk): the question string (with a +;; terse whitespace-only parenthetical), the labeled-but-terse choice list, and +;; the key->action mapping. The interactive read loop, the diff display, and the +;; save/revert dispatch are exercised live, not here. + +;;; Code: + +(require 'ert) +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'custom-buffer-file) + +(declare-function cj/--buffer-differs-prompt-string "custom-buffer-file" (name ws-only-p)) +(declare-function cj/--buffer-differs-choices "custom-buffer-file" ()) +(declare-function cj/--buffer-differs-action "custom-buffer-file" (key)) + +;;; ------------------- cj/--buffer-differs-prompt-string ---------------------- + +(ert-deftest test-cbf-buffer-differs-prompt-plain () + "Normal: without whitespace-only, the prompt names the buffer, no parenthetical." + (let ((s (cj/--buffer-differs-prompt-string "todo.org" nil))) + (should (string-match-p "todo\\.org" s)) + (should-not (string-match-p "whitespace" s)))) + +(ert-deftest test-cbf-buffer-differs-prompt-whitespace-only () + "Normal: whitespace-only folds in a terse \"(whitespace only)\" parenthetical." + (let ((s (cj/--buffer-differs-prompt-string "todo.org" t))) + (should (string-match-p "todo\\.org" s)) + (should (string-match-p "(whitespace only)" s)))) + +;;; ---------------------- cj/--buffer-differs-choices ------------------------- + +(ert-deftest test-cbf-buffer-differs-choices-keys () + "Normal: the menu offers save, diff, clean, revert, and cancel." + (let ((c (cj/--buffer-differs-choices))) + (dolist (key '(?s ?d ?w ?r ?c)) + (should (assq key c))))) + +(ert-deftest test-cbf-buffer-differs-choices-terse-names () + "Boundary: inline names stay terse (one word) so the menu fits at a glance." + (dolist (entry (cj/--buffer-differs-choices)) + (let ((name (nth 1 entry))) + (should (stringp name)) + (should-not (string-match-p " " name))))) + +(ert-deftest test-cbf-buffer-differs-choices-clean-help-mentions-whitespace () + "Normal: the clean option's description (the ? help) names whitespace." + (let ((entry (assq ?w (cj/--buffer-differs-choices)))) + (should (string-match-p "whitespace" (or (nth 2 entry) ""))))) + +(ert-deftest test-cbf-buffer-differs-choices-revert-help-mentions-disk () + "Normal: the revert option's description makes clear it rereads from disk." + (let ((entry (assq ?r (cj/--buffer-differs-choices)))) + (should (string-match-p "disk" (or (nth 2 entry) ""))))) + +;;; ---------------------- cj/--buffer-differs-action -------------------------- + +(ert-deftest test-cbf-buffer-differs-action-save () + "Normal: s overwrites the file with the buffer." + (should (eq (cj/--buffer-differs-action ?s) 'save))) + +(ert-deftest test-cbf-buffer-differs-action-clean () + "Normal: w cleans whitespace, then saves." + (should (eq (cj/--buffer-differs-action ?w) 'clean-save))) + +(ert-deftest test-cbf-buffer-differs-action-revert () + "Normal: r discards edits and rereads from disk." + (should (eq (cj/--buffer-differs-action ?r) 'revert))) + +(ert-deftest test-cbf-buffer-differs-action-diff () + "Normal: d peeks at the diff (re-prompt is the caller's concern)." + (should (eq (cj/--buffer-differs-action ?d) 'diff))) + +(ert-deftest test-cbf-buffer-differs-action-cancel () + "Boundary: c cancels, leaving the buffer untouched." + (should (eq (cj/--buffer-differs-action ?c) 'cancel))) + +(ert-deftest test-cbf-buffer-differs-action-unknown () + "Error: an unmapped key returns nil." + (should-not (cj/--buffer-differs-action ?z))) + +;;; ------------------- cj/--buffer-changed-on-disk-p -------------------------- +;; Real visited-file buffers; modtime state is driven (set-visited-file-modtime), +;; not mocked. The trigger is the disk-changed conflict: modified AND the file +;; changed on disk since visited. + +(declare-function cj/--buffer-changed-on-disk-p "custom-buffer-file" (buffer)) + +(defun test-cbf-cod--with-visited (edit-fn body-fn) + "Visit a temp file, run EDIT-FN in its buffer, call BODY-FN with the buffer." + (let ((f (make-temp-file "cbf-cod-" nil ".txt"))) + (unwind-protect + (progn + (with-temp-file f (insert "original\n")) + (let ((buf (find-file-noselect f))) + (unwind-protect + (with-current-buffer buf (funcall edit-fn) (funcall body-fn buf)) + (with-current-buffer buf (set-buffer-modified-p nil)) + (kill-buffer buf)))) + (when (file-exists-p f) (delete-file f))))) + +(ert-deftest test-cbf-changed-on-disk-detects () + "Normal: modified buffer whose recorded modtime no longer matches is changed-on-disk." + (test-cbf-cod--with-visited + (lambda () (goto-char (point-max)) (insert "edit\n") (set-visited-file-modtime '(0 0))) + (lambda (buf) (should (cj/--buffer-changed-on-disk-p buf))))) + +(ert-deftest test-cbf-changed-on-disk-clean-modtime () + "Boundary: modified buffer whose modtime still matches is not changed-on-disk." + (test-cbf-cod--with-visited + (lambda () (goto-char (point-max)) (insert "edit\n")) + (lambda (buf) (should-not (cj/--buffer-changed-on-disk-p buf))))) + +(ert-deftest test-cbf-changed-on-disk-unmodified () + "Boundary: an unmodified buffer is never changed-on-disk (nothing of mine to lose)." + (test-cbf-cod--with-visited + (lambda () (set-visited-file-modtime '(0 0))) + (lambda (buf) (should-not (cj/--buffer-changed-on-disk-p buf))))) + +;;; -------------- cj/--buffer-differs-dispatch (data direction) --------------- +;; The destructive directions, driven against real files: `save' overwrites the +;; disk with the buffer (buffer wins); `revert' discards the buffer's edits and +;; rereads the disk (disk wins); `clean-save' strips trailing whitespace first. + +(declare-function cj/--buffer-differs-dispatch "custom-buffer-file" (buffer action)) +(declare-function cj/save-buffer "custom-buffer-file" ()) + +(defun test-cbf-disp--with-conflict (buffer-insert disk-content body-fn) + "Visit a temp file, BUFFER-INSERT into the buffer, overwrite the file with +DISK-CONTENT underneath, then call BODY-FN with the buffer and file path." + (let ((f (make-temp-file "cbf-disp-" nil ".txt"))) + (unwind-protect + (progn + (with-temp-file f (insert "original\n")) + (let ((buf (find-file-noselect f))) + (unwind-protect + (with-current-buffer buf + (goto-char (point-max)) (insert buffer-insert) + (with-temp-file f (insert disk-content)) + (funcall body-fn buf f)) + (with-current-buffer buf (set-buffer-modified-p nil)) + (kill-buffer buf)))) + (when (file-exists-p f) (delete-file f))))) + +(defun test-cbf-disp--disk (f) + "Return the on-disk contents of F." + (with-temp-buffer (insert-file-contents f) (buffer-string))) + +(ert-deftest test-cbf-buffer-differs-dispatch-save-overwrites-disk () + "Normal: save writes the buffer over the disk version (buffer wins)." + (test-cbf-disp--with-conflict + "my edit\n" "disk changed underneath\n" + (lambda (buf f) + (cj/--buffer-differs-dispatch buf 'save) + (should-not (buffer-modified-p buf)) + (should (string= (test-cbf-disp--disk f) "original\nmy edit\n"))))) + +(ert-deftest test-cbf-buffer-differs-dispatch-revert-discards-edits () + "Normal: revert discards the buffer's edits and rereads the disk (disk wins)." + (test-cbf-disp--with-conflict + "my edit\n" "disk version\n" + (lambda (buf f) + (cj/--buffer-differs-dispatch buf 'revert) + (should-not (buffer-modified-p buf)) + (should (string= (with-current-buffer buf (buffer-string)) "disk version\n"))))) + +(ert-deftest test-cbf-buffer-differs-dispatch-clean-save-strips-whitespace () + "Normal: clean-save strips trailing whitespace, then overwrites the disk." + (test-cbf-disp--with-conflict + "edit \n" "disk changed\n" + (lambda (buf f) + (cj/--buffer-differs-dispatch buf 'clean-save) + (should-not (buffer-modified-p buf)) + (should (string= (test-cbf-disp--disk f) "original\nedit\n"))))) + +(ert-deftest test-cbf-save-buffer-fast-path-no-conflict () + "Boundary: with no disk conflict, cj/save-buffer just saves (no prompt path)." + (let ((f (make-temp-file "cbf-fast-" nil ".txt"))) + (unwind-protect + (progn + (with-temp-file f (insert "base\n")) + (let ((buf (find-file-noselect f))) + (unwind-protect + (with-current-buffer buf + (goto-char (point-max)) (insert "added\n") + (cj/save-buffer) ; modtime matches -> fast path + (should-not (buffer-modified-p)) + (should (string= (test-cbf-disp--disk f) "base\nadded\n"))) + (with-current-buffer buf (set-buffer-modified-p nil)) + (kill-buffer buf)))) + (when (file-exists-p f) (delete-file f))))) + +(provide 'test-custom-buffer-file--buffer-differs-prompt) +;;; test-custom-buffer-file--buffer-differs-prompt.el ends here diff --git a/tests/test-custom-buffer-file--diff-whitespace-only.el b/tests/test-custom-buffer-file--diff-whitespace-only.el new file mode 100644 index 000000000..e792637b5 --- /dev/null +++ b/tests/test-custom-buffer-file--diff-whitespace-only.el @@ -0,0 +1,146 @@ +;;; test-custom-buffer-file--diff-whitespace-only.el --- whitespace-only diff detection -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for cj/--diff-whitespace-only-p, the route-1 detector behind the +;; buffer-differs save prompt: two files differ ONLY in whitespace when a plain +;; diff finds changes but `diff -w' (ignore all whitespace) finds none. Uses +;; real temp files and the real diff(1) binary (a system boundary we keep), so +;; nothing is mocked. + +;;; Code: + +(require 'ert) +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'custom-buffer-file) + +(declare-function cj/--diff-whitespace-only-p "custom-buffer-file" (file-a file-b)) + +(defun test-cbf-ws--two-files (content-a content-b fn) + "Write CONTENT-A and CONTENT-B to temp files, call FN with their paths, clean up." + (let ((a (make-temp-file "cbf-ws-a-")) + (b (make-temp-file "cbf-ws-b-"))) + (unwind-protect + (progn + (with-temp-file a (insert content-a)) + (with-temp-file b (insert content-b)) + (funcall fn a b)) + (delete-file a) + (delete-file b)))) + +(ert-deftest test-cbf-diff-whitespace-only-trailing () + "Normal: files differing only by trailing whitespace are whitespace-only." + (test-cbf-ws--two-files + "alpha\nbeta\n" "alpha \nbeta\n" + (lambda (a b) (should (cj/--diff-whitespace-only-p a b))))) + +(ert-deftest test-cbf-diff-whitespace-only-indentation () + "Normal: files differing only by leading indentation are whitespace-only." + (test-cbf-ws--two-files + "(foo)\n(bar)\n" "(foo)\n (bar)\n" + (lambda (a b) (should (cj/--diff-whitespace-only-p a b))))) + +(ert-deftest test-cbf-diff-whitespace-only-real-content () + "Normal: files differing in actual content are NOT whitespace-only." + (test-cbf-ws--two-files + "alpha\nbeta\n" "alpha\nGAMMA\n" + (lambda (a b) (should-not (cj/--diff-whitespace-only-p a b))))) + +(ert-deftest test-cbf-diff-whitespace-only-identical () + "Boundary: identical files do not differ at all, so not whitespace-only." + (test-cbf-ws--two-files + "alpha\nbeta\n" "alpha\nbeta\n" + (lambda (a b) (should-not (cj/--diff-whitespace-only-p a b))))) + +(ert-deftest test-cbf-diff-whitespace-only-mixed () + "Boundary: whitespace change plus a real content change is NOT whitespace-only." + (test-cbf-ws--two-files + "alpha\nbeta\n" "alpha \nGAMMA\n" + (lambda (a b) (should-not (cj/--diff-whitespace-only-p a b))))) + +;;; -------------------- cj/--diff-buffer-renderer ----------------------------- +;; Which renderer the diff command uses: whitespace-only diffs go to a plain +;; unified diff (trailing whitespace highlighted, so it is actually visible) +;; because difftastic treats trailing-whitespace as no change and renders it +;; blank. Real content diffs use difftastic when available, else plain diff. + +(declare-function cj/--diff-buffer-renderer "custom-buffer-file" (ws-only difft-available)) + +(ert-deftest test-cbf-diff-renderer-whitespace-over-difftastic () + "Normal: a whitespace-only diff uses the whitespace renderer even when difft is present." + (should (eq (cj/--diff-buffer-renderer t t) 'whitespace))) + +(ert-deftest test-cbf-diff-renderer-whitespace-no-difft () + "Boundary: whitespace-only still uses the whitespace renderer without difft." + (should (eq (cj/--diff-buffer-renderer t nil) 'whitespace))) + +(ert-deftest test-cbf-diff-renderer-content-uses-difftastic () + "Normal: a content diff uses difftastic when it is available." + (should (eq (cj/--diff-buffer-renderer nil t) 'difftastic))) + +(ert-deftest test-cbf-diff-renderer-content-no-difft-regular () + "Boundary: a content diff falls back to the regular renderer without difft." + (should (eq (cj/--diff-buffer-renderer nil nil) 'regular))) + +;;; --------------- cj/--buffer-file-whitespace-only-p (buffer) ---------------- +;; Buffer-vs-its-file variant: writes the buffer to a temp file and reuses the +;; detector against the buffer's visited file. Uses a real visited-file buffer. + +(declare-function cj/--buffer-file-whitespace-only-p "custom-buffer-file" (buffer)) + +(defun test-cbf-ws--with-visited (disk-content edit-fn body-fn) + "Visit a temp file holding DISK-CONTENT, apply EDIT-FN in it, call BODY-FN with the buffer." + (let ((f (make-temp-file "cbf-bws-" nil ".txt"))) + (unwind-protect + (progn + (with-temp-file f (insert disk-content)) + (let ((buf (find-file-noselect f))) + (unwind-protect + (with-current-buffer buf + (funcall edit-fn) + (funcall body-fn buf)) + (with-current-buffer buf (set-buffer-modified-p nil)) + (kill-buffer buf)))) + (when (file-exists-p f) (delete-file f))))) + +(ert-deftest test-cbf-buffer-file-ws-only-trailing () + "Normal: an unsaved trailing-whitespace edit is whitespace-only vs the file." + (test-cbf-ws--with-visited + "alpha\nbeta\n" + (lambda () (goto-char (point-min)) (end-of-line) (insert " ")) + (lambda (buf) (should (cj/--buffer-file-whitespace-only-p buf))))) + +(ert-deftest test-cbf-buffer-file-ws-only-content () + "Normal: an unsaved content edit is NOT whitespace-only vs the file." + (test-cbf-ws--with-visited + "alpha\nbeta\n" + (lambda () (goto-char (point-max)) (insert "gamma\n")) + (lambda (buf) (should-not (cj/--buffer-file-whitespace-only-p buf))))) + +;;; --------- cj/diff-buffer-with-file return value (for the toggle) ----------- + +(ert-deftest test-cbf-diff-returns-buffer-when-differs () + "Normal: cj/diff-buffer-with-file returns the live diff buffer when the buffer differs." + (test-cbf-ws--with-visited + "x\ny\n" + (lambda () (goto-char (point-max)) (insert "ADDED\n")) + (lambda (buf) + (let ((db (with-current-buffer buf (cj/diff-buffer-with-file)))) + (should (bufferp db)) + (should (buffer-live-p db)))))) + +(ert-deftest test-cbf-diff-returns-nil-when-identical () + "Boundary: with no differences, cj/diff-buffer-with-file returns nil." + (test-cbf-ws--with-visited + "x\ny\n" + (lambda () nil) + (lambda (buf) + (should-not (with-current-buffer buf (cj/diff-buffer-with-file)))))) + +(ert-deftest test-cbf-buffer-file-ws-only-non-file () + "Boundary: a buffer not visiting a file is not whitespace-only." + (with-temp-buffer + (insert "scratch") + (should-not (cj/--buffer-file-whitespace-only-p (current-buffer))))) + +(provide 'test-custom-buffer-file--diff-whitespace-only) +;;; test-custom-buffer-file--diff-whitespace-only.el ends here diff --git a/tests/test-custom-buffer-file--save-some-buffers.el b/tests/test-custom-buffer-file--save-some-buffers.el new file mode 100644 index 000000000..d4ecd318d --- /dev/null +++ b/tests/test-custom-buffer-file--save-some-buffers.el @@ -0,0 +1,123 @@ +;;; test-custom-buffer-file--save-some-buffers.el --- save-loop prompt pieces -*- lexical-binding: t; -*- + +;;; Commentary: +;; Pure-logic tests for the read-multiple-choice save loop that replaces +;; save-some-buffers' terse map-y-or-n-p prompt: the key->action mapping (what +;; to do with this buffer, and how the choice steers the rest of the loop) and +;; the labeled choice list. The interactive loop, the file saves, and the +;; override wiring are exercised live, not here. + +;;; Code: + +(require 'ert) +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'custom-buffer-file) + +(declare-function cj/--save-some-buffers-action "custom-buffer-file" (key)) +(declare-function cj/--save-some-buffers-choices "custom-buffer-file" ()) + +;;; --------------------- cj/--save-some-buffers-action ------------------------ +;; Each result is (THIS-ACTION . LOOP-EFFECT): +;; THIS-ACTION ∈ save | clean-save | skip | diff +;; LOOP-EFFECT ∈ continue | save-rest | stop | reprompt + +(ert-deftest test-cbf-ssb-action-save () + "Normal: y saves this buffer and continues prompting." + (should (equal (cj/--save-some-buffers-action ?y) '(save . continue)))) + +(ert-deftest test-cbf-ssb-action-skip () + "Normal: n skips this buffer and continues." + (should (equal (cj/--save-some-buffers-action ?n) '(skip . continue)))) + +(ert-deftest test-cbf-ssb-action-clean-save () + "Normal: w cleans whitespace, saves this buffer, and continues." + (should (equal (cj/--save-some-buffers-action ?w) '(clean-save . continue)))) + +(ert-deftest test-cbf-ssb-action-save-rest () + "Boundary: ! saves this buffer and all remaining without asking." + (should (equal (cj/--save-some-buffers-action ?!) '(save . save-rest)))) + +(ert-deftest test-cbf-ssb-action-save-this-stop () + "Boundary: . saves this buffer and skips the rest." + (should (equal (cj/--save-some-buffers-action ?.) '(save . stop)))) + +(ert-deftest test-cbf-ssb-action-quit () + "Boundary: q saves no more buffers (skips this and the rest)." + (should (equal (cj/--save-some-buffers-action ?q) '(skip . stop)))) + +(ert-deftest test-cbf-ssb-action-diff () + "Normal: d views the diff and re-prompts rather than resolving." + (should (equal (cj/--save-some-buffers-action ?d) '(diff . reprompt)))) + +(ert-deftest test-cbf-ssb-action-unknown () + "Error: an unmapped key returns nil." + (should-not (cj/--save-some-buffers-action ?z))) + +;;; --------------------- cj/--save-some-buffers-choices ----------------------- + +(ert-deftest test-cbf-ssb-choices-cover-all-keys () + "Normal: the choice list offers every save-loop key, each labeled." + (let ((choices (cj/--save-some-buffers-choices))) + (dolist (key '(?y ?n ?w ?d ?! ?. ?q)) + (let ((entry (assq key choices))) + (should entry) + ;; entry is (KEY NAME &optional DESC); NAME must be a non-empty label. + (should (stringp (nth 1 entry))) + (should (> (length (nth 1 entry)) 0)))))) + +(ert-deftest test-cbf-ssb-choices-terse-names () + "Boundary: inline names are single words so the menu takes minimum space." + (dolist (entry (cj/--save-some-buffers-choices)) + (let ((name (nth 1 entry))) + (should (stringp name)) + (should-not (string-match-p " " name))))) + +(ert-deftest test-cbf-ssb-choices-clean-mentions-whitespace () + "Normal: the clean-and-save choice is labeled with whitespace." + (let ((entry (assq ?w (cj/--save-some-buffers-choices)))) + (should (string-match-p "whitespace" + (mapconcat #'identity (cdr entry) " "))))) + +;;; ---------------------- cj/--save-some-buffers-plan ------------------------- +;; The pure planner: given the candidate BUFFERS and a KEY-FN that yields a +;; (non-diff) key per buffer, resolve each to `save' / `clean-save' / `skip', +;; honoring ! (save the rest) and . / q (stop after this). Buffers are opaque +;; here (symbols stand in), so the planner is testable without real buffers. + +(declare-function cj/--save-some-buffers-plan "custom-buffer-file" (buffers key-fn)) + +(ert-deftest test-cbf-ssb-plan-mixed () + "Normal: y / n / w resolve per-buffer to save / skip / clean-save." + (let* ((keys '((a . ?y) (b . ?n) (c . ?w))) + (plan (cj/--save-some-buffers-plan + '(a b c) (lambda (buf) (cdr (assq buf keys)))))) + (should (equal plan '((a . save) (b . skip) (c . clean-save)))))) + +(ert-deftest test-cbf-ssb-plan-save-rest () + "Boundary: ! saves this and all remaining without consulting KEY-FN again." + (let* ((asked nil) + (plan (cj/--save-some-buffers-plan + '(a b c) + (lambda (buf) (push buf asked) (if (eq buf 'a) ?! ?n))))) + (should (equal plan '((a . save) (b . save) (c . save)))) + ;; key-fn consulted only for the first buffer; the rest ride save-all. + (should (equal asked '(a))))) + +(ert-deftest test-cbf-ssb-plan-save-this-stop () + "Boundary: . saves this buffer and skips the rest." + (let ((plan (cj/--save-some-buffers-plan + '(a b c) (lambda (buf) (if (eq buf 'a) ?. ?y))))) + (should (equal plan '((a . save) (b . skip) (c . skip)))))) + +(ert-deftest test-cbf-ssb-plan-quit-skips-all () + "Boundary: q skips this buffer and all remaining." + (let ((plan (cj/--save-some-buffers-plan + '(a b c) (lambda (_) ?q)))) + (should (equal plan '((a . skip) (b . skip) (c . skip)))))) + +(ert-deftest test-cbf-ssb-plan-empty () + "Boundary: no candidate buffers yields an empty plan." + (should-not (cj/--save-some-buffers-plan '() (lambda (_) ?y)))) + +(provide 'test-custom-buffer-file--save-some-buffers) +;;; test-custom-buffer-file--save-some-buffers.el ends here diff --git a/tests/test-custom-misc-cj--count-characters.el b/tests/test-custom-counts--count-characters.el index 1834b5c4f..8abd759f9 100644 --- a/tests/test-custom-misc-cj--count-characters.el +++ b/tests/test-custom-counts--count-characters.el @@ -1,7 +1,7 @@ -;;; test-custom-misc-cj--count-characters.el --- Tests for cj/--count-characters -*- lexical-binding: t; -*- +;;; test-custom-counts--count-characters.el --- Tests for cj/--count-characters -*- lexical-binding: t; -*- ;;; Commentary: -;; Tests for the cj/--count-characters internal implementation function from custom-misc.el +;; Tests for the cj/--count-characters internal implementation function from custom-counts.el ;; ;; This internal function counts characters between START and END positions. ;; It validates that START is not greater than END and returns the character count. @@ -18,7 +18,7 @@ "Stub keymap for testing.") ;; Now load the actual production module -(require 'custom-misc) +(require 'custom-counts) ;;; Setup and Teardown @@ -34,7 +34,7 @@ ;;; Normal Cases -(ert-deftest test-custom-misc-cj--count-characters-normal-simple-text-returns-count () +(ert-deftest test-custom-counts--count-characters-normal-simple-text-returns-count () "Should count characters in simple text region." (test-count-characters-setup) (unwind-protect @@ -44,7 +44,7 @@ (should (= result 13)))) (test-count-characters-teardown))) -(ert-deftest test-custom-misc-cj--count-characters-normal-partial-region-returns-count () +(ert-deftest test-custom-counts--count-characters-normal-partial-region-returns-count () "Should count characters in partial region." (test-count-characters-setup) (unwind-protect @@ -54,7 +54,7 @@ (should (= result 5)))) (test-count-characters-teardown))) -(ert-deftest test-custom-misc-cj--count-characters-normal-multiline-returns-count () +(ert-deftest test-custom-counts--count-characters-normal-multiline-returns-count () "Should count characters including newlines." (test-count-characters-setup) (unwind-protect @@ -67,7 +67,7 @@ ;;; Boundary Cases -(ert-deftest test-custom-misc-cj--count-characters-boundary-empty-region-returns-zero () +(ert-deftest test-custom-counts--count-characters-boundary-empty-region-returns-zero () "Should return 0 for empty region (start equals end)." (test-count-characters-setup) (unwind-protect @@ -77,7 +77,7 @@ (should (= result 0)))) (test-count-characters-teardown))) -(ert-deftest test-custom-misc-cj--count-characters-boundary-single-character-returns-one () +(ert-deftest test-custom-counts--count-characters-boundary-single-character-returns-one () "Should return 1 for single character region." (test-count-characters-setup) (unwind-protect @@ -87,7 +87,7 @@ (should (= result 1)))) (test-count-characters-teardown))) -(ert-deftest test-custom-misc-cj--count-characters-boundary-large-region-returns-count () +(ert-deftest test-custom-counts--count-characters-boundary-large-region-returns-count () "Should handle very large region." (test-count-characters-setup) (unwind-protect @@ -98,7 +98,7 @@ (should (= result 100000))))) (test-count-characters-teardown))) -(ert-deftest test-custom-misc-cj--count-characters-boundary-unicode-returns-count () +(ert-deftest test-custom-counts--count-characters-boundary-unicode-returns-count () "Should count unicode characters (emoji, RTL text, combining characters)." (test-count-characters-setup) (unwind-protect @@ -110,7 +110,7 @@ (should (= result (- (point-max) (point-min)))))) (test-count-characters-teardown))) -(ert-deftest test-custom-misc-cj--count-characters-boundary-whitespace-only-returns-count () +(ert-deftest test-custom-counts--count-characters-boundary-whitespace-only-returns-count () "Should count whitespace characters." (test-count-characters-setup) (unwind-protect @@ -121,7 +121,7 @@ (should (= result 7)))) (test-count-characters-teardown))) -(ert-deftest test-custom-misc-cj--count-characters-boundary-newlines-at-boundaries-returns-count () +(ert-deftest test-custom-counts--count-characters-boundary-newlines-at-boundaries-returns-count () "Should count newlines at start and end." (test-count-characters-setup) (unwind-protect @@ -132,7 +132,7 @@ (should (= result 9)))) (test-count-characters-teardown))) -(ert-deftest test-custom-misc-cj--count-characters-boundary-binary-content-returns-count () +(ert-deftest test-custom-counts--count-characters-boundary-binary-content-returns-count () "Should handle binary content." (test-count-characters-setup) (unwind-protect @@ -144,7 +144,7 @@ ;;; Error Cases -(ert-deftest test-custom-misc-cj--count-characters-error-start-greater-than-end-signals-error () +(ert-deftest test-custom-counts--count-characters-error-start-greater-than-end-signals-error () "Should signal error when start is greater than end." (test-count-characters-setup) (unwind-protect @@ -154,7 +154,7 @@ :type 'error)) (test-count-characters-teardown))) -(ert-deftest test-custom-misc-cj--count-characters-error-positions-out-of-bounds-handled () +(ert-deftest test-custom-counts--count-characters-error-positions-out-of-bounds-handled () "Should handle positions beyond buffer bounds (Emacs handles this)." (test-count-characters-setup) (unwind-protect @@ -167,5 +167,5 @@ (should (= result 5)))) (test-count-characters-teardown))) -(provide 'test-custom-misc-cj--count-characters) -;;; test-custom-misc-cj--count-characters.el ends here +(provide 'test-custom-counts--count-characters) +;;; test-custom-counts--count-characters.el ends here diff --git a/tests/test-custom-misc-cj-count-characters-buffer-or-region.el b/tests/test-custom-counts-count-characters-buffer-or-region.el index dbbda00d8..adeb812a8 100644 --- a/tests/test-custom-misc-cj-count-characters-buffer-or-region.el +++ b/tests/test-custom-counts-count-characters-buffer-or-region.el @@ -1,7 +1,7 @@ -;;; test-custom-misc-cj-count-characters-buffer-or-region.el --- Tests for cj/count-characters-buffer-or-region -*- lexical-binding: t; -*- +;;; test-custom-counts-count-characters-buffer-or-region.el --- Tests for cj/count-characters-buffer-or-region -*- lexical-binding: t; -*- ;;; Commentary: -;; Tests for the cj/count-characters-buffer-or-region function from custom-misc.el +;; Tests for the cj/count-characters-buffer-or-region function from custom-counts.el ;; ;; This function counts characters in the active region or the entire buffer ;; if no region is active. It displays the count in the minibuffer. @@ -18,7 +18,7 @@ "Stub keymap for testing.") ;; Now load the actual production module -(require 'custom-misc) +(require 'custom-counts) ;;; Setup and Teardown @@ -35,7 +35,7 @@ ;;; Normal Cases -(ert-deftest test-custom-misc-cj-count-characters-buffer-or-region-normal-whole-buffer-counts-all () +(ert-deftest test-custom-counts-count-characters-buffer-or-region-normal-whole-buffer-counts-all () "Should count all characters in buffer when no region is active." (test-count-characters-buffer-or-region-setup) (unwind-protect @@ -51,7 +51,7 @@ (should (string-match-p "13 characters.*buffer" message-output))))) (test-count-characters-buffer-or-region-teardown))) -(ert-deftest test-custom-misc-cj-count-characters-buffer-or-region-normal-active-region-counts-region () +(ert-deftest test-custom-counts-count-characters-buffer-or-region-normal-active-region-counts-region () "Should count characters in active region." (test-count-characters-buffer-or-region-setup) (unwind-protect @@ -70,7 +70,7 @@ (should (string-match-p "5 characters.*region" message-output))))) (test-count-characters-buffer-or-region-teardown))) -(ert-deftest test-custom-misc-cj-count-characters-buffer-or-region-normal-multiline-buffer-counts-all () +(ert-deftest test-custom-counts-count-characters-buffer-or-region-normal-multiline-buffer-counts-all () "Should count characters including newlines in buffer." (test-count-characters-buffer-or-region-setup) (unwind-protect @@ -86,7 +86,7 @@ (should (string-match-p "20 characters.*buffer" message-output))))) (test-count-characters-buffer-or-region-teardown))) -(ert-deftest test-custom-misc-cj-count-characters-buffer-or-region-normal-multiline-region-counts-region () +(ert-deftest test-custom-counts-count-characters-buffer-or-region-normal-multiline-region-counts-region () "Should count characters including newlines in region." (test-count-characters-buffer-or-region-setup) (unwind-protect @@ -108,7 +108,7 @@ ;;; Boundary Cases -(ert-deftest test-custom-misc-cj-count-characters-buffer-or-region-boundary-empty-buffer-returns-zero () +(ert-deftest test-custom-counts-count-characters-buffer-or-region-boundary-empty-buffer-returns-zero () "Should return 0 for empty buffer." (test-count-characters-buffer-or-region-setup) (unwind-protect @@ -122,7 +122,7 @@ (should (string-match-p "0 characters.*buffer" message-output))))) (test-count-characters-buffer-or-region-teardown))) -(ert-deftest test-custom-misc-cj-count-characters-buffer-or-region-boundary-empty-region-counts-buffer () +(ert-deftest test-custom-counts-count-characters-buffer-or-region-boundary-empty-region-counts-buffer () "Should count whole buffer when region is empty (point equals mark). When mark and point are at the same position, use-region-p returns nil, so the function correctly falls back to counting the entire buffer." @@ -144,7 +144,7 @@ so the function correctly falls back to counting the entire buffer." (should (string-match-p "13 characters.*buffer" message-output))))) (test-count-characters-buffer-or-region-teardown))) -(ert-deftest test-custom-misc-cj-count-characters-buffer-or-region-boundary-large-buffer-counts-all () +(ert-deftest test-custom-counts-count-characters-buffer-or-region-boundary-large-buffer-counts-all () "Should handle very large buffer." (test-count-characters-buffer-or-region-setup) (unwind-protect @@ -160,7 +160,7 @@ so the function correctly falls back to counting the entire buffer." (should (string-match-p "100000 characters.*buffer" message-output)))))) (test-count-characters-buffer-or-region-teardown))) -(ert-deftest test-custom-misc-cj-count-characters-buffer-or-region-boundary-unicode-counts-correctly () +(ert-deftest test-custom-counts-count-characters-buffer-or-region-boundary-unicode-counts-correctly () "Should count unicode characters (emoji, RTL text) correctly." (test-count-characters-buffer-or-region-setup) (unwind-protect @@ -177,7 +177,7 @@ so the function correctly falls back to counting the entire buffer." message-output))))) (test-count-characters-buffer-or-region-teardown))) -(ert-deftest test-custom-misc-cj-count-characters-buffer-or-region-boundary-whitespace-only-counts-whitespace () +(ert-deftest test-custom-counts-count-characters-buffer-or-region-boundary-whitespace-only-counts-whitespace () "Should count whitespace characters." (test-count-characters-buffer-or-region-setup) (unwind-protect @@ -193,7 +193,7 @@ so the function correctly falls back to counting the entire buffer." (should (string-match-p "7 characters.*buffer" message-output))))) (test-count-characters-buffer-or-region-teardown))) -(ert-deftest test-custom-misc-cj-count-characters-buffer-or-region-boundary-single-character-returns-one () +(ert-deftest test-custom-counts-count-characters-buffer-or-region-boundary-single-character-returns-one () "Should return 1 for single character buffer." (test-count-characters-buffer-or-region-setup) (unwind-protect @@ -208,7 +208,7 @@ so the function correctly falls back to counting the entire buffer." (should (string-match-p "1 character.*buffer" message-output))))) (test-count-characters-buffer-or-region-teardown))) -(ert-deftest test-custom-misc-cj-count-characters-buffer-or-region-boundary-narrowed-buffer-counts-visible () +(ert-deftest test-custom-counts-count-characters-buffer-or-region-boundary-narrowed-buffer-counts-visible () "Should count only visible characters in narrowed buffer." (test-count-characters-buffer-or-region-setup) (unwind-protect @@ -227,5 +227,5 @@ so the function correctly falls back to counting the entire buffer." (should (string-match-p "7 characters.*buffer" message-output))))) (test-count-characters-buffer-or-region-teardown))) -(provide 'test-custom-misc-cj-count-characters-buffer-or-region) -;;; test-custom-misc-cj-count-characters-buffer-or-region.el ends here +(provide 'test-custom-counts-count-characters-buffer-or-region) +;;; test-custom-counts-count-characters-buffer-or-region.el ends here diff --git a/tests/test-custom-misc-count-words.el b/tests/test-custom-counts-count-words.el index f2bf793f4..642a5a411 100644 --- a/tests/test-custom-misc-count-words.el +++ b/tests/test-custom-counts-count-words.el @@ -1,7 +1,7 @@ -;;; test-custom-misc-count-words.el --- Tests for cj/--count-words -*- lexical-binding: t; -*- +;;; test-custom-counts-count-words.el --- Tests for cj/--count-words -*- lexical-binding: t; -*- ;;; Commentary: -;; Tests for the cj/--count-words function from custom-misc.el +;; Tests for the cj/--count-words function from custom-counts.el ;; ;; This function counts words in a region using Emacs's built-in count-words. ;; A word is defined by Emacs's word boundaries, which generally means @@ -24,7 +24,7 @@ "Stub keymap for testing.") ;; Now load the actual production module -(require 'custom-misc) +(require 'custom-counts) ;;; Test Helpers @@ -144,5 +144,5 @@ words in it.")) (let ((end (match-end 0))) (should (= 3 (cj/--count-words start end))))))) -(provide 'test-custom-misc-count-words) -;;; test-custom-misc-count-words.el ends here +(provide 'test-custom-counts-count-words) +;;; test-custom-counts-count-words.el ends here diff --git a/tests/test-custom-misc-format-region.el b/tests/test-custom-format-format-region.el index c40a8898e..27f1c6b99 100644 --- a/tests/test-custom-misc-format-region.el +++ b/tests/test-custom-format-format-region.el @@ -1,7 +1,7 @@ -;;; test-custom-misc-format-region.el --- Tests for cj/--format-region -*- lexical-binding: t; -*- +;;; test-custom-format-format-region.el --- Tests for cj/--format-region -*- lexical-binding: t; -*- ;;; Commentary: -;; Tests for the cj/--format-region function from custom-misc.el +;; Tests for the cj/--format-region function from custom-format.el ;; ;; This function reformats text by applying three operations: ;; 1. untabify - converts tabs to spaces @@ -28,7 +28,7 @@ "Stub keymap for testing.") ;; Now load the actual production module -(require 'custom-misc) +(require 'custom-format) ;;; Test Helpers @@ -157,5 +157,5 @@ Returns the buffer string after operation." ;; Should complete without error (should (string= (buffer-string) "hello world"))))) -(provide 'test-custom-misc-format-region) -;;; test-custom-misc-format-region.el ends here +(provide 'test-custom-format-format-region) +;;; test-custom-format-format-region.el ends here diff --git a/tests/test-custom-misc-jump-to-matching-paren.el b/tests/test-custom-line-paragraph-jump-to-matching-paren.el index 973b6dfa9..31853da67 100644 --- a/tests/test-custom-misc-jump-to-matching-paren.el +++ b/tests/test-custom-line-paragraph-jump-to-matching-paren.el @@ -1,7 +1,7 @@ -;;; test-custom-misc-jump-to-matching-paren.el --- Tests for cj/jump-to-matching-paren -*- lexical-binding: t; -*- +;;; test-custom-line-paragraph-jump-to-matching-paren.el --- Tests for cj/jump-to-matching-paren -*- lexical-binding: t; -*- ;;; Commentary: -;; Tests for the cj/jump-to-matching-paren function from custom-misc.el +;; Tests for the cj/jump-to-matching-paren function from custom-line-paragraph.el ;; ;; This function jumps to matching delimiters using Emacs's sexp navigation. ;; It works with any delimiter that has matching syntax according to the @@ -32,7 +32,7 @@ "Stub keymap for testing.") ;; Now load the actual production module -(require 'custom-misc) +(require 'custom-line-paragraph) ;;; Test Helpers @@ -193,5 +193,5 @@ POINT-POSITION is 1-indexed (1 = first character)." ;; The parens in the string should be ignored (should (= 18 (test-jump-to-matching-paren "(\"hello (world)\")" 1)))) -(provide 'test-custom-misc-jump-to-matching-paren) -;;; test-custom-misc-jump-to-matching-paren.el ends here +(provide 'test-custom-line-paragraph-jump-to-matching-paren) +;;; test-custom-line-paragraph-jump-to-matching-paren.el ends here diff --git a/tests/test-custom-misc-replace-fraction-glyphs.el b/tests/test-custom-text-transform-replace-fraction-glyphs.el index 81d1546e1..ed961c63e 100644 --- a/tests/test-custom-misc-replace-fraction-glyphs.el +++ b/tests/test-custom-text-transform-replace-fraction-glyphs.el @@ -1,7 +1,7 @@ -;;; test-custom-misc-replace-fraction-glyphs.el --- Tests for cj/--replace-fraction-glyphs -*- lexical-binding: t; -*- +;;; test-custom-text-transform-replace-fraction-glyphs.el --- Tests for cj/--replace-fraction-glyphs -*- lexical-binding: t; -*- ;;; Commentary: -;; Tests for the cj/--replace-fraction-glyphs function from custom-misc.el +;; Tests for the cj/--replace-fraction-glyphs function from custom-text-transform.el ;; ;; This function bidirectionally converts between text fractions (1/4) and ;; Unicode fraction glyphs (¼). It supports 5 common fractions: @@ -28,7 +28,7 @@ "Stub keymap for testing.") ;; Now load the actual production module -(require 'custom-misc) +(require 'custom-text-transform) ;;; Test Helpers @@ -181,5 +181,5 @@ Returns the buffer string after operation." ;; Should complete without error (should (string= (buffer-string) "1/4"))))) -(provide 'test-custom-misc-replace-fraction-glyphs) -;;; test-custom-misc-replace-fraction-glyphs.el ends here +(provide 'test-custom-text-transform-replace-fraction-glyphs) +;;; test-custom-text-transform-replace-fraction-glyphs.el ends here diff --git a/tests/test-dashboard-config-launchers.el b/tests/test-dashboard-config-launchers.el index a9a871979..53c46caa9 100644 --- a/tests/test-dashboard-config-launchers.el +++ b/tests/test-dashboard-config-launchers.el @@ -27,19 +27,20 @@ ;; Telegram moved from "g" to "G" so "g" is free for dashboard refresh. ;; Signal ("S") added as the 14th launcher. -(defconst test-dash--keys '("c" "d" "t" "a" "r" "b" "f" "m" "e" "i" "G" "s" "l" "S")) +;; Weather ("w") added after Agenda as the 15th launcher (top-row daily glance). +(defconst test-dash--keys '("c" "d" "t" "a" "w" "r" "b" "f" "m" "e" "i" "G" "s" "l" "S")) ;; ----------------------------- launcher table -------------------------------- (ert-deftest test-dashboard-launchers-keys-in-order () - "Normal: 14 launchers with the expected keys in display order." - (should (= 14 (length cj/dashboard--launchers))) + "Normal: 15 launchers with the expected keys in display order." + (should (= 15 (length cj/dashboard--launchers))) (should (equal test-dash--keys (mapcar (lambda (l) (nth 0 l)) cj/dashboard--launchers)))) (ert-deftest test-dashboard-launchers-labels-in-order () "Normal: labels in display order (Telegram and Slack reordered so Slack sits next to Linear on the last navigator row)." - (should (equal '("Code" "Files" "Terminal" "Agenda" "Feeds" "Books" + (should (equal '("Code" "Files" "Terminal" "Agenda" "Weather" "Feeds" "Books" "Flashcards" "Music" "Email" "IRC" "Telegram" "Slack" "Linear" "Signal") (mapcar (lambda (l) (nth 3 l)) cj/dashboard--launchers)))) @@ -50,18 +51,19 @@ next to Linear on the last navigator row)." ;; --------------------------- navigator rows ---------------------------------- -(ert-deftest test-dashboard-navigator-rows-grouped-4-4-3-3 () - "Normal: navigator derives rows per `cj/dashboard--row-sizes' (4 4 3 3), with -Slack, Linear, and Signal sharing the last row." +(ert-deftest test-dashboard-navigator-rows-grouped-5-4-3-3 () + "Normal: navigator derives rows per `cj/dashboard--row-sizes' (5 4 3 3), with +Weather joining the top row and Slack, Linear, and Signal sharing the last row." (cl-letf (((symbol-function 'nerd-icons-faicon) (lambda (n &rest _) (concat "I:" n))) ((symbol-function 'nerd-icons-devicon) (lambda (n &rest _) (concat "I:" n))) ((symbol-function 'nerd-icons-mdicon) (lambda (n &rest _) (concat "I:" n))) ((symbol-function 'nerd-icons-octicon) (lambda (n &rest _) (concat "I:" n))) - ((symbol-function 'nerd-icons-codicon) (lambda (n &rest _) (concat "I:" n)))) + ((symbol-function 'nerd-icons-codicon) (lambda (n &rest _) (concat "I:" n))) + ((symbol-function 'nerd-icons-wicon) (lambda (n &rest _) (concat "I:" n)))) (let ((rows (cj/dashboard--navigator-rows))) (should (= 4 (length rows))) - (should (equal '(4 4 3 3) (mapcar #'length rows))) - (should (equal '("Code" "Files" "Terminal" "Agenda") + (should (equal '(5 4 3 3) (mapcar #'length rows))) + (should (equal '("Code" "Files" "Terminal" "Agenda" "Weather") (mapcar (lambda (b) (nth 1 b)) (nth 0 rows)))) (should (equal '("Slack" "Linear" "Signal") (mapcar (lambda (b) (nth 1 b)) (nth 3 rows)))) @@ -86,7 +88,7 @@ Slack, Linear, and Signal sharing the last row." (let ((map (make-sparse-keymap)) (calls nil)) (cl-letf (((symbol-function 'projectile-switch-project) (lambda (&rest _) (push 'code calls))) ((symbol-function 'dirvish) (lambda (&rest _) (push 'files calls))) - ((symbol-function 'ghostel) (lambda (&rest _) (push 'term calls))) + ((symbol-function 'cj/term-toggle) (lambda (&rest _) (push 'term calls))) ((symbol-function 'cj/main-agenda-display) (lambda (&rest _) (push 'agenda calls))) ((symbol-function 'cj/elfeed-open) (lambda (&rest _) (push 'feeds calls))) ((symbol-function 'calibredb) (lambda (&rest _) (push 'books calls))) @@ -98,7 +100,10 @@ Slack, Linear, and Signal sharing the last row." ((symbol-function 'cj/slack-start) (lambda (&rest _) (push 'slack calls))) ((symbol-function 'cj/telega) (lambda (&rest _) (push 'tg calls))) ((symbol-function 'pearl-list-issues) (lambda (&rest _) (push 'linear calls))) - ((symbol-function 'cj/signel-message) (lambda (&rest _) (push 'signal calls)))) + ((symbol-function 'cj/signel-message) (lambda (&rest _) (push 'signal calls))) + ;; wttrin is invoked via `call-interactively', so the stub must be + ;; a command -- a plain variadic lambda masked the real arity bug. + ((symbol-function 'wttrin) (lambda (&rest _) (interactive) (push 'weather calls)))) (cj/dashboard--bind-launchers map) (dolist (key test-dash--keys) (call-interactively (keymap-lookup map key))) @@ -108,7 +113,8 @@ Slack, Linear, and Signal sharing the last row." (should (memq 'm-toggle calls)) (should (memq 'm-load calls)) (should (memq 'signal calls)) - (should (= 15 (length calls)))))) ; 14 keys, Music fires two + (should (memq 'weather calls)) + (should (= 16 (length calls)))))) ; 15 keys, Music fires two (provide 'test-dashboard-config-launchers) ;;; test-dashboard-config-launchers.el ends here diff --git a/tests/test-dirvish-config--dired-keys.el b/tests/test-dirvish-config--dired-keys.el new file mode 100644 index 000000000..2df0e8db6 --- /dev/null +++ b/tests/test-dirvish-config--dired-keys.el @@ -0,0 +1,23 @@ +;;; test-dirvish-config--dired-keys.el --- dired d=diff / D=delete bindings -*- lexical-binding: t; -*- + +;;; Commentary: +;; Regression: d and D in dired (and dirvish, which uses dired-mode-map) are the +;; diff and delete pair, matching the convention under C-; b and in ibuffer. A +;; mismatch -- or a swapped which-key label -- once led to deleting a file while +;; trying to diff it. + +;;; Code: + +(require 'ert) +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'dired) +(require 'dirvish-config) + +(ert-deftest test-dirvish-dired-d-diffs-D-deletes () + "Normal: dired d runs the ediff diff and D deletes, matching the d=diff / +D=delete convention used under C-; b and in ibuffer." + (should (eq (keymap-lookup dired-mode-map "d") #'cj/dired-ediff-files)) + (should (eq (keymap-lookup dired-mode-map "D") #'dired-do-delete))) + +(provide 'test-dirvish-config--dired-keys) +;;; test-dirvish-config--dired-keys.el ends here diff --git a/tests/test-eshell-config--prompt.el b/tests/test-eshell-config--prompt.el new file mode 100644 index 000000000..7073c7e0b --- /dev/null +++ b/tests/test-eshell-config--prompt.el @@ -0,0 +1,75 @@ +;;; test-eshell-config--prompt.el --- Tests for eshell prompt helpers -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for the pure prompt-segment helpers added for zsh parity: the +;; .git/HEAD branch reader and the exit-status segment. + +;;; Code: + +(require 'ert) + +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'eshell-config) + +(defvar eshell-last-command-status) ; declared special for the status tests + +;;; cj/--eshell-git-branch + +(ert-deftest test-eshell-git-branch-reads-head () + "Normal: a .git/HEAD pointing at a branch returns the branch name." + (let ((dir (make-temp-file "esh-git-" t))) + (unwind-protect + (progn + (make-directory (expand-file-name ".git" dir)) + (with-temp-file (expand-file-name ".git/HEAD" dir) + (insert "ref: refs/heads/feature-x\n")) + (let ((default-directory (file-name-as-directory dir))) + (should (equal (cj/--eshell-git-branch) "feature-x")))) + (delete-directory dir t)))) + +(ert-deftest test-eshell-git-branch-no-repo-nil () + "Boundary: a directory with no .git returns nil." + (let ((dir (make-temp-file "esh-nogit-" t))) + (unwind-protect + (let ((default-directory (file-name-as-directory dir))) + (should-not (cj/--eshell-git-branch))) + (delete-directory dir t)))) + +(ert-deftest test-eshell-git-branch-detached-nil () + "Boundary: a detached HEAD (a raw SHA, no ref) returns nil." + (let ((dir (make-temp-file "esh-detached-" t))) + (unwind-protect + (progn + (make-directory (expand-file-name ".git" dir)) + (with-temp-file (expand-file-name ".git/HEAD" dir) + (insert "a1b2c3d4e5f6\n")) + (let ((default-directory (file-name-as-directory dir))) + (should-not (cj/--eshell-git-branch)))) + (delete-directory dir t)))) + +(ert-deftest test-eshell-git-branch-remote-skipped () + "Boundary: a remote default-directory is skipped (no TRAMP read)." + (let ((default-directory "/ssh:host:/some/path/")) + (should-not (cj/--eshell-git-branch)))) + +;;; cj/--eshell-prompt-status-segment + +(ert-deftest test-eshell-prompt-status-zero-empty () + "Normal: a zero exit status yields an empty segment." + (let ((eshell-last-command-status 0)) + (should (equal (cj/--eshell-prompt-status-segment) "")))) + +(ert-deftest test-eshell-prompt-status-nonzero-bracketed () + "Normal: a non-zero exit status is shown in brackets." + (let ((eshell-last-command-status 1)) + (should (equal (cj/--eshell-prompt-status-segment) " [1]"))) + (let ((eshell-last-command-status 130)) + (should (equal (cj/--eshell-prompt-status-segment) " [130]")))) + +(ert-deftest test-eshell-prompt-status-unset-empty () + "Boundary: an unset status yields an empty segment, no error." + (let ((eshell-last-command-status nil)) + (should (equal (cj/--eshell-prompt-status-segment) "")))) + +(provide 'test-eshell-config--prompt) +;;; test-eshell-config--prompt.el ends here diff --git a/tests/test-external-open-commands.el b/tests/test-external-open-commands.el index c0c83a340..3d8adc15e 100644 --- a/tests/test-external-open-commands.el +++ b/tests/test-external-open-commands.el @@ -81,8 +81,9 @@ ;;; cj/find-file-auto (ert-deftest test-external-open-find-file-auto-routes-media-externally () - "Normal: a `.mp4' filename (in `default-open-extensions') triggers -`cj/xdg-open' instead of the original `find-file'." + "Normal: a non-video external extension (`.docx', in +`default-open-extensions') triggers `cj/xdg-open' instead of the original +`find-file'." (let ((opened nil) (orig-called nil)) (cl-letf (((symbol-function 'cj/xdg-open) @@ -90,8 +91,23 @@ ;; orig-fun replacement -- shouldn't run for a routed extension. ((symbol-function 'cj/find-file-auto--orig-stub) (lambda (&rest _) (setq orig-called t)))) - (cj/find-file-auto #'cj/find-file-auto--orig-stub "/tmp/video.mp4")) - (should (equal opened "/tmp/video.mp4")) + (cj/find-file-auto #'cj/find-file-auto--orig-stub "/tmp/report.docx")) + (should (equal opened "/tmp/report.docx")) + (should-not orig-called))) + +(ert-deftest test-external-open-find-file-auto-routes-video-to-looping-player () + "Normal: a video filename triggers `cj/open-video-looping', not `cj/xdg-open' +or the original `find-file'." + (let ((looped nil) (xdg nil) (orig-called nil)) + (cl-letf (((symbol-function 'cj/open-video-looping) + (lambda (file) (setq looped file))) + ((symbol-function 'cj/xdg-open) + (lambda (_) (setq xdg t))) + ((symbol-function 'cj/find-file-auto--orig-stub) + (lambda (&rest _) (setq orig-called t)))) + (cj/find-file-auto #'cj/find-file-auto--orig-stub "/tmp/clip.mp4")) + (should (equal looped "/tmp/clip.mp4")) + (should-not xdg) (should-not orig-called))) (ert-deftest test-external-open-find-file-auto-passes-through-text-files () @@ -116,5 +132,66 @@ (cj/find-file-auto #'cj/find-file-auto--orig-stub nil)) (should orig-called))) +;;; cj/--video-file-p + +(ert-deftest test-external-open-video-file-p-matches-video () + "Normal: common video extensions match, case-insensitively." + (should (cj/--video-file-p "/tmp/a.mp4")) + (should (cj/--video-file-p "/tmp/a.mkv")) + (should (cj/--video-file-p "/tmp/a.webm")) + (should (cj/--video-file-p "/tmp/A.MP4"))) + +(ert-deftest test-external-open-video-file-p-rejects-non-video () + "Boundary: audio, docs, and nil do not match." + (should-not (cj/--video-file-p "/tmp/a.mp3")) + (should-not (cj/--video-file-p "/tmp/a.txt")) + (should-not (cj/--video-file-p "/tmp/a.docx")) + (should-not (cj/--video-file-p nil))) + +;;; cj/--video-open-arglist + +(ert-deftest test-external-open-video-arglist-appends-file-after-args () + "Normal: the player args precede the file in the argument list." + (let ((cj/video-open-args '("--loop-file=inf"))) + (should (equal (cj/--video-open-arglist "/tmp/a.mp4") + '("--loop-file=inf" "/tmp/a.mp4"))))) + +(ert-deftest test-external-open-video-arglist-respects-custom-args () + "Boundary: custom args are honored; empty args yields just the file." + (let ((cj/video-open-args '("--loop=inf" "--mute=yes"))) + (should (equal (cj/--video-open-arglist "/tmp/a.mkv") + '("--loop=inf" "--mute=yes" "/tmp/a.mkv")))) + (let ((cj/video-open-args nil)) + (should (equal (cj/--video-open-arglist "/tmp/a.mkv") '("/tmp/a.mkv"))))) + +;;; cj/open-video-looping + +(ert-deftest test-external-open-video-looping-calls-player-with-loop-args () + "Normal: posix path calls the player with loop args + file, async (no wait)." + (let ((tmp (make-temp-file "test-ext-video-" nil ".mp4")) + (call nil)) + (unwind-protect + (cl-letf (((symbol-function 'env-windows-p) (lambda () nil)) + ((symbol-function 'call-process) + (lambda (prog _infile dest _disp &rest args) + (setq call (list prog dest args)) + 0))) + (let ((cj/video-open-command "mpv") + (cj/video-open-args '("--loop-file=inf"))) + (cj/open-video-looping tmp))) + (delete-file tmp)) + (should (equal (nth 0 call) "mpv")) + (should (equal (nth 1 call) 0)) ; async destination: don't wait + (should (member "--loop-file=inf" (nth 2 call))) + (should (cl-find-if (lambda (a) (and (stringp a) + (string-match-p "\\.mp4\\'" a))) + (nth 2 call))))) + +(ert-deftest test-external-open-video-looping-errors-when-no-file () + "Error: a buffer with no associated file signals user-error." + (with-temp-buffer + (cl-letf (((symbol-function 'cj/file-from-context) (lambda (_) nil))) + (should-error (cj/open-video-looping) :type 'user-error)))) + (provide 'test-external-open-commands) ;;; test-external-open-commands.el ends here diff --git a/tests/test-font-config--frame-lifecycle.el b/tests/test-font-config--frame-lifecycle.el index 826edbd69..8f338b996 100644 --- a/tests/test-font-config--frame-lifecycle.el +++ b/tests/test-font-config--frame-lifecycle.el @@ -2,7 +2,7 @@ ;;; Commentary: ;; cj/apply-font-settings-to-frame, cj/cleanup-frame-list, and -;; cj/maybe-install-all-the-icons-fonts were defined inside use-package +;; cj/maybe-install-nerd-icons-fonts were defined inside use-package ;; :config / with-eval-after-load (unreachable under `make test'). Lifting ;; them to top level makes their branching unit-testable; env-gui-p and the ;; package side-effect calls are mocked at the boundary. @@ -57,9 +57,9 @@ (let ((installed nil)) (cl-letf (((symbol-function 'env-gui-p) (lambda () t)) ((symbol-function 'cj/font-installed-p) (lambda (_n) nil)) - ((symbol-function 'all-the-icons-install-fonts) (lambda (&rest _) (setq installed t))) + ((symbol-function 'nerd-icons-install-fonts) (lambda (&rest _) (setq installed t))) ((symbol-function 'remove-hook) #'ignore)) - (cj/maybe-install-all-the-icons-fonts)) + (cj/maybe-install-nerd-icons-fonts)) (should installed))) (ert-deftest test-font-maybe-install-icons-already-present-skips () @@ -67,8 +67,8 @@ (let ((installed nil)) (cl-letf (((symbol-function 'env-gui-p) (lambda () t)) ((symbol-function 'cj/font-installed-p) (lambda (_n) t)) - ((symbol-function 'all-the-icons-install-fonts) (lambda (&rest _) (setq installed t)))) - (cj/maybe-install-all-the-icons-fonts)) + ((symbol-function 'nerd-icons-install-fonts) (lambda (&rest _) (setq installed t)))) + (cj/maybe-install-nerd-icons-fonts)) (should-not installed))) (provide 'test-font-config--frame-lifecycle) diff --git a/tests/test-font-config.el b/tests/test-font-config.el index 8fada25e2..393a77584 100644 --- a/tests/test-font-config.el +++ b/tests/test-font-config.el @@ -5,9 +5,10 @@ ;; font-config.el is mostly top-level font/package setup. These smoke tests ;; cover the logic that should stay correct regardless of which fonts are ;; installed: the install check, and the daemon-frame font applier (env-gui-p -;; guard plus idempotency). The module :demand's fontaine and all-the-icons, -;; so the tests skip when those packages are absent rather than failing on a -;; bare checkout. GUI and font lookups are stubbed so the run stays headless. +;; guard plus idempotency). The module :demand's fontaine and references +;; nerd-icons, so the tests skip when those packages are absent rather than +;; failing on a bare checkout. GUI and font lookups are stubbed so the run +;; stays headless. ;;; Code: @@ -21,9 +22,8 @@ (defconst test-font-config--available (and (locate-library "fontaine") - (locate-library "all-the-icons") - (locate-library "all-the-icons-nerd-fonts")) - "Non-nil when the packages font-config :demand's are loadable.") + (locate-library "nerd-icons")) + "Non-nil when the packages font-config needs are loadable.") ;;; cj/font-installed-p diff --git a/tests/test-init-module-headers.el b/tests/test-init-module-headers.el index 478819b89..f395fd71f 100644 --- a/tests/test-init-module-headers.el +++ b/tests/test-init-module-headers.el @@ -35,7 +35,9 @@ "custom-datetime" "custom-buffer-file" "custom-line-paragraph" - "custom-misc" + "custom-counts" + "custom-format" + "custom-text-transform" "custom-ordering" "custom-text-enclose" "custom-whitespace" @@ -97,6 +99,10 @@ "ai-term" "browser-config" "calendar-sync" + "calendar-sync-ics" + "calendar-sync-recurrence" + "calendar-sync-org" + "calendar-sync-source" "calibredb-epub-config" "chrono-tools" "dirvish-config" @@ -129,7 +135,8 @@ "tramp-config" "transcription-config" "video-audio-recording" - "term-config" + "video-audio-recording-devices" + "video-audio-recording-capture" "weather-config" "wrap-up") "Modules annotated with the load-graph header contract. diff --git a/tests/test-local-repository--car-member.el b/tests/test-local-repository--car-member.el index 8b8c9a7db..30ae58c6b 100644 --- a/tests/test-local-repository--car-member.el +++ b/tests/test-local-repository--car-member.el @@ -1,7 +1,7 @@ -;;; test-local-repository--car-member.el --- Tests for car-member -*- lexical-binding: t -*- +;;; test-local-repository--car-member.el --- Tests for localrepo--car-member -*- lexical-binding: t -*- ;;; Commentary: -;; Tests for `car-member' in local-repository.el — the predicate +;; Tests for `localrepo--car-member' in local-repository.el — the predicate ;; localrepo-initialize uses to check whether an archive id is already ;; registered in package-archives / package-archive-priorities. @@ -12,47 +12,47 @@ ;;; Normal Cases -(ert-deftest test-local-repository-car-member-found () +(ert-deftest test-local-repository-localrepo--car-member-found () "Normal: VALUE present as a car returns the matching tail (non-nil)." - (should (equal (car-member 'b '((a . 1) (b . 2) (c . 3))) + (should (equal (localrepo--car-member 'b '((a . 1) (b . 2) (c . 3))) '(b c)))) -(ert-deftest test-local-repository-car-member-not-found () +(ert-deftest test-local-repository-localrepo--car-member-not-found () "Normal: VALUE absent from every car returns nil." - (should-not (car-member 'z '((a . 1) (b . 2))))) + (should-not (localrepo--car-member 'z '((a . 1) (b . 2))))) -(ert-deftest test-local-repository-car-member-string-car () +(ert-deftest test-local-repository-localrepo--car-member-string-car () "Normal: car comparison uses `equal', so string keys match by value." - (should (car-member "localrepo" + (should (localrepo--car-member "localrepo" '(("gnu" . "url1") ("localrepo" . "url2"))))) ;;; Boundary Cases -(ert-deftest test-local-repository-car-member-empty-list () +(ert-deftest test-local-repository-localrepo--car-member-empty-list () "Boundary: an empty list never matches." - (should-not (car-member 'a nil))) + (should-not (localrepo--car-member 'a nil))) -(ert-deftest test-local-repository-car-member-single-match () +(ert-deftest test-local-repository-localrepo--car-member-single-match () "Boundary: a single-element list whose car matches returns non-nil." - (should (car-member 'only '((only . 1))))) + (should (localrepo--car-member 'only '((only . 1))))) -(ert-deftest test-local-repository-car-member-single-no-match () +(ert-deftest test-local-repository-localrepo--car-member-single-no-match () "Boundary: a single-element list whose car differs returns nil." - (should-not (car-member 'x '((only . 1))))) + (should-not (localrepo--car-member 'x '((only . 1))))) -(ert-deftest test-local-repository-car-member-nil-value-with-nil-car () +(ert-deftest test-local-repository-localrepo--car-member-nil-value-with-nil-car () "Boundary: a nil VALUE matches a cons whose car is nil." - (should (car-member nil '((nil . 1) (a . 2))))) + (should (localrepo--car-member nil '((nil . 1) (a . 2))))) -(ert-deftest test-local-repository-car-member-nil-value-no-nil-car () +(ert-deftest test-local-repository-localrepo--car-member-nil-value-no-nil-car () "Boundary: a nil VALUE with no nil car returns nil." - (should-not (car-member nil '((a . 1) (b . 2))))) + (should-not (localrepo--car-member nil '((a . 1) (b . 2))))) ;;; Error Cases -(ert-deftest test-local-repository-car-member-non-cons-element () +(ert-deftest test-local-repository-localrepo--car-member-non-cons-element () "Error: a non-cons element makes `car' signal wrong-type-argument." - (should-error (car-member 'x '(1 2)) :type 'wrong-type-argument)) + (should-error (localrepo--car-member 'x '(1 2)) :type 'wrong-type-argument)) (provide 'test-local-repository--car-member) ;;; test-local-repository--car-member.el ends here diff --git a/tests/test-meta-package-headers.el b/tests/test-meta-package-headers.el new file mode 100644 index 000000000..f9b57cbfc --- /dev/null +++ b/tests/test-meta-package-headers.el @@ -0,0 +1,98 @@ +;;; test-meta-package-headers.el --- Enforce Elisp package-header conventions -*- lexical-binding: t; -*- + +;;; Commentary: +;; Checks that every owned active config module follows the standard Emacs +;; Library Header conventions -- the part test-init-module-headers.el does not +;; cover (it enforces the load-graph metadata block inside the Commentary): +;; +;; 1. First line is ;;; NAME.el --- SUMMARY -*- ... -*- (name carries the +;; .el, summary present, file-local-variable cookie present). +;; 2. ;;; Commentary: appears before ;;; Code:. +;; 3. A (provide 'NAME) footer, so the file is require-able. +;; 4. No UTF-8 BOM before the header. +;; +;; Scope is modules/*.el, the owned active module set. Vendored (custom/), +;; generated (themes/, browser-choice.el), archived (archive/), and private +;; (*.local.el) files are out of scope by design -- classifying those is the +;; file-class policy task, not this test. The checker reads files on disk +;; without loading them, so it adds no startup or package dependency. + +;;; Code: + +(require 'ert) + +(defconst test-pkg-header--exempt '() + "Basenames under modules/ exempt from the package-header checks. +Empty today. Add a basename with a comment when a module is intentionally +shaped differently, so the exemption is explicit rather than silent.") + +(defun test-pkg-header--check (name text) + "Return the list of violation symbols for module NAME given file TEXT. +NAME is the basename (e.g. \"font-config.el\"). An empty list means the +file is conformant. Possible symbols: `bom', `header', `markers', +`order', `provide'." + (let ((violations '())) + (when (string-prefix-p "" text) + (push 'bom violations)) + (let ((first-line (car (split-string text "\n")))) + (unless (string-match-p + (concat "\\`;;; " (regexp-quote name) " --- .+-\\*-.*-\\*-") + first-line) + (push 'header violations))) + (let ((commentary (string-match "^;;; Commentary:" text)) + (code (string-match "^;;; Code:" text))) + (cond ((or (null commentary) (null code)) (push 'markers violations)) + ((>= commentary code) (push 'order violations)))) + (let ((stem (file-name-sans-extension name))) + (unless (string-match-p (concat "^(provide '" (regexp-quote stem) ")") text) + (push 'provide violations))) + (nreverse violations))) + +(ert-deftest test-pkg-header-checker-flags-malformed () + "Error: the checker catches each malformed shape." + (should (memq 'bom + (test-pkg-header--check + "foo.el" + ";;; foo.el --- x -*- lexical-binding: t; -*-\n;;; Commentary:\n;;; Code:\n(provide 'foo)"))) + (should (memq 'header + (test-pkg-header--check + "foo.el" + ";;; foo --- x -*- lexical-binding: t; -*-\n;;; Commentary:\n;;; Code:\n(provide 'foo)"))) + (should (memq 'order + (test-pkg-header--check + "foo.el" + ";;; foo.el --- x -*- lexical-binding: t; -*-\n;;; Code:\n;;; Commentary:\n(provide 'foo)"))) + (should (memq 'provide + (test-pkg-header--check + "foo.el" + ";;; foo.el --- x -*- lexical-binding: t; -*-\n;;; Commentary:\n;;; Code:\n")))) + +(ert-deftest test-pkg-header-checker-passes-conformant () + "Normal: a well-formed module yields no violations." + (should-not (test-pkg-header--check + "foo.el" + ";;; foo.el --- A thing -*- lexical-binding: t; -*-\n;;; Commentary:\n;; doc\n;;; Code:\n(provide 'foo)\n"))) + +(ert-deftest test-pkg-header-checker-boundary-empty () + "Boundary: empty file text reports every applicable violation, no crash." + (let ((v (test-pkg-header--check "foo.el" ""))) + (should (memq 'header v)) + (should (memq 'markers v)) + (should (memq 'provide v)))) + +(ert-deftest test-pkg-header-all-modules-conform () + "Normal: every modules/*.el passes the package-header checks." + (let ((dir (expand-file-name "modules" user-emacs-directory)) + (bad '())) + (dolist (file (directory-files dir t "\\.el\\'")) + (let ((name (file-name-nondirectory file))) + (unless (member name test-pkg-header--exempt) + (let* ((text (with-temp-buffer + (insert-file-contents file) + (buffer-string))) + (violations (test-pkg-header--check name text))) + (when violations (push (cons name violations) bad)))))) + (should-not bad))) + +(provide 'test-meta-package-headers) +;;; test-meta-package-headers.el ends here diff --git a/tests/test-music-config--faces.el b/tests/test-music-config--faces.el new file mode 100644 index 000000000..c45049e1a --- /dev/null +++ b/tests/test-music-config--faces.el @@ -0,0 +1,25 @@ +;;; test-music-config--faces.el --- music playlist face definitions -*- lexical-binding: t; -*- + +;;; Commentary: +;; The playlist header propertizes text with cj/music-* faces. Each must be a +;; defined face (defface) or the reference is invalid -- an undefined face spams +;; "Invalid face reference" on every header render. The faces inherit from +;; themed base faces so the theme still owns their colors. + +;;; Code: + +(require 'ert) +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'music-config) + +(ert-deftest test-music-config-header-faces-are-defined () + "Normal: every cj/music face the playlist header uses is a defined face." + (dolist (f '(cj/music-header-face + cj/music-header-value-face + cj/music-mode-on-face + cj/music-mode-off-face + cj/music-keyhint-face)) + (should (facep f)))) + +(provide 'test-music-config--faces) +;;; test-music-config--faces.el ends here diff --git a/tests/test-nov-reading--palette.el b/tests/test-nov-reading--palette.el new file mode 100644 index 000000000..b34ea2cac --- /dev/null +++ b/tests/test-nov-reading--palette.el @@ -0,0 +1,92 @@ +;;; test-nov-reading--palette.el --- nov reading-palette tests -*- lexical-binding: t; -*- + +;;; Commentary: +;; Pure-logic tests for the nov-mode reading-palette selector: name->face +;; resolution and the cycle order (palettes, then the no-palette state, wrapping). +;; The buffer-local face-remap application is exercised live, not here. + +;;; Code: + +(require 'ert) +(require 'cl-lib) +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'nov-reading) + +(declare-function cj/nov--reading-palette-face "nov-reading" (name)) +(declare-function cj/nov--reading-palette-plist "nov-reading" (name)) +(declare-function cj/nov--next-reading-palette "nov-reading" (current names)) +(defvar cj/nov-reading-palettes) + +;; Each palette entry is a property list: :face supplies bg/fg, :heading and +;; :link recolor shr's heading/link faces. Structural keys are optional. +(defconst test-nov-reading--palettes + '(("sepia" :face cj/nov-reading-sepia + :heading cj/nov-reading-sepia-heading + :link cj/nov-reading-sepia-link) + ("dark" :face cj/nov-reading-dark)) + "Bundle-shaped palette fixture: sepia carries structural faces, dark omits them.") + +;;; ----------------------- cj/nov--reading-palette-face ----------------------- + +(ert-deftest test-nov-reading-palette-face-known () + "Normal: a known palette name resolves to its :face." + (let ((cj/nov-reading-palettes test-nov-reading--palettes)) + (should (eq (cj/nov--reading-palette-face "sepia") 'cj/nov-reading-sepia)) + (should (eq (cj/nov--reading-palette-face "dark") 'cj/nov-reading-dark)))) + +(ert-deftest test-nov-reading-palette-face-unknown () + "Error: an unknown name resolves to nil." + (let ((cj/nov-reading-palettes test-nov-reading--palettes)) + (should-not (cj/nov--reading-palette-face "nope")))) + +(ert-deftest test-nov-reading-palette-face-nil () + "Boundary: a nil name resolves to nil." + (let ((cj/nov-reading-palettes test-nov-reading--palettes)) + (should-not (cj/nov--reading-palette-face nil)))) + +;;; ---------------------- cj/nov--reading-palette-plist ----------------------- + +(ert-deftest test-nov-reading-palette-plist-structural-faces () + "Normal: a palette's :heading and :link faces are retrievable from its plist." + (let ((cj/nov-reading-palettes test-nov-reading--palettes)) + (should (eq (plist-get (cj/nov--reading-palette-plist "sepia") :heading) + 'cj/nov-reading-sepia-heading)) + (should (eq (plist-get (cj/nov--reading-palette-plist "sepia") :link) + 'cj/nov-reading-sepia-link)))) + +(ert-deftest test-nov-reading-palette-plist-omitted-structural () + "Boundary: a palette that omits structural keys yields nil for them." + (let ((cj/nov-reading-palettes test-nov-reading--palettes)) + (should (eq (plist-get (cj/nov--reading-palette-plist "dark") :face) + 'cj/nov-reading-dark)) + (should-not (plist-get (cj/nov--reading-palette-plist "dark") :heading)) + (should-not (plist-get (cj/nov--reading-palette-plist "dark") :link)))) + +(ert-deftest test-nov-reading-palette-plist-unknown () + "Error: an unknown palette name yields a nil plist." + (let ((cj/nov-reading-palettes test-nov-reading--palettes)) + (should-not (cj/nov--reading-palette-plist "nope")))) + +;;; ----------------------- cj/nov--next-reading-palette ----------------------- + +(ert-deftest test-nov-reading-next-palette-advances () + "Normal: cycles to the next palette in order." + (should (equal (cj/nov--next-reading-palette "sepia" '("sepia" "dark" "light")) + "dark"))) + +(ert-deftest test-nov-reading-next-palette-last-to-none () + "Boundary: the last palette cycles to the no-palette state (nil)." + (should-not (cj/nov--next-reading-palette "light" '("sepia" "dark" "light")))) + +(ert-deftest test-nov-reading-next-palette-none-to-first () + "Boundary: the no-palette state (nil) cycles to the first palette." + (should (equal (cj/nov--next-reading-palette nil '("sepia" "dark" "light")) + "sepia"))) + +(ert-deftest test-nov-reading-next-palette-unknown-current-falls-to-first () + "Error: an unknown current palette falls back to the first." + (should (equal (cj/nov--next-reading-palette "gone" '("sepia" "dark" "light")) + "sepia"))) + +(provide 'test-nov-reading--palette) +;;; test-nov-reading--palette.el ends here diff --git a/tests/test-nov-reading--text-scale.el b/tests/test-nov-reading--text-scale.el new file mode 100644 index 000000000..8c2fed8b4 --- /dev/null +++ b/tests/test-nov-reading--text-scale.el @@ -0,0 +1,105 @@ +;;; test-nov-reading--text-scale.el --- nov reading text-scale persistence tests -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for the persisted global reading text-scale offset: parsing the stored +;; value (pure) and the save/load round-trip through the data file. The live +;; text-scale application in the +/-/= commands is exercised live, not here. + +;;; Code: + +(require 'ert) +(require 'cl-lib) +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'nov-reading) + +(declare-function cj/nov-reading--parse-text-scale "nov-reading" (s)) +(declare-function cj/nov-reading--load-text-scale "nov-reading" ()) +(declare-function cj/nov-reading--save-text-scale "nov-reading" (amount)) +(defvar cj/nov-reading-text-scale-file) + +;;; --------------------- cj/nov-reading--parse-text-scale ---------------------- + +(ert-deftest test-nov-reading-parse-text-scale-positive () + "Normal: a positive integer string parses to that integer." + (should (= (cj/nov-reading--parse-text-scale "3") 3))) + +(ert-deftest test-nov-reading-parse-text-scale-negative () + "Normal: a negative integer string parses to that integer." + (should (= (cj/nov-reading--parse-text-scale "-2") -2))) + +(ert-deftest test-nov-reading-parse-text-scale-trailing-newline () + "Boundary: surrounding whitespace/newline is tolerated." + (should (= (cj/nov-reading--parse-text-scale "4\n") 4))) + +(ert-deftest test-nov-reading-parse-text-scale-zero () + "Boundary: \"0\" parses to 0." + (should (= (cj/nov-reading--parse-text-scale "0") 0))) + +(ert-deftest test-nov-reading-parse-text-scale-nil () + "Boundary: nil parses to 0." + (should (= (cj/nov-reading--parse-text-scale nil) 0))) + +(ert-deftest test-nov-reading-parse-text-scale-empty () + "Boundary: an empty string parses to 0." + (should (= (cj/nov-reading--parse-text-scale "") 0))) + +(ert-deftest test-nov-reading-parse-text-scale-garbage () + "Error: non-numeric content parses to 0." + (should (= (cj/nov-reading--parse-text-scale "garbage") 0))) + +(ert-deftest test-nov-reading-parse-text-scale-float-rejected () + "Error: a non-integer numeric string parses to 0 (offsets are integers)." + (should (= (cj/nov-reading--parse-text-scale "3.5") 0))) + +;;; ------------------ cj/nov-reading--save/load round-trip --------------------- + +(ert-deftest test-nov-reading-save-load-roundtrip-positive () + "Normal: a saved positive offset loads back unchanged." + (let ((cj/nov-reading-text-scale-file (make-temp-file "nov-scale-"))) + (unwind-protect + (progn + (cj/nov-reading--save-text-scale 4) + (should (= (cj/nov-reading--load-text-scale) 4))) + (delete-file cj/nov-reading-text-scale-file)))) + +(ert-deftest test-nov-reading-save-load-roundtrip-negative () + "Normal: a saved negative offset loads back unchanged." + (let ((cj/nov-reading-text-scale-file (make-temp-file "nov-scale-"))) + (unwind-protect + (progn + (cj/nov-reading--save-text-scale -3) + (should (= (cj/nov-reading--load-text-scale) -3))) + (delete-file cj/nov-reading-text-scale-file)))) + +(ert-deftest test-nov-reading-save-load-roundtrip-zero () + "Boundary: a saved 0 offset loads back as 0." + (let ((cj/nov-reading-text-scale-file (make-temp-file "nov-scale-"))) + (unwind-protect + (progn + (cj/nov-reading--save-text-scale 0) + (should (= (cj/nov-reading--load-text-scale) 0))) + (delete-file cj/nov-reading-text-scale-file)))) + +(ert-deftest test-nov-reading-load-missing-file-defaults-zero () + "Boundary: loading when no file exists yet returns 0." + (let ((cj/nov-reading-text-scale-file + (expand-file-name "nov-scale-absent" + (make-temp-file "nov-scale-dir-" t)))) + (unwind-protect + (should (= (cj/nov-reading--load-text-scale) 0)) + (delete-directory (file-name-directory cj/nov-reading-text-scale-file) t)))) + +(ert-deftest test-nov-reading-save-creates-missing-directory () + "Boundary: save creates the data directory when it is absent." + (let* ((dir (make-temp-file "nov-scale-dir-" t)) + (cj/nov-reading-text-scale-file + (expand-file-name "sub/nov-reading-text-scale" dir))) + (unwind-protect + (progn + (cj/nov-reading--save-text-scale 2) + (should (file-readable-p cj/nov-reading-text-scale-file)) + (should (= (cj/nov-reading--load-text-scale) 2))) + (delete-directory dir t)))) + +(provide 'test-nov-reading--text-scale) +;;; test-nov-reading--text-scale.el ends here diff --git a/tests/test-org-capture-config-popup-window.el b/tests/test-org-capture-config-popup-window.el index 671d55ab9..af96ba012 100644 --- a/tests/test-org-capture-config-popup-window.el +++ b/tests/test-org-capture-config-popup-window.el @@ -110,11 +110,11 @@ deletes the popup frame instead of leaving it orphaned. Components integrated: - cj/quick-capture (real) - org-capture (MOCKED — signals user-error \"Abort\") -- cj/org-capture--delete-popup-frame (MOCKED — records the call)" +- cj/org-capture-reap-popup-frames (MOCKED — records the call)" (let ((deleted 0)) (cl-letf (((symbol-function 'org-capture) (lambda (&rest _) (user-error "Abort"))) - ((symbol-function 'cj/org-capture--delete-popup-frame) + ((symbol-function 'cj/org-capture-reap-popup-frames) (lambda () (cl-incf deleted)))) (cj/quick-capture)) (should (= deleted 1)))) @@ -124,7 +124,7 @@ Components integrated: (let ((deleted 0)) (cl-letf (((symbol-function 'org-capture) (lambda (&rest _) (signal 'quit nil))) - ((symbol-function 'cj/org-capture--delete-popup-frame) + ((symbol-function 'cj/org-capture-reap-popup-frames) (lambda () (cl-incf deleted)))) (cj/quick-capture)) (should (= deleted 1)))) @@ -134,19 +134,32 @@ Components integrated: the finalize hook owns that." (let ((deleted 0)) (cl-letf (((symbol-function 'org-capture) (lambda (&rest _) nil)) - ((symbol-function 'cj/org-capture--delete-popup-frame) + ((symbol-function 'cj/org-capture-reap-popup-frames) (lambda () (cl-incf deleted)))) (cj/quick-capture)) (should (= deleted 0)))) -;;; cj/org-capture--popup-frame-p +;;; cj/org-capture--frame-reapable-p -(ert-deftest test-org-capture-config-popup-frame-p () - "Normal/Boundary: true only when the selected frame is named \"org-capture\"." - (cl-letf (((symbol-function 'frame-parameter) (lambda (&rest _) "org-capture"))) - (should (cj/org-capture--popup-frame-p))) - (cl-letf (((symbol-function 'frame-parameter) (lambda (&rest _) "emacs"))) - (should-not (cj/org-capture--popup-frame-p)))) +(ert-deftest test-org-capture-config-frame-reapable-p-no-capture-ui () + "Normal: an \"org-capture\" frame showing only non-capture buffers is reapable." + (should (cj/org-capture--frame-reapable-p + "org-capture" '("agent [.emacs.d]" "*dashboard*")))) + +(ert-deftest test-org-capture-config-frame-reapable-p-capture-buffer-spares () + "Boundary: a CAPTURE-* buffer means the popup is mid-capture — not reapable." + (should-not (cj/org-capture--frame-reapable-p + "org-capture" '("CAPTURE-todo.org" "*dashboard*")))) + +(ert-deftest test-org-capture-config-frame-reapable-p-select-menu-spares () + "Boundary: the *Org Select* template menu means mid-capture — not reapable." + (should-not (cj/org-capture--frame-reapable-p + "org-capture" '("*Org Select*")))) + +(ert-deftest test-org-capture-config-frame-reapable-p-other-frame-never () + "Error: a frame not named \"org-capture\" is never reapable, even when empty." + (should-not (cj/org-capture--frame-reapable-p + "Emacs 30.2 : agent [.emacs.d]" '("agent [.emacs.d]")))) ;;; cj/org-capture--popup-frame (find the popup frame by name) diff --git a/tests/test-system-commands-keymap.el b/tests/test-system-commands-keymap.el index ac78a25d5..82be1d8de 100644 --- a/tests/test-system-commands-keymap.el +++ b/tests/test-system-commands-keymap.el @@ -2,8 +2,9 @@ ;;; Commentary: -;; The system command keymap should remain mounted as a prefix under C-; ! so -;; which-key can show the documented subcommands. +;; C-; ! is bound directly to the completing-read menu. The per-command leaf +;; keys (s/r/e/l/L/E/S) were removed to reclaim the key real-estate; every +;; command stays reachable through the menu (see the menu-dispatch test). ;;; Code: @@ -14,23 +15,21 @@ (require 'system-commands) -(ert-deftest test-system-commands-keymap-normal-prefix-mounted () - "Normal: C-; ! remains a prefix keymap, not a direct command." - (should (eq (keymap-lookup cj/custom-keymap "!") - cj/system-command-map))) - -(ert-deftest test-system-commands-keymap-normal-documented-subkeys () - "Normal: documented system command subkeys resolve under the prefix." - (dolist (binding '(("!" . cj/system-command-menu) - ("L" . cj/system-cmd-logout) - ("r" . cj/system-cmd-reboot) - ("s" . cj/system-cmd-shutdown) - ("S" . cj/system-cmd-suspend) - ("l" . cj/system-cmd-lock) - ("E" . cj/system-cmd-exit-emacs) - ("e" . cj/system-cmd-restart-emacs))) - (should (eq (keymap-lookup cj/system-command-map (car binding)) - (cdr binding))))) +(ert-deftest test-system-commands-keymap-normal-menu-bound-directly () + "Normal: C-; ! is the completing-read menu command, not a prefix keymap." + (let ((binding (keymap-lookup cj/custom-keymap "!"))) + (should (eq binding 'cj/system-command-menu)) + (should (commandp binding)))) + +(ert-deftest test-system-commands-keymap-normal-leaf-subkeys-removed () + "Normal: no subkeys hang off C-; !, and the commands remain defined." + ;; "!" is now a command, not a prefix, so there is no submap to walk into. + (should-not (keymapp (keymap-lookup cj/custom-keymap "!"))) + ;; The commands themselves stay defined and reachable via the menu. + (dolist (cmd '(cj/system-cmd-logout cj/system-cmd-reboot cj/system-cmd-shutdown + cj/system-cmd-suspend cj/system-cmd-lock cj/system-cmd-exit-emacs + cj/system-cmd-restart-emacs)) + (should (fboundp cmd)))) (provide 'test-system-commands-keymap) ;;; test-system-commands-keymap.el ends here diff --git a/tests/test-system-commands-resolve-and-run.el b/tests/test-system-commands-resolve-and-run.el index af2288fd9..9d92c5d68 100644 --- a/tests/test-system-commands-resolve-and-run.el +++ b/tests/test-system-commands-resolve-and-run.el @@ -172,9 +172,15 @@ does not run the command." (ert-deftest test-system-cmd-restart-emacs-no-service-aborts () "Error: when no emacs.service exists, restart aborts without running anything." (let ((ran nil)) + ;; Drive the real service check to nil at its boundary (no systemctl on + ;; PATH) rather than mocking cj/system-cmd--emacs-service-available-p + ;; itself: cj/system-cmd-restart-emacs reaches that helper through a + ;; native-comp intra-file direct call that bypasses a symbol-function + ;; redefinition, so the helper-level mock silently no-ops and the real + ;; check passes on a machine that has emacs.service. executable-find is a + ;; subr the helper calls, and its trampoline honors the cl-letf swap. (cl-letf (((symbol-function 'daemonp) (lambda () t)) - ((symbol-function 'cj/system-cmd--emacs-service-available-p) - (lambda () nil)) + ((symbol-function 'executable-find) (lambda (&rest _) nil)) ((symbol-function 'read-char-choice) (lambda (&rest _) ?y)) ((symbol-function 'call-process-shell-command) (lambda (&rest _) (setq ran t)))) diff --git a/tests/test-system-defaults-functions.el b/tests/test-system-defaults-functions.el index 2562ff6aa..c603fc7eb 100644 --- a/tests/test-system-defaults-functions.el +++ b/tests/test-system-defaults-functions.el @@ -9,7 +9,7 @@ ;; cj/minibuffer-setup-hook -- inflate gc-cons-threshold while ;; typing in the minibuffer ;; cj/minibuffer-exit-hook -- restore gc-cons-threshold on exit -;; unpropertize-kill-ring -- strip text properties from +;; cj/--unpropertize-kill-ring -- strip text properties from ;; kill-ring at shutdown ;; cj/log-comp-warning -- route native-comp warnings to a ;; file rather than the *Warnings* @@ -79,13 +79,13 @@ (should (eq (cj/disabled) nil)) (should (commandp #'cj/disabled))) -;;; unpropertize-kill-ring +;;; cj/--unpropertize-kill-ring (ert-deftest test-system-defaults-unpropertize-kill-ring-strips-properties () "Normal: every kill-ring entry comes back with no text properties." (let ((kill-ring (list (propertize "alpha" 'face 'bold) (propertize "beta" 'face 'underline)))) - (unpropertize-kill-ring) + (cj/--unpropertize-kill-ring) (should (equal kill-ring '("alpha" "beta"))) (should-not (text-properties-at 0 (nth 0 kill-ring))) (should-not (text-properties-at 0 (nth 1 kill-ring))))) @@ -93,7 +93,7 @@ (ert-deftest test-system-defaults-unpropertize-kill-ring-boundary-empty-ring () "Boundary: an empty `kill-ring' stays empty after the strip pass." (let ((kill-ring nil)) - (unpropertize-kill-ring) + (cj/--unpropertize-kill-ring) (should (null kill-ring)))) ;;; cj/log-comp-warning diff --git a/tests/test-system-defaults.el b/tests/test-system-defaults.el index f653e1fbb..a641adea1 100644 --- a/tests/test-system-defaults.el +++ b/tests/test-system-defaults.el @@ -8,7 +8,7 @@ ;; writes land, where backups go, and whether the minibuffer GC hooks are ;; installed. Load happens in the shared sandbox (testutil-system-defaults.el). ;; -;; The module's functions (cj/disabled, the GC hook bodies, unpropertize-kill-ring, +;; The module's functions (cj/disabled, the GC hook bodies, cj/--unpropertize-kill-ring, ;; cj/log-comp-warning) are covered by test-system-defaults-functions.el, and the ;; vc-follow-symlinks default by test-system-defaults-vc-follow-symlinks.el. diff --git a/tests/test-system-lib--completion-file-annotator.el b/tests/test-system-lib--completion-file-annotator.el new file mode 100644 index 000000000..9e1f4aa4a --- /dev/null +++ b/tests/test-system-lib--completion-file-annotator.el @@ -0,0 +1,54 @@ +;;; test-system-lib--completion-file-annotator.el --- Tests for cj/completion-file-annotator -*- lexical-binding: t; -*- + +;;; Commentary: +;; Unit tests for `cj/completion-file-annotator', the annotation-function +;; factory used to annotate file-basename completion pickers with size and +;; modification date. + +;;; Code: + +(require 'ert) +(require 'system-lib) + +(ert-deftest test-system-lib-completion-file-annotator-normal-file-shows-size-and-date () + "Normal: a regular file is annotated with a size and an ISO date." + (let ((file (make-temp-file "cfa-test-" nil ".txt" "hello world"))) + (unwind-protect + (let* ((annotate (cj/completion-file-annotator + (lambda (_cand) file))) + (result (funcall annotate "anything"))) + (should (stringp result)) + ;; file-size-human-readable of 11 bytes is "11" + (should (string-match-p "11" result)) + ;; ISO date for the file's mtime + (should (string-match-p + (format-time-string "%Y-%m-%d" + (file-attribute-modification-time + (file-attributes file))) + result))) + (delete-file file)))) + +(ert-deftest test-system-lib-completion-file-annotator-boundary-directory-marked-dir () + "Boundary: a directory candidate is annotated with the `dir' marker." + (let ((dir (make-temp-file "cfa-dir-" t))) + (unwind-protect + (let* ((annotate (cj/completion-file-annotator (lambda (_c) dir))) + (result (funcall annotate "d"))) + (should (stringp result)) + (should (string-match-p "dir" result))) + (delete-directory dir t)))) + +(ert-deftest test-system-lib-completion-file-annotator-error-nil-path-returns-nil () + "Error: a candidate whose path-resolver returns nil yields no annotation." + (let ((annotate (cj/completion-file-annotator (lambda (_c) nil)))) + (should (null (funcall annotate "missing"))))) + +(ert-deftest test-system-lib-completion-file-annotator-error-missing-file-returns-nil () + "Error: a path that does not exist yields no annotation." + (let* ((path (expand-file-name "definitely-not-here-12345.txt" + temporary-file-directory)) + (annotate (cj/completion-file-annotator (lambda (_c) path)))) + (should (null (funcall annotate "gone"))))) + +(provide 'test-system-lib--completion-file-annotator) +;;; test-system-lib--completion-file-annotator.el ends here diff --git a/tests/test-system-utils-commands.el b/tests/test-system-utils-commands.el index b7b61dc22..6f2099a24 100644 --- a/tests/test-system-utils-commands.el +++ b/tests/test-system-utils-commands.el @@ -90,5 +90,14 @@ and lands in a dedicated output buffer." (should saved) (should killed))) +;;; ibuffer delete/diff keybinding swap + +(ert-deftest test-system-utils-ibuffer-d-diffs-D-deletes () + "Normal: in the ibuffer list, d diffs the buffer at point against its file and +D marks it for deletion (the swap of ibuffer's default d/= bindings)." + (require 'ibuffer) + (should (eq (keymap-lookup ibuffer-mode-map "d") #'ibuffer-diff-with-file)) + (should (eq (keymap-lookup ibuffer-mode-map "D") #'ibuffer-mark-for-delete))) + (provide 'test-system-utils-commands) ;;; test-system-utils-commands.el ends here diff --git a/tests/test-term-config--f8-in-term.el b/tests/test-term-config--f8-in-term.el deleted file mode 100644 index 6cee4ff46..000000000 --- a/tests/test-term-config--f8-in-term.el +++ /dev/null @@ -1,42 +0,0 @@ -;;; test-term-config--f8-in-term.el --- F8 reaches Emacs from inside a ghostel buffer -*- lexical-binding: t; -*- - -;;; Commentary: -;; <f8> is a global binding (`cj/main-agenda-display', set in org-agenda-config). -;; ghostel's semi-char mode forwards every key NOT in `ghostel-keymap-exceptions' -;; to the terminal program, so a plain <f8> typed while point is in a ghostel -;; buffer would be sent to the program instead of opening the agenda. Unlike the -;; F9 family, F8 is NOT re-bound in `ghostel-mode-map' -- it simply falls through -;; to the global map once the semi-char map stops forwarding it, so the only -;; wiring term-config.el adds is the keymap-exceptions entry plus the rebuild. -;; These tests require ghostel (so term-config's `with-eval-after-load' fires) -;; BEFORE term-config, then confirm the exception landed and the rebuilt -;; semi-char map no longer forwards <f8>. `(require 'ghostel)' does not load the -;; native module, so this stays light. - -;;; Code: - -(require 'ert) -(require 'package) - -(setq package-user-dir (expand-file-name "elpa" user-emacs-directory)) -(package-initialize) -(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) -(require 'ghostel) -(require 'term-config) - -(ert-deftest test-term-config-f8-in-keymap-exceptions () - "Regression: <f8> is in `ghostel-keymap-exceptions' so semi-char mode lets it -reach Emacs instead of forwarding it to the terminal program. This is what lets -the global agenda binding work from inside a ghostel buffer." - (should (member "<f8>" ghostel-keymap-exceptions))) - -(ert-deftest test-term-config-f8-not-forwarded-by-semi-char-map () - "Regression: the rebuilt semi-char map must no longer forward <f8> to the pty. -`add-to-list' updates the exceptions list but not the already-built map -- only -`ghostel--rebuild-semi-char-keymap' (run in term-config's :init) drops the -forwarding binding so <f8> falls through to the global agenda command." - (should-not (eq (keymap-lookup ghostel-semi-char-mode-map "<f8>") - 'ghostel--send-event))) - -(provide 'test-term-config--f8-in-term) -;;; test-term-config--f8-in-term.el ends here diff --git a/tests/test-term-tmux-history.el b/tests/test-term-tmux-history.el index 0ea7cf37d..a5f5c93cd 100644 --- a/tests/test-term-tmux-history.el +++ b/tests/test-term-tmux-history.el @@ -1,14 +1,13 @@ -;;; test-term-tmux-history.el --- Tests for term-config tmux history + menu UX -*- lexical-binding: t; -*- +;;; test-term-tmux-history.el --- Tests for the EAT terminal copy-mode + tmux history -*- lexical-binding: t; -*- ;;; Commentary: -;; Exercises the term-config (ghostel) terminal UX: the Emacs-owned tmux -;; history buffer, the copy-mode-dwim engine pick, the tmux pane-id / -;; attached-client predicates, and the C-; x menu bindings. +;; Exercises the terminal UX carried into eat-config for the EAT agent +;; terminals: the Emacs-owned tmux history buffer, the copy-mode-dwim engine +;; pick, the tmux pane-id / attached-client predicates, and the C-; x menu +;; bindings. Agents run EAT over tmux, so copy-mode is tmux's own copy-mode. ;; -;; ghostel is required (which defines `ghostel-mode-map' / -;; `ghostel-keymap-exceptions' and lets term-config's `with-eval-after-load' -;; fire) before term-config. `(require 'ghostel)' does not load the native -;; module; tmux is mocked via `process-file', so nothing spawns. +;; eat is required (so eat-config's `with-eval-after-load' fires for the C-<up> +;; bind) before eat-config; tmux is mocked via `process-file', so nothing spawns. ;;; Code: @@ -21,9 +20,9 @@ (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) -(require 'ghostel) -(require 'term-config) -(require 'testutil-ghostel-buffers) +(require 'eat) +(require 'eat-config) +(require 'testutil-terminal-buffers) (defmacro test-term-tmux-history--with-tmux-mock (responses &rest body) "Run BODY with `process-file' mocked for tmux RESPONSES. @@ -51,6 +50,8 @@ RESPONSES is an alist of (ARGS EXIT-CODE OUTPUT)." exit-code)))) ,@body))) +;;; tmux helpers + (ert-deftest test-term-tmux-history--pane-id-for-tty-matches-client () "Normal: current terminal pty maps to the active pane for that tmux client." (test-term-tmux-history--with-tmux-mock @@ -66,9 +67,32 @@ RESPONSES is an alist of (ARGS EXIT-CODE OUTPUT)." (should (equal (cj/term--tmux-capture-pane "%8") "first line\nsecond line\n")))) +(ert-deftest test-term-current-tmux-pane-id-rejects-non-eat-buffer () + "Error: pane-id lookup refuses a buffer that is not in `eat-mode'." + (with-temp-buffer + (should-error (cj/term--current-tmux-pane-id) :type 'user-error))) + +(ert-deftest test-term-current-tmux-pane-id-accepts-agent-named-buffer () + "Normal: an agent-named eat buffer resolves by process TTY, not buffer name." + (let ((agent (cj/test--make-fake-eat-buffer "agent [emacs.d]"))) + (unwind-protect + (with-current-buffer agent + (cl-letf (((symbol-function 'get-buffer-process) + (lambda (_buffer) 'fake-process)) + ((symbol-function 'process-tty-name) + (lambda (_process &rest _) "/dev/pts/8"))) + (test-term-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/term--current-tmux-pane-id) "%8"))))) + (when (buffer-live-p agent) + (kill-buffer agent))))) + +;;; tmux history buffer + (ert-deftest test-term-tmux-history-open-renders-read-only-history-buffer () - "Normal: command renders tmux history in a normal Emacs buffer." - (let ((origin (cj/test--make-fake-ghostel-buffer "*test-term-history-origin*"))) + "Normal: the command renders tmux history in a normal Emacs buffer." + (let ((origin (cj/test--make-fake-eat-buffer "*test-term-history-origin*"))) (unwind-protect (save-window-excursion (switch-to-buffer origin) @@ -90,41 +114,8 @@ RESPONSES is an alist of (ARGS EXIT-CODE OUTPUT)." (when (buffer-live-p origin) (kill-buffer origin))))) -(ert-deftest test-term-tmux-history-replaces-origin-buffer-in-same-window () - "Normal: the history view replaces the origin in the selected window. - -`cj/term-tmux-history' uses `switch-to-buffer' so reading scrollback keeps -the terminal's frame slot rather than splitting or popping a new window." - (let ((origin (cj/test--make-fake-ghostel-buffer "*test-term-history-inplace*"))) - (unwind-protect - (save-window-excursion - (delete-other-windows) - (switch-to-buffer origin) - (let ((win (selected-window))) - (should (eq (window-buffer win) origin)) - (should (one-window-p)) - (cl-letf (((symbol-function 'get-buffer-process) - (lambda (_buffer) 'fake-process)) - ((symbol-function 'process-tty-name) - (lambda (_process &rest _) "/dev/pts/8"))) - (test-term-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 - "scrollback line\n")) - (cj/term-tmux-history))) - (should (one-window-p)) - (should (eq (selected-window) win)) - (should (string-prefix-p - "*terminal tmux history:" - (buffer-name (window-buffer win)))))) - (cj/test--kill-buffers-matching-prefix "*terminal tmux history") - (when (buffer-live-p origin) - (kill-buffer origin))))) - (ert-deftest test-term-tmux-history-quit-returns-to-origin () - "Normal: q / <escape> / C-g (cj/term-tmux-history-quit) kills the history -buffer and restores the origin buffer, window, and point." + "Normal: quit kills the history buffer and restores origin buffer/window/point." (let ((origin (get-buffer-create "*test-term-history-return*"))) (unwind-protect (let ((history (get-buffer-create "*terminal tmux history: test*"))) @@ -149,10 +140,8 @@ buffer and restores the origin buffer, window, and point." (kill-buffer origin))))) (ert-deftest test-term-tmux-history-mode-keymap () - "Normal: in the history buffer M-w copies without quitting; q, <escape>, -and C-g quit back to the terminal; RET is left unbound (no special exit)." - (should (eq (keymap-lookup cj/term-tmux-history-mode-map "M-w") - #'kill-ring-save)) + "Normal: M-w copies; q/<escape>/C-g quit; RET is left unbound." + (should (eq (keymap-lookup cj/term-tmux-history-mode-map "M-w") #'kill-ring-save)) (should (eq (keymap-lookup cj/term-tmux-history-mode-map "q") #'cj/term-tmux-history-quit)) (should (eq (keymap-lookup cj/term-tmux-history-mode-map "<escape>") @@ -161,50 +150,11 @@ and C-g quit back to the terminal; RET is left unbound (no special exit)." #'cj/term-tmux-history-quit)) (should-not (keymap-lookup cj/term-tmux-history-mode-map "RET"))) -(ert-deftest test-term-keymap-includes-history-and-copy-bindings () - "Normal: the personal terminal map owns the high-level UX commands, and C-; -reaches Emacs inside ghostel buffers so the prefix works there." - (should (member "C-;" ghostel-keymap-exceptions)) - (should (eq (keymap-lookup cj/custom-keymap "x h") #'cj/term-tmux-history)) - (should (eq (keymap-lookup cj/custom-keymap "x c") #'cj/term-copy-mode-dwim)) - (should (equal (keymap-lookup ghostel-mode-map "C-;") cj/custom-keymap)) - (should (eq (keymap-lookup ghostel-mode-map "C-; x h") #'cj/term-tmux-history)) - (should (eq (keymap-lookup ghostel-mode-map "C-; x c") #'cj/term-copy-mode-dwim))) - -(ert-deftest test-term-keymap-prompt-navigation () - "Normal: n/p navigate prompts, capital N creates a new terminal buffer." - (should (eq (keymap-lookup cj/custom-keymap "x n") #'ghostel-next-prompt)) - (should (eq (keymap-lookup cj/custom-keymap "x p") #'ghostel-previous-prompt)) - (should (eq (keymap-lookup cj/custom-keymap "x N") #'ghostel))) - -(ert-deftest test-term-current-tmux-pane-id-rejects-non-ghostel-buffer () - "Error: pane-id lookup refuses a buffer that is not in `ghostel-mode'." - (with-temp-buffer - (should-error (cj/term--current-tmux-pane-id) :type 'user-error))) - -(ert-deftest test-term-current-tmux-pane-id-accepts-agent-named-buffer () - "Normal: an agent-named ghostel buffer resolves by process TTY. - -The pane lookup keys off the live process TTY, never the buffer name, so a -buffer named `agent [repo]' (ai-term.el's naming) resolves like any other -ghostel-mode terminal." - (let ((agent (cj/test--make-fake-ghostel-buffer "agent [emacs.d]"))) - (unwind-protect - (with-current-buffer agent - (cl-letf (((symbol-function 'get-buffer-process) - (lambda (_buffer) 'fake-process)) - ((symbol-function 'process-tty-name) - (lambda (_process &rest _) "/dev/pts/8"))) - (test-term-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/term--current-tmux-pane-id) "%8"))))) - (when (buffer-live-p agent) - (kill-buffer agent))))) +;;; in-tmux-p predicate (ert-deftest test-term-in-tmux-p-true-when-client-attached () "Normal: predicate returns t when tmux reports a client for our tty." - (let ((agent (cj/test--make-fake-ghostel-buffer "agent [emacs.d]"))) + (let ((agent (cj/test--make-fake-eat-buffer "agent [emacs.d]"))) (unwind-protect (with-current-buffer agent (cl-letf (((symbol-function 'get-buffer-process) @@ -218,25 +168,18 @@ ghostel-mode terminal." (when (buffer-live-p agent) (kill-buffer agent))))) -(ert-deftest test-term-in-tmux-p-nil-when-no-matching-client () - "Boundary: predicate returns nil when tmux runs but our tty has no client." - (let ((agent (cj/test--make-fake-ghostel-buffer "agent [emacs.d]"))) - (unwind-protect - (with-current-buffer agent - (cl-letf (((symbol-function 'get-buffer-process) - (lambda (_buffer) 'fake-process)) - ((symbol-function 'process-tty-name) - (lambda (_process &rest _) "/dev/pts/8"))) - (test-term-tmux-history--with-tmux-mock - '((("list-clients" "-F" "#{client_tty}\t#{pane_id}") 0 - "/dev/pts/1\t%1\n")) - (should-not (cj/term--in-tmux-p))))) - (when (buffer-live-p agent) - (kill-buffer agent))))) +(ert-deftest test-term-in-tmux-p-nil-when-not-eat-mode () + "Boundary: predicate refuses non-eat buffers without calling tmux." + (with-temp-buffer + (let ((tmux-called nil)) + (cl-letf (((symbol-function 'process-file) + (lambda (&rest _) (setq tmux-called t) 0))) + (should-not (cj/term--in-tmux-p)) + (should-not tmux-called))))) (ert-deftest test-term-in-tmux-p-nil-when-tmux-fails () "Error: predicate swallows tmux failures and returns nil." - (let ((agent (cj/test--make-fake-ghostel-buffer "agent [emacs.d]"))) + (let ((agent (cj/test--make-fake-eat-buffer "agent [emacs.d]"))) (unwind-protect (with-current-buffer agent (cl-letf (((symbol-function 'get-buffer-process) @@ -250,117 +193,33 @@ ghostel-mode terminal." (when (buffer-live-p agent) (kill-buffer agent))))) -(ert-deftest test-term-in-tmux-p-nil-when-not-ghostel-mode () - "Boundary: predicate refuses non-ghostel buffers without calling tmux." - (with-temp-buffer - (let ((tmux-called nil)) - (cl-letf (((symbol-function 'process-file) - (lambda (&rest _) (setq tmux-called t) 0))) - (should-not (cj/term--in-tmux-p)) - (should-not tmux-called))))) +;;; copy-mode (tmux path -- the agent terminal case) (ert-deftest test-term-copy-mode-dwim-sends-tmux-prefix-when-attached () - "Normal: with tmux attached, dwim writes C-b [ then C-a into the pty so -tmux enters its own copy-mode and lands the cursor at the start of the -line. Without the trailing C-a the cursor inherits the live column (far -right after a prompt) and scrolling up runs up the right edge; start-of-line -puts it at column 0 so it runs up the left." - (let ((agent (cj/test--make-fake-ghostel-buffer "agent [emacs.d]")) - (sent nil) - (copy-mode-called nil)) + "Normal: with tmux attached, dwim writes C-b [ then C-a into the pty so tmux +enters copy-mode with the cursor at column 0." + (let ((agent (cj/test--make-fake-eat-buffer "agent [emacs.d]")) + (sent nil)) (unwind-protect (with-current-buffer agent (cl-letf (((symbol-function 'get-buffer-process) (lambda (_buffer) 'fake-process)) ((symbol-function 'process-tty-name) (lambda (_process &rest _) "/dev/pts/8")) - ((symbol-function 'ghostel-send-string) - (lambda (s) (push s sent))) - ((symbol-function 'ghostel-copy-mode) - (lambda () (setq copy-mode-called t)))) + ((symbol-function 'cj/--term-send-string) + (lambda (s) (push s sent)))) (test-term-tmux-history--with-tmux-mock '((("list-clients" "-F" "#{client_tty}\t#{pane_id}") 0 "/dev/pts/8\t%8\n")) (cj/term-copy-mode-dwim) - (should (equal sent '("\C-b[\C-a"))) - (should-not copy-mode-called)))) - (when (buffer-live-p agent) - (kill-buffer agent))))) - -(ert-deftest test-term-copy-mode-dwim-falls-back-without-tmux () - "Boundary: without tmux, dwim calls `ghostel-copy-mode' then moves point -to the start of the line and sends nothing to the pty. The -`beginning-of-line' must run after `ghostel-copy-mode' so it repositions -inside the copy view; column 0 keeps the cursor on the left edge while -scrolling, parity with the tmux branch's trailing C-a." - (let ((agent (cj/test--make-fake-ghostel-buffer "agent [emacs.d]")) - (sent nil) - (dwim-order nil)) - (unwind-protect - (with-current-buffer agent - (cl-letf (((symbol-function 'get-buffer-process) - (lambda (_buffer) 'fake-process)) - ((symbol-function 'process-tty-name) - (lambda (_process &rest _) "/dev/pts/8")) - ((symbol-function 'ghostel-send-string) - (lambda (s) (push s sent))) - ((symbol-function 'ghostel-copy-mode) - (lambda () (push 'copy-mode dwim-order))) - ((symbol-function 'beginning-of-line) - (lambda (&optional _n) (push 'beginning-of-line dwim-order)))) - (test-term-tmux-history--with-tmux-mock - '((("list-clients" "-F" "#{client_tty}\t#{pane_id}") 1 - "no server running")) - (cj/term-copy-mode-dwim) - (should-not sent) - (should (equal (reverse dwim-order) '(copy-mode beginning-of-line)))))) + (should (equal sent '("\C-b[\C-a")))))) (when (buffer-live-p agent) (kill-buffer agent))))) -(ert-deftest test-term-prefix-and-f12-in-keymap-exceptions () - "Regression: C-; and F12 are in `ghostel-keymap-exceptions' and the rebuilt -semi-char map no longer forwards them to the pty, so the prefix keymap and the -F12 toggle reach Emacs inside ghostel buffers." - (dolist (key '("C-;" "<f12>")) - (should (member key ghostel-keymap-exceptions))) - (should-not (eq (keymap-lookup ghostel-semi-char-mode-map "<f12>") - 'ghostel--send-event))) - -(ert-deftest test-term-window-nav-keys-in-keymap-exceptions () - "Regression: windmove (S-arrows) and buffer-move (C-M-arrows) are in -`ghostel-keymap-exceptions' so they reach Emacs from inside a ghostel buffer -instead of being forwarded to the terminal program." - (dolist (key '("S-<up>" "S-<down>" "S-<left>" "S-<right>" - "C-M-<up>" "C-M-<down>" "C-M-<left>" "C-M-<right>")) - (should (member key ghostel-keymap-exceptions))) - (should-not (eq (keymap-lookup ghostel-semi-char-mode-map "C-M-<left>") - 'ghostel--send-event))) - -(ert-deftest test-term-f10-music-in-keymap-exceptions () - "Regression: F10 (music playlist toggle) is in `ghostel-keymap-exceptions' -so it reaches Emacs from inside a ghostel buffer instead of being forwarded -to the terminal program. It is a global binding, so dropping it from the -semi-char map lets the lookup fall through to the global map. Server -shutdown moved off C-F10 to C-x C, which is deliberately NOT an exception -(C-x C stays forwarding to the terminal program inside an agent buffer)." - (should (member "<f10>" ghostel-keymap-exceptions)) - (should-not (member "C-<f10>" ghostel-keymap-exceptions)) - (should-not (eq (keymap-lookup ghostel-semi-char-mode-map "<f10>") - 'ghostel--send-event))) - -(ert-deftest test-term-c-spc-forwarded-not-set-mark () - "Regression: C-SPC is forwarded to the terminal, not bound to the global -`set-mark-command'. ghostel only forwards the `C-@' event, so without this an -Emacs region gets stuck in the ghostel buffer and tmux copy-mode's -begin-selection never starts." - (should (eq (keymap-lookup ghostel-mode-map "C-SPC") #'cj/term-send-C-SPC))) - -;; ----------------------------- copy-mode scroll ------------------------------ - (ert-deftest test-term-copy-mode-up-tmux-enters-then-scrolls-up () "Normal: from a live (non-copy) tmux pane, C-<up> enters copy-mode then sends the up-arrow, so one stroke both enters copy-mode and scrolls up." - (let ((agent (cj/test--make-fake-ghostel-buffer "agent [emacs.d]")) + (let ((agent (cj/test--make-fake-eat-buffer "agent [emacs.d]")) (sent nil)) (unwind-protect (with-current-buffer agent @@ -368,7 +227,7 @@ the up-arrow, so one stroke both enters copy-mode and scrolls up." (lambda (_buffer) 'fake-process)) ((symbol-function 'process-tty-name) (lambda (_process &rest _) "/dev/pts/8")) - ((symbol-function 'ghostel-send-string) + ((symbol-function 'cj/--term-send-string) (lambda (s) (push s sent)))) (test-term-tmux-history--with-tmux-mock '((("list-clients" "-F" "#{client_tty}\t#{pane_id}") 0 @@ -381,8 +240,8 @@ the up-arrow, so one stroke both enters copy-mode and scrolls up." (ert-deftest test-term-copy-mode-up-tmux-already-in-mode-just-scrolls () "Normal: when the tmux pane is already in copy-mode, C-<up> only sends the -up-arrow -- it does not re-enter (which would reset the cursor)." - (let ((agent (cj/test--make-fake-ghostel-buffer "agent [emacs.d]")) +up-arrow -- it does not re-enter and reset the cursor." + (let ((agent (cj/test--make-fake-eat-buffer "agent [emacs.d]")) (sent nil)) (unwind-protect (with-current-buffer agent @@ -390,7 +249,7 @@ up-arrow -- it does not re-enter (which would reset the cursor)." (lambda (_buffer) 'fake-process)) ((symbol-function 'process-tty-name) (lambda (_process &rest _) "/dev/pts/8")) - ((symbol-function 'ghostel-send-string) + ((symbol-function 'cj/--term-send-string) (lambda (s) (push s sent)))) (test-term-tmux-history--with-tmux-mock '((("list-clients" "-F" "#{client_tty}\t#{pane_id}") 0 @@ -401,54 +260,61 @@ up-arrow -- it does not re-enter (which would reset the cursor)." (when (buffer-live-p agent) (kill-buffer agent))))) -(ert-deftest test-term-copy-mode-up-nontmux-enters-then-moves-up () - "Boundary: without tmux and not yet in copy-mode, C-<up> enters -ghostel-copy-mode then moves point up a line, sending nothing to the pty." - (with-temp-buffer - (insert "abc\ndef\nghi\n") - (goto-char (point-min)) - (forward-line 2) ; land on line 3 - (let ((sent nil) (entered nil)) - (cl-letf (((symbol-function 'ghostel-send-string) (lambda (s) (push s sent))) - ((symbol-function 'ghostel-copy-mode) (lambda () (setq entered t)))) - (cj/term-copy-mode-up) - (should entered) - (should-not sent) - (should (= (line-number-at-pos) 2)))))) - -(ert-deftest test-term-copy-mode-up-nontmux-already-in-copy-just-moves () - "Normal: when ghostel is already in copy-mode, C-<up> just moves point up -- -it does not call `ghostel-copy-mode' again (which would toggle copy-mode off)." +;;; bindings + +(ert-deftest test-term-keymap-history-and-copy-bindings () + "Normal: the C-; x terminal map owns the tmux-history and copy-mode commands." + (should (eq (keymap-lookup cj/custom-keymap "x h") #'cj/term-tmux-history)) + (should (eq (keymap-lookup cj/custom-keymap "x c") #'cj/term-copy-mode-dwim)) + (should (eq (keymap-lookup cj/custom-keymap "x t") #'cj/term-toggle))) + +(ert-deftest test-term-copy-mode-up-bound-in-eat-semi-char-map () + "Normal: C-<up> enters copy-mode + scrolls up from inside an EAT terminal." + (should (eq (keymap-lookup eat-semi-char-mode-map "C-<up>") + #'cj/term-copy-mode-up))) + +(ert-deftest test-term-escape-bound-as-unified-exit () + "Normal: Escape sends ESC in semi-char mode (cancels tmux copy-mode) and +returns to semi-char from EAT's emacs/char mode -- one exit key for both." + (should (eq (keymap-lookup eat-semi-char-mode-map "<escape>") + #'cj/term-send-escape)) + (should (eq (keymap-lookup eat-mode-map "<escape>") #'eat-semi-char-mode))) + +(ert-deftest test-term-send-escape-writes-esc-to-pty () + "Normal: `cj/term-send-escape' sends a bare ESC to the terminal process." + (let ((sent nil)) + (cl-letf (((symbol-function 'cj/--term-send-string) + (lambda (s) (push s sent)))) + (cj/term-send-escape) + (should (equal sent '("\e")))))) + +(ert-deftest test-term-word-motion-arrows-forwarded-not-window-arrows () + "Normal: C-/M-left/right forward to the terminal (word motion in the program's +input) instead of moving Emacs point; windmove's S-arrows still reach Emacs." + (dolist (key '("C-<left>" "C-<right>" "M-<left>" "M-<right>")) + (should (eq (keymap-lookup eat-semi-char-mode-map key) #'eat-self-input))) + (dolist (key '("S-<left>" "S-<right>")) + (should-not (eq (keymap-lookup eat-semi-char-mode-map key) #'eat-self-input)))) + +(ert-deftest test-term-eat-tame-scroll-sets-minimal-scroll () + "Normal: `cj/--eat-tame-scroll' sets buffer-local minimal-scroll behavior so +the EAT window line-scrolls instead of recentering on full-frame redraws." (with-temp-buffer - (insert "abc\ndef\nghi\n") - (goto-char (point-min)) - (forward-line 2) ; land on line 3 - (setq-local ghostel--input-mode 'copy) - (let ((sent nil) (entered nil)) - (cl-letf (((symbol-function 'ghostel-send-string) (lambda (s) (push s sent))) - ((symbol-function 'ghostel-copy-mode) (lambda () (setq entered t)))) - (cj/term-copy-mode-up) - (should-not entered) - (should-not sent) - (should (= (line-number-at-pos) 2)))))) - -(ert-deftest test-term-copy-mode-only-c-up-bound () - "Normal/Regression: only C-<up> enters copy-mode in ghostel-mode-map; the -other arrows are not bound to it, so they pass through to the terminal." - (should (eq (keymap-lookup ghostel-mode-map "C-<up>") #'cj/term-copy-mode-up)) - (dolist (key '("C-<down>" "C-<left>" "C-<right>" - "M-<up>" "M-<down>" "M-<left>" "M-<right>")) - (should-not (eq (keymap-lookup ghostel-mode-map key) #'cj/term-copy-mode-up)))) - -(ert-deftest test-term-copy-mode-only-c-up-in-keymap-exceptions () - "Regression (C-arrow copy-mode bug): only C-<up> is in -`ghostel-keymap-exceptions'. C-<left>/<right>/<down> are readline word-motion -at the shell prompt and the M-arrows have no copy-mode role, so none are -exceptions -- they reach the terminal program instead of Emacs." - (should (member "C-<up>" ghostel-keymap-exceptions)) - (dolist (key '("C-<down>" "C-<left>" "C-<right>" - "M-<up>" "M-<down>" "M-<left>" "M-<right>")) - (should-not (member key ghostel-keymap-exceptions)))) + (cj/--eat-tame-scroll) + (should (= scroll-conservatively 101)) + (should (= scroll-margin 0)) + (should (null auto-window-vscroll)))) + +(ert-deftest test-term-eat-reset-sgr-at-newline () + "Normal: the SGR-reset advice injects a reset before each newline when enabled +\(containing an unterminated color), and passes output through unchanged when +disabled." + (let ((cj/eat-reset-sgr-at-newline t)) + (should (equal (cj/--eat-reset-sgr-at-newline (list (quote term) "a\nb\n")) + (list (quote term) "a\e[0m\nb\e[0m\n")))) + (let ((cj/eat-reset-sgr-at-newline nil)) + (should (equal (cj/--eat-reset-sgr-at-newline (list (quote term) "a\nb\n")) + (list (quote term) "a\nb\n"))))) (provide 'test-term-tmux-history) ;;; test-term-tmux-history.el ends here diff --git a/tests/test-term-toggle--buffer-filter.el b/tests/test-term-toggle--buffer-filter.el index 44f30aad6..f56459a06 100644 --- a/tests/test-term-toggle--buffer-filter.el +++ b/tests/test-term-toggle--buffer-filter.el @@ -4,9 +4,9 @@ ;; Three closely-related helpers determine which terminal buffer F12 ;; manages: the predicate `cj/--term-toggle-buffer-p', the list ;; `cj/--term-toggle-buffers', and the per-frame window finder -;; `cj/--term-toggle-displayed-window'. F12 manages the EAT terminal; -;; ghostel buffers (including ai-term's agent buffers) are NOT F12-managed -- -;; they live on M-SPC. +;; `cj/--term-toggle-displayed-window'. F12 opens eshell (run through EAT via +;; eat-eshell-mode), so it manages eshell-mode buffers. Standalone eat buffers +;; and ai-term's agent buffers (also eat) are NOT F12-managed. ;;; Code: @@ -14,26 +14,26 @@ (add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) (add-to-list 'load-path (expand-file-name "tests" user-emacs-directory)) -(require 'term-config) -(require 'testutil-ghostel-buffers) +(require 'eat-config) +(require 'testutil-terminal-buffers) (defun test-term-toggle--cleanup () "Kill leftover agent- and *test-term- prefixed buffers." (cj/test--kill-agent-buffers) (cj/test--kill-test-term-buffers)) -(ert-deftest test-term-toggle--buffer-p-accepts-eat-mode () - "Normal: an eat-mode buffer qualifies as the F12 terminal." +(ert-deftest test-term-toggle--buffer-p-accepts-eshell-mode () + "Normal: an eshell-mode buffer qualifies as the F12 terminal." (test-term-toggle--cleanup) - (let ((buf (cj/test--make-fake-eat-buffer "*test-term-1*"))) + (let ((buf (cj/test--make-fake-eshell-buffer "*test-term-1*"))) (unwind-protect (should (cj/--term-toggle-buffer-p buf)) (kill-buffer buf)))) -(ert-deftest test-term-toggle--buffer-p-rejects-ghostel () - "Boundary: a ghostel buffer is NOT F12-managed (ghostel is ai-term's, M-SPC)." +(ert-deftest test-term-toggle--buffer-p-rejects-eat () + "Boundary: a standalone eat buffer is NOT F12-managed (F12 opens eshell)." (test-term-toggle--cleanup) - (let ((buf (cj/test--make-fake-ghostel-buffer "*test-term-ghostel*"))) + (let ((buf (cj/test--make-fake-eat-buffer "*test-term-eat*"))) (unwind-protect (should-not (cj/--term-toggle-buffer-p buf)) (kill-buffer buf)))) @@ -41,13 +41,13 @@ (ert-deftest test-term-toggle--buffer-p-rejects-agent () "Boundary: ai-term agent buffers are excluded from F12's set." (test-term-toggle--cleanup) - (let ((buf (cj/test--make-fake-ghostel-buffer "agent [project-a]"))) + (let ((buf (cj/test--make-fake-eat-buffer "agent [project-a]"))) (unwind-protect (should-not (cj/--term-toggle-buffer-p buf)) (kill-buffer buf)))) (ert-deftest test-term-toggle--buffer-p-rejects-non-terminal () - "Boundary: a regular buffer (not eat-mode, no terminal name prefix) -> nil." + "Boundary: a regular buffer (not eshell-mode) -> nil." (test-term-toggle--cleanup) (let ((buf (get-buffer-create "*test-term-regular*"))) (unwind-protect @@ -57,40 +57,40 @@ (ert-deftest test-term-toggle--buffer-p-rejects-dead-buffer () "Boundary: nil and dead buffers -> nil." (should-not (cj/--term-toggle-buffer-p nil)) - (let ((buf (cj/test--make-fake-eat-buffer "*test-term-dead*"))) + (let ((buf (cj/test--make-fake-eshell-buffer "*test-term-dead*"))) (kill-buffer buf) (should-not (cj/--term-toggle-buffer-p buf)))) -(ert-deftest test-term-toggle--buffers-returns-eat-excludes-others () - "Normal: returns the EAT terminal but not ghostel/agent buffers." +(ert-deftest test-term-toggle--buffers-returns-eshell-excludes-others () + "Normal: returns the eshell terminal but not eat/agent buffers." (test-term-toggle--cleanup) - (let ((eat (cj/test--make-fake-eat-buffer "*test-term-eat*")) - (agent (cj/test--make-fake-ghostel-buffer "agent [for-test]"))) + (let ((esh (cj/test--make-fake-eshell-buffer "*test-term-esh*")) + (agent (cj/test--make-fake-eat-buffer "agent [for-test]"))) (unwind-protect (let ((result (cj/--term-toggle-buffers))) - (should (memq eat result)) + (should (memq esh result)) (should-not (memq agent result))) - (kill-buffer eat) + (kill-buffer esh) (kill-buffer agent)))) (ert-deftest test-term-toggle--displayed-window-finds-terminal () - "Normal: the EAT terminal in a window -> returns that window." + "Normal: the eshell terminal in a window -> returns that window." (test-term-toggle--cleanup) - (let ((eat (cj/test--make-fake-eat-buffer "*test-term-shown*"))) + (let ((esh (cj/test--make-fake-eshell-buffer "*test-term-shown*"))) (unwind-protect (save-window-excursion (delete-other-windows) (let ((win (split-window-right))) - (set-window-buffer win eat) + (set-window-buffer win esh) (let ((result (cj/--term-toggle-displayed-window))) (should (windowp result)) - (should (eq (window-buffer result) eat))))) - (kill-buffer eat)))) + (should (eq (window-buffer result) esh))))) + (kill-buffer esh)))) (ert-deftest test-term-toggle--displayed-window-skips-agent () "Boundary: only an agent terminal is displayed -> nil (agent not F12-managed)." (test-term-toggle--cleanup) - (let ((agent (cj/test--make-fake-ghostel-buffer "agent [skip-test]"))) + (let ((agent (cj/test--make-fake-eat-buffer "agent [skip-test]"))) (unwind-protect (save-window-excursion (delete-other-windows) diff --git a/tests/test-term-toggle--dispatch.el b/tests/test-term-toggle--dispatch.el index f13c2840b..43db4c3fe 100644 --- a/tests/test-term-toggle--dispatch.el +++ b/tests/test-term-toggle--dispatch.el @@ -14,8 +14,8 @@ (add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) (add-to-list 'load-path (expand-file-name "tests" user-emacs-directory)) -(require 'term-config) -(require 'testutil-ghostel-buffers) +(require 'eat-config) +(require 'testutil-terminal-buffers) (ert-deftest test-term-toggle--dispatch-window-displayed-returns-toggle-off () "Normal: displayed terminal window -> (toggle-off . WIN)." diff --git a/tests/test-term-toggle--display.el b/tests/test-term-toggle--display.el index d6dd33da2..d59d23b15 100644 --- a/tests/test-term-toggle--display.el +++ b/tests/test-term-toggle--display.el @@ -14,7 +14,7 @@ (require 'cl-lib) (add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) -(require 'term-config) +(require 'eat-config) (ert-deftest test-term-toggle--capture-state-records-direction-and-size () "Normal: capture-state writes direction and integer size. diff --git a/tests/test-transcription-process-and-sentinel.el b/tests/test-transcription-process-and-sentinel.el index 90b56f0a5..185412934 100644 --- a/tests/test-transcription-process-and-sentinel.el +++ b/tests/test-transcription-process-and-sentinel.el @@ -96,6 +96,35 @@ the script and the audio path." (should (equal (plist-get make-process-args :command) (list script audio))))) +(ert-deftest test-tx-start-process-stderr-is-a-buffer-not-a-path () + "Normal: :stderr is a live buffer, not a file path. +Passing a path string makes Emacs create a phantom buffer named after the +path, so stderr never reaches the log file and that buffer leaks per run." + (let* ((audio (make-temp-file "cj-tx-audio-" nil ".mp3")) + (script (make-temp-file "cj-tx-script-")) + (cj/transcriptions-list nil) + make-process-args) + (set-file-modes script #o755) + (unwind-protect + (cl-letf (((symbol-function 'cj/--transcription-script-path) + (lambda () script)) + ((symbol-function 'cj/--init-log-file) #'ignore) + ((symbol-function 'cj/--build-process-environment) + (lambda (_) '("FOO=bar"))) + ((symbol-function 'make-process) + (lambda (&rest kwargs) + (setq make-process-args kwargs) + 'fake-process)) + ((symbol-function 'cj/--notify) #'ignore) + ((symbol-function 'force-mode-line-update) #'ignore)) + (cj/--start-transcription-process audio)) + (delete-file audio) + (delete-file script)) + (let ((stderr (plist-get make-process-args :stderr))) + (should (bufferp stderr)) + (should (buffer-live-p stderr)) + (when (buffer-live-p stderr) (kill-buffer stderr))))) + ;;; cj/--transcription-sentinel (ert-deftest test-tx-sentinel-success-writes-transcript-and-updates-status () @@ -105,6 +134,7 @@ the entry status to `complete', and fires a normal-urgency notification." (log-file (make-temp-file "cj-tx-log-" nil ".log")) (process-buffer (generate-new-buffer " *cj-tx-test*")) (proc (list 'mock-process)) + (stderr-buffer (generate-new-buffer " *cj-tx-test-stderr*")) (cj/transcriptions-list (list (list proc "/tmp/audio.mp3" (current-time) 'running))) notify-urgency) @@ -121,12 +151,15 @@ the entry status to `complete', and fires a normal-urgency notification." (lambda (_t _m &optional u) (setq notify-urgency u)))) (cj/--transcription-sentinel proc "finished\n" "/tmp/audio.mp3" - txt-file log-file)) + txt-file log-file stderr-buffer)) (when (buffer-live-p process-buffer) (kill-buffer process-buffer)) + (when (buffer-live-p stderr-buffer) (kill-buffer stderr-buffer)) (delete-file txt-file) (delete-file log-file)) ;; success notification uses default (nil/normal) urgency. (should-not notify-urgency) + ;; the stderr buffer is drained and killed, never leaked. + (should-not (buffer-live-p stderr-buffer)) ;; entry status updated to complete. (let ((entry (car cj/transcriptions-list))) (should (eq (nth 3 entry) 'complete))))) @@ -138,10 +171,14 @@ marks the entry as `error'." (log-file (make-temp-file "cj-tx-log-" nil ".log")) (process-buffer (generate-new-buffer " *cj-tx-fail*")) (proc (list 'mock-fail)) + (stderr-buffer (generate-new-buffer " *cj-tx-fail-stderr*")) (cj/transcriptions-list (list (list proc "/tmp/audio.mp3" (current-time) 'running))) + log-contents notify-urgency) - (with-current-buffer process-buffer (insert "stderr blob")) + (with-current-buffer process-buffer (insert "partial transcript")) + (with-current-buffer stderr-buffer (insert "whisper: CUDA out of memory")) + (with-temp-file log-file (insert "HEADER\n")) (unwind-protect (cl-letf (((symbol-function 'process-buffer) (lambda (_) process-buffer)) @@ -153,11 +190,18 @@ marks the entry as `error'." (lambda (_t _m &optional u) (setq notify-urgency u)))) (cj/--transcription-sentinel proc "exited abnormally\n" "/tmp/audio.mp3" - txt-file log-file)) + txt-file log-file stderr-buffer) + (setq log-contents + (with-temp-buffer (insert-file-contents log-file) (buffer-string)))) (when (buffer-live-p process-buffer) (kill-buffer process-buffer)) + (when (buffer-live-p stderr-buffer) (kill-buffer stderr-buffer)) (delete-file txt-file) (delete-file log-file)) (should (eq notify-urgency 'critical)) + ;; the actual stderr error text reaches the log on failure. + (should (string-match-p "CUDA out of memory" log-contents)) + ;; the stderr buffer is killed, never leaked. + (should-not (buffer-live-p stderr-buffer)) (let ((entry (car cj/transcriptions-list))) (should (eq (nth 3 entry) 'error))))) diff --git a/tests/test-ui-navigation--window-resize.el b/tests/test-ui-navigation--window-resize.el index 553219755..b011fb063 100644 --- a/tests/test-ui-navigation--window-resize.el +++ b/tests/test-ui-navigation--window-resize.el @@ -82,5 +82,50 @@ real window split happens under `--batch'." (should (eq (keymap-lookup cj/buffer-and-file-map arrow) #'cj/window-resize-sticky)))) +(ert-deftest test-ui-navigation-window-resize-sticky-meta-arrow-pulls-away () + "Normal: M-<arrow> reaches the same pull-away as the bare arrow. The +direction is derived with `event-basic-type', so the Meta modifier is stripped +and a sole window pulls a sliver to the side opposite the arrow, exactly as the +bare-arrow path does." + (dolist (case '((M-down . above) + (M-up . below) + (M-left . right) + (M-right . left))) + (let ((pulled nil) + (overriding-terminal-local-map nil) + (pre-command-hook nil)) + (cl-letf (((symbol-function 'one-window-p) (lambda (&rest _) t)) + ((symbol-function 'cj/window--pull-away) + (lambda (dir) (setq pulled dir)))) + (let ((last-command-event (car case))) + (cj/window-resize-sticky))) + (should (eq pulled (cdr case))) ; meta stripped, pulled to opposite side + (should overriding-terminal-local-map)))) ; loop armed + +(ert-deftest test-ui-navigation-window-resize-sticky-meta-arrow-resizes () + "Normal: with more than one window, M-<arrow> dispatches the matching +`windsize' command, same as the bare arrow -- the Meta modifier is stripped +before the resize-map lookup." + (dolist (case '((M-left . windsize-left) + (M-right . windsize-right) + (M-up . windsize-up) + (M-down . windsize-down))) + (let ((ran nil) + (overriding-terminal-local-map nil) + (pre-command-hook nil)) + (cl-letf (((symbol-function 'one-window-p) (lambda (&rest _) nil)) + ((symbol-function (cdr case)) + (lambda (&rest _) (interactive) (setq ran t)))) + (let ((last-command-event (car case))) + (cj/window-resize-sticky))) + (should ran) + (should overriding-terminal-local-map)))) + +(ert-deftest test-ui-navigation-window-resize-bound-under-meta-arrow () + "Normal: each global `M-<arrow>' reaches the sticky-resize command." + (dolist (arrow '("M-<left>" "M-<right>" "M-<up>" "M-<down>")) + (should (eq (keymap-lookup (current-global-map) arrow) + #'cj/window-resize-sticky)))) + (provide 'test-ui-navigation--window-resize) ;;; test-ui-navigation--window-resize.el ends here diff --git a/tests/test-undead-buffers--buffer-undead-p.el b/tests/test-undead-buffers--buffer-undead-p.el new file mode 100644 index 000000000..e196e41a9 --- /dev/null +++ b/tests/test-undead-buffers--buffer-undead-p.el @@ -0,0 +1,52 @@ +;;; test-undead-buffers--buffer-undead-p.el --- undead predicate (name + regexp) -*- lexical-binding: t; -*- + +;;; Commentary: +;; `cj/--buffer-undead-p' decides whether a buffer name is buried instead of +;; killed. A name is undead when it is in `cj/undead-buffer-list' (exact) or +;; matches any regexp in `cj/undead-buffer-regexps' (dynamic families like the +;; ai-term agent buffers, named "agent [<project>]"). `cj/make-buffer-pattern-undead' +;; registers a regexp. + +;;; Code: + +(require 'ert) +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'undead-buffers) + +(ert-deftest test-undead-buffer-undead-p-name-list () + "Normal: a name in the exact list is undead; others are not." + (let ((cj/undead-buffer-list '("*scratch*" "*Messages*")) + (cj/undead-buffer-regexps nil)) + (should (cj/--buffer-undead-p "*scratch*")) + (should (cj/--buffer-undead-p "*Messages*")) + (should-not (cj/--buffer-undead-p "other")))) + +(ert-deftest test-undead-buffer-undead-p-regexp () + "Normal: a name matching a regexp is undead; the agent pattern is anchored." + (let ((cj/undead-buffer-list nil) + (cj/undead-buffer-regexps '("\\`agent \\["))) + (should (cj/--buffer-undead-p "agent [rulesets]")) + (should (cj/--buffer-undead-p "agent [.emacs.d]")) + (should-not (cj/--buffer-undead-p "not an agent")) + (should-not (cj/--buffer-undead-p "my agent [x]")))) ; anchored: must start with "agent [" + +(ert-deftest test-undead-buffer-undead-p-neither () + "Boundary/Error: a name in neither, an empty string, and a non-string are not undead." + (let ((cj/undead-buffer-list '("*scratch*")) + (cj/undead-buffer-regexps '("\\`agent \\["))) + (should-not (cj/--buffer-undead-p "random")) + (should-not (cj/--buffer-undead-p "")) + (should-not (cj/--buffer-undead-p nil)))) + +(ert-deftest test-undead-make-buffer-pattern-undead-adds-and-rejects () + "Normal/Error: registering a regexp makes matching names undead; a blank or +non-string regexp signals." + (let ((cj/undead-buffer-regexps nil)) + (cj/make-buffer-pattern-undead "\\`agent \\[") + (should (member "\\`agent \\[" cj/undead-buffer-regexps)) + (should (cj/--buffer-undead-p "agent [x]")) + (should-error (cj/make-buffer-pattern-undead "")) + (should-error (cj/make-buffer-pattern-undead 42)))) + +(provide 'test-undead-buffers--buffer-undead-p) +;;; test-undead-buffers--buffer-undead-p.el ends here diff --git a/tests/test-undead-buffers.el b/tests/test-undead-buffers.el index d08649b7c..cd2a4176e 100644 --- a/tests/test-undead-buffers.el +++ b/tests/test-undead-buffers.el @@ -1,4 +1,4 @@ -;;; test-undead-buffers.el --- -*- coding: utf-8; lexical-binding: t; -*- +;;; test-undead-buffers.el --- Tests for undead buffer kill/bury behavior -*- coding: utf-8; lexical-binding: t; -*- ;;; Commentary: ;; ERT tests for undead-buffers.el. diff --git a/tests/testutil-general.el b/tests/testutil-general.el index 52b8a8eae..81743cad8 100644 --- a/tests/testutil-general.el +++ b/tests/testutil-general.el @@ -1,4 +1,4 @@ -;;; testutil-general.el --- -*- coding: utf-8; lexical-binding: t; -*- +;;; testutil-general.el --- Shared filesystem helpers for ERT tests -*- coding: utf-8; lexical-binding: t; -*- ;; ;; Author: Craig Jennings <c@cjennings.net> ;; diff --git a/tests/testutil-ghostel-buffers.el b/tests/testutil-terminal-buffers.el index 3c8d75d00..c2a43a3c7 100644 --- a/tests/testutil-ghostel-buffers.el +++ b/tests/testutil-terminal-buffers.el @@ -1,10 +1,8 @@ -;;; testutil-ghostel-buffers.el --- Shared helpers for ghostel/agent buffer tests -*- lexical-binding: t; -*- +;;; testutil-terminal-buffers.el --- Shared helpers for terminal/agent buffer tests -*- lexical-binding: t; -*- ;;; Commentary: -;; Cleanup helpers and a fake-ghostel constructor used across the -;; ai-term and term-toggle test files. Replaces the older -;; testutil-vterm-buffers helpers when the terminal engine moved from -;; vterm to ghostel. +;; Cleanup helpers and fake-terminal-buffer constructors (eat, eshell) used +;; across the ai-term and term-toggle test files. ;;; Code: @@ -13,10 +11,10 @@ (defun cj/test--call-as-gui (fn) "Call FN, stubbing `env-terminal-p' to return nil (a GUI frame). -The terminal refuse-guard was dropped when ghostel replaced vterm (ghostel -renders in TTY frames too), so this no longer gates behavior; it is kept as a -thin passthrough so window-behavior tests written against the old guard keep -working unchanged." +The terminal refuse-guard was dropped when the terminal engine moved off vterm +(EAT and eshell render in TTY frames too), so this no longer gates behavior; it +is kept as a thin passthrough so window-behavior tests written against the old +guard keep working unchanged." (cl-letf (((symbol-function 'env-terminal-p) (lambda () nil))) (funcall fn))) @@ -34,17 +32,6 @@ working unchanged." "Kill all live buffers whose name starts with \"*test-term\"." (cj/test--kill-buffers-matching-prefix "*test-term")) -(defun cj/test--make-fake-ghostel-buffer (name) - "Return a buffer named NAME with `major-mode' set to `ghostel-mode'. - -Avoids actually launching a ghostel process by setting the mode -buffer-locally. Used by tests that need a buffer satisfying the -ghostel-mode predicate without the side-effects of `(ghostel)'." - (let ((buf (get-buffer-create name))) - (with-current-buffer buf - (setq-local major-mode 'ghostel-mode)) - buf)) - (defun cj/test--make-fake-eat-buffer (name) "Return a buffer named NAME with `major-mode' set to `eat-mode'. @@ -56,5 +43,15 @@ predicate without the side-effects of `(eat)'." (setq-local major-mode 'eat-mode)) buf)) -(provide 'testutil-ghostel-buffers) -;;; testutil-ghostel-buffers.el ends here +(defun cj/test--make-fake-eshell-buffer (name) + "Return a buffer named NAME with `major-mode' set to `eshell-mode'. + +Avoids starting a real eshell by setting the mode buffer-locally. Used by the +F12 toggle tests that need a buffer satisfying the eshell-mode predicate." + (let ((buf (get-buffer-create name))) + (with-current-buffer buf + (setq-local major-mode 'eshell-mode)) + buf)) + +(provide 'testutil-terminal-buffers) +;;; testutil-terminal-buffers.el ends here |