[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master 86969f9658: Cache the backend value together with the project roo
From: |
Dmitry Gutov |
Subject: |
master 86969f9658: Cache the backend value together with the project root |
Date: |
Wed, 2 Mar 2022 22:42:02 -0500 (EST) |
branch: master
commit 86969f9658e278ebacb3d625d0309046ff1f2b54
Author: Dmitry Gutov <dgutov@yandex.ru>
Commit: Dmitry Gutov <dgutov@yandex.ru>
Cache the backend value together with the project root
* lisp/progmodes/project.el (project-try-vc):
Cache the backend value together with the root.
(project-root, project-files, project-ignores):
Update to access the new data structure.
---
lisp/progmodes/project.el | 61 +++++++++++++++++++++++++----------------------
1 file changed, 32 insertions(+), 29 deletions(-)
diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el
index 4d6b93ceb5..b44f4618be 100644
--- a/lisp/progmodes/project.el
+++ b/lisp/progmodes/project.el
@@ -418,30 +418,33 @@ The directory names should be absolute. Used in the VC
project
backend implementation of `project-external-roots'.")
(defun project-try-vc (dir)
- (let* ((backend
- ;; FIXME: This is slow. Cache it.
- (ignore-errors (vc-responsible-backend dir)))
- (root
- (pcase backend
- ('Git
- ;; Don't stop at submodule boundary.
- ;; FIXME: Cache for a shorter time.
- (or (vc-file-getprop dir 'project-git-root)
- (let ((root (vc-call-backend backend 'root dir)))
- (vc-file-setprop
- dir 'project-git-root
- (if (and
- ;; FIXME: Invalidate the cache when the value
- ;; of this variable changes.
- (project--vc-merge-submodules-p root)
- (project--submodule-p root))
- (let* ((parent (file-name-directory
- (directory-file-name root))))
- (vc-call-backend backend 'root parent))
- root)))))
- ('nil nil)
- (_ (ignore-errors (vc-call-backend backend 'root dir))))))
- (and root (cons 'vc root))))
+ (or (vc-file-getprop dir 'project-vc)
+ (let* ((backend (ignore-errors (vc-responsible-backend dir)))
+ (root
+ (pcase backend
+ ('Git
+ ;; Don't stop at submodule boundary.
+ (or (vc-file-getprop dir 'project-git-root)
+ (let ((root (vc-call-backend backend 'root dir)))
+ (vc-file-setprop
+ dir 'project-git-root
+ (if (and
+ ;; FIXME: Invalidate the cache when the value
+ ;; of this variable changes.
+ (project--vc-merge-submodules-p root)
+ (project--submodule-p root))
+ (let* ((parent (file-name-directory
+ (directory-file-name root))))
+ (vc-call-backend backend 'root parent))
+ root)))))
+ ('nil nil)
+ (_ (ignore-errors (vc-call-backend backend 'root dir)))))
+ project)
+ (when root
+ (setq project (list 'vc backend root))
+ ;; FIXME: Cache for a shorter time.
+ (vc-file-setprop dir 'project-vc project)
+ project))))
(defun project--submodule-p (root)
;; XXX: We only support Git submodules for now.
@@ -467,7 +470,7 @@ backend implementation of `project-external-roots'.")
(t nil))))
(cl-defmethod project-root ((project (head vc)))
- (cdr project))
+ (nth 2 project))
(cl-defmethod project-external-roots ((project (head vc)))
(project-subtract-directories
@@ -482,8 +485,8 @@ backend implementation of `project-external-roots'.")
(lambda (dir)
(let ((ignores (project--value-in-dir 'project-vc-ignores dir))
backend)
- (if (and (file-equal-p dir (cdr project))
- (setq backend (vc-responsible-backend dir))
+ (if (and (file-equal-p dir (nth 2 project))
+ (setq backend (cadr project))
(cond
((eq backend 'Hg))
((and (eq backend 'Git)
@@ -595,11 +598,11 @@ backend implementation of `project-external-roots'.")
(file-missing nil)))
(cl-defmethod project-ignores ((project (head vc)) dir)
- (let* ((root (cdr project))
+ (let* ((root (nth 2 project))
backend)
(append
(when (file-equal-p dir root)
- (setq backend (vc-responsible-backend root))
+ (setq backend (cadr project))
(delq
nil
(mapcar
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- master 86969f9658: Cache the backend value together with the project root,
Dmitry Gutov <=