diff options
author | Dmitry Gutov <dgutov@yandex.ru> | 2019-12-27 18:18:41 +0300 |
---|---|---|
committer | Dmitry Gutov <dgutov@yandex.ru> | 2019-12-27 18:30:16 +0300 |
commit | 3f2788d4acd53fbb3e3b9106530169643fa8948c (patch) | |
tree | 43ceaf9a754575d2e3e99c0ffec05c16e4f5b586 | |
parent | f0da3aa83e010d3b5570ecbf2e0b396dd1aab91d (diff) | |
download | emacs-3f2788d4acd53fbb3e3b9106530169643fa8948c.tar.gz |
project--vc-list-files: Recurse into submodules
* lisp/progmodes/project.el (project-try-vc): Do not treat a Git
submodule as a project root, go up to the parent repo.
(project--git-submodules): New function.
(project--vc-list-files): Use it. Recurse into submodules.
-rw-r--r-- | lisp/progmodes/project.el | 51 |
1 files changed, 43 insertions, 8 deletions
diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index d8909aca740..74c2bf91c41 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -262,8 +262,15 @@ backend implementation of `project-external-roots'.") (defun project-try-vc (dir) (let* ((backend (ignore-errors (vc-responsible-backend dir))) - (root (and backend (ignore-errors - (vc-call-backend backend 'root dir))))) + (root + (pcase backend + ('Git + ;; Don't stop at submodule boundary. + (or (vc-file-getprop dir 'project-git-root) + (vc-file-setprop dir 'project-git-root + (vc-find-root dir ".git/")))) + ('nil nil) + (_ (ignore-errors (vc-call-backend backend 'root dir)))))) (and root (cons 'vc root)))) (cl-defmethod project-roots ((project (head vc))) @@ -303,7 +310,8 @@ backend implementation of `project-external-roots'.") (pcase backend (`Git (let ((default-directory (expand-file-name (file-name-as-directory dir))) - (args '("-z"))) + (args '("-z")) + files) ;; Include unregistered. (setq args (append args '("-c" "-o" "--exclude-standard"))) (when extra-ignores @@ -315,11 +323,26 @@ backend implementation of `project-external-roots'.") (format ":!/:%s" (substring i 2)) (format ":!:%s" i))) extra-ignores))))) - (mapcar - (lambda (file) (concat default-directory file)) - (split-string - (apply #'vc-git--run-command-string nil "ls-files" args) - "\0" t)))) + (setq files + (mapcar + (lambda (file) (concat default-directory file)) + (split-string + (apply #'vc-git--run-command-string nil "ls-files" args) + "\0" t))) + ;; Unfortunately, 'ls-files --recurse-submodules' conflicts with '-o'. + (let* ((submodules (project--git-submodules)) + (sub-files + (mapcar + (lambda (module) + (when (file-directory-p module) + (project--vc-list-files + (concat default-directory module) + backend + extra-ignores))) + submodules))) + (setq files + (apply #'nconc files sub-files))) + files)) (`Hg (let ((default-directory (expand-file-name (file-name-as-directory dir))) args) @@ -337,6 +360,18 @@ backend implementation of `project-external-roots'.") (lambda (s) (concat default-directory s)) (split-string (buffer-string) "\0" t))))))) +(defun project--git-submodules () + ;; 'git submodule foreach' is much slower. + (condition-case nil + (with-temp-buffer + (insert-file-contents ".gitmodules") + (let (res) + (goto-char (point-min)) + (while (re-search-forward "path *= *\\(.+\\)" nil t) + (push (match-string 1) res)) + (nreverse res))) + (file-missing nil))) + (cl-defmethod project-ignores ((project (head vc)) dir) (let* ((root (cdr project)) backend) |