diff options
| -rw-r--r-- | modules/modeline-config.el | 7 | ||||
| -rw-r--r-- | modules/ui-config.el | 57 | ||||
| -rw-r--r-- | modules/user-constants.el | 45 | ||||
| -rw-r--r-- | tests/test-ui-buffer-status-colors.el | 243 | ||||
| -rw-r--r-- | tests/test-ui-config--buffer-cursor-state.el | 55 | ||||
| -rw-r--r-- | tests/test-ui-cursor-color-integration.el | 253 |
6 files changed, 278 insertions, 382 deletions
diff --git a/modules/modeline-config.el b/modules/modeline-config.el index 21ecd7e47..f6b8ef4eb 100644 --- a/modules/modeline-config.el +++ b/modules/modeline-config.el @@ -75,12 +75,7 @@ Example: `my-very-long-name.el' → `my-ver...me.el'" ;; -------------------------- Modeline Segments -------------------------------- (defvar-local cj/modeline-buffer-name - '(:eval (let* ((state (cond - (buffer-read-only 'read-only) - (overwrite-mode 'overwrite) - ((buffer-modified-p) 'modified) - (t 'unmodified))) - (color (alist-get state cj/buffer-status-colors)) + '(:eval (let* ((color (cj/buffer-status-color (cj/buffer-status-state))) (name (buffer-name)) (truncated-name (cj/modeline-string-cut-middle name))) (propertize truncated-name diff --git a/modules/ui-config.el b/modules/ui-config.el index 7afe528b2..86670b29d 100644 --- a/modules/ui-config.el +++ b/modules/ui-config.el @@ -94,53 +94,32 @@ When `cj/enable-transparency' is nil, reset alpha to fully opaque." (if cj/enable-transparency "enabled" "disabled"))) ;; ----------------------------------- Cursor ---------------------------------- -;; set cursor color according to mode -;; -;; #f06a3f indicates a read-only document -;; #c48702 indicates overwrite mode -;; #64aa0f indicates insert and read/write mode +;; Set the cursor color from the active theme's faces according to buffer state. +;; The state classifier and the state->face map live in user-constants.el +;; (cj/buffer-status-state / cj/buffer-status-faces, colored via the theme's +;; error / warning / success faces) and are shared with the modeline buffer-name +;; indicator, so the cursor and the modeline stay in sync. (defvar cj/-cursor-last-color nil "Last color applied by `cj/set-cursor-color-according-to-mode'.") (defvar cj/-cursor-last-buffer nil "Last buffer name where cursor color was applied.") -(defun cj/--buffer-cursor-state () - "Return the buffer-state symbol used to choose the cursor color. - -One of `read-only', `overwrite', `modified', or `unmodified' — keys -of `cj/buffer-status-colors'. - -A live ghostel terminal (in `ghostel-mode' and an input mode that -forwards keys — semi-char / char / line) reports `unmodified' even -though the buffer is read-only: keystrokes go to the terminal process, -so from the user's side the buffer is writeable and the read-only -(orange) cursor would be misleading. ghostel's `copy' and `emacs' -input modes are the exception — there the buffer really is a read-only -Emacs buffer the user navigates, so it falls through to `read-only' -and keeps the orange cursor." - (cond - ((and (eq major-mode 'ghostel-mode) - (not (memq (bound-and-true-p ghostel--input-mode) '(copy emacs)))) - 'unmodified) - (buffer-read-only 'read-only) - (overwrite-mode 'overwrite) - ((buffer-modified-p) 'modified) - (t 'unmodified))) - (defun cj/set-cursor-color-according-to-mode () - "Change cursor color according to buffer state (modified, read-only, overwrite). -Only updates for real user buffers, not internal/temporary buffers. -A no-op on non-graphical frames -- TTY/batch sessions have no cursor color -to set." + "Set the cursor color from the active theme according to buffer state. +The state and its theme face come from `cj/buffer-status-state' and +`cj/buffer-status-color' (shared with the modeline), so the color follows the +loaded theme. Only updates real user buffers, not internal/temporary ones; a +no-op on non-graphical frames -- TTY/batch sessions have no cursor color to set." (when (display-graphic-p) - ;; Only update cursor for real buffers (not internal ones like *temp*, *Echo Area*, etc.) - (unless (string-prefix-p " " (buffer-name)) ; Internal buffers start with space - (let ((color (alist-get (cj/--buffer-cursor-state) cj/buffer-status-colors))) - ;; Only skip if BOTH color AND buffer are the same (optimization) - ;; This allows color to update when buffer state changes - (unless (and (string= color cj/-cursor-last-color) - (string= (buffer-name) cj/-cursor-last-buffer)) + ;; Only update cursor for real buffers (not internal ones like *temp*, *Echo Area*). + (unless (string-prefix-p " " (buffer-name)) ; internal buffers start with a space + (let ((color (cj/buffer-status-color (cj/buffer-status-state)))) + ;; Skip only when BOTH color and buffer are unchanged (so the color still + ;; updates when the buffer state changes). + (when (and color + (not (and (equal color cj/-cursor-last-color) + (equal (buffer-name) cj/-cursor-last-buffer)))) (set-cursor-color color) (setq cj/-cursor-last-color color cj/-cursor-last-buffer (buffer-name))))))) diff --git a/modules/user-constants.el b/modules/user-constants.el index 2e64b355e..1ee8ecda3 100644 --- a/modules/user-constants.el +++ b/modules/user-constants.el @@ -55,13 +55,44 @@ mail, chime, etc." ;; ---------------------------- Buffer Status Colors --------------------------- -(defconst cj/buffer-status-colors - '((read-only . "#f06a3f") ; red – buffer is read-only - (overwrite . "#c48702") ; gold – overwrite mode - (modified . "#64aa0f") ; green – modified & writeable - (unmodified . "#ffffff")) ; white – unmodified & writeable - "Alist mapping buffer states to their colors. -Used by cursor color, modeline, and other UI elements.") +(defconst cj/buffer-status-faces + '((read-only . error) ; can't edit + (overwrite . warning) ; overwrite mode + (modified . warning) ; writeable, with unsaved changes + (unmodified . success)) ; clean and writeable + "Alist mapping a buffer state to the theme face whose foreground colors it. +Shared by the cursor color (ui-config.el) and the modeline buffer-status +indicator (modeline-config.el) so the two stay in sync and follow the active +theme, rather than hard-coding hex colors.") + +(defun cj/buffer-status-state () + "Return the buffer-state symbol for the current buffer. +One of `read-only', `overwrite', `modified', or `unmodified' -- the keys of +`cj/buffer-status-faces'. + +A live ghostel terminal (in `ghostel-mode' and an input mode that forwards keys +-- semi-char / char / line) reports `unmodified' even though the buffer is +read-only: keystrokes go to the terminal process, so from the user's side it is +writeable and the read-only state would be misleading. ghostel's `copy' and +`emacs' input modes are the exception -- there the buffer really is a read-only +Emacs buffer the user navigates, so it falls through to `read-only'." + (cond + ((and (eq major-mode 'ghostel-mode) + (not (memq (bound-and-true-p ghostel--input-mode) '(copy emacs)))) + 'unmodified) + (buffer-read-only 'read-only) + (overwrite-mode 'overwrite) + ((buffer-modified-p) 'modified) + (t 'unmodified))) + +(defun cj/buffer-status-color (state) + "Return the foreground color of the theme face mapped to buffer STATE. +Resolves STATE through `cj/buffer-status-faces' against the active theme. Nil +when the state is unknown or its face has no concrete foreground (face-attribute +returns the symbol `unspecified' there), so callers can skip cleanly." + (when-let* ((face (alist-get state cj/buffer-status-faces)) + (fg (face-attribute face :foreground nil t))) + (and (stringp fg) fg))) ;; --------------------------- Media File Extensions --------------------------- diff --git a/tests/test-ui-buffer-status-colors.el b/tests/test-ui-buffer-status-colors.el index bb905ad4d..06e466b85 100644 --- a/tests/test-ui-buffer-status-colors.el +++ b/tests/test-ui-buffer-status-colors.el @@ -1,8 +1,11 @@ -;;; test-ui-buffer-status-colors.el --- Tests for buffer status colors -*- lexical-binding: t; -*- +;;; test-ui-buffer-status-colors.el --- Tests for buffer-status faces -*- lexical-binding: t; -*- ;;; Commentary: -;; Unit tests for buffer status color system. -;; Tests the state detection logic used by both cursor color and modeline. +;; The buffer-status state classifier (`cj/buffer-status-state'), the state->face +;; map (`cj/buffer-status-faces'), and the resolver (`cj/buffer-status-color') +;; drive both the cursor color and the modeline buffer-name color, kept in sync. +;; Theme faces (error / warning / success) replace the old hard-coded hexes so +;; the colors follow whatever theme is loaded. ;;; Code: @@ -11,211 +14,85 @@ (require 'ui-config) (require 'modeline-config) -;;; Color Constant Tests +;;; State -> face map -(ert-deftest test-buffer-status-colors-has-all-states () - "Test that all required states are defined in color alist." - (should (alist-get 'read-only cj/buffer-status-colors)) - (should (alist-get 'overwrite cj/buffer-status-colors)) - (should (alist-get 'modified cj/buffer-status-colors)) - (should (alist-get 'unmodified cj/buffer-status-colors))) +(ert-deftest test-buffer-status-faces-has-all-states () + "Normal: every buffer state is mapped to a face." + (dolist (state '(read-only overwrite modified unmodified)) + (should (alist-get state cj/buffer-status-faces)))) -(ert-deftest test-buffer-status-colors-values-are-strings () - "Test that all color values are strings (hex colors)." - (dolist (entry cj/buffer-status-colors) - (should (stringp (cdr entry))) - ;; Check if it looks like a hex color - (should (string-match-p "^#[0-9a-fA-F]\\{6\\}$" (cdr entry))))) +(ert-deftest test-buffer-status-faces-values-are-real-faces () + "Normal: every mapped value is an existing face." + (dolist (entry cj/buffer-status-faces) + (should (facep (cdr entry))))) -;;; Cursor Color State Detection Tests +(ert-deftest test-buffer-status-faces-mapping () + "Normal: read-only->error, overwrite/modified->warning, unmodified->success." + (should (eq (alist-get 'read-only cj/buffer-status-faces) 'error)) + (should (eq (alist-get 'overwrite cj/buffer-status-faces) 'warning)) + (should (eq (alist-get 'modified cj/buffer-status-faces) 'warning)) + (should (eq (alist-get 'unmodified cj/buffer-status-faces) 'success))) -(ert-deftest test-cursor-color-state-read-only-buffer () - "Test state detection for read-only buffer." +;;; State classifier (the shared function, exercised directly) + +(ert-deftest test-buffer-status-state-read-only () + "Normal: a read-only buffer reports `read-only'." (with-temp-buffer (setq buffer-read-only t) - (let* ((state (cond - (buffer-read-only 'read-only) - (overwrite-mode 'overwrite) - ((buffer-modified-p) 'modified) - (t 'unmodified)))) - (should (eq state 'read-only))))) - -(ert-deftest test-cursor-color-state-overwrite-mode () - "Test state detection for overwrite mode." + (should (eq (cj/buffer-status-state) 'read-only)))) + +(ert-deftest test-buffer-status-state-overwrite-wins-over-modified () + "Boundary: overwrite-mode takes priority over the modified state." (with-temp-buffer - (setq buffer-read-only nil) + (insert "x") (overwrite-mode 1) - (let* ((state (cond - (buffer-read-only 'read-only) - (overwrite-mode 'overwrite) - ((buffer-modified-p) 'modified) - (t 'unmodified)))) - (should (eq state 'overwrite))))) - -(ert-deftest test-cursor-color-state-modified-buffer () - "Test state detection for modified buffer." + (should (eq (cj/buffer-status-state) 'overwrite)))) + +(ert-deftest test-buffer-status-state-modified () + "Normal: a writeable buffer with unsaved changes reports `modified'." (with-temp-buffer - (setq buffer-read-only nil) - (insert "test") - (set-buffer-modified-p t) - (let* ((state (cond - (buffer-read-only 'read-only) - (overwrite-mode 'overwrite) - ((buffer-modified-p) 'modified) - (t 'unmodified)))) - (should (eq state 'modified))))) - -(ert-deftest test-cursor-color-state-unmodified-buffer () - "Test state detection for unmodified buffer." + (insert "x") + (should (eq (cj/buffer-status-state) 'modified)))) + +(ert-deftest test-buffer-status-state-unmodified () + "Normal: a clean writeable buffer reports `unmodified'." (with-temp-buffer - (setq buffer-read-only nil) (set-buffer-modified-p nil) - (let* ((state (cond - (buffer-read-only 'read-only) - (overwrite-mode 'overwrite) - ((buffer-modified-p) 'modified) - (t 'unmodified)))) - (should (eq state 'unmodified))))) - -(ert-deftest test-cursor-color-state-priority-read-only-over-modified () - "Test that read-only state takes priority over modified state." + (should (eq (cj/buffer-status-state) 'unmodified)))) + +(ert-deftest test-buffer-status-state-read-only-wins-over-modified () + "Boundary: read-only takes priority over modified." (with-temp-buffer - (insert "test") + (insert "x") (set-buffer-modified-p t) (setq buffer-read-only t) - (let* ((state (cond - (buffer-read-only 'read-only) - (overwrite-mode 'overwrite) - ((buffer-modified-p) 'modified) - (t 'unmodified)))) - (should (eq state 'read-only))))) - -(ert-deftest test-cursor-color-state-priority-overwrite-over-modified () - "Test that overwrite mode takes priority over modified state." - (with-temp-buffer - (insert "test") - (set-buffer-modified-p t) - (overwrite-mode 1) - (let* ((state (cond - (buffer-read-only 'read-only) - (overwrite-mode 'overwrite) - ((buffer-modified-p) 'modified) - (t 'unmodified)))) - (should (eq state 'overwrite))))) + (should (eq (cj/buffer-status-state) 'read-only)))) -;;; Integration Tests - Cursor Color Function +;;; Resolver -(ert-deftest test-cursor-color-function-exists () - "Test that cursor color function is defined." - (should (fboundp 'cj/set-cursor-color-according-to-mode))) +(ert-deftest test-buffer-status-color-resolves-through-the-face () + "Normal: the color is the mapped face's foreground." + (let ((orig (face-attribute 'error :foreground nil t))) + (unwind-protect + (progn + (set-face-foreground 'error "#abcdef") + (should (equal (cj/buffer-status-color 'read-only) "#abcdef"))) + (when (stringp orig) (set-face-foreground 'error orig))))) -(ert-deftest test-cursor-color-returns-correct-color-for-read-only () - "Test cursor color function returns red for read-only buffer." - (with-temp-buffer - (setq buffer-read-only t) - (let* ((state (cond - (buffer-read-only 'read-only) - (overwrite-mode 'overwrite) - ((buffer-modified-p) 'modified) - (t 'unmodified))) - (color (alist-get state cj/buffer-status-colors))) - (should (equal color "#f06a3f"))))) - -(ert-deftest test-cursor-color-returns-correct-color-for-overwrite () - "Test cursor color function returns gold for overwrite mode." - (with-temp-buffer - (overwrite-mode 1) - (let* ((state (cond - (buffer-read-only 'read-only) - (overwrite-mode 'overwrite) - ((buffer-modified-p) 'modified) - (t 'unmodified))) - (color (alist-get state cj/buffer-status-colors))) - (should (equal color "#c48702"))))) - -(ert-deftest test-cursor-color-returns-correct-color-for-modified () - "Test cursor color function returns green for modified buffer." - (with-temp-buffer - (insert "test") - (set-buffer-modified-p t) - (let* ((state (cond - (buffer-read-only 'read-only) - (overwrite-mode 'overwrite) - ((buffer-modified-p) 'modified) - (t 'unmodified))) - (color (alist-get state cj/buffer-status-colors))) - (should (equal color "#64aa0f"))))) - -(ert-deftest test-cursor-color-returns-correct-color-for-unmodified () - "Test cursor color function returns white for unmodified buffer." - (with-temp-buffer - (set-buffer-modified-p nil) - (let* ((state (cond - (buffer-read-only 'read-only) - (overwrite-mode 'overwrite) - ((buffer-modified-p) 'modified) - (t 'unmodified))) - (color (alist-get state cj/buffer-status-colors))) - (should (equal color "#ffffff"))))) +(ert-deftest test-buffer-status-color-nil-for-unknown-state () + "Error: an unknown state has no face, so no color." + (should-not (cj/buffer-status-color 'nonexistent))) -;;; Modeline Integration Tests +;;; Modeline integration (ert-deftest test-modeline-buffer-name-variable-exists () - "Test that modeline buffer name variable is defined." + "Normal: the modeline buffer-name construct is defined." (should (boundp 'cj/modeline-buffer-name))) (ert-deftest test-modeline-buffer-name-is-mode-line-construct () - "Test that modeline buffer name is a valid mode-line construct." + "Normal: it is an :eval mode-line construct." (should (listp cj/modeline-buffer-name)) (should (eq (car cj/modeline-buffer-name) :eval))) -;;; Edge Cases - -(ert-deftest test-buffer-status-new-buffer-starts-unmodified () - "Test that new buffer starts in unmodified state." - (with-temp-buffer - (let* ((state (cond - (buffer-read-only 'read-only) - (overwrite-mode 'overwrite) - ((buffer-modified-p) 'modified) - (t 'unmodified)))) - (should (eq state 'unmodified))))) - -(ert-deftest test-buffer-status-insert-makes-modified () - "Test that inserting text changes state to modified." - (with-temp-buffer - ;; Initially unmodified - (set-buffer-modified-p nil) - (let ((state1 (cond - (buffer-read-only 'read-only) - (overwrite-mode 'overwrite) - ((buffer-modified-p) 'modified) - (t 'unmodified)))) - (should (eq state1 'unmodified))) - - ;; Insert text - (insert "test") - (let ((state2 (cond - (buffer-read-only 'read-only) - (overwrite-mode 'overwrite) - ((buffer-modified-p) 'modified) - (t 'unmodified)))) - (should (eq state2 'modified))))) - -(ert-deftest test-buffer-status-explicit-unmodify () - "Test that explicitly setting unmodified works." - (with-temp-buffer - (insert "test") - (should (buffer-modified-p)) - - ;; Explicitly set unmodified - (set-buffer-modified-p nil) - (let ((state (cond - (buffer-read-only 'read-only) - (overwrite-mode 'overwrite) - ((buffer-modified-p) 'modified) - (t 'unmodified)))) - (should (eq state 'unmodified))))) - (provide 'test-ui-buffer-status-colors) ;;; test-ui-buffer-status-colors.el ends here diff --git a/tests/test-ui-config--buffer-cursor-state.el b/tests/test-ui-config--buffer-cursor-state.el index 852865869..76b74c97f 100644 --- a/tests/test-ui-config--buffer-cursor-state.el +++ b/tests/test-ui-config--buffer-cursor-state.el @@ -1,7 +1,7 @@ ;;; test-ui-config--buffer-cursor-state.el --- Tests for cursor-state classification -*- lexical-binding: t; -*- ;;; Commentary: -;; `cj/--buffer-cursor-state' picks the buffer-state symbol that +;; `cj/buffer-status-state' picks the buffer-state symbol that ;; `cj/set-cursor-color-according-to-mode' maps to a cursor color via ;; `cj/buffer-status-colors'. The subtle case: a live ghostel terminal is ;; technically `buffer-read-only' but the user types into it -- keystrokes go @@ -26,26 +26,26 @@ "Normal: a clean writeable buffer reports `unmodified'." (with-temp-buffer (set-buffer-modified-p nil) - (should (eq (cj/--buffer-cursor-state) 'unmodified)))) + (should (eq (cj/buffer-status-state) 'unmodified)))) (ert-deftest test-ui-config-buffer-cursor-state-readwrite-modified () "Normal: a writeable buffer with unsaved changes reports `modified'." (with-temp-buffer (insert "x") - (should (eq (cj/--buffer-cursor-state) 'modified)))) + (should (eq (cj/buffer-status-state) 'modified)))) (ert-deftest test-ui-config-buffer-cursor-state-read-only () "Normal: a plain read-only buffer reports `read-only'." (with-temp-buffer (setq buffer-read-only t) - (should (eq (cj/--buffer-cursor-state) 'read-only)))) + (should (eq (cj/buffer-status-state) 'read-only)))) (ert-deftest test-ui-config-buffer-cursor-state-overwrite () "Boundary: `overwrite-mode' wins over the modified/unmodified split." (with-temp-buffer (insert "x") (overwrite-mode 1) - (should (eq (cj/--buffer-cursor-state) 'overwrite)))) + (should (eq (cj/buffer-status-state) 'overwrite)))) (ert-deftest test-ui-config-buffer-cursor-state-live-ghostel-is-writeable () "Boundary: a live ghostel buffer is `buffer-read-only' but reports a @@ -56,7 +56,7 @@ read-only (orange) cursor would be misleading." (with-current-buffer buf (setq buffer-read-only t) ; ghostel keeps the buffer read-only (setq-local ghostel--input-mode 'semi-char) - (should-not (eq (cj/--buffer-cursor-state) 'read-only))) + (should-not (eq (cj/buffer-status-state) 'read-only))) (when (buffer-live-p buf) (kill-buffer buf))))) (ert-deftest test-ui-config-buffer-cursor-state-ghostel-copy-mode-is-read-only () @@ -67,29 +67,36 @@ the user navigates, so `read-only' (orange) is kept." (with-current-buffer buf (setq buffer-read-only t) (setq-local ghostel--input-mode 'copy) - (should (eq (cj/--buffer-cursor-state) 'read-only))) + (should (eq (cj/buffer-status-state) 'read-only))) (when (buffer-live-p buf) (kill-buffer buf))))) -(ert-deftest test-ui-config-set-cursor-color-live-ghostel-not-orange () - "Normal: in a live ghostel terminal the cursor-color hook picks a writeable -color, not the read-only orange -- even though the buffer is read-only. -`display-graphic-p' is stubbed t so the function reaches its work body in -batch mode (the live function no-ops on TTY frames by design)." +(ert-deftest test-ui-config-set-cursor-color-live-ghostel-uses-writeable-color () + "Normal: in a live ghostel terminal the cursor-color hook applies the writeable +\(success) color, not the read-only (error) color, even though the buffer is +read-only. `error' and `success' are given known foregrounds so the resolver +returns concrete colors; `display-graphic-p' is stubbed t so the body runs in +batch (the live function no-ops on TTY frames by design)." (let ((buf (cj/test--make-fake-ghostel-buffer "*test-ghostel-cursor-color*")) + (orig-err (face-attribute 'error :foreground nil t)) + (orig-suc (face-attribute 'success :foreground nil t)) (applied 'unset)) (unwind-protect - (with-current-buffer buf - (setq buffer-read-only t) - (setq-local ghostel--input-mode 'semi-char) - (let ((cj/-cursor-last-color nil) - (cj/-cursor-last-buffer nil)) - (cl-letf (((symbol-function 'display-graphic-p) (lambda () t)) - ((symbol-function 'set-cursor-color) - (lambda (c) (setq applied c)))) - (cj/set-cursor-color-according-to-mode))) - (should (stringp applied)) - (should-not (equal applied - (alist-get 'read-only cj/buffer-status-colors)))) + (progn + (set-face-foreground 'error "#ff0000") + (set-face-foreground 'success "#00ff00") + (with-current-buffer buf + (setq buffer-read-only t) + (setq-local ghostel--input-mode 'semi-char) + (let ((cj/-cursor-last-color nil) + (cj/-cursor-last-buffer nil)) + (cl-letf (((symbol-function 'display-graphic-p) (lambda () t)) + ((symbol-function 'set-cursor-color) + (lambda (c) (setq applied c)))) + (cj/set-cursor-color-according-to-mode)))) + (should (equal applied "#00ff00")) + (should-not (equal applied "#ff0000"))) + (when (stringp orig-err) (set-face-foreground 'error orig-err)) + (when (stringp orig-suc) (set-face-foreground 'success orig-suc)) (when (buffer-live-p buf) (kill-buffer buf))))) (provide 'test-ui-config--buffer-cursor-state) diff --git a/tests/test-ui-cursor-color-integration.el b/tests/test-ui-cursor-color-integration.el index c28bde923..0c2b4df86 100644 --- a/tests/test-ui-cursor-color-integration.el +++ b/tests/test-ui-cursor-color-integration.el @@ -1,27 +1,44 @@ ;;; test-ui-cursor-color-integration.el --- Integration tests for cursor color -*- lexical-binding: t; -*- ;;; Commentary: -;; Integration tests for cursor color hook behavior. -;; Tests that cursor color actually updates when switching buffers, -;; modifying files, etc. +;; Integration tests for the cursor-color hook. The cursor color now comes from +;; the active theme's faces (error / warning / success) via +;; `cj/buffer-status-color', not hard-coded hexes, so these tests pin those three +;; faces to known foregrounds and assert the resolved color per buffer state: +;; read-only -> error, unmodified -> success, modified/overwrite -> warning. ;;; Code: (require 'ert) (require 'user-constants) -;; `cj/set-cursor-color-according-to-mode' and the `post-command-hook' -;; install both gate on `display-graphic-p' -- a TTY / batch run is a -;; no-op for cursor coloring by design. These integration tests -;; exercise the work body, so we pretend we're in a graphical session -;; for the whole file. Stubbing the symbol BEFORE loading ui-config -;; matters because the hook install reads `display-graphic-p' at load -;; time. +;; `cj/set-cursor-color-according-to-mode' and the `post-command-hook' install +;; both gate on `display-graphic-p' -- a TTY / batch run is a no-op by design. +;; These integration tests exercise the work body, so pretend we're graphical +;; for the whole file. Stub BEFORE loading ui-config: the hook install reads +;; `display-graphic-p' at load time. (advice-add 'display-graphic-p :around (lambda (orig &rest args) (or (apply orig args) t))) (require 'ui-config) +(defmacro test-cursor--with-status-colors (&rest body) + "Run BODY with error/success/warning foregrounds pinned to known hexes. +read-only -> error #ff0000, unmodified -> success #00ff00, +modified/overwrite -> warning #ffaa00. Restores the originals after." + `(let ((oe (face-attribute 'error :foreground nil t)) + (os (face-attribute 'success :foreground nil t)) + (ow (face-attribute 'warning :foreground nil t))) + (unwind-protect + (progn + (set-face-foreground 'error "#ff0000") + (set-face-foreground 'success "#00ff00") + (set-face-foreground 'warning "#ffaa00") + ,@body) + (when (stringp oe) (set-face-foreground 'error oe)) + (when (stringp os) (set-face-foreground 'success os)) + (when (stringp ow) (set-face-foreground 'warning ow))))) + ;;; Hook Integration Tests (ert-deftest test-cursor-color-integration-post-command-hook-installed () @@ -30,20 +47,16 @@ (ert-deftest test-cursor-color-integration-function-runs-without-error () "Test that cursor color function runs without error in various buffers." - (with-temp-buffer - (should-not (condition-case err - (progn - (cj/set-cursor-color-according-to-mode) - nil) - (error err)))) - - (with-temp-buffer - (setq buffer-read-only t) - (should-not (condition-case err - (progn - (cj/set-cursor-color-according-to-mode) - nil) - (error err))))) + (test-cursor--with-status-colors + (with-temp-buffer + (should-not (condition-case err + (progn (cj/set-cursor-color-according-to-mode) nil) + (error err)))) + (with-temp-buffer + (setq buffer-read-only t) + (should-not (condition-case err + (progn (cj/set-cursor-color-according-to-mode) nil) + (error err)))))) (ert-deftest test-cursor-color-integration-internal-buffers-ignored () "Test that internal buffers (starting with space) are ignored." @@ -53,123 +66,117 @@ (unwind-protect (with-current-buffer internal-buf (cj/set-cursor-color-according-to-mode) - ;; Cursor state should not have been updated (should-not cj/-cursor-last-buffer)) (kill-buffer internal-buf)))) (ert-deftest test-cursor-color-integration-normal-buffers-processed () "Test that normal buffers (not starting with space) are processed." - (let ((normal-buf (get-buffer-create "test-normal")) - (cj/-cursor-last-color nil) - (cj/-cursor-last-buffer nil)) - (unwind-protect - (with-current-buffer normal-buf - (cj/set-cursor-color-according-to-mode) - ;; Cursor state should have been updated - (should (equal cj/-cursor-last-buffer "test-normal"))) - (kill-buffer normal-buf)))) + (test-cursor--with-status-colors + (let ((normal-buf (get-buffer-create "test-normal")) + (cj/-cursor-last-color nil) + (cj/-cursor-last-buffer nil)) + (unwind-protect + (with-current-buffer normal-buf + (cj/set-cursor-color-according-to-mode) + (should (equal cj/-cursor-last-buffer "test-normal"))) + (kill-buffer normal-buf))))) (ert-deftest test-cursor-color-integration-cache-prevents-redundant-updates () - "Test that cache prevents redundant cursor color updates." - (let* ((normal-buf (generate-new-buffer "test-cache")) - (call-count 0) - (advice-fn (lambda (&rest _) (setq call-count (1+ call-count))))) - (unwind-protect - (progn - (advice-add 'set-cursor-color :before advice-fn) - (with-current-buffer normal-buf - ;; First call - cache matches, no update - (let ((cj/-cursor-last-color "#ffffff") - (cj/-cursor-last-buffer (buffer-name))) - (cj/set-cursor-color-according-to-mode) - (should (= call-count 0))) ; Cached, no update needed - - ;; Modify buffer and clear cache - should update - (insert "test") - (let ((cj/-cursor-last-buffer nil)) ; Force update - (cj/set-cursor-color-according-to-mode) - (should (= call-count 1))))) ; New state, should update - (advice-remove 'set-cursor-color advice-fn) - (kill-buffer normal-buf)))) + "Test that the cache prevents redundant cursor color updates." + (test-cursor--with-status-colors + (let* ((normal-buf (generate-new-buffer "test-cache")) + (call-count 0) + (advice-fn (lambda (&rest _) (setq call-count (1+ call-count))))) + (unwind-protect + (progn + (advice-add 'set-cursor-color :before advice-fn) + (with-current-buffer normal-buf + ;; Clean buffer -> success (#00ff00); seed the cache with that color + ;; and this buffer so the call is a no-op. + (set-buffer-modified-p nil) + (let ((cj/-cursor-last-color "#00ff00") + (cj/-cursor-last-buffer (buffer-name))) + (cj/set-cursor-color-according-to-mode) + (should (= call-count 0))) + ;; Modify -> warning (#ffaa00); clear the buffer cache to force update. + (insert "test") + (let ((cj/-cursor-last-color "#00ff00") + (cj/-cursor-last-buffer nil)) + (cj/set-cursor-color-according-to-mode) + (should (= call-count 1))))) + (advice-remove 'set-cursor-color advice-fn) + (kill-buffer normal-buf))))) (ert-deftest test-cursor-color-integration-different-buffers-different-colors () - "Test that switching between buffers with different states updates cursor." - (let ((buf1 (generate-new-buffer "test1")) - (buf2 (generate-new-buffer "test2")) - (cj/-cursor-last-color nil) - (cj/-cursor-last-buffer nil)) - (unwind-protect - (progn - ;; Set buf1 to read-only - (with-current-buffer buf1 - (setq buffer-read-only t) - (cj/set-cursor-color-according-to-mode) - (should (equal cj/-cursor-last-color "#f06a3f"))) ; Red - - ;; Set buf2 to normal - (with-current-buffer buf2 - (setq buffer-read-only nil) - (set-buffer-modified-p nil) - (cj/set-cursor-color-according-to-mode) - (should (equal cj/-cursor-last-color "#ffffff")))) ; White - (kill-buffer buf1) - (kill-buffer buf2)))) + "Test that buffers in different states resolve to different theme colors." + (test-cursor--with-status-colors + (let ((buf1 (generate-new-buffer "test1")) + (buf2 (generate-new-buffer "test2")) + (cj/-cursor-last-color nil) + (cj/-cursor-last-buffer nil)) + (unwind-protect + (progn + (with-current-buffer buf1 + (setq buffer-read-only t) + (cj/set-cursor-color-according-to-mode) + (should (equal cj/-cursor-last-color "#ff0000"))) ; read-only -> error + (with-current-buffer buf2 + (setq buffer-read-only nil) + (set-buffer-modified-p nil) + (cj/set-cursor-color-according-to-mode) + (should (equal cj/-cursor-last-color "#00ff00")))) ; unmodified -> success + (kill-buffer buf1) + (kill-buffer buf2))))) (ert-deftest test-cursor-color-integration-buffer-modification-changes-color () - "Test that modifying a buffer changes cursor from white to green." - (let ((normal-buf (generate-new-buffer "test-mod")) - (cj/-cursor-last-color nil) - (cj/-cursor-last-buffer nil)) - (unwind-protect - (with-current-buffer normal-buf - ;; Start unmodified - (set-buffer-modified-p nil) - (cj/set-cursor-color-according-to-mode) - (should (equal cj/-cursor-last-color "#ffffff")) ; White - - ;; Modify buffer - (insert "test") - (should (buffer-modified-p)) - ;; Reset last buffer to force update - (setq cj/-cursor-last-buffer nil) - (cj/set-cursor-color-according-to-mode) - (should (equal cj/-cursor-last-color "#64aa0f"))) ; Green - (kill-buffer normal-buf)))) + "Test that modifying a buffer moves the cursor from success to warning." + (test-cursor--with-status-colors + (let ((normal-buf (generate-new-buffer "test-mod")) + (cj/-cursor-last-color nil) + (cj/-cursor-last-buffer nil)) + (unwind-protect + (with-current-buffer normal-buf + (set-buffer-modified-p nil) + (cj/set-cursor-color-according-to-mode) + (should (equal cj/-cursor-last-color "#00ff00")) ; unmodified -> success + (insert "test") + (should (buffer-modified-p)) + (setq cj/-cursor-last-buffer nil) + (cj/set-cursor-color-according-to-mode) + (should (equal cj/-cursor-last-color "#ffaa00"))) ; modified -> warning + (kill-buffer normal-buf))))) (ert-deftest test-cursor-color-integration-save-changes-color-back () - "Test that saving a modified buffer changes cursor from green to white." - (let ((test-file (make-temp-file "test-cursor-")) - (cj/-cursor-last-color nil) - (cj/-cursor-last-buffer nil)) - (unwind-protect - (progn - ;; Create and modify file - (with-current-buffer (find-file-noselect test-file) - (insert "test") - (should (buffer-modified-p)) - (cj/set-cursor-color-according-to-mode) - (should (equal cj/-cursor-last-color "#64aa0f")) ; Green - - ;; Save file - (save-buffer) - (should-not (buffer-modified-p)) - (cj/set-cursor-color-according-to-mode) - (should (equal cj/-cursor-last-color "#ffffff")) ; White - (kill-buffer))) - (delete-file test-file)))) + "Test that saving a modified buffer moves the cursor from warning to success." + (test-cursor--with-status-colors + (let ((test-file (make-temp-file "test-cursor-")) + (cj/-cursor-last-color nil) + (cj/-cursor-last-buffer nil)) + (unwind-protect + (with-current-buffer (find-file-noselect test-file) + (insert "test") + (should (buffer-modified-p)) + (cj/set-cursor-color-according-to-mode) + (should (equal cj/-cursor-last-color "#ffaa00")) ; modified -> warning + (save-buffer) + (should-not (buffer-modified-p)) + (setq cj/-cursor-last-buffer nil) + (cj/set-cursor-color-according-to-mode) + (should (equal cj/-cursor-last-color "#00ff00")) ; unmodified -> success + (kill-buffer)) + (delete-file test-file))))) ;;; Performance Tests (ert-deftest test-cursor-color-integration-multiple-calls-efficient () "Test that multiple rapid calls don't cause performance issues." - (with-temp-buffer - (let ((start-time (current-time))) - ;; Call 1000 times - (dotimes (_ 1000) - (cj/set-cursor-color-according-to-mode)) - (let ((elapsed (float-time (time-subtract (current-time) start-time)))) - ;; Should complete in less than 1 second (cache makes this very fast) - (should (< elapsed 1.0)))))) + (test-cursor--with-status-colors + (with-temp-buffer + (let ((start-time (current-time))) + (dotimes (_ 1000) + (cj/set-cursor-color-according-to-mode)) + (let ((elapsed (float-time (time-subtract (current-time) start-time)))) + (should (< elapsed 1.0))))))) (provide 'test-ui-cursor-color-integration) ;;; test-ui-cursor-color-integration.el ends here |