mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2026-01-11 14:01:43 -08:00
Code Issues Projects Releases Wiki Activity

project--vc-list-files: Recurse into submodules

Browse source 
* 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.
This commit is contained in:
Dmitry Gutov 2019-12-27 18:18:41 +03:00
parent f0da3aa83e
commit 3f2788d4ac
1 changed files with 43 additions and 8 deletions
Download patch file Download diff file Expand all files Collapse all files

51
lisp/progmodes/project.el
View file

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