diff options
| author | Eli Zaretskii | 2022-12-09 18:21:31 +0200 |
|---|---|---|
| committer | Eli Zaretskii | 2022-12-09 18:21:31 +0200 |
| commit | bcf235acd58dfc0d335114c18bcf9299f5155d36 (patch) | |
| tree | f675ddb3e67a0412128f17f80fa5965830e031b6 | |
| parent | 2ea7a357fd1ed9de89ee506a3810e644a2d847fd (diff) | |
| parent | d268ab1c5d749d0f15474f9d200bc0356ad85765 (diff) | |
| download | emacs-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.el | 25 | ||||
| -rw-r--r-- | test/lisp/progmodes/project-resources/.dir-locals.el | 1 | ||||
| -rw-r--r-- | test/lisp/progmodes/project-resources/etc | 1 | ||||
| -rw-r--r-- | test/lisp/progmodes/project-resources/foo | 1 | ||||
| -rw-r--r-- | test/lisp/progmodes/project-tests.el | 13 |
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 |