Do cache and timed invalidation in "VC-aware" project backend

* lisp/progmodes/project.el: Describe the new cache in Commentary,
the "VC-aware project" section.
(project-vc-cache-timeout)
(project-vc-non-essential-cache-timeout): New variables.
(project--get-cached, project--set-cached):
New functions.
(project-try-vc, project--value-in-dir): Use them.
(project--read-dir-locals): New function, extracted from the
above.  Return the full alist, to be saved to cache at once.
(project--clear-cache): New function.
(project-remember-projects-under)
(project-forget-zombie-projects, project-forget-projects-under):
Use it.
(project-uniquify-dirname-transform, project-mode-line-format):
Bind 'non-essential' to choose the longer caching strategy.
(project-name-cache-timeout, project-name-cached): Remove.
(project-mode-line-format): Switch to calling 'project-name'
directly, with the new caching in use.

Co-authored-by: Juri Linkov <juri@linkov.net>
This commit is contained in:
Dmitry Gutov 2026-02-10 02:50:17 +02:00
parent 8cb9aaec0f
commit 583a112169
3 changed files with 107 additions and 35 deletions

View file

@ -2323,6 +2323,10 @@ configuration (if any), excluding the ``ignored'' files from the output.
It has some performance optimizations for listing the files with some of
the popular VCS systems (currently Git and Mercurial).
It also uses a cache for some of the computations, for shorter or longer
periods of time, depending on whether it's being used from an
interactive command, or from non-essential code running in background.
@defopt project-vc-include-untracked
By default, files which are neither registered with nor ignored by the
VCS are considered part of the project. Customize this variable to nil

View file

@ -726,6 +726,11 @@ If the value of 'project-mode-line' is 'non-remote', project name and
the Project menu will be shown on the mode line only for projects with
local files.
*** The "VC-aware" project backend caches the current project and its name.
The duration for which the values are cached depends on whether it's
called from 'non-essential' context, and it determined by variables
'project-vc-cache-timeout' and 'project-vc-non-essential-cache-timeout'.
** Help
+++

View file

@ -84,6 +84,12 @@
;; This project type can also be used for non-VCS controlled
;; directories, see the variable `project-vc-extra-root-markers'.
;;
;; Some of the methods on this backend cache their computations for time
;; determined either by variable `project-vc-cache-timeout' or
;; `project-vc-non-essential-cache-timeout', depending on whether the
;; MAYBE-PROMPT argument to `project-current' is non-nil, or the value
;; of `non-essential' when project methods are called.
;;
;; Utils:
;;
;; `project-combine-directories' and `project-subtract-directories',
@ -587,16 +593,72 @@ project backend implementation of `project-external-roots'.")
See `project-vc-extra-root-markers' for the marker value format.")
;; FIXME: Should perhaps use `vc--repo-*prop' functions
;; (after promoting those to public). --spwhitton
(defvar project-vc-cache-timeout '((file-remote-p . nil)
(always . 2))
"Number of seconds to cache a value in VC-aware project methods.
It can be nil, a number, or an alist where
the key is a predicate, and the value is a number.
Set to nil to disable time-based expiration.")
(defvar project-vc-non-essential-cache-timeout '((file-remote-p . nil)
(always . 300))
"Number of seconds to cache non-essential information.
Unlike `project-vc-cache-timeout' intended for interactive
commands, this variable has much more aggressive caching,
and is intended for \"background\" things like `project-mode-line'
indicators and `project-uniquify-dirname-transform'.
It is used when `non-essential' is non-nil.")
(defun project--get-cached (dir key)
(let ((cached (vc-file-getprop dir key))
(current-time (float-time)))
(when (and (numberp (cdr cached))
;; Support package upgrade mid-session.
(let* ((project-vc-cache-timeout
(if non-essential
project-vc-non-essential-cache-timeout
project-vc-cache-timeout))
(timeout
(cond
((numberp project-vc-cache-timeout)
project-vc-cache-timeout)
((null project-vc-cache-timeout)
nil)
((listp project-vc-cache-timeout)
(cdr
(seq-find (lambda (pair)
(and (functionp (car pair))
(funcall (car pair) dir)))
project-vc-cache-timeout)))
(t nil))))
(or (null timeout)
(< (- current-time (cdr cached)) timeout))))
(car cached))))
(defun project--set-cached (dir key value)
(vc-file-setprop dir key (cons value (float-time))))
;; TODO: We can have our own, separate obarray.
(defun project--clear-cache ()
(obarray-map
(lambda (sym)
(if (get sym 'project-vc)
(put sym 'project-vc nil)))
vc-file-prop-obarray))
(defun project-try-vc (dir)
;; FIXME: Learn to invalidate when the value changes:
;; `project-vc-merge-submodules' or `project-vc-extra-root-markers'.
(or (vc-file-getprop dir 'project-vc)
;; FIXME: Cache for a shorter time (bug#78545).
(let ((res (project-try-vc--search dir)))
(and res (vc-file-setprop dir 'project-vc res))
res)))
"Returns a project value corresponding to DIR from the VC-aware backend.
The value is cached, and depending on whether MAYBE-PROMPT was non-nil
in the `project-current' call, the timeout is determined by
`project-vc-cache-timeout' or `project-vc-non-essential-cache-timeout'."
(let ((cached (project--get-cached dir 'project-vc)))
(if (eq cached 'none)
nil
(or cached
(let ((res (project-try-vc--search dir)))
(project--set-cached dir 'project-vc (or res 'none))
res)))))
(defun project-try-vc--search (dir)
(let* ((backend-markers
@ -897,13 +959,24 @@ DIRS must contain directory names."
(cl-set-difference files dirs :test #'file-in-directory-p))
(defun project--value-in-dir (var dir)
(alist-get
var
(let ((cached (project--get-cached dir 'project-vc-dir-locals)))
(if (eq cached 'none)
nil
(or cached
(let ((res (project--read-dir-locals dir)))
(project--set-cached dir 'project-vc-dir-locals (or res 'none))
res))))
(symbol-value var)))
(defun project--read-dir-locals (dir)
(with-temp-buffer
(setq default-directory (file-name-as-directory dir))
;; Don't use `hack-local-variables-apply' to avoid setting modes.
(let ((enable-local-variables :all))
(hack-dir-local-variables))
;; Don't use `hack-local-variables-apply' to avoid setting modes.
(alist-get var file-local-variables-alist
(symbol-value var))))
file-local-variables-alist))
(cl-defmethod project-buffers ((project (head vc)))
(let* ((root (expand-file-name (file-name-as-directory (project-root project))))
@ -925,6 +998,11 @@ DIRS must contain directory names."
(nreverse bufs)))
(cl-defmethod project-name ((project (head vc)))
"Returns the name of this VC-aware type PROJECT.
The value is cached, and depending on whether `non-essential' is nil,
the timeout is determined by `project-vc-cache-timeout' or
`project-vc-non-essential-cache-timeout'."
(or (project--value-in-dir 'project-vc-name (project-root project))
(cl-call-next-method)))
@ -2386,6 +2464,7 @@ projects.
Display a message at the end summarizing what was found.
Return the number of detected projects."
(interactive "DDirectory: \nP")
(project--clear-cache)
(project--ensure-read-project-list)
(let ((dirs (if recursive
(directory-files-recursively dir "" t)
@ -2429,6 +2508,7 @@ projects should be deleted."
(defun project-forget-zombie-projects (&optional interactive)
"Forget all known projects that don't exist any more."
(interactive (list t))
(project--clear-cache)
(let ((pred (when interactive (alist-get 'interactively project-prune-zombie-projects))))
(project--delete-zombie-projects pred)))
@ -2441,6 +2521,7 @@ to remove those projects from the index.
Display a message at the end summarizing what was forgotten.
Return the number of forgotten projects."
(interactive "DDirectory: \nP")
(project--clear-cache)
(let ((count 0))
(if recursive
(dolist (proj (project-known-project-roots))
@ -2630,7 +2711,8 @@ slash-separated components from `project-name' will be appended to
the buffer's directory name when buffers from two different projects
would otherwise have the same name."
(if-let* ((proj (project-current nil dirname)))
(let ((root (project-root proj)))
(let ((root (project-root proj))
(non-essential t))
(expand-file-name
(file-name-concat
(file-name-directory root)
@ -2640,27 +2722,6 @@ would otherwise have the same name."
;;; Project mode-line
(defvar project-name-cache-timeout 300
"Number of seconds to cache the project name.
Used by `project-name-cached'.")
(defun project-name-cached (dir)
"Return the cached project name for the directory DIR.
Until it's cached, retrieve the project name using `project-current'
and `project-name', then put the name to the cache for the time defined
by the variable `project-name-cache-timeout'. This function is useful
for project indicators such as on the mode line."
(let ((cached (vc-file-getprop dir 'project-name))
(current-time (float-time)))
(if (and cached (< (- current-time (cdr cached))
project-name-cache-timeout))
(let ((value (car cached)))
(if (eq value 'none) nil value))
(let ((res (when-let* ((project (project-current nil dir)))
(project-name project))))
(vc-file-setprop dir 'project-name (cons (or res 'none) current-time))
res))))
;;;###autoload
(defcustom project-mode-line nil
"Whether to show current project name and Project menu on the mode line.
@ -2697,7 +2758,9 @@ value is `non-remote', show the project name only for local files."
;; 'last-coding-system-used' when reading the project name
;; from .dir-locals.el also enables flyspell-mode (bug#66825).
(when-let* ((last-coding-system-used last-coding-system-used)
(project-name (project-name-cached default-directory)))
(non-essential t)
(project (project-current))
(project-name (project-name project)))
(concat
" "
(propertize