mirror of
git://git.sv.gnu.org/emacs.git
synced 2026-02-16 09:14:18 +00:00
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:
parent
8cb9aaec0f
commit
583a112169
3 changed files with 107 additions and 35 deletions
|
|
@ -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
|
||||
|
|
|
|||
5
etc/NEWS
5
etc/NEWS
|
|
@ -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
|
||||
|
||||
+++
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Reference in a new issue