diff options
Diffstat (limited to 'tests')
26 files changed, 1681 insertions, 25 deletions
diff --git a/tests/test-ai-term--close.el b/tests/test-ai-term--close.el index 654e85f0..4098c091 100644 --- a/tests/test-ai-term--close.el +++ b/tests/test-ai-term--close.el @@ -13,7 +13,9 @@ (require 'cl-lib) (add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(add-to-list 'load-path (expand-file-name "tests" user-emacs-directory)) (require 'ai-term) +(require 'testutil-ghostel-buffers) (ert-deftest test-ai-term--kill-tmux-session-runs-kill-session () "Normal: invokes `tmux kill-session -t <session>'." @@ -58,6 +60,35 @@ (should (buffer-live-p buf))) (when (buffer-live-p buf) (kill-buffer buf))))) +(ert-deftest test-ai-term--close-buffer-keeps-window-split () + "Regression: closing an agent in a split keeps its window in the layout, +showing a non-agent buffer, instead of deleting the split. Craig's M-F9 +annoyance -- a close must not tear down the window arrangement (the F9 hide +toggle is what collapses the split; close should not)." + (cj/test--kill-agent-buffers) + (let ((work (get-buffer-create "*test-close-keep-work*")) + (agent (get-buffer-create "agent [close-keep]"))) + (with-current-buffer agent (setq-local default-directory "/tmp/close-keep/")) + (unwind-protect + (save-window-excursion + (delete-other-windows) + (set-window-buffer (selected-window) work) + (let ((agent-win (split-window (selected-window) nil 'below))) + (set-window-buffer agent-win agent) + (should-not (one-window-p)) + (cl-letf (((symbol-function 'cj/--ai-term-kill-tmux-session) + (lambda (_s) 0))) + (cj/--ai-term-close-buffer agent)) + ;; The window survives the close ... + (should (window-live-p agent-win)) + (should-not (one-window-p)) + ;; ... now showing a non-agent buffer ... + (should-not (cj/--ai-term-buffer-p (window-buffer agent-win))) + ;; ... and the agent buffer itself is gone. + (should-not (buffer-live-p agent)))) + (when (get-buffer "*test-close-keep-work*") (kill-buffer "*test-close-keep-work*")) + (cj/test--kill-agent-buffers)))) + (ert-deftest test-ai-term--close-target-current-agent-buffer () "Normal: returns the current buffer when it is an agent buffer." (let ((buf (get-buffer-create "agent [cur]"))) diff --git a/tests/test-build-theme.el b/tests/test-build-theme.el new file mode 100644 index 00000000..87b17e0a --- /dev/null +++ b/tests/test-build-theme.el @@ -0,0 +1,333 @@ +;;; test-build-theme.el --- Tests for the theme.json -> dupre-*.el converter -*- lexical-binding: t -*- + +;;; Commentary: + +;; ERT tests for scripts/theme-studio/build-theme.el, the converter that +;; turns a theme.json exported by the theme-studio into a loadable Emacs +;; deftheme file. This is the correctness-sensitive end of the pipeline, so +;; it is covered Normal / Boundary / Error per category. + +;;; Code: + +(require 'ert) +(require 'json) + +;; The converter lives under scripts/, not on the normal load-path. Add it at +;; compile time too (the validate hook byte-compiles this file in isolation and +;; only -L's the project, modules, tests, and themes dirs). +(eval-and-compile + (add-to-list 'load-path + (expand-file-name + "../scripts/theme-studio" + (file-name-directory + (or load-file-name + (bound-and-true-p byte-compile-current-file) + buffer-file-name + default-directory))))) + +(require 'build-theme) + +;;; --------------------------------------------------------------------------- +;;; Fixtures + +(defconst test-build-theme--fixture-json + "{ + \"name\": \"dupre-fixture\", + \"palette\": [[\"#000000\",\"ground\"],[\"#7a9abe\",\"blue\"],[\"#84b068\",\"green\"]], + \"assignments\": { + \"bg\":\"#000000\", \"p\":\"#cdced1\", + \"kw\":\"#7a9abe\", \"str\":\"#84b068\", \"cm\":\"#838d97\", \"dec\":\"#e8bd30\" + }, + \"bold\": [\"kw\"], + \"italic\": [\"cm\"], + \"ui\": { + \"region\": {\"fg\":null, \"bg\":\"#264364\"}, + \"mode-line\": {\"fg\":\"#cdced1\", \"bg\":\"#2f343a\"} + }, + \"packages\": { + \"org-mode\": { + \"org-level-1\": {\"fg\":\"#67809c\",\"bg\":null,\"bold\":true,\"italic\":false,\"inherit\":null,\"source\":\"default\"}, + \"org-level-2\": {\"fg\":\"#e8bd30\",\"bg\":null,\"bold\":false,\"italic\":false,\"inherit\":\"org-level-1\",\"height\":1.2,\"source\":\"user\"}, + \"org-tag\": {\"fg\":null,\"bg\":null,\"bold\":false,\"italic\":false,\"inherit\":null,\"source\":\"cleared\"} + } + } +}" + "A self-contained theme.json exercising every tier: default, syntax (bold + +italic + the unmappable dec key), UI, and packages (a plain face, an +inherit+height face, and a cleared face). Owned by the test so it can't drift +the way Craig's downloaded exports under scripts/theme-studio/ can.") + +(defun test-build-theme--write-fixture (dir) + "Write the fixture JSON into DIR and return its path." + (let ((path (expand-file-name "dupre-fixture.json" dir))) + (with-temp-file path (insert test-build-theme--fixture-json)) + path)) + +(defmacro test-build-theme--with-sandbox (var &rest body) + "Bind VAR to a fresh temp directory, run BODY, then delete it." + (declare (indent 1)) + `(let ((,var (make-temp-file "build-theme-test-" t))) + (unwind-protect (progn ,@body) + (delete-directory ,var t)))) + +;; --- WCAG contrast helpers (mirror of the dupre-theme test helpers) --- + +(defun test-build-theme--channel-luminance (c) + "Linearize an 8-bit channel value C (0-255) per the WCAG formula." + (let ((x (/ c 255.0))) + (if (<= x 0.03928) (/ x 12.92) (expt (/ (+ x 0.055) 1.055) 2.4)))) + +(defun test-build-theme--relative-luminance (hex) + "WCAG relative luminance of HEX color \"#rrggbb\"." + (+ (* 0.2126 (test-build-theme--channel-luminance (string-to-number (substring hex 1 3) 16))) + (* 0.7152 (test-build-theme--channel-luminance (string-to-number (substring hex 3 5) 16))) + (* 0.0722 (test-build-theme--channel-luminance (string-to-number (substring hex 5 7) 16))))) + +(defun test-build-theme--contrast (fg bg) + "WCAG contrast ratio between hex colors FG and BG." + (let ((l1 (test-build-theme--relative-luminance fg)) + (l2 (test-build-theme--relative-luminance bg))) + (/ (+ (max l1 l2) 0.05) (+ (min l1 l2) 0.05)))) + +;;; --------------------------------------------------------------------------- +;;; build-theme/--attrs (the core attribute builder) + +(ert-deftest test-build-theme-attrs-fg-and-bold () + "Normal: a foreground plus bold yields :foreground and :weight bold." + (should (equal (build-theme/--attrs nil "#67809c" nil t nil nil nil nil) + '(:foreground "#67809c" :weight bold)))) + +(ert-deftest test-build-theme-attrs-full-ordering () + "Normal: every attribute present, in canonical order." + (should (equal (build-theme/--attrs 'org-level-1 "#e8bd30" "#1a1714" t t t t 1.3) + '(:inherit org-level-1 :foreground "#e8bd30" :background "#1a1714" + :weight bold :slant italic :underline t :strike-through t :height 1.3)))) + +(ert-deftest test-build-theme-attrs-underline-and-strike () + "Normal: underline and strike yield :underline t and :strike-through t." + (should (equal (build-theme/--attrs nil "#67809c" nil nil nil t t nil) + '(:foreground "#67809c" :underline t :strike-through t))) + ;; either alone + (should (equal (build-theme/--attrs nil nil nil nil nil t nil nil) + '(:underline t))) + (should (equal (build-theme/--attrs nil nil nil nil nil nil t nil) + '(:strike-through t)))) + +(ert-deftest test-build-theme-attrs-empty-is-nil () + "Boundary: a fully-cleared face (all nil) yields an empty plist." + (should (equal (build-theme/--attrs nil nil nil nil nil nil nil nil) '()))) + +(ert-deftest test-build-theme-attrs-bold-false-omits-weight () + "Boundary: bold false produces no :weight key (only overrides are written)." + (should (equal (build-theme/--attrs nil "#cdced1" nil nil nil nil nil nil) + '(:foreground "#cdced1")))) + +(ert-deftest test-build-theme-attrs-height-one-omitted () + "Boundary: a height of exactly 1.0 is omitted (the default multiplier)." + (should (equal (build-theme/--attrs nil "#cdced1" nil nil nil nil nil 1.0) + '(:foreground "#cdced1"))) + (should (equal (build-theme/--attrs nil "#cdced1" nil nil nil nil nil 1) + '(:foreground "#cdced1")))) + +;;; --------------------------------------------------------------------------- +;;; build-theme/--face-spec (skips empty faces) + +(ert-deftest test-build-theme-face-spec-normal () + "Normal: a face with attrs becomes a custom-theme-set-faces spec." + (should (equal (build-theme/--face-spec 'font-lock-string-face '(:foreground "#84b068")) + '(font-lock-string-face ((t (:foreground "#84b068"))))))) + +(ert-deftest test-build-theme-face-spec-empty-skipped () + "Boundary: a face with no attributes (cleared) yields nil, not an empty spec." + (should (null (build-theme/--face-spec 'whatever '())))) + +;;; --------------------------------------------------------------------------- +;;; Syntax tier + +(ert-deftest test-build-theme-syntax-keyword-bold () + "Normal: kw maps to font-lock-keyword-face and picks up the bold set." + (let* ((assignments '((kw . "#7a9abe") (str . "#84b068"))) + (specs (build-theme/--syntax-face-specs assignments '(kw) '()))) + (should (member '(font-lock-keyword-face ((t (:foreground "#7a9abe" :weight bold)))) + specs)) + (should (member '(font-lock-string-face ((t (:foreground "#84b068")))) + specs)))) + +(ert-deftest test-build-theme-syntax-one-to-many () + "Normal: punc fans out to every punctuation/bracket/delimiter face." + (let ((specs (build-theme/--syntax-face-specs '((punc . "#a9b2bb")) '() '()))) + (dolist (face '(font-lock-punctuation-face font-lock-bracket-face + font-lock-delimiter-face font-lock-misc-punctuation-face)) + (should (member `(,face ((t (:foreground "#a9b2bb")))) specs))))) + +(ert-deftest test-build-theme-syntax-decorator-omitted () + "Boundary: dec has no independent Emacs face, so it maps to nothing. +Emacs renders decorators with font-lock-type-face, which ty already owns; +mapping dec would clobber the type color." + (let ((specs (build-theme/--syntax-face-specs '((dec . "#e8bd30")) '() '()))) + (should (null specs)))) + +(ert-deftest test-build-theme-syntax-comment-italic () + "Normal: cm in the italic set yields :slant italic on the comment face." + (let ((specs (build-theme/--syntax-face-specs '((cm . "#a9b2bb")) '() '(cm)))) + (should (member '(font-lock-comment-face ((t (:foreground "#a9b2bb" :slant italic)))) + specs)))) + +;;; --------------------------------------------------------------------------- +;;; Default face + +(ert-deftest test-build-theme-default-face () + "Normal: default takes background from bg and foreground from p." + (should (equal (build-theme/--default-spec '((bg . "#000000") (p . "#cdced1"))) + '(default ((t (:foreground "#cdced1" :background "#000000"))))))) + +;;; --------------------------------------------------------------------------- +;;; UI tier + +(ert-deftest test-build-theme-ui-passthrough () + "Normal: a ui face passes fg/bg straight through." + (let ((specs (build-theme/--ui-face-specs + '((region . ((fg . nil) (bg . "#264364"))) + (mode-line . ((fg . "#cdced1") (bg . "#2f343a"))))))) + (should (member '(region ((t (:background "#264364")))) specs)) + (should (member '(mode-line ((t (:foreground "#cdced1" :background "#2f343a")))) specs)))) + +(ert-deftest test-build-theme-box-styles () + "Normal/Boundary: a face box spec converts to the right Emacs :box value." + (should (equal (build-theme/--box '((style . "released") (width . 1))) + '(:line-width 1 :style released-button))) + (should (equal (build-theme/--box '((style . "pressed") (width . 2))) + '(:line-width 2 :style pressed-button))) + (should (equal (build-theme/--box '((style . "line") (color . "#67809c"))) + '(:line-width 1 :color "#67809c"))) + (should (equal (build-theme/--box '((style . "line"))) '(:line-width 1))) + (should (null (build-theme/--box nil))) + (should (null (build-theme/--box '((style . "none")))))) + +(ert-deftest test-build-theme-ui-face-emits-box () + "Normal: a ui face with a box exports a :box attribute." + (let ((specs (build-theme/--ui-face-specs + '((mode-line . ((fg . "#cdced1") (bg . "#2f343a") + (box . ((style . "released") (width . 1))))))))) + (should (member '(mode-line ((t (:foreground "#cdced1" :background "#2f343a" + :box (:line-width 1 :style released-button))))) + specs)))) + +;;; --------------------------------------------------------------------------- +;;; Package tier + +(ert-deftest test-build-theme-package-inherit-and-height () + "Normal: a package face writes :inherit plus overrides plus :height." + (let ((specs (build-theme/--package-face-specs + '((org-mode . ((org-level-2 . ((fg . "#e8bd30") (bg . nil) + (bold . nil) (italic . nil) + (inherit . "org-level-1") (height . 1.2) + (source . "user"))))))))) + (should (member '(org-level-2 ((t (:inherit org-level-1 :foreground "#e8bd30" :height 1.2)))) + specs)))) + +(ert-deftest test-build-theme-package-underline-and-strike () + "Normal: a package face writes :underline and :strike-through from the flags." + (let ((specs (build-theme/--package-face-specs + '((shr . ((shr-link . ((fg . "#67809c") (bg . nil) (bold . nil) (italic . nil) + (underline . t) (strike . nil) (inherit . nil) (source . "default"))) + (shr-strike-through . ((fg . "#5e6770") (bg . nil) (bold . nil) (italic . nil) + (underline . nil) (strike . t) (inherit . nil) (source . "default"))))))))) + (should (member '(shr-link ((t (:foreground "#67809c" :underline t)))) specs)) + (should (member '(shr-strike-through ((t (:foreground "#5e6770" :strike-through t)))) specs)))) + +(ert-deftest test-build-theme-package-cleared-skipped () + "Boundary: a cleared package face (no renderable attrs) is not emitted." + (let ((specs (build-theme/--package-face-specs + '((org-mode . ((org-tag . ((fg . nil) (bg . nil) (bold . nil) + (italic . nil) (inherit . nil) + (height . nil) (source . "cleared"))))))))) + (should (null specs)))) + +;;; --------------------------------------------------------------------------- +;;; Hex validation + +(ert-deftest test-build-theme-hex-p () + "Normal/Error: only #rrggbb strings validate." + (should (build-theme/--hex-p "#0d0b0a")) + (should (build-theme/--hex-p "#FFFFFF")) + (should-not (build-theme/--hex-p "0d0b0a")) + (should-not (build-theme/--hex-p "#fff")) + (should-not (build-theme/--hex-p nil))) + +;;; --------------------------------------------------------------------------- +;;; End-to-end: convert a file and load the result + +(ert-deftest test-build-theme-convert-file-writes-loadable-theme () + "Integration: converting the fixture produces a theme Emacs can load. +Components integrated: +- build-theme/convert-file (entry point, real) +- json parsing of the inline fixture (real) +- custom-theme-set-faces / load-theme (real) +Validates the syntax, default, UI, and package tiers all reach real faces, +including an inherit+height package face." + (require 'org) + (test-build-theme--with-sandbox out + (let* ((in (test-build-theme--write-fixture out)) + (path (build-theme/convert-file in out))) + (should (file-exists-p path)) + (should (string-suffix-p "dupre-fixture-theme.el" path)) + (let ((custom-theme-load-path (cons out custom-theme-load-path)) + (load-path (cons out load-path))) + (unwind-protect + (progn + (load-theme 'dupre-fixture t) + ;; default tier + (should (string= (face-attribute 'default :background nil t) "#000000")) + (should (string= (face-attribute 'default :foreground nil t) "#cdced1")) + ;; syntax tier (kw is blue + bold in the fixture) + (should (string= (face-attribute 'font-lock-keyword-face :foreground nil t) "#7a9abe")) + (should (eq (face-attribute 'font-lock-keyword-face :weight nil t) 'bold)) + ;; ui tier + (should (string= (face-attribute 'region :background nil t) "#264364")) + ;; package tier — plain face and an inherit+height face + (should (string= (face-attribute 'org-level-1 :foreground nil t) "#67809c")) + (should (eq (face-attribute 'org-level-2 :inherit nil t) 'org-level-1)) + (should (= (face-attribute 'org-level-2 :height nil t) 1.2))) + (disable-theme 'dupre-fixture)))))) + +(ert-deftest test-build-theme-convert-file-old-json-without-packages () + "Boundary: a theme.json with no packages key still converts and loads." + (test-build-theme--with-sandbox out + (let* ((json "{\"name\":\"noformat\",\"palette\":[[\"#000000\",\"ground\"]],\"assignments\":{\"bg\":\"#000000\",\"p\":\"#ffffff\",\"kw\":\"#67809c\"},\"bold\":[\"kw\"],\"italic\":[],\"ui\":{}}") + (in (expand-file-name "noformat.json" out))) + (with-temp-file in (insert json)) + (let ((path (build-theme/convert-file in out))) + (should (file-exists-p path)) + (let ((custom-theme-load-path (cons out custom-theme-load-path)) + (load-path (cons out load-path))) + (unwind-protect + (progn + (load-theme 'noformat t) + (should (string= (face-attribute 'default :background nil t) "#000000")) + (should (string= (face-attribute 'font-lock-keyword-face :foreground nil t) "#67809c"))) + (disable-theme 'noformat))))))) + +(ert-deftest test-build-theme-convert-file-missing-input-errors () + "Error: a missing input file signals rather than writing garbage." + (test-build-theme--with-sandbox out + (should-error (build-theme/convert-file (expand-file-name "does-not-exist.json" out) out)))) + +(ert-deftest test-build-theme-generated-default-meets-wcag-aa () + "Error/Regression: the generated default face stays legible. +A WCAG-AA (>= 4.5:1) assertion on the round-tripped result -- proves the whole +parse -> spec -> file -> face pipeline preserves the designed contrast." + (test-build-theme--with-sandbox out + (let ((path (build-theme/convert-file (test-build-theme--write-fixture out) out))) + (let ((custom-theme-load-path (cons out custom-theme-load-path)) + (load-path (cons out load-path))) + (unwind-protect + (progn + (load-theme 'dupre-fixture t) + (let ((fg (face-attribute 'default :foreground nil t)) + (bg (face-attribute 'default :background nil t))) + (should (>= (test-build-theme--contrast fg bg) 4.5)))) + (disable-theme 'dupre-fixture)))))) + +(provide 'test-build-theme) +;;; test-build-theme.el ends here diff --git a/tests/test-calibredb-epub-config--bookmark-name.el b/tests/test-calibredb-epub-config--bookmark-name.el new file mode 100644 index 00000000..2e1d253e --- /dev/null +++ b/tests/test-calibredb-epub-config--bookmark-name.el @@ -0,0 +1,87 @@ +;;; test-calibredb-epub-config--bookmark-name.el --- Nov 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". + +;;; Code: + +(require 'ert) +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'calibredb-epub-config) + +;;; cj/--nov-clean-title + +(ert-deftest test-nov-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"))) + +(ert-deftest test-nov-clean-title-restores-colon () + "Boundary: Calibre's \"_ \" colon substitution is restored to \": \"." + (should (equal (cj/--nov-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") + "The Fool's Progress: An Honest Novel"))) + +(ert-deftest test-nov-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"))) + +(ert-deftest test-nov-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))) + +;;; cj/--nov-bookmark-name-from-file + +(ert-deftest test-nov-bookmark-name-real-examples () + "Normal: real Calibre filenames become \"Author, Title\" with colons restored." + (should (equal (cj/--nov-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 + "/books/The A.B.C. Murders - Agatha Christie.epub") + "Agatha Christie, The A.B.C. Murders")) + (should (equal (cj/--nov-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 () + "Boundary: a title containing \" - \" splits on the LAST separator." + (should (equal (cj/--nov-bookmark-name-from-file "/b/Title - Part Two - Some Author.epub") + "Some Author, Title - Part Two"))) + +(ert-deftest test-nov-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") + "Untitled: Draft"))) + +(ert-deftest test-nov-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 ""))) + +;;; cj/--nov-bookmark-rename-record + +(ert-deftest test-nov-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))) + (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 () + "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)))) + +(provide 'test-calibredb-epub-config--bookmark-name) +;;; test-calibredb-epub-config--bookmark-name.el ends here diff --git a/tests/test-calibredb-epub-config--menu.el b/tests/test-calibredb-epub-config--menu.el new file mode 100644 index 00000000..4860efc3 --- /dev/null +++ b/tests/test-calibredb-epub-config--menu.el @@ -0,0 +1,52 @@ +;;; test-calibredb-epub-config--menu.el --- calibredb curated-menu tests -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for the docked book-description command bound into the curated calibredb +;; menu. The transient itself, its `?'/`H' keybindings, and the +;; display-buffer-alist dock live in calibredb's deferred `use-package' config +;; (they need the elpa transient, which batch does not load) and are verified +;; live in the daemon; here we cover the describe command, which has no transient +;; dependency. + +;;; Code: + +(require 'ert) +(require 'cl-lib) +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'calibredb-epub-config) + +;; calibredb vars (defvar'd here so the tests' `let' bindings are dynamic; the +;; module's bare defvars are file-local to its own compilation unit). +(defvar calibredb-sort-by) +(defvar calibredb-search-filter) +(defvar calibredb-format-filter-p) + +(ert-deftest test-calibredb-describe-at-point-shows-entry-without-switch () + "Normal: describe calls `calibredb-show-entry' on the entry at point with no +switch argument, so the entry lands in the docked window with focus (q quits)." + (let (call) + (cl-letf (((symbol-function 'calibredb-find-candidate-at-point) + (lambda () '(the-entry extra))) + ((symbol-function 'calibredb-show-entry) + (lambda (&rest args) (setq call args)))) + (cj/calibredb-describe-at-point) + ;; one argument only -- the entry -- and switch is therefore nil + (should (equal call '(the-entry)))))) + +(ert-deftest test-calibredb-sort-preserving-filter-keeps-filter () + "Normal: the filter-preserving sort sets the field and refreshes via +`calibredb-search-refresh-or-resume' without touching the active filter." + (let ((calibredb-sort-by 'id) + (calibredb-search-filter "epub") + (calibredb-format-filter-p t) + (refreshed nil)) + (cl-letf (((symbol-function 'calibredb-search-refresh-or-resume) + (lambda (&rest _) (setq refreshed t)))) + (cj/--calibredb-sort-preserving-filter 'author) + (should (eq calibredb-sort-by 'author)) ; field updated + (should refreshed) ; refreshed + (should (equal calibredb-search-filter "epub")) ; filter kept + (should calibredb-format-filter-p)))) ; filter flag kept + +(provide 'test-calibredb-epub-config--menu) +;;; test-calibredb-epub-config--menu.el ends here diff --git a/tests/test-custom-buffer-file-keymap-bindings.el b/tests/test-custom-buffer-file-keymap-bindings.el new file mode 100644 index 00000000..ea9ceb26 --- /dev/null +++ b/tests/test-custom-buffer-file-keymap-bindings.el @@ -0,0 +1,30 @@ +;;; test-custom-buffer-file-keymap-bindings.el --- d/D bindings in the buffer-and-file keymap -*- lexical-binding: t; -*- + +;;; Commentary: +;; `cj/buffer-and-file-map' should put the destructive op on the capital key and +;; the frequently-used op on the easy lowercase key: D = delete-buffer-and-file, +;; d = diff-buffer-with-file. Guards the swap against silently reverting. + +;;; Code: + +(require 'ert) + +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) + +;; Stub dependencies before loading the module (mirrors the sibling tests). +(defvar cj/custom-keymap (make-sparse-keymap) + "Stub keymap for testing.") +(provide 'ps-print) + +(require 'custom-buffer-file) + +(ert-deftest test-custom-buffer-file-keymap-diff-on-lowercase-d () + "Normal: lowercase d runs diff -- the frequently-used, non-destructive op." + (should (eq (keymap-lookup cj/buffer-and-file-map "d") #'cj/diff-buffer-with-file))) + +(ert-deftest test-custom-buffer-file-keymap-delete-on-capital-d () + "Normal: capital D runs delete -- the destructive op on the capital key." + (should (eq (keymap-lookup cj/buffer-and-file-map "D") #'cj/delete-buffer-and-file))) + +(provide 'test-custom-buffer-file-keymap-bindings) +;;; test-custom-buffer-file-keymap-bindings.el ends here diff --git a/tests/test-dashboard-config-recentf-exclude.el b/tests/test-dashboard-config-recentf-exclude.el new file mode 100644 index 00000000..f35b3eda --- /dev/null +++ b/tests/test-dashboard-config-recentf-exclude.el @@ -0,0 +1,33 @@ +;;; test-dashboard-config-recentf-exclude.el --- recentf-exclude is not clobbered -*- lexical-binding: t; -*- + +;;; Commentary: +;; `cj/--dashboard-exclude-emms-from-recentf' adds the EMMS history pattern +;; to `recentf-exclude'. It must ADD to the list, not replace it, or it +;; wipes the exclusions system-defaults.el set earlier in init order +;; (emacs_bookmarks, elpa, recentf, ElfeedDB, airootfs). + +;;; Code: + +(require 'ert) +(require 'recentf) ; makes `recentf-exclude' special so the let below is dynamic + +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'testutil-general) +(require 'dashboard-config) + +(ert-deftest test-dashboard-config-exclude-emms-preserves-existing-entries () + "Error: excluding the EMMS history preserves prior recentf-exclude entries." + (let ((recentf-exclude (list "emacs_bookmarks" "airootfs"))) + (cj/--dashboard-exclude-emms-from-recentf) + (should (member "/emms/history" recentf-exclude)) + (should (member "emacs_bookmarks" recentf-exclude)) + (should (member "airootfs" recentf-exclude)))) + +(ert-deftest test-dashboard-config-exclude-emms-adds-the-pattern () + "Normal: the EMMS history pattern is present after the call." + (let ((recentf-exclude nil)) + (cj/--dashboard-exclude-emms-from-recentf) + (should (member "/emms/history" recentf-exclude)))) + +(provide 'test-dashboard-config-recentf-exclude) +;;; test-dashboard-config-recentf-exclude.el ends here diff --git a/tests/test-dupre-theme.el b/tests/test-dupre-theme.el index dec648d1..4d0e786c 100644 --- a/tests/test-dupre-theme.el +++ b/tests/test-dupre-theme.el @@ -223,5 +223,39 @@ The defface registration in dupre-faces.el is what makes direct use work." (should (string= (face-attribute 'dupre-org-todo-dim :foreground nil 'default) "#869038"))) +;;; Diff face legibility (WCAG contrast) + +(defun dupre-test--channel-luminance (c) + "Linearize an 8-bit channel value C (0-255) per the WCAG formula." + (let ((x (/ c 255.0))) + (if (<= x 0.03928) (/ x 12.92) (expt (/ (+ x 0.055) 1.055) 2.4)))) + +(defun dupre-test--relative-luminance (hex) + "WCAG relative luminance of HEX color \"#rrggbb\"." + (+ (* 0.2126 (dupre-test--channel-luminance (string-to-number (substring hex 1 3) 16))) + (* 0.7152 (dupre-test--channel-luminance (string-to-number (substring hex 3 5) 16))) + (* 0.0722 (dupre-test--channel-luminance (string-to-number (substring hex 5 7) 16))))) + +(defun dupre-test--contrast (fg bg) + "WCAG contrast ratio between hex colors FG and BG." + (let ((l1 (dupre-test--relative-luminance fg)) + (l2 (dupre-test--relative-luminance bg))) + (/ (+ (max l1 l2) 0.05) (+ (min l1 l2) 0.05)))) + +(ert-deftest dupre-diff-changed-faces-meet-wcag-aa () + "Error/Regression: diff-changed and diff-refine-changed must stay legible as +standalone backgrounds (WCAG AA, >= 4.5:1 for normal text). Guards the bug +where diff-refine-changed rendered the default fg (#f0fef0) on the bright-gold +yellow-1 (#ffd700) at 1.35:1 -- unreadable wherever the face is used as a plain +background, not just inside diff-mode's own foreground overlay." + (require 'diff-mode) + (load-theme 'dupre t) + (dolist (face '(diff-changed diff-refine-changed)) + (let ((fg (face-attribute face :foreground nil t)) + (bg (face-attribute face :background nil t))) + (should (string-match-p "^#[0-9a-fA-F]\\{6\\}$" fg)) + (should (string-match-p "^#[0-9a-fA-F]\\{6\\}$" bg)) + (should (>= (dupre-test--contrast fg bg) 4.5))))) + (provide 'test-dupre-theme) ;;; test-dupre-theme.el ends here diff --git a/tests/test-dwim-shell-config-command-fixes.el b/tests/test-dwim-shell-config-command-fixes.el new file mode 100644 index 00000000..2f49a868 --- /dev/null +++ b/tests/test-dwim-shell-config-command-fixes.el @@ -0,0 +1,33 @@ +;;; test-dwim-shell-config-command-fixes.el --- zip/backup command builders -*- lexical-binding: t; -*- + +;;; Commentary: +;; Two audit fixes, extracted into top-level command-string builders so they're +;; testable without loading the dwim-shell-command package (the command defuns +;; that call them live inside its use-package :config, which the batch test +;; harness doesn't instantiate): +;; - cj/dwim-shell--zip-single-file-command names the archive <fne>.zip +;; - cj/dwim-shell--dated-backup-command carries a real timestamp, not "$(date)" +;; The third fix (dired menu key M-S-d -> M-D) is a keybinding inside the same +;; :config block; it's verified in the live daemon, not here. + +;;; Code: + +(require 'ert) +(require 'dwim-shell-config) + +(ert-deftest test-dwim-zip-single-file-command-names-archive-dot-zip () + "Normal: the single-file zip template names the archive <fne>.zip, with no +leftover <<e>> that would rebuild the input filename." + (let ((cmd (cj/dwim-shell--zip-single-file-command))) + (should (string-match-p "'<<fne>>\\.zip'" cmd)) + (should-not (string-match-p "<<e>>" cmd)))) + +(ert-deftest test-dwim-dated-backup-command-carries-real-timestamp () + "Normal: the dated-backup template interpolates a real YYYYMMDD_HHMMSS stamp, +so the substitution can't sit dead inside single quotes." + (let ((cmd (cj/dwim-shell--dated-backup-command))) + (should (string-match-p "\\.[0-9]\\{8\\}_[0-9]\\{6\\}\\.bak'" cmd)) + (should-not (string-match-p "\\$(date" cmd)))) + +(provide 'test-dwim-shell-config-command-fixes) +;;; test-dwim-shell-config-command-fixes.el ends here diff --git a/tests/test-help-config.el b/tests/test-help-config.el new file mode 100644 index 00000000..0ba95c41 --- /dev/null +++ b/tests/test-help-config.el @@ -0,0 +1,32 @@ +;;; test-help-config.el --- Tests for the Info-open decision logic -*- lexical-binding: t; -*- + +;;; Commentary: +;; cj/open-with-info-mode opens the current .info buffer in Info, prompting to +;; save first if the buffer is modified. The save/cancel/open decision is +;; factored into the pure helper `cj/--info-open-plan' so it's testable without +;; driving find-file, Info, or the save prompt. Declining the prompt must yield +;; `cancel' -- the original cl-return-from inside a plain defun signalled +;; "No catch for tag" instead of cancelling. + +;;; Code: + +(require 'ert) + +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'help-config) + +(ert-deftest test-info-open-plan-unmodified-opens () + "Normal: an unmodified buffer opens in Info directly." + (should (eq (cj/--info-open-plan nil nil) 'open))) + +(ert-deftest test-info-open-plan-modified-confirmed-saves-then-opens () + "Normal: a modified buffer whose save is confirmed saves, then opens." + (should (eq (cj/--info-open-plan t t) 'save-then-open))) + +(ert-deftest test-info-open-plan-modified-declined-cancels () + "Error/edge: a modified buffer whose save is declined cancels -- the path that +used to signal \"No catch for tag\" via cl-return-from in a plain defun." + (should (eq (cj/--info-open-plan t nil) 'cancel))) + +(provide 'test-help-config) +;;; test-help-config.el ends here diff --git a/tests/test-init-module-headers.el b/tests/test-init-module-headers.el index 2680a19c..bbda2388 100644 --- a/tests/test-init-module-headers.el +++ b/tests/test-init-module-headers.el @@ -113,7 +113,7 @@ "jumper" "latex-config" ;; Batch 9 — Remaining domain / integration / optional modules (Layer 2-4) - "linear-config" + "pearl-config" "local-repository" "lorem-optimum" "mail-config" diff --git a/tests/test-mail-config-refile-folder.el b/tests/test-mail-config-refile-folder.el new file mode 100644 index 00000000..e2d224eb --- /dev/null +++ b/tests/test-mail-config-refile-folder.el @@ -0,0 +1,40 @@ +;;; test-mail-config-refile-folder.el --- Tests for refile-folder dispatch -*- lexical-binding: t; -*- + +;;; Commentary: +;; ERT tests for `cj/mu4e--refile-folder-for-maildir', the per-message refile +;; (archive) target dispatch. cmail has a real synced Archive folder; the +;; Gmail-backed accounts (gmail, dmail) have none, so refiling them must signal +;; rather than move mail into an unsynced, phantom folder (silent mail loss). + +;;; Code: + +(require 'ert) + +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'mail-config) + +(ert-deftest test-mail-config-refile-cmail-returns-archive () + "Normal: a cmail message refiles into the synced /cmail/Archive folder." + (should (string= (cj/mu4e--refile-folder-for-maildir "/cmail/INBOX") + "/cmail/Archive")) + (should (string= (cj/mu4e--refile-folder-for-maildir "/cmail/Sent") + "/cmail/Archive"))) + +(ert-deftest test-mail-config-refile-gmail-signals () + "Error: gmail has no synced archive folder, so refile signals rather than +moving mail into a phantom folder." + (should-error (cj/mu4e--refile-folder-for-maildir "/gmail/INBOX") + :type 'user-error)) + +(ert-deftest test-mail-config-refile-dmail-signals () + "Error: dmail (Gmail-backed) has no synced archive folder; refile signals." + (should-error (cj/mu4e--refile-folder-for-maildir "/dmail/INBOX") + :type 'user-error)) + +(ert-deftest test-mail-config-refile-nil-maildir-signals () + "Boundary: a message with no maildir cannot be refiled; signal." + (should-error (cj/mu4e--refile-folder-for-maildir nil) + :type 'user-error)) + +(provide 'test-mail-config-refile-folder) +;;; test-mail-config-refile-folder.el ends here diff --git a/tests/test-markdown-config.el b/tests/test-markdown-config.el index 45e1a601..edb20d35 100644 --- a/tests/test-markdown-config.el +++ b/tests/test-markdown-config.el @@ -9,6 +9,7 @@ ;;; Code: (require 'ert) +(require 'cl-lib) (add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) @@ -50,5 +51,14 @@ (should (string-match-p "<xmp" (buffer-string)))) (kill-buffer src)))) +;;; cj/markdown-preview (guard: refuse when the httpd listener is down) + +(ert-deftest test-markdown-preview-errors-when-server-down () + "Error: `cj/markdown-preview' signals a user-error when the simple-httpd +listener is not running, rather than opening a preview against a dead server. +Also pins the rename off the bare `markdown-preview' that markdown-mode shadows." + (cl-letf (((symbol-function 'httpd-running-p) (lambda () nil))) + (should-error (cj/markdown-preview) :type 'user-error))) + (provide 'test-markdown-config) ;;; test-markdown-config.el ends here diff --git a/tests/test-org-capture-config-popup-window.el b/tests/test-org-capture-config-popup-window.el new file mode 100644 index 00000000..34f67b36 --- /dev/null +++ b/tests/test-org-capture-config-popup-window.el @@ -0,0 +1,281 @@ +;;; test-org-capture-config-popup-window.el --- Quick-capture popup single-window tests -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for the pure predicate behind the quick-capture popup single-window +;; fix. The Hyprland Super+Shift+N popup opens an emacsclient frame named +;; "org-capture"; in that frame the *Org Select* template menu and the +;; CAPTURE-* buffer must fill the frame's sole window instead of splitting it. +;; `cj/org-capture--popup-sole-window-p' is the frame+buffer decision; the +;; display-buffer action that acts on it is exercised by hand (window ops), +;; not here. + +;;; Code: + +(require 'ert) +(require 'cl-lib) +(require 'org) +(require 'org-capture) ; makes `org-capture-templates' a real special var +(require 'user-constants) +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'org-capture-config) + +(defconst test-org-capture-popup--sample-templates + '(("t" "Task" entry (function cj/--org-capture-project-location) + "* TODO %?" :prepend t) + ("b" "Bug" entry (function cj/--org-capture-project-location) + "* TODO [#C] %?" :prepend t) + ("e" "Event" entry (file+headline schedule-file "Scheduled Events") + "* %?" :prepend t :prepare-finalize cj/org-capture-format-event-headline) + ("m" "Mu4e Email" entry (file+headline inbox-file "Inbox") "* TODO %?" :prepend t) + ("L" "Link" entry (file+headline inbox-file "Inbox") "* %?" :immediate-finish t) + ("d" "Drill Question" entry (file ignore) "* Item :drill:\n%?" :prepend t)) + "A representative org-capture-templates list for popup-subset tests.") + +;;; cj/org-capture--popup-sole-window-p + +(ert-deftest test-org-capture-config-popup-sole-window-p-select-menu () + "Normal: the *Org Select* menu in the popup frame wants the sole window." + (should (cj/org-capture--popup-sole-window-p "org-capture" "*Org Select*"))) + +(ert-deftest test-org-capture-config-popup-sole-window-p-capture-buffer () + "Normal: a CAPTURE-* buffer in the popup frame wants the sole window." + (should (cj/org-capture--popup-sole-window-p "org-capture" "CAPTURE-todo.org"))) + +(ert-deftest test-org-capture-config-popup-sole-window-p-capture-prefix-only () + "Boundary: the bare \"CAPTURE-\" prefix still matches." + (should (cj/org-capture--popup-sole-window-p "org-capture" "CAPTURE-"))) + +(ert-deftest test-org-capture-config-popup-sole-window-p-other-frame () + "Boundary: the same menu in a normal frame is left alone." + (should-not (cj/org-capture--popup-sole-window-p "emacs" "*Org Select*")) + (should-not (cj/org-capture--popup-sole-window-p nil "CAPTURE-todo.org"))) + +(ert-deftest test-org-capture-config-popup-sole-window-p-other-buffer () + "Boundary: an unrelated buffer in the popup frame is left alone." + (should-not (cj/org-capture--popup-sole-window-p "org-capture" "todo.org")) + (should-not (cj/org-capture--popup-sole-window-p "org-capture" "*scratch*"))) + +(ert-deftest test-org-capture-config-popup-sole-window-p-nil-buffer () + "Error: a nil or non-string buffer name returns nil without raising." + (should-not (cj/org-capture--popup-sole-window-p "org-capture" nil)) + (should-not (cj/org-capture--popup-sole-window-p "org-capture" 42))) + +;;; Integration: the display-buffer-alist entry routes to a sole window + +(ert-deftest test-integration-org-capture-popup-display-sole-window () + "Integration: in an \"org-capture\"-named frame, displaying a CAPTURE-* +buffer fills the frame's sole window via the registered display-buffer-alist +entry, instead of splitting. + +Components integrated: +- cj/org-capture--popup-display-condition (real) +- cj/org-capture--display-sole-window (real) +- display-buffer / display-buffer-alist (real) + +Validates the popup frame ends with one window showing the CAPTURE buffer." + ;; The batch frame is auto-named (\"F1\"), which cannot be restored by name + ;; (\"F<num> usurped by Emacs\"); reset to nil to return it to auto-naming, + ;; keeping the test independent of execution order. + (let ((buf (get-buffer-create "CAPTURE-itest"))) + (unwind-protect + (progn + (set-frame-parameter nil 'name "org-capture") + (delete-other-windows) + (display-buffer buf) + (should (= (length (window-list)) 1)) + (should (eq (window-buffer (selected-window)) buf))) + (set-frame-parameter nil 'name nil) + (when (buffer-live-p buf) (kill-buffer buf))))) + +;;; cj/--org-capture-popup-templates (pure subset/retarget) + +(ert-deftest test-org-capture-config-popup-templates-keeps-tbe () + "Normal: only Task, Bug, Event survive, preserving order." + (should (equal (mapcar #'car (cj/--org-capture-popup-templates + test-org-capture-popup--sample-templates "/inbox.org")) + '("t" "b" "e")))) + +(ert-deftest test-org-capture-config-popup-templates-retargets-task-bug () + "Normal: Task and Bug retarget to the inbox \"Inbox\" headline; body + props kept." + (let* ((result (cj/--org-capture-popup-templates + test-org-capture-popup--sample-templates "/inbox.org")) + (task (assoc "t" result)) + (bug (assoc "b" result))) + (should (equal (nth 3 task) '(file+headline "/inbox.org" "Inbox"))) + (should (equal (nth 3 bug) '(file+headline "/inbox.org" "Inbox"))) + (should (equal (nth 4 task) "* TODO %?")) + (should (equal (nth 4 bug) "* TODO [#C] %?")) + (should (memq :prepend task)))) + +(ert-deftest test-org-capture-config-popup-templates-event-unchanged () + "Boundary: Event passes through untouched, schedule-file target and props intact." + (let ((event (assoc "e" (cj/--org-capture-popup-templates + test-org-capture-popup--sample-templates "/inbox.org")))) + (should (equal (nth 3 event) '(file+headline schedule-file "Scheduled Events"))) + (should (memq :prepare-finalize event)))) + +(ert-deftest test-org-capture-config-popup-templates-drops-context-templates () + "Boundary: context-dependent templates (mu4e, link, drill) are dropped." + (let ((result (cj/--org-capture-popup-templates + test-org-capture-popup--sample-templates "/inbox.org"))) + (should-not (assoc "m" result)) + (should-not (assoc "L" result)) + (should-not (assoc "d" result)))) + +(ert-deftest test-org-capture-config-popup-templates-empty () + "Error/Boundary: empty or all-dropped input yields nil without raising." + (should-not (cj/--org-capture-popup-templates nil "/inbox.org")) + (should-not (cj/--org-capture-popup-templates + '(("L" "Link" entry (file+headline f "Inbox") "* %?")) "/inbox.org"))) + +;;; cj/quick-capture (binds the subset; integration with a stubbed org-capture) + +(ert-deftest test-integration-org-capture-quick-capture-binds-subset () + "Integration: cj/quick-capture runs org-capture with only Task/Bug/Event, +Task and Bug retargeted to the inbox. + +Components integrated: +- cj/quick-capture (real) +- cj/--org-capture-popup-templates (real) +- org-capture (MOCKED — records the dynamically-bound templates)" + (let ((org-capture-templates test-org-capture-popup--sample-templates) + captured) + (cl-letf (((symbol-function 'org-capture) + (lambda (&rest _) (setq captured org-capture-templates)))) + (cj/quick-capture)) + (should (equal (mapcar #'car captured) '("t" "b" "e"))) + (should (equal (nth 3 (assoc "t" captured)) (list 'file+headline inbox-file "Inbox"))) + (should (equal (nth 3 (assoc "b" captured)) (list 'file+headline inbox-file "Inbox"))))) + +(ert-deftest test-integration-org-capture-quick-capture-closes-frame-on-abort () + "Integration: when selection aborts (org-capture signals), cj/quick-capture +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)" + (let ((org-capture-templates test-org-capture-popup--sample-templates) + (deleted 0)) + (cl-letf (((symbol-function 'org-capture) + (lambda (&rest _) (user-error "Abort"))) + ((symbol-function 'cj/org-capture--delete-popup-frame) + (lambda () (cl-incf deleted)))) + (cj/quick-capture)) + (should (= deleted 1)))) + +(ert-deftest test-integration-org-capture-quick-capture-closes-frame-on-quit () + "Integration: a C-g (quit) during capture also closes the popup frame." + (let ((org-capture-templates test-org-capture-popup--sample-templates) + (deleted 0)) + (cl-letf (((symbol-function 'org-capture) + (lambda (&rest _) (signal 'quit nil))) + ((symbol-function 'cj/org-capture--delete-popup-frame) + (lambda () (cl-incf deleted)))) + (cj/quick-capture)) + (should (= deleted 1)))) + +(ert-deftest test-integration-org-capture-quick-capture-keeps-frame-on-success () + "Integration: a successful capture (no signal) does NOT delete the frame — +the finalize hook owns that." + (let ((org-capture-templates test-org-capture-popup--sample-templates) + (deleted 0)) + (cl-letf (((symbol-function 'org-capture) (lambda (&rest _) nil)) + ((symbol-function 'cj/org-capture--delete-popup-frame) + (lambda () (cl-incf deleted)))) + (cj/quick-capture)) + (should (= deleted 0)))) + +;;; cj/--org-capture-popup-strip-specials (drop the Customize menu entry) + +(ert-deftest test-org-capture-config-popup-strip-specials-removes-customize () + "Normal: the \"C\" Customize entry is removed, \"q\" Abort kept, order intact." + (should (equal (cj/--org-capture-popup-strip-specials + '(("C" "Customize org-capture-templates") ("q" "Abort"))) + '(("q" "Abort"))))) + +(ert-deftest test-org-capture-config-popup-strip-specials-no-customize () + "Boundary: specials without a \"C\" entry pass through unchanged." + (should (equal (cj/--org-capture-popup-strip-specials '(("q" "Abort"))) + '(("q" "Abort"))))) + +(ert-deftest test-org-capture-config-popup-strip-specials-empty () + "Error/Boundary: nil specials yields nil without raising." + (should-not (cj/--org-capture-popup-strip-specials nil))) + +;;; cj/org-capture--popup-frame-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)))) + +;;; cj/org-capture--popup-mks-advice (frame-gated specials stripping) + +(ert-deftest test-org-capture-config-popup-mks-advice-strips-in-popup () + "Integration: in the popup frame, org-mks receives specials without \"C\"." + (let (seen) + (cl-letf (((symbol-function 'cj/org-capture--popup-frame-p) (lambda () t))) + (cj/org-capture--popup-mks-advice + (lambda (_table _title _prompt specials) (setq seen specials)) + nil nil nil '(("C" "Customize org-capture-templates") ("q" "Abort")))) + (should (equal seen '(("q" "Abort")))))) + +(ert-deftest test-org-capture-config-popup-mks-advice-keeps-elsewhere () + "Integration: in a normal frame, org-mks receives the specials untouched." + (let (seen) + (cl-letf (((symbol-function 'cj/org-capture--popup-frame-p) (lambda () nil))) + (cj/org-capture--popup-mks-advice + (lambda (_table _title _prompt specials) (setq seen specials)) + nil nil nil '(("C" "Customize org-capture-templates") ("q" "Abort")))) + (should (equal seen '(("C" "Customize org-capture-templates") ("q" "Abort")))))) + +;;; cj/org-capture--popup-frame (find the popup frame by name) + +(ert-deftest test-org-capture-config-popup-frame-found () + "Normal: returns the live frame whose name is \"org-capture\"." + (cl-letf (((symbol-function 'frame-list) (lambda () '(fa fb fc))) + ((symbol-function 'frame-live-p) (lambda (_f) t)) + ((symbol-function 'frame-parameter) + (lambda (f _p) (if (eq f 'fb) "org-capture" "other")))) + (should (eq (cj/org-capture--popup-frame) 'fb)))) + +(ert-deftest test-org-capture-config-popup-frame-none () + "Boundary: no popup frame present yields nil." + (cl-letf (((symbol-function 'frame-list) (lambda () '(fa fc))) + ((symbol-function 'frame-live-p) (lambda (_f) t)) + ((symbol-function 'frame-parameter) (lambda (_f _p) "other"))) + (should-not (cj/org-capture--popup-frame)))) + +;;; cj/quick-capture targets the popup frame + +(ert-deftest test-integration-org-capture-quick-capture-selects-named-frame () + "Integration: cj/quick-capture selects the \"org-capture\" frame found by name, +not whatever frame happens to be selected (the emacsclient -c focus race)." + (let ((org-capture-templates test-org-capture-popup--sample-templates) + (focused nil)) + (cl-letf (((symbol-function 'cj/org-capture--popup-frame) (lambda () 'popup-frame)) + ((symbol-function 'select-frame-set-input-focus) + (lambda (f) (setq focused f))) + ((symbol-function 'org-capture) (lambda (&rest _) nil))) + (cj/quick-capture)) + (should (eq focused 'popup-frame)))) + +(ert-deftest test-integration-org-capture-quick-capture-no-frame-still-captures () + "Integration: when no popup frame is found, cj/quick-capture skips the focus +call and still runs the capture (no error)." + (let ((org-capture-templates test-org-capture-popup--sample-templates) + (focused 'unset) + (captured nil)) + (cl-letf (((symbol-function 'cj/org-capture--popup-frame) (lambda () nil)) + ((symbol-function 'select-frame-set-input-focus) + (lambda (f) (setq focused f))) + ((symbol-function 'org-capture) (lambda (&rest _) (setq captured t)))) + (cj/quick-capture)) + (should (eq focused 'unset)) + (should captured))) + +(provide 'test-org-capture-config-popup-window) +;;; test-org-capture-config-popup-window.el ends here diff --git a/tests/test-org-capture-config-project-target.el b/tests/test-org-capture-config-project-target.el new file mode 100644 index 00000000..c9091c91 --- /dev/null +++ b/tests/test-org-capture-config-project-target.el @@ -0,0 +1,174 @@ +;;; test-org-capture-config-project-target.el --- Project-aware capture tests -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for the project-aware capture target shared by C-c c t (Task) and +;; C-c c b (Bug): the pure project-name and target-decision helpers, the +;; find-or-create "Open Work" / "Inbox" heading helpers, the function-target +;; wiring, and the two template registrations. + +;;; Code: + +(require 'ert) +(require 'cl-lib) +(require 'org) +(require 'org-capture) +(require 'user-constants) +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'org-capture-config) + +;;; cj/--org-capture-project-name + +(ert-deftest test-org-capture-project-name-normal () + "Normal: basename, first letter upcased; trailing slash ignored." + (should (equal (cj/--org-capture-project-name "/home/cj/code/duet/") "Duet")) + (should (equal (cj/--org-capture-project-name "/home/cj/code/duet") "Duet"))) + +(ert-deftest test-org-capture-project-name-strips-leading-dot () + "Boundary: a single leading dot is stripped before upcasing." + (should (equal (cj/--org-capture-project-name "/home/cj/.emacs.d/") "Emacs.d"))) + +(ert-deftest test-org-capture-project-name-nil-and-empty () + "Error: nil or empty root yields nil." + (should-not (cj/--org-capture-project-name nil)) + (should-not (cj/--org-capture-project-name ""))) + +;;; cj/--org-capture-project-target + +(ert-deftest test-org-capture-target-project-with-todo () + "Normal: a projectile root whose todo.org exists targets that file's Open Work." + (let ((root (make-temp-file "captest-" t))) + (unwind-protect + (progn + (with-temp-file (expand-file-name "todo.org" root) + (insert "* X Open Work\n")) + (let ((plan (cj/--org-capture-project-target root "/tmp/inbox.org"))) + (should (string= (plist-get plan :file) + (expand-file-name "todo.org" root))) + (should (plist-get plan :open-work)) + (should-not (plist-get plan :warn)))) + (delete-directory root t)))) + +(ert-deftest test-org-capture-target-project-without-todo () + "Boundary: a projectile root with no todo.org falls back to inbox and warns." + (let ((root (make-temp-file "captest-" t))) + (unwind-protect + (let ((plan (cj/--org-capture-project-target root "/tmp/inbox.org"))) + (should (string= (plist-get plan :file) "/tmp/inbox.org")) + (should-not (plist-get plan :open-work)) + (should (stringp (plist-get plan :warn))) + (should (string-match-p (regexp-quote (cj/--org-capture-project-name root)) + (plist-get plan :warn)))) + (delete-directory root t)))) + +(ert-deftest test-org-capture-target-no-project () + "Boundary: nil root targets the inbox with no warning." + (let ((plan (cj/--org-capture-project-target nil "/tmp/inbox.org"))) + (should (string= (plist-get plan :file) "/tmp/inbox.org")) + (should-not (plist-get plan :open-work)) + (should-not (plist-get plan :warn)))) + +;;; cj/--org-capture-goto-open-work + +(ert-deftest test-org-capture-goto-open-work-finds-existing () + "Normal: an existing top-level \"... Open Work\" heading is reused, not duplicated." + (with-temp-buffer + (org-mode) + (insert "* Emacs Open Work\n** TODO a\n* Emacs Resolved\n") + (cj/--org-capture-goto-open-work "Ignored") + (should (string= (org-get-heading t t t t) "Emacs Open Work")) + (should-not (string-match-p "Ignored" (buffer-string))))) + +(ert-deftest test-org-capture-goto-open-work-matches-tagged-heading () + "Boundary: a tagged \"... Open Work\" heading still matches and is not duplicated." + (with-temp-buffer + (org-mode) + (insert "* Foo Open Work :stuff:\n") + (cj/--org-capture-goto-open-work "Bar") + (should (string-match-p "Open Work" (org-get-heading t t t t))) + (should-not (string-match-p "Bar Open Work" (buffer-string))))) + +(ert-deftest test-org-capture-goto-open-work-creates-when-absent () + "Boundary: with no Open Work heading, create \"* NAME Open Work\" at end." + (with-temp-buffer + (org-mode) + (insert "* Something Else\n") + (cj/--org-capture-goto-open-work "Duet") + (should (string-match-p "^\\* Duet Open Work$" (buffer-string))) + (should (string= (org-get-heading t t t t) "Duet Open Work")))) + +;;; cj/--org-capture-goto-exact-headline + +(ert-deftest test-org-capture-goto-exact-headline-finds () + "Normal: an existing Inbox heading is found." + (with-temp-buffer + (org-mode) + (insert "* Inbox\n** TODO x\n") + (cj/--org-capture-goto-exact-headline "Inbox") + (should (string= (org-get-heading t t t t) "Inbox")))) + +(ert-deftest test-org-capture-goto-exact-headline-creates () + "Boundary: a missing Inbox heading is created at end of buffer." + (with-temp-buffer + (org-mode) + (insert "* Other\n") + (cj/--org-capture-goto-exact-headline "Inbox") + (should (string-match-p "^\\* Inbox$" (buffer-string))))) + +;;; cj/--org-capture-project-location (function-target wiring) + +(ert-deftest test-org-capture-location-files-into-project-open-work () + "Integration: in a project with a todo.org, the location function visits that +file and lands point on its Open Work heading." + (let* ((root (make-temp-file "captest-" t)) + (todo (expand-file-name "todo.org" root)) + (org-capture-plist nil) + visited) + (unwind-protect + (progn + (with-temp-file todo (insert "* Captest Open Work\n** TODO old\n")) + (cl-letf (((symbol-function 'projectile-project-root) + (lambda (&optional _d) root))) + (cj/--org-capture-project-location) + (setq visited (current-buffer)) + (should (string= (buffer-file-name) todo)) + (should (string-match-p "Open Work" (org-get-heading t t t t))))) + (when (buffer-live-p visited) (kill-buffer visited)) + (delete-directory root t)))) + +(ert-deftest test-org-capture-location-falls-back-to-inbox-without-project () + "Integration: with no project, the location function visits the inbox file +under its Inbox heading." + (let* ((inbox (make-temp-file "captest-inbox-" nil ".org" "* Inbox\n")) + (inbox-file inbox) + (org-capture-plist nil) + visited) + (unwind-protect + (cl-letf (((symbol-function 'projectile-project-root) + (lambda (&optional _d) nil))) + (cj/--org-capture-project-location) + (setq visited (current-buffer)) + (should (string= (buffer-file-name) inbox)) + (should (string= (org-get-heading t t t t) "Inbox"))) + (when (buffer-live-p visited) (kill-buffer visited)) + (delete-file inbox)))) + +;;; templates + +(ert-deftest test-org-capture-task-template-is-project-aware () + "Normal: the Task template (t) targets the project-aware function." + (let ((entry (assoc "t" org-capture-templates))) + (should entry) + (should (equal (nth 3 entry) + '(function cj/--org-capture-project-location))))) + +(ert-deftest test-org-capture-bug-template-registered () + "Normal: the Bug template (b) exists, targets the project-aware function, and +defaults to the [#C] priority." + (let ((entry (assoc "b" org-capture-templates))) + (should entry) + (should (equal (nth 3 entry) + '(function cj/--org-capture-project-location))) + (should (string-match-p "\\[#C\\]" (nth 4 entry))))) + +(provide 'test-org-capture-config-project-target) +;;; test-org-capture-config-project-target.el ends here diff --git a/tests/test-org-drill-config-commands.el b/tests/test-org-drill-config-commands.el index 7d197616..c35bd6cd 100644 --- a/tests/test-org-drill-config-commands.el +++ b/tests/test-org-drill-config-commands.el @@ -71,21 +71,50 @@ ;;; cj/drill-refile -(ert-deftest test-org-drill-refile-sets-targets-and-delegates () - "Normal: drill-refile narrows `org-refile-targets' to current buffer + -`drill-dir', then dispatches to `org-refile' via `call-interactively'." - (let (seen-targets called-fn) - (cl-letf (((symbol-function 'call-interactively) +(ert-deftest test-org-drill-refile-targets-from-validated-helper () + "Normal: drill-refile builds its drill targets from the shared +`cj/--drill-files-or-error' helper, expanded against `drill-dir' — not from +a raw `directory-files' call (so it inherits the helper's dot-file exclusion +and validation)." + (let ((drill-dir "/tmp/cj-drill/") + seen-targets called-fn) + (cl-letf (((symbol-function 'cj/--drill-files-or-error) + (lambda (_dir) '("a.org" "b.org"))) + ;; If the old raw path were still in use it would call + ;; `directory-files'; a sentinel here keeps it from masquerading. + ((symbol-function 'directory-files) + (lambda (&rest _) '("/WRONG/raw.org"))) + ((symbol-function 'call-interactively) (lambda (fn) (setq called-fn fn seen-targets org-refile-targets)))) (cj/drill-refile)) (should (eq called-fn 'org-refile)) - (should seen-targets) - ;; Two entries: (nil :maxlevel . 1) and (drill-dir :maxlevel . 1). (should (= 2 (length seen-targets))) (should (assoc nil seen-targets)) - (should (assoc 'drill-dir seen-targets)))) + (should (equal (car (nth 1 seen-targets)) + '("/tmp/cj-drill/a.org" "/tmp/cj-drill/b.org"))))) + +(ert-deftest test-org-drill-refile-does-not-clobber-global-targets () + "Error: drill-refile let-binds `org-refile-targets'; the session-wide value +survives the call instead of being permanently replaced." + (let ((drill-dir "/tmp/cj-drill/") + (org-refile-targets '((sentinel :maxlevel . 9)))) + (cl-letf (((symbol-function 'cj/--drill-files-or-error) (lambda (_dir) '("a.org"))) + ((symbol-function 'call-interactively) (lambda (_fn) nil))) + (cj/drill-refile)) + (should (equal org-refile-targets '((sentinel :maxlevel . 9)))))) + +(ert-deftest test-org-drill-refile-errors-on-missing-drill-dir () + "Error: a missing or unreadable drill dir signals a clear `user-error' via +the shared validated helper, instead of a low-level error, and never reaches +`org-refile'." + (let ((drill-dir (expand-file-name "cj-drill-nonexistent-XYZ/" + temporary-file-directory)) + (called nil)) + (cl-letf (((symbol-function 'call-interactively) (lambda (_fn) (setq called t)))) + (should-error (cj/drill-refile) :type 'user-error)) + (should-not called))) (provide 'test-org-drill-config-commands) ;;; test-org-drill-config-commands.el ends here diff --git a/tests/test-org-roam-config-dailies-head.el b/tests/test-org-roam-config-dailies-head.el new file mode 100644 index 00000000..631f017c --- /dev/null +++ b/tests/test-org-roam-config-dailies-head.el @@ -0,0 +1,29 @@ +;;; test-org-roam-config-dailies-head.el --- Tests for the dailies template head -*- lexical-binding: t; -*- + +;;; Commentary: +;; `cj/--org-roam-dailies-head' is the head inserted into a new org-roam +;; daily file. #+FILETAGS and #+TITLE must sit on separate lines, or Org +;; never parses the #+TITLE keyword and the FILETAGS value swallows the +;; rest of the line. + +;;; Code: + +(require 'ert) +(require 'testutil-general) + +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'org-roam-config) + +(ert-deftest test-org-roam-config-dailies-head-separates-filetags-and-title () + "Boundary: #+FILETAGS and #+TITLE sit on separate lines." + (should (string-match-p "#\\+FILETAGS: Journal\n#\\+TITLE:" + cj/--org-roam-dailies-head)) + ;; And never run together on one line. + (should-not (string-match-p "Journal #\\+TITLE:" cj/--org-roam-dailies-head))) + +(ert-deftest test-org-roam-config-dailies-head-ends-with-newline () + "Boundary: the head ends with a newline so the capture body starts clean." + (should (string-suffix-p "\n" cj/--org-roam-dailies-head))) + +(provide 'test-org-roam-config-dailies-head) +;;; test-org-roam-config-dailies-head.el ends here diff --git a/tests/test-prog-general--electric-pair-angle.el b/tests/test-prog-general--electric-pair-angle.el new file mode 100644 index 00000000..cb33725a --- /dev/null +++ b/tests/test-prog-general--electric-pair-angle.el @@ -0,0 +1,54 @@ +;;; test-prog-general--electric-pair-angle.el --- Angle-bracket pairing inhibit -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for cj/--electric-pair-inhibit-angle, which stops electric-pair from +;; pairing "<" into "<>". Craig's yasnippet keys start with "<" (e.g. <cj); +;; auto-pairing the "<" strands a ">" after the expanded snippet, which broke +;; the cj-comment close fence into "#+end_src>". + +;;; Code: + +(require 'ert) +(require 'cl-lib) +(require 'elec-pair) +(require 'org) +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'prog-general) + +;;; cj/--electric-pair-inhibit-angle + +(ert-deftest test-prog-general-electric-pair-inhibit-angle-open () + "Normal: the open angle bracket is inhibited." + (should (cj/--electric-pair-inhibit-angle ?<))) + +(ert-deftest test-prog-general-electric-pair-inhibit-angle-delegates () + "Boundary: any other character defers to electric-pair-default-inhibit." + (cl-letf (((symbol-function 'electric-pair-default-inhibit) + (lambda (_c) 'delegated))) + (should (eq (cj/--electric-pair-inhibit-angle ?a) 'delegated)) + (should (eq (cj/--electric-pair-inhibit-angle ?\() 'delegated)))) + +(ert-deftest test-prog-general-electric-pair-predicate-installed () + "Normal: prog-general installs the predicate as the global value." + (should (eq electric-pair-inhibit-predicate #'cj/--electric-pair-inhibit-angle))) + +;;; Integration — the actual pairing behavior + +(ert-deftest test-integration-prog-general-angle-not-paired-in-org () + "Integration: in an org buffer (where < has paren syntax), typing < with the +inhibit predicate active inserts just <, not <>. + +Components integrated: +- cj/--electric-pair-inhibit-angle (real) +- electric-pair-local-mode / self-insert-command (real) +- org-mode syntax table (real — gives < paren syntax)" + (with-temp-buffer + (org-mode) + (electric-pair-local-mode 1) + (setq-local electric-pair-inhibit-predicate #'cj/--electric-pair-inhibit-angle) + (let ((last-command-event ?<)) + (call-interactively #'self-insert-command)) + (should (equal (buffer-substring-no-properties (point-min) (point-max)) "<")))) + +(provide 'test-prog-general--electric-pair-angle) +;;; test-prog-general--electric-pair-angle.el ends here diff --git a/tests/test-reconcile--find-git-repos.el b/tests/test-reconcile--find-git-repos.el index e065fca9..c6a190a1 100644 --- a/tests/test-reconcile--find-git-repos.el +++ b/tests/test-reconcile--find-git-repos.el @@ -81,6 +81,15 @@ (should (= (length repos) 1)) (should (string-suffix-p "visible-repo" (car repos)))))) +(ert-deftest test-find-git-repos-boundary-dotted-repo-name-found () + "Boundary: a repo whose directory name contains a dot (e.g. mcp.el) is +discovered. Regression for the `^[^.]+$' filter that matched only dot-free +names and silently skipped dotted repos like mcp.el / capture.el." + (reconcile-test-with-temp-dirs + ("mcp.el/.git/" "capture.el/.git/" "plain-repo/.git/") + (let ((repos (cj/find-git-repos test-root))) + (should (= (length repos) 3))))) + (ert-deftest test-find-git-repos-boundary-prunes-heavy-directories () "Skips generated/heavy directories while discovering repos." (reconcile-test-with-temp-dirs diff --git a/tests/test-selection-framework--consult-line-or-repeat.el b/tests/test-selection-framework--consult-line-or-repeat.el index fcaddcfd..66f5b172 100644 --- a/tests/test-selection-framework--consult-line-or-repeat.el +++ b/tests/test-selection-framework--consult-line-or-repeat.el @@ -64,5 +64,11 @@ "Normal: `cj/consult-line-or-repeat' is an interactive command." (should (commandp #'cj/consult-line-or-repeat))) +(ert-deftest test-selection-framework-vertico-repeat-save-on-minibuffer-setup () + "Normal: loading the module registers `vertico-repeat-save' on +`minibuffer-setup-hook'. Without it `vertico-repeat' has no saved session +and the second C-s signals \"No Vertico session\"." + (should (memq 'vertico-repeat-save minibuffer-setup-hook))) + (provide 'test-selection-framework--consult-line-or-repeat) ;;; test-selection-framework--consult-line-or-repeat.el ends here diff --git a/tests/test-signal-config-notify.el b/tests/test-signal-config-notify.el new file mode 100644 index 00000000..c4067a66 --- /dev/null +++ b/tests/test-signal-config-notify.el @@ -0,0 +1,150 @@ +;;; test-signal-config-notify.el --- Tests for the signal-config notification slice -*- lexical-binding: t -*- + +;;; Commentary: +;; ERT tests for the notification slice of `signal-config': the pure +;; body formatter (whitespace collapse + truncation to +;; `cj/signal--notify-body-max') and `cj/signel--notify' routing (the +;; suppression gate, the notify-script path with the sound flag, and +;; the `notifications-notify' fallback). Spec: the "Notification +;; slice" addendum in docs/design/signal-client.org. No signal-cli or +;; linked account needed. + +;;; Code: + +(require 'ert) +(require 'cl-lib) + +;; signel is the fork at ~/code/signel; signal-config wires it via +;; use-package but these tests need the symbols available directly. +(eval-and-compile + (add-to-list 'load-path (expand-file-name "~/code/signel"))) +(require 'signel) + +(require 'signal-config) + +;;; cj/signal--format-notify-body + +(ert-deftest test-signal-config-format-notify-body-passthrough () + "Normal: short single-line text passes through unchanged." + (should (equal (cj/signal--format-notify-body "lunch at noon?") + "lunch at noon?"))) + +(ert-deftest test-signal-config-format-notify-body-collapses-whitespace () + "Normal: newlines and whitespace runs collapse to single spaces." + (should (equal (cj/signal--format-notify-body "two\nlines\n\nhere") + "two lines here")) + (should (equal (cj/signal--format-notify-body "tabs\t\tand spaces") + "tabs and spaces"))) + +(ert-deftest test-signal-config-format-notify-body-trims () + "Boundary: leading and trailing whitespace is trimmed." + (should (equal (cj/signal--format-notify-body " hi ") "hi"))) + +(ert-deftest test-signal-config-format-notify-body-empty () + "Boundary: the empty string stays empty." + (should (equal (cj/signal--format-notify-body "") ""))) + +(ert-deftest test-signal-config-format-notify-body-exact-limit () + "Boundary: a body exactly at the limit is untouched." + (let ((s (make-string cj/signal--notify-body-max ?x))) + (should (equal (cj/signal--format-notify-body s) s)))) + +(ert-deftest test-signal-config-format-notify-body-truncates-over-limit () + "Boundary: over-limit text truncates to the limit, ending in an ellipsis." + (let* ((s (make-string (1+ cj/signal--notify-body-max) ?x)) + (out (cj/signal--format-notify-body s))) + (should (= (length out) cj/signal--notify-body-max)) + (should (string-suffix-p "…" out)))) + +(ert-deftest test-signal-config-format-notify-body-unicode () + "Boundary: multibyte text truncates by characters, not bytes." + (let* ((s (make-string (+ cj/signal--notify-body-max 10) ?é)) + (out (cj/signal--format-notify-body s))) + (should (= (length out) cj/signal--notify-body-max)) + (should (string-suffix-p "…" out)))) + +;;; cj/signel--notify routing + +(ert-deftest test-signal-config-notify-suppressed-when-viewing () + "Normal: nothing fires when the suppression predicate says no." + (let (script-calls fallback-calls) + (cl-letf (((symbol-function 'cj/signal--should-notify-p) + (lambda (_chat-id) nil)) + ((symbol-function 'start-process) + (lambda (&rest args) (push args script-calls) nil)) + ((symbol-function 'notifications-notify) + (lambda (&rest args) (push args fallback-calls) nil))) + (cj/signel--notify "+15551234567" "Alice" "hi")) + (should-not script-calls) + (should-not fallback-calls))) + +(ert-deftest test-signal-config-notify-script-silent-by-default () + "Normal: with the script present and sound off, runs notify info --silent." + (let (script-calls) + (cl-letf (((symbol-function 'cj/signal--should-notify-p) + (lambda (_chat-id) t)) + ((symbol-function 'executable-find) + (lambda (p &optional _remote) + (when (equal p "notify") "/usr/bin/notify"))) + ((symbol-function 'start-process) + (lambda (&rest args) (push args script-calls) nil)) + ((symbol-function 'notifications-notify) + (lambda (&rest _) + (error "Fallback must not fire when the script is present")))) + (let ((cj/signel-notify-sound nil)) + (cj/signel--notify "+15551234567" "Alice" "hi"))) + (should (= (length script-calls) 1)) + ;; start-process args: (NAME BUFFER PROGRAM &rest PROGRAM-ARGS); + ;; PROGRAM is the path executable-find resolved, not the bare name. + (should (equal (nthcdr 2 (car script-calls)) + '("/usr/bin/notify" "info" "Signal: Alice" "hi" "--silent"))))) + +(ert-deftest test-signal-config-notify-sound-enabled-drops-silent () + "Normal: with `cj/signel-notify-sound' non-nil, --silent is omitted." + (let (script-calls) + (cl-letf (((symbol-function 'cj/signal--should-notify-p) + (lambda (_chat-id) t)) + ((symbol-function 'executable-find) + (lambda (p &optional _remote) + (when (equal p "notify") "/usr/bin/notify"))) + ((symbol-function 'start-process) + (lambda (&rest args) (push args script-calls) nil))) + (let ((cj/signel-notify-sound t)) + (cj/signel--notify "+15551234567" "Alice" "hi"))) + (should (equal (nthcdr 2 (car script-calls)) + '("/usr/bin/notify" "info" "Signal: Alice" "hi"))))) + +(ert-deftest test-signal-config-notify-fallback-when-script-missing () + "Error: without the script on PATH, falls back to notifications-notify." + (let (script-calls fallback-calls) + (cl-letf (((symbol-function 'cj/signal--should-notify-p) + (lambda (_chat-id) t)) + ((symbol-function 'executable-find) + (lambda (_p &optional _remote) nil)) + ((symbol-function 'start-process) + (lambda (&rest args) (push args script-calls) nil)) + ((symbol-function 'notifications-notify) + (lambda (&rest args) (push args fallback-calls) nil))) + (cj/signel--notify "+15551234567" "Alice" "hi")) + (should-not script-calls) + (should (= (length fallback-calls) 1)) + (let ((args (car fallback-calls))) + (should (equal (plist-get args :title) "Signal: Alice")) + (should (equal (plist-get args :body) "hi"))))) + +(ert-deftest test-signal-config-notify-formats-body-before-send () + "Normal: the body runs through the formatter before reaching the script." + (let (script-calls) + (cl-letf (((symbol-function 'cj/signal--should-notify-p) + (lambda (_chat-id) t)) + ((symbol-function 'executable-find) + (lambda (p &optional _remote) + (when (equal p "notify") "/usr/bin/notify"))) + ((symbol-function 'start-process) + (lambda (&rest args) (push args script-calls) nil))) + (let ((cj/signel-notify-sound nil)) + (cj/signel--notify "+15551234567" "Alice" "first line\nsecond line"))) + (should (equal (nth 5 (car script-calls)) "first line second line")))) + +(provide 'test-signal-config-notify) +;;; test-signal-config-notify.el ends here diff --git a/tests/test-signal-config.el b/tests/test-signal-config.el index 3be63362..7556efdb 100644 --- a/tests/test-signal-config.el +++ b/tests/test-signal-config.el @@ -368,6 +368,16 @@ commands the workflow spec names." (should (eq (keymap-lookup cj/signel-prefix-map "SPC") #'cj/signel-connect))) +(ert-deftest test-signal-config-prefix-map-registered-under-c-semi-m () + "Normal: loading signal-config registers `cj/signel-prefix-map' under +`M' in `cj/custom-keymap', so C-; M reaches the signel prefix. Guards +the wiring contract that the load-order bug broke: signal-config must +register through `cj/register-prefix-map', not a boundp-guarded direct +mutation that silently no-ops when keybindings loaded in a different +order." + (require 'keybindings) + (should (eq (keymap-lookup cj/custom-keymap "M") cj/signel-prefix-map))) + ;;; display-buffer-alist entry for *Signel: ...* chat buffers (ert-deftest test-signal-config-chat-buffer-display-rule-uses-bottom-30 () diff --git a/tests/test-signel-notify-function.el b/tests/test-signel-notify-function.el new file mode 100644 index 00000000..cff7f739 --- /dev/null +++ b/tests/test-signel-notify-function.el @@ -0,0 +1,89 @@ +;;; test-signel-notify-function.el --- Tests for signel's notify-function dispatch -*- lexical-binding: t -*- + +;;; Commentary: +;; signel's receive handler (signel.el in the fork at ~/code/signel) +;; raised notifications through a hardwired `notifications-notify' +;; call. The notification slice (docs/design/signal-client.org, +;; "Notification slice" addendum) replaces that with +;; `signel-notify-function', a customization point called with +;; CHAT-ID, SENDER, and BODY so a config layer can add suppression or +;; route through an external notifier. These tests cover the +;; dispatch: text, sticker, and attachment bodies reach the function +;; with the right arguments, and the default preserves the plain +;; `notifications-notify' behavior. +;; +;; `signel--handle-receive' is exercised directly with synthetic +;; envelope alists; buffer/dashboard side effects are stubbed. No +;; live process needed. + +;;; Code: + +(require 'ert) +(require 'cl-lib) + +(eval-and-compile + (add-to-list 'load-path (expand-file-name "~/code/signel"))) +(require 'signel) + +(defun test-signel-notify--receive (envelope) + "Run `signel--handle-receive' on ENVELOPE, capturing notify calls. +Returns the list of (CHAT-ID SENDER BODY) argument lists the handler +passed to `signel-notify-function', oldest first. Buffer and +dashboard side effects are stubbed out." + (let (calls) + (cl-letf (((symbol-function 'signel--insert-msg) (lambda (&rest _) nil)) + ((symbol-function 'signel--dashboard-refresh) (lambda () nil)) + ((symbol-function 'signel--get-buffer) + (lambda (_) (current-buffer)))) + (let ((signel-notify-function + (lambda (chat-id sender body) + (push (list chat-id sender body) calls))) + (signel-auto-open-buffer nil)) + (signel--handle-receive `((envelope . ,envelope))))) + (nreverse calls))) + +(ert-deftest test-signel-notify-function-text-message () + "Normal: a text dataMessage calls the function with chat-id, sender, text." + (should (equal (test-signel-notify--receive + '((sourceNumber . "+15551234567") + (sourceName . "Alice") + (dataMessage . ((message . "hi there"))))) + '(("+15551234567" "Alice" "hi there"))))) + +(ert-deftest test-signel-notify-function-sticker-placeholder () + "Boundary: a sticker with no text gets the [Sticker] placeholder body." + (should (equal (test-signel-notify--receive + '((sourceNumber . "+15551234567") + (sourceName . "Alice") + (dataMessage . ((sticker . ((packId . "p1"))))))) + '(("+15551234567" "Alice" "[Sticker]"))))) + +(ert-deftest test-signel-notify-function-attachment-placeholder () + "Boundary: an attachment with no text gets the [Attachment] placeholder." + (should (equal (test-signel-notify--receive + '((sourceNumber . "+15551234567") + (sourceName . "Alice") + (dataMessage . ((attachments . [((id . "a1"))]))))) + '(("+15551234567" "Alice" "[Attachment]"))))) + +(ert-deftest test-signel-notify-function-no-data-no-call () + "Boundary: an envelope with no dataMessage never calls the function." + (should-not (test-signel-notify--receive + '((sourceNumber . "+15551234567") + (sourceName . "Alice") + (typingMessage . ((action . "STARTED"))))))) + +(ert-deftest test-signel-notify-function-default-preserves-behavior () + "Normal: the default value raises a plain notifications-notify toast." + (should (eq signel-notify-function #'signel--notify-default)) + (let (calls) + (cl-letf (((symbol-function 'notifications-notify) + (lambda (&rest args) (push args calls) nil))) + (signel--notify-default "+15551234567" "Alice" "hi")) + (should (= (length calls) 1)) + (let ((args (car calls))) + (should (equal (plist-get args :title) "Signel: Alice")) + (should (equal (plist-get args :body) "hi"))))) + +(provide 'test-signel-notify-function) +;;; test-signel-notify-function.el ends here diff --git a/tests/test-system-lib-confirm-strong.el b/tests/test-system-lib-confirm-strong.el new file mode 100644 index 00000000..26c00822 --- /dev/null +++ b/tests/test-system-lib-confirm-strong.el @@ -0,0 +1,37 @@ +;;; test-system-lib-confirm-strong.el --- Tests for cj/confirm-strong -*- lexical-binding: t; -*- + +;;; Commentary: +;; ERT tests for `cj/confirm-strong', the typed-"yes" confirmation used for +;; irreversible actions. The behavior under test is the long-form guarantee: +;; the prompt demands a typed yes/no even when the global single-key default +;; (`use-short-answers') is in effect. + +;;; Code: + +(require 'ert) +(require 'cl-lib) +(require 'system-lib) + +(ert-deftest test-system-lib-confirm-strong-returns-t-on-yes () + "Normal: passes a t answer through from `yes-or-no-p'." + (cl-letf (((symbol-function 'yes-or-no-p) (lambda (&rest _) t))) + (should (eq (cj/confirm-strong "Really? ") t)))) + +(ert-deftest test-system-lib-confirm-strong-returns-nil-on-no () + "Normal: passes a nil answer through from `yes-or-no-p'." + (cl-letf (((symbol-function 'yes-or-no-p) (lambda (&rest _) nil))) + (should (eq (cj/confirm-strong "Really? ") nil)))) + +(ert-deftest test-system-lib-confirm-strong-forces-long-form () + "Boundary: binds `use-short-answers' to nil for the call even when it is +globally t, so the irreversible prompt requires a typed yes/no regardless of +the single-key default." + (let ((use-short-answers t) + (seen 'unset)) + (cl-letf (((symbol-function 'yes-or-no-p) + (lambda (&rest _) (setq seen use-short-answers) t))) + (cj/confirm-strong "Really? ") + (should (eq seen nil))))) + +(provide 'test-system-lib-confirm-strong) +;;; test-system-lib-confirm-strong.el ends here diff --git a/tests/test-term-config--f8-in-term.el b/tests/test-term-config--f8-in-term.el new file mode 100644 index 00000000..6cee4ff4 --- /dev/null +++ b/tests/test-term-config--f8-in-term.el @@ -0,0 +1,42 @@ +;;; 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 1bb7e73b..51e9725c 100644 --- a/tests/test-term-tmux-history.el +++ b/tests/test-term-tmux-history.el @@ -260,8 +260,11 @@ ghostel-mode terminal." (should-not tmux-called))))) (ert-deftest test-term-copy-mode-dwim-sends-tmux-prefix-when-attached () - "Normal: with tmux attached, dwim writes C-b [ into the pty so tmux enters -its own copy-mode against the full pane history." + "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)) @@ -279,16 +282,20 @@ its own copy-mode against the full pane history." '((("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["))) + (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' and sends nothing." + "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) - (copy-mode-called nil)) + (dwim-order nil)) (unwind-protect (with-current-buffer agent (cl-letf (((symbol-function 'get-buffer-process) @@ -298,13 +305,15 @@ its own copy-mode against the full pane history." ((symbol-function 'ghostel-send-string) (lambda (s) (push s sent))) ((symbol-function 'ghostel-copy-mode) - (lambda () (setq copy-mode-called t)))) + (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 copy-mode-called)))) + (should (equal (reverse dwim-order) '(copy-mode beginning-of-line)))))) (when (buffer-live-p agent) (kill-buffer agent))))) @@ -327,6 +336,17 @@ instead of being forwarded to the terminal program." (should-not (eq (keymap-lookup ghostel-semi-char-mode-map "C-M-<left>") 'ghostel--send-event))) +(ert-deftest test-term-f10-music-and-shutdown-in-keymap-exceptions () + "Regression: F10 (music playlist toggle) and C-F10 (server shutdown) are in +`ghostel-keymap-exceptions' so they reach Emacs from inside a ghostel buffer +instead of being forwarded to the terminal program. Both are global bindings, +so dropping them from the semi-char map lets the lookup fall through to the +global map." + (dolist (key '("<f10>" "C-<f10>")) + (should (member key 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 diff --git a/tests/test-ui-navigation-split-follow-undo-kill.el b/tests/test-ui-navigation-split-follow-undo-kill.el index 74c1e2fc..8e390074 100644 --- a/tests/test-ui-navigation-split-follow-undo-kill.el +++ b/tests/test-ui-navigation-split-follow-undo-kill.el @@ -54,8 +54,9 @@ ;;; cj/undo-kill-buffer -(ert-deftest test-ui-navigation-undo-kill-buffer-opens-most-recent () - "Normal: with no arg, opens the head of recentf-list that isn't currently visited." +(ert-deftest test-ui-navigation-undo-kill-buffer-no-prefix-opens-most-recent () + "Normal: no prefix (arg=1, the value `\"p\"' yields) opens the most-recent +non-visited entry, not the second." (let ((opened nil) (recentf-mode t) (recentf-list '("/tmp/dead.org" "/tmp/alive.txt"))) @@ -71,12 +72,12 @@ ((symbol-function 'find-file) (lambda (f) (setq opened f)))) (unwind-protect - (cj/undo-kill-buffer 0) + (cj/undo-kill-buffer 1) (when (get-buffer "*test-alive*") (kill-buffer "*test-alive*")))) (should (equal opened "/tmp/dead.org")))) -(ert-deftest test-ui-navigation-undo-kill-buffer-honors-numeric-arg () - "Normal: with N=1, opens the second non-visited entry from recentf-list." +(ert-deftest test-ui-navigation-undo-kill-buffer-numeric-arg-is-one-based () + "Normal: a numeric prefix is 1-based — N=2 opens the second non-visited entry." (let ((opened nil) (recentf-mode t) (recentf-list '("/tmp/a.org" "/tmp/b.org" "/tmp/c.org"))) @@ -85,10 +86,7 @@ ((symbol-function 'buffer-list) (lambda (&rest _) nil)) ((symbol-function 'find-file) (lambda (f) (setq opened f)))) - ;; cj/undo-kill-buffer takes a prefix `arg' and indexes into the list - ;; with `(nth arg ...)` when arg is non-nil. Passing 1 grabs the 2nd - ;; entry. - (cj/undo-kill-buffer 1)) + (cj/undo-kill-buffer 2)) (should (equal opened "/tmp/b.org")))) (ert-deftest test-ui-navigation-undo-kill-buffer-no-op-when-list-empty () @@ -104,5 +102,18 @@ (cj/undo-kill-buffer 0)) (should-not opened))) +(ert-deftest test-ui-navigation-undo-kill-buffer-out-of-range-arg-errors () + "Error: a prefix larger than the killed-file list signals a clear user-error, +not a wrong-type-argument from find-file on nil." + (let ((opened nil) + (recentf-mode t) + (recentf-list '("/tmp/a.org"))) + (cl-letf (((symbol-function 'require) (lambda (&rest _) t)) + ((symbol-function 'recentf-mode) (lambda (&rest _) t)) + ((symbol-function 'buffer-list) (lambda (&rest _) nil)) + ((symbol-function 'find-file) (lambda (f) (setq opened f)))) + (should-error (cj/undo-kill-buffer 5) :type 'user-error)) + (should-not opened))) + (provide 'test-ui-navigation-split-follow-undo-kill) ;;; test-ui-navigation-split-follow-undo-kill.el ends here |