aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorEli Zaretskii2022-12-09 18:21:31 +0200
committerEli Zaretskii2022-12-09 18:21:31 +0200
commitbcf235acd58dfc0d335114c18bcf9299f5155d36 (patch)
treef675ddb3e67a0412128f17f80fa5965830e031b6
parent2ea7a357fd1ed9de89ee506a3810e644a2d847fd (diff)
parentd268ab1c5d749d0f15474f9d200bc0356ad85765 (diff)
downloademacs-bcf235acd58dfc0d335114c18bcf9299f5155d36.tar.gz
emacs-bcf235acd58dfc0d335114c18bcf9299f5155d36.zip
Merge branch 'emacs-29' of git.savannah.gnu.org:/srv/git/emacs into emacs-29
-rw-r--r--lisp/progmodes/project.el25
-rw-r--r--test/lisp/progmodes/project-resources/.dir-locals.el1
-rw-r--r--test/lisp/progmodes/project-resources/etc1
-rw-r--r--test/lisp/progmodes/project-resources/foo1
-rw-r--r--test/lisp/progmodes/project-tests.el13
5 files changed, 35 insertions, 6 deletions
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'.")
515 (marker-re 515 (marker-re
516 (mapconcat 516 (mapconcat
517 (lambda (m) (format "\\(%s\\)" (wildcard-to-regexp m))) 517 (lambda (m) (format "\\(%s\\)" (wildcard-to-regexp m)))
518 (append backend-markers project-vc-extra-root-markers) 518 (append backend-markers
519 (project--value-in-dir 'project-vc-extra-root-markers dir))
519 "\\|")) 520 "\\|"))
520 (locate-dominating-stop-dir-regexp 521 (locate-dominating-stop-dir-regexp
521 (or vc-ignore-dir-regexp locate-dominating-stop-dir-regexp)) 522 (or vc-ignore-dir-regexp locate-dominating-stop-dir-regexp))
@@ -535,7 +536,7 @@ project backend implementation of `project-external-roots'.")
535 project) 536 project)
536 (when (and 537 (when (and
537 (eq backend 'Git) 538 (eq backend 'Git)
538 project-vc-merge-submodules 539 (project--vc-merge-submodules-p root)
539 (project--submodule-p root)) 540 (project--submodule-p root))
540 (let* ((parent (file-name-directory (directory-file-name root)))) 541 (let* ((parent (file-name-directory (directory-file-name root))))
541 (setq root (vc-call-backend 'Git 'root parent)))) 542 (setq root (vc-call-backend 'Git 'root parent))))
@@ -582,7 +583,7 @@ project backend implementation of `project-external-roots'.")
582(cl-defmethod project-files ((project (head vc)) &optional dirs) 583(cl-defmethod project-files ((project (head vc)) &optional dirs)
583 (mapcan 584 (mapcan
584 (lambda (dir) 585 (lambda (dir)
585 (let ((ignores project-vc-ignores) 586 (let ((ignores (project--value-in-dir 'project-vc-ignores (nth 2 project)))
586 (backend (cadr project))) 587 (backend (cadr project)))
587 (when backend 588 (when backend
588 (require (intern (concat "vc-" (downcase (symbol-name backend)))))) 589 (require (intern (concat "vc-" (downcase (symbol-name backend))))))
@@ -647,7 +648,7 @@ project backend implementation of `project-external-roots'.")
647 (split-string 648 (split-string
648 (apply #'vc-git--run-command-string nil "ls-files" args) 649 (apply #'vc-git--run-command-string nil "ls-files" args)
649 "\0" t))) 650 "\0" t)))
650 (when project-vc-merge-submodules 651 (when (project--vc-merge-submodules-p default-directory)
651 ;; Unfortunately, 'ls-files --recurse-submodules' conflicts with '-o'. 652 ;; Unfortunately, 'ls-files --recurse-submodules' conflicts with '-o'.
652 (let* ((submodules (project--git-submodules)) 653 (let* ((submodules (project--git-submodules))
653 (sub-files 654 (sub-files
@@ -681,6 +682,11 @@ project backend implementation of `project-external-roots'.")
681 (lambda (s) (concat default-directory s)) 682 (lambda (s) (concat default-directory s))
682 (split-string (buffer-string) "\0" t))))))) 683 (split-string (buffer-string) "\0" t)))))))
683 684
685(defun project--vc-merge-submodules-p (dir)
686 (project--value-in-dir
687 'project-vc-merge-submodules
688 dir))
689
684(defun project--git-submodules () 690(defun project--git-submodules ()
685 ;; 'git submodule foreach' is much slower. 691 ;; 'git submodule foreach' is much slower.
686 (condition-case nil 692 (condition-case nil
@@ -722,7 +728,7 @@ project backend implementation of `project-external-roots'.")
722 (condition-case nil 728 (condition-case nil
723 (vc-call-backend backend 'ignore-completion-table root) 729 (vc-call-backend backend 'ignore-completion-table root)
724 (vc-not-supported () nil))))) 730 (vc-not-supported () nil)))))
725 project-vc-ignores 731 (project--value-in-dir 'project-vc-ignores root)
726 (mapcar 732 (mapcar
727 (lambda (dir) 733 (lambda (dir)
728 (concat dir "/")) 734 (concat dir "/"))
@@ -753,9 +759,16 @@ DIRS must contain directory names."
753 ;; Sidestep the issue of expanded/abbreviated file names here. 759 ;; Sidestep the issue of expanded/abbreviated file names here.
754 (cl-set-difference files dirs :test #'file-in-directory-p)) 760 (cl-set-difference files dirs :test #'file-in-directory-p))
755 761
762(defun project--value-in-dir (var dir)
763 (with-temp-buffer
764 (setq default-directory dir)
765 (let ((enable-local-variables :all))
766 (hack-dir-local-variables-non-file-buffer))
767 (symbol-value var)))
768
756(cl-defmethod project-buffers ((project (head vc))) 769(cl-defmethod project-buffers ((project (head vc)))
757 (let* ((root (expand-file-name (file-name-as-directory (project-root project)))) 770 (let* ((root (expand-file-name (file-name-as-directory (project-root project))))
758 (modules (unless (or project-vc-merge-submodules 771 (modules (unless (or (project--vc-merge-submodules-p root)
759 (project--submodule-p root)) 772 (project--submodule-p root))
760 (mapcar 773 (mapcar
761 (lambda (m) (format "%s%s/" root m)) 774 (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."
139 (should-not (null project)) 139 (should-not (null project))
140 (should (string-match-p "/test/lisp/\\'" (project-root project))))) 140 (should (string-match-p "/test/lisp/\\'" (project-root project)))))
141 141
142(ert-deftest project-vc-supports-project-in-different-dir ()
143 "Check that it picks up dir-locals settings from somewhere else."
144 (skip-unless (eq (vc-responsible-backend default-directory) 'Git))
145 (let* ((dir (ert-resource-directory))
146 (_ (vc-file-clearprops dir))
147 (project-vc-extra-root-markers '(".dir-locals.el"))
148 (project (project-current nil dir)))
149 (should-not (null project))
150 (should (string-match-p "/test/lisp/progmodes/project-resources/\\'" (project-root project)))
151 (should (member "etc" (project-ignores project dir)))
152 (should (equal '(".dir-locals.el" "foo")
153 (mapcar #'file-name-nondirectory (project-files project))))))
154
142;;; project-tests.el ends here 155;;; project-tests.el ends here