From d268ab1c5d749d0f15474f9d200bc0356ad85765 Mon Sep 17 00:00:00 2001 From: Dmitry Gutov Date: Fri, 9 Dec 2022 18:15:49 +0200 Subject: [PATCH] Bring back the project--value-in-dir logic Essentialy revert commit 2389158a31b4a12, restoring the changes and fixing the conflicts. Motivated by the problem brought up in bug#59722 (behavior of project-find-files/regexp when switching projects). We should find other ways to improve performance. * lisp/progmodes/project.el (project--value-in-dir, project--vc-merge-submodules-p): Restore. (project-try-vc, project-files, project--vc-list-files) (project-ignores, project-buffers): Use. * test/lisp/progmodes/project-tests.el (project-vc-supports-project-in-different-dir): New test. * test/lisp/progmodes/project-resources/.dir-locals.el: * test/lisp/progmodes/project-resources/foo: * test/lisp/progmodes/project-resources/etc: New files. --- lisp/progmodes/project.el | 25 ++++++++++++++----- .../project-resources/.dir-locals.el | 1 + test/lisp/progmodes/project-resources/etc | 1 + test/lisp/progmodes/project-resources/foo | 1 + test/lisp/progmodes/project-tests.el | 13 ++++++++++ 5 files changed, 35 insertions(+), 6 deletions(-) create mode 100644 test/lisp/progmodes/project-resources/.dir-locals.el create mode 100644 test/lisp/progmodes/project-resources/etc create mode 100644 test/lisp/progmodes/project-resources/foo diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index 38d4fdad5fc..342ee239c7e 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -515,7 +515,8 @@ project backend implementation of `project-external-roots'.") (marker-re (mapconcat (lambda (m) (format "\\(%s\\)" (wildcard-to-regexp m))) - (append backend-markers project-vc-extra-root-markers) + (append backend-markers + (project--value-in-dir 'project-vc-extra-root-markers dir)) "\\|")) (locate-dominating-stop-dir-regexp (or vc-ignore-dir-regexp locate-dominating-stop-dir-regexp)) @@ -535,7 +536,7 @@ project backend implementation of `project-external-roots'.") project) (when (and (eq backend 'Git) - project-vc-merge-submodules + (project--vc-merge-submodules-p root) (project--submodule-p root)) (let* ((parent (file-name-directory (directory-file-name root)))) (setq root (vc-call-backend 'Git 'root parent)))) @@ -582,7 +583,7 @@ project backend implementation of `project-external-roots'.") (cl-defmethod project-files ((project (head vc)) &optional dirs) (mapcan (lambda (dir) - (let ((ignores project-vc-ignores) + (let ((ignores (project--value-in-dir 'project-vc-ignores (nth 2 project))) (backend (cadr project))) (when backend (require (intern (concat "vc-" (downcase (symbol-name backend)))))) @@ -647,7 +648,7 @@ project backend implementation of `project-external-roots'.") (split-string (apply #'vc-git--run-command-string nil "ls-files" args) "\0" t))) - (when project-vc-merge-submodules + (when (project--vc-merge-submodules-p default-directory) ;; Unfortunately, 'ls-files --recurse-submodules' conflicts with '-o'. (let* ((submodules (project--git-submodules)) (sub-files @@ -681,6 +682,11 @@ project backend implementation of `project-external-roots'.") (lambda (s) (concat default-directory s)) (split-string (buffer-string) "\0" t))))))) +(defun project--vc-merge-submodules-p (dir) + (project--value-in-dir + 'project-vc-merge-submodules + dir)) + (defun project--git-submodules () ;; 'git submodule foreach' is much slower. (condition-case nil @@ -722,7 +728,7 @@ project backend implementation of `project-external-roots'.") (condition-case nil (vc-call-backend backend 'ignore-completion-table root) (vc-not-supported () nil))))) - project-vc-ignores + (project--value-in-dir 'project-vc-ignores root) (mapcar (lambda (dir) (concat dir "/")) @@ -753,9 +759,16 @@ DIRS must contain directory names." ;; Sidestep the issue of expanded/abbreviated file names here. (cl-set-difference files dirs :test #'file-in-directory-p)) +(defun project--value-in-dir (var dir) + (with-temp-buffer + (setq default-directory dir) + (let ((enable-local-variables :all)) + (hack-dir-local-variables-non-file-buffer)) + (symbol-value var))) + (cl-defmethod project-buffers ((project (head vc))) (let* ((root (expand-file-name (file-name-as-directory (project-root project)))) - (modules (unless (or project-vc-merge-submodules + (modules (unless (or (project--vc-merge-submodules-p root) (project--submodule-p root)) (mapcar (lambda (m) (format "%s%s/" root m)) diff --git a/test/lisp/progmodes/project-resources/.dir-locals.el b/test/lisp/progmodes/project-resources/.dir-locals.el new file mode 100644 index 00000000000..a311b7efa9a --- /dev/null +++ b/test/lisp/progmodes/project-resources/.dir-locals.el @@ -0,0 +1 @@ +((nil . ((project-vc-ignores . ("etc"))))) diff --git a/test/lisp/progmodes/project-resources/etc b/test/lisp/progmodes/project-resources/etc new file mode 100644 index 00000000000..dd7999bd3dd --- /dev/null +++ b/test/lisp/progmodes/project-resources/etc @@ -0,0 +1 @@ +etc \ No newline at end of file diff --git a/test/lisp/progmodes/project-resources/foo b/test/lisp/progmodes/project-resources/foo new file mode 100644 index 00000000000..19102815663 --- /dev/null +++ b/test/lisp/progmodes/project-resources/foo @@ -0,0 +1 @@ +foo \ No newline at end of file diff --git a/test/lisp/progmodes/project-tests.el b/test/lisp/progmodes/project-tests.el index c3b886873d3..e666e3a6fab 100644 --- a/test/lisp/progmodes/project-tests.el +++ b/test/lisp/progmodes/project-tests.el @@ -139,4 +139,17 @@ When `project-ignores' includes a name matching project dir." (should-not (null project)) (should (string-match-p "/test/lisp/\\'" (project-root project))))) +(ert-deftest project-vc-supports-project-in-different-dir () + "Check that it picks up dir-locals settings from somewhere else." + (skip-unless (eq (vc-responsible-backend default-directory) 'Git)) + (let* ((dir (ert-resource-directory)) + (_ (vc-file-clearprops dir)) + (project-vc-extra-root-markers '(".dir-locals.el")) + (project (project-current nil dir))) + (should-not (null project)) + (should (string-match-p "/test/lisp/progmodes/project-resources/\\'" (project-root project))) + (should (member "etc" (project-ignores project dir))) + (should (equal '(".dir-locals.el" "foo") + (mapcar #'file-name-nondirectory (project-files project)))))) + ;;; project-tests.el ends here -- 2.39.2