Bring back the project--value-in-dir logic

Essentialy revert commit 2389158a31, 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.
This commit is contained in:
Dmitry Gutov 2022-12-09 18:15:49 +02:00
parent fa36b5ddf5
commit d268ab1c5d
5 changed files with 35 additions and 6 deletions

View file

@ -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))

View file

@ -0,0 +1 @@
((nil . ((project-vc-ignores . ("etc")))))

View file

@ -0,0 +1 @@
etc

View file

@ -0,0 +1 @@
foo

View file

@ -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