From 86969f9658e278ebacb3d625d0309046ff1f2b54 Mon Sep 17 00:00:00 2001 From: Dmitry Gutov Date: Thu, 3 Mar 2022 05:23:26 +0200 Subject: [PATCH] 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 4d6b93ceb5c..b44f4618bea 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 -- 2.39.5