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:
parent
fa36b5ddf5
commit
d268ab1c5d
5 changed files with 35 additions and 6 deletions
|
@ -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))
|
||||
|
|
1
test/lisp/progmodes/project-resources/.dir-locals.el
Normal file
1
test/lisp/progmodes/project-resources/.dir-locals.el
Normal file
|
@ -0,0 +1 @@
|
|||
((nil . ((project-vc-ignores . ("etc")))))
|
1
test/lisp/progmodes/project-resources/etc
Normal file
1
test/lisp/progmodes/project-resources/etc
Normal file
|
@ -0,0 +1 @@
|
|||
etc
|
1
test/lisp/progmodes/project-resources/foo
Normal file
1
test/lisp/progmodes/project-resources/foo
Normal file
|
@ -0,0 +1 @@
|
|||
foo
|
|
@ -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
|
||||
|
|
Loading…
Add table
Reference in a new issue