diff options
| -rw-r--r-- | modules/modeline-config.el | 117 | ||||
| -rw-r--r-- | tests/test-modeline-config-vc-cache.el | 102 |
2 files changed, 196 insertions, 23 deletions
diff --git a/modules/modeline-config.el b/modules/modeline-config.el index 6573671a..7fc75594 100644 --- a/modules/modeline-config.el +++ b/modules/modeline-config.el @@ -32,6 +32,16 @@ :type 'natnum :group 'modeline) +(defcustom cj/modeline-vc-cache-ttl 5 + "Seconds to reuse cached VC branch and state in the modeline." + :type 'number + :group 'modeline) + +(defcustom cj/modeline-vc-show-remote nil + "When non-nil, show VC branch and state for remote files." + :type 'boolean + :group 'modeline) + ;; -------------------------- Helper Functions --------------------------------- (defun cj/modeline-window-narrow-p () @@ -95,31 +105,89 @@ Uses built-in cached values for performance.") (up-to-date . vc-up-to-date-state)) "VC state to face mapping.") +(defvar-local cj/modeline-vc-cache-key nil + "Cache key for the current buffer's modeline VC data.") + +(defvar-local cj/modeline-vc-cache-time nil + "Timestamp for the current buffer's modeline VC cache.") + +(defvar-local cj/modeline-vc-cache-value nil + "Cached modeline VC plist for the current buffer.") + +(defvar-local cj/modeline-vc-cache-set-p nil + "Non-nil when the current buffer's modeline VC cache has a value.") + +(defun cj/modeline-vc-file () + "Return the file or directory to inspect for VC modeline data." + (or buffer-file-name default-directory)) + +(defun cj/modeline-vc-cache-clear () + "Clear cached VC modeline data for the current buffer." + (setq cj/modeline-vc-cache-key nil + cj/modeline-vc-cache-time nil + cj/modeline-vc-cache-value nil + cj/modeline-vc-cache-set-p nil)) + +(defun cj/modeline-vc-cache-key (file) + "Return the cache key for FILE." + (list file cj/modeline-vc-show-remote)) + +(defun cj/modeline-vc-cache-valid-p (key now) + "Return non-nil when cached VC data is valid for KEY at NOW." + (and cj/modeline-vc-cache-set-p + cj/modeline-vc-cache-time + (equal key cj/modeline-vc-cache-key) + (<= (- now cj/modeline-vc-cache-time) cj/modeline-vc-cache-ttl))) + +(defun cj/modeline-vc-fetch (file) + "Fetch modeline VC data for FILE. +Return a plist with `:branch' and `:state', or nil when FILE has no VC data." + (unless (and (file-remote-p file) (not cj/modeline-vc-show-remote)) + (when-let* ((backend (vc-backend file)) + (branch (vc-working-revision file backend))) + (when (eq backend 'Git) + (unless (fboundp 'vc-git--symbolic-ref) + (require 'vc-git)) + (when-let* ((symbolic (vc-git--symbolic-ref file))) + (setq branch symbolic))) + (list :branch branch + :state (vc-state file backend))))) + +(defun cj/modeline-vc-info () + "Return cached modeline VC data for the current buffer." + (when-let* ((file (cj/modeline-vc-file))) + (unless (and (file-remote-p file) (not cj/modeline-vc-show-remote)) + (let* ((now (float-time)) + (key (cj/modeline-vc-cache-key file))) + (if (cj/modeline-vc-cache-valid-p key now) + cj/modeline-vc-cache-value + (setq cj/modeline-vc-cache-key key + cj/modeline-vc-cache-time now + cj/modeline-vc-cache-value (cj/modeline-vc-fetch file) + cj/modeline-vc-cache-set-p t) + cj/modeline-vc-cache-value))))) + +(defun cj/modeline-vc-render (info) + "Render modeline VC INFO plist." + (when-let* ((branch (plist-get info :branch))) + (let* ((state (plist-get info :state)) + (face (alist-get state cj/modeline-vc-faces 'vc-up-to-date-state)) + (truncated-branch (cj/modeline-string-cut-middle branch))) + (concat + (propertize (char-to-string #xE0A0) 'face 'shadow) + " " + (propertize truncated-branch + 'face face + 'mouse-face 'mode-line-highlight + 'help-echo (format "Branch: %s\nState: %s\nmouse-1: vc-diff\nmouse-3: vc-root-diff" branch state) + 'local-map (let ((map (make-sparse-keymap))) + (define-key map [mode-line mouse-1] 'vc-diff) + (define-key map [mode-line mouse-3] 'vc-root-diff) + map)))))) + (defvar-local cj/modeline-vc-branch '(:eval (when (mode-line-window-selected-p) ; Only show in active window - (when-let* ((file (or buffer-file-name default-directory)) - (backend (vc-backend file))) - (when-let* ((branch (vc-working-revision file backend))) - ;; For Git, try to get symbolic branch name - (when (eq backend 'Git) - (require 'vc-git) - (when-let* ((symbolic (vc-git--symbolic-ref file))) - (setq branch symbolic))) - ;; Get VC state for face - (let* ((state (vc-state file backend)) - (face (alist-get state cj/modeline-vc-faces 'vc-up-to-date-state)) - (truncated-branch (cj/modeline-string-cut-middle branch))) - (concat - (propertize (char-to-string #xE0A0) 'face 'shadow) ; Git branch symbol - " " - (propertize truncated-branch - 'face face - 'mouse-face 'mode-line-highlight - 'help-echo (format "Branch: %s\nState: %s\nmouse-1: vc-diff\nmouse-3: vc-root-diff" branch state) - 'local-map (let ((map (make-sparse-keymap))) - (define-key map [mode-line mouse-1] 'vc-diff) - (define-key map [mode-line mouse-3] 'vc-root-diff) - map)))))))) + (cj/modeline-vc-render (cj/modeline-vc-info)))) "Git branch with symbol and colored by VC state. Shows only in active window. Truncates in narrow windows. Click to show diffs with `vc-diff' or `vc-root-diff'.") @@ -144,6 +212,9 @@ Click to show help with `describe-mode'.") "Misc info (chime notifications, etc). Shows only in active window.") +(add-hook 'after-save-hook #'cj/modeline-vc-cache-clear) +(add-hook 'after-revert-hook #'cj/modeline-vc-cache-clear) + ;; -------------------------- Modeline Assembly -------------------------------- (setq-default mode-line-format diff --git a/tests/test-modeline-config-vc-cache.el b/tests/test-modeline-config-vc-cache.el new file mode 100644 index 00000000..b6aafbfb --- /dev/null +++ b/tests/test-modeline-config-vc-cache.el @@ -0,0 +1,102 @@ +;;; test-modeline-config-vc-cache.el --- Tests for modeline VC cache -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for the custom modeline VC helper behavior. The modeline evaluates +;; often, so expensive VC calls should be cached and remote files should be +;; skipped by default. + +;;; Code: + +(require 'ert) +(require 'cl-lib) + +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) + +(require 'modeline-config) + +(ert-deftest test-modeline-config-vc-info-caches-per-buffer () + "Repeated VC info reads in one buffer should reuse the cache." + (let ((cj/modeline-vc-cache-ttl 60) + (backend-calls 0)) + (with-temp-buffer + (setq buffer-file-name "/tmp/project/file.el") + (cl-letf (((symbol-function 'float-time) + (lambda (&optional _time) 100.0)) + ((symbol-function 'file-remote-p) + (lambda (&rest _args) nil)) + ((symbol-function 'vc-backend) + (lambda (_file) (cl-incf backend-calls) 'Git)) + ((symbol-function 'vc-working-revision) + (lambda (_file _backend) "main-revision")) + ((symbol-function 'vc-git--symbolic-ref) + (lambda (_file) "main")) + ((symbol-function 'vc-state) + (lambda (_file _backend) 'edited))) + (should (equal (cj/modeline-vc-info) + '(:branch "main" :state edited))) + (should (equal (cj/modeline-vc-info) + '(:branch "main" :state edited))) + (should (= backend-calls 1)))))) + +(ert-deftest test-modeline-config-vc-info-refreshes-after-ttl () + "Expired VC cache entries should be refreshed." + (let ((cj/modeline-vc-cache-ttl 5) + (backend-calls 0) + (times '(100.0 106.0))) + (with-temp-buffer + (setq buffer-file-name "/tmp/project/file.el") + (cl-letf (((symbol-function 'float-time) + (lambda (&optional _time) (or (pop times) 106.0))) + ((symbol-function 'file-remote-p) + (lambda (&rest _args) nil)) + ((symbol-function 'vc-backend) + (lambda (_file) (cl-incf backend-calls) 'Git)) + ((symbol-function 'vc-working-revision) + (lambda (_file _backend) "main-revision")) + ((symbol-function 'vc-git--symbolic-ref) + (lambda (_file) "main")) + ((symbol-function 'vc-state) + (lambda (_file _backend) 'up-to-date))) + (should (equal (cj/modeline-vc-info) + '(:branch "main" :state up-to-date))) + (should (equal (cj/modeline-vc-info) + '(:branch "main" :state up-to-date))) + (should (= backend-calls 2)))))) + +(ert-deftest test-modeline-config-vc-info-skips-remote-files-by-default () + "Remote files should not call VC unless explicitly enabled." + (let ((backend-calls 0)) + (with-temp-buffer + (setq buffer-file-name "/ssh:host:/tmp/project/file.el") + (cl-letf (((symbol-function 'file-remote-p) + (lambda (&rest _args) t)) + ((symbol-function 'vc-backend) + (lambda (_file) (cl-incf backend-calls) 'Git))) + (should-not (cj/modeline-vc-info)) + (should (= backend-calls 0)))))) + +(ert-deftest test-modeline-config-vc-cache-clear-resets-buffer-cache () + "Clearing the VC cache should remove buffer-local cached values." + (with-temp-buffer + (setq cj/modeline-vc-cache-key '("/tmp/project/file.el") + cj/modeline-vc-cache-time 100.0 + cj/modeline-vc-cache-value '(:branch "main" :state edited)) + (cj/modeline-vc-cache-clear) + (should-not cj/modeline-vc-cache-key) + (should-not cj/modeline-vc-cache-time) + (should-not cj/modeline-vc-cache-value))) + +(ert-deftest test-modeline-config-vc-render-formats-branch-and-state () + "VC rendering should keep the branch text and state face metadata." + (cl-letf (((symbol-function 'cj/modeline-string-cut-middle) + (lambda (str) str))) + (let ((rendered (cj/modeline-vc-render '(:branch "feature/cache" + :state edited)))) + (should (string-match-p "feature/cache" rendered)) + (should (text-property-any 0 (length rendered) + 'face 'vc-edited-state rendered)) + (should (text-property-any 0 (length rendered) + 'mouse-face 'mode-line-highlight rendered))))) + +(provide 'test-modeline-config-vc-cache) +;;; test-modeline-config-vc-cache.el ends here |