diff options
| -rw-r--r-- | modules/ui-config.el | 29 | ||||
| -rw-r--r-- | tests/test-ui-config--buffer-cursor-state.el | 93 |
2 files changed, 116 insertions, 6 deletions
diff --git a/modules/ui-config.el b/modules/ui-config.el index 775aefb2..f9fddb0d 100644 --- a/modules/ui-config.el +++ b/modules/ui-config.el @@ -96,17 +96,34 @@ When `cj/enable-transparency' is nil, reset alpha to fully opaque." (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 vterm buffer (in `vterm-mode' but NOT `vterm-copy-mode') +reports `unmodified' even though `vterm-mode' sets `buffer-read-only': +keystrokes there go to the terminal process, so from the user's side +the buffer is writeable, and the read-only (orange) cursor would be +misleading. `vterm-copy-mode' is 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 'vterm-mode) + (not (bound-and-true-p vterm-copy-mode))) + '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." ;; 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* ((state (cond - (buffer-read-only 'read-only) - (overwrite-mode 'overwrite) - ((buffer-modified-p) 'modified) - (t 'unmodified))) - (color (alist-get state cj/buffer-status-colors))) + (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) diff --git a/tests/test-ui-config--buffer-cursor-state.el b/tests/test-ui-config--buffer-cursor-state.el new file mode 100644 index 00000000..add0d030 --- /dev/null +++ b/tests/test-ui-config--buffer-cursor-state.el @@ -0,0 +1,93 @@ +;;; 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/set-cursor-color-according-to-mode' maps to a cursor color via +;; `cj/buffer-status-colors'. The subtle case: a live vterm buffer is +;; technically `buffer-read-only' (the `vterm-mode' body sets it) but the +;; user can type into it -- keystrokes go to the terminal process -- so it +;; must report a writeable state, not `read-only'. `vterm-copy-mode' is +;; the exception: there the buffer really is a read-only Emacs buffer the +;; user navigates, so `read-only' (the orange cursor) is correct and kept. + +;;; Code: + +(require 'ert) +(require 'cl-lib) + +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(add-to-list 'load-path (expand-file-name "tests" user-emacs-directory)) +(setq load-prefer-newer t) +(defvar vterm-copy-mode nil) +(require 'ui-config) +(require 'testutil-vterm-buffers) + +(ert-deftest test-ui-config-buffer-cursor-state-readwrite-unmodified () + "Normal: a clean writeable buffer reports `unmodified'." + (with-temp-buffer + (set-buffer-modified-p nil) + (should (eq (cj/--buffer-cursor-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)))) + +(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)))) + +(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)))) + +(ert-deftest test-ui-config-buffer-cursor-state-live-vterm-is-writeable () + "Boundary: a live vterm buffer is `buffer-read-only' but reports a +writeable state -- the user types into the terminal process there, so the +read-only (orange) cursor would be misleading." + (let ((buf (cj/test--make-fake-vterm-buffer "*test-vterm-cursor-state*"))) + (unwind-protect + (with-current-buffer buf + (setq buffer-read-only t) ; `vterm-mode' does this + (setq-local vterm-copy-mode nil) + (should-not (eq (cj/--buffer-cursor-state) 'read-only))) + (when (buffer-live-p buf) (kill-buffer buf))))) + +(ert-deftest test-ui-config-buffer-cursor-state-vterm-copy-mode-is-read-only () + "Boundary: in `vterm-copy-mode' the vterm buffer is a read-only Emacs +buffer the user navigates, so `read-only' (orange) is kept." + (let ((buf (cj/test--make-fake-vterm-buffer "*test-vterm-cursor-state-copy*"))) + (unwind-protect + (with-current-buffer buf + (setq buffer-read-only t) + (setq-local vterm-copy-mode t) + (should (eq (cj/--buffer-cursor-state) 'read-only))) + (when (buffer-live-p buf) (kill-buffer buf))))) + +(ert-deftest test-ui-config-set-cursor-color-live-vterm-not-orange () + "Normal: in a live vterm the cursor-color hook picks a writeable color, +not the read-only orange -- even though the vterm buffer is read-only." + (let ((buf (cj/test--make-fake-vterm-buffer "*test-vterm-cursor-color*")) + (applied 'unset)) + (unwind-protect + (with-current-buffer buf + (setq buffer-read-only t) + (setq-local vterm-copy-mode nil) + (let ((cj/-cursor-last-color nil) + (cj/-cursor-last-buffer nil)) + (cl-letf (((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)))) + (when (buffer-live-p buf) (kill-buffer buf))))) + +(provide 'test-ui-config--buffer-cursor-state) +;;; test-ui-config--buffer-cursor-state.el ends here |