diff options
| author | Dmitry Gutov | 2019-12-27 18:18:41 +0300 |
|---|---|---|
| committer | Dmitry Gutov | 2019-12-27 18:30:16 +0300 |
| commit | 3f2788d4acd53fbb3e3b9106530169643fa8948c (patch) | |
| tree | 43ceaf9a754575d2e3e99c0ffec05c16e4f5b586 | |
| parent | f0da3aa83e010d3b5570ecbf2e0b396dd1aab91d (diff) | |
| download | emacs-3f2788d4acd53fbb3e3b9106530169643fa8948c.tar.gz emacs-3f2788d4acd53fbb3e3b9106530169643fa8948c.zip | |
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'.") | |||
| 262 | 262 | ||
| 263 | (defun project-try-vc (dir) | 263 | (defun project-try-vc (dir) |
| 264 | (let* ((backend (ignore-errors (vc-responsible-backend dir))) | 264 | (let* ((backend (ignore-errors (vc-responsible-backend dir))) |
| 265 | (root (and backend (ignore-errors | 265 | (root |
| 266 | (vc-call-backend backend 'root dir))))) | 266 | (pcase backend |
| 267 | ('Git | ||
| 268 | ;; Don't stop at submodule boundary. | ||
| 269 | (or (vc-file-getprop dir 'project-git-root) | ||
| 270 | (vc-file-setprop dir 'project-git-root | ||
| 271 | (vc-find-root dir ".git/")))) | ||
| 272 | ('nil nil) | ||
| 273 | (_ (ignore-errors (vc-call-backend backend 'root dir)))))) | ||
| 267 | (and root (cons 'vc root)))) | 274 | (and root (cons 'vc root)))) |
| 268 | 275 | ||
| 269 | (cl-defmethod project-roots ((project (head vc))) | 276 | (cl-defmethod project-roots ((project (head vc))) |
| @@ -303,7 +310,8 @@ backend implementation of `project-external-roots'.") | |||
| 303 | (pcase backend | 310 | (pcase backend |
| 304 | (`Git | 311 | (`Git |
| 305 | (let ((default-directory (expand-file-name (file-name-as-directory dir))) | 312 | (let ((default-directory (expand-file-name (file-name-as-directory dir))) |
| 306 | (args '("-z"))) | 313 | (args '("-z")) |
| 314 | files) | ||
| 307 | ;; Include unregistered. | 315 | ;; Include unregistered. |
| 308 | (setq args (append args '("-c" "-o" "--exclude-standard"))) | 316 | (setq args (append args '("-c" "-o" "--exclude-standard"))) |
| 309 | (when extra-ignores | 317 | (when extra-ignores |
| @@ -315,11 +323,26 @@ backend implementation of `project-external-roots'.") | |||
| 315 | (format ":!/:%s" (substring i 2)) | 323 | (format ":!/:%s" (substring i 2)) |
| 316 | (format ":!:%s" i))) | 324 | (format ":!:%s" i))) |
| 317 | extra-ignores))))) | 325 | extra-ignores))))) |
| 318 | (mapcar | 326 | (setq files |
| 319 | (lambda (file) (concat default-directory file)) | 327 | (mapcar |
| 320 | (split-string | 328 | (lambda (file) (concat default-directory file)) |
| 321 | (apply #'vc-git--run-command-string nil "ls-files" args) | 329 | (split-string |
| 322 | "\0" t)))) | 330 | (apply #'vc-git--run-command-string nil "ls-files" args) |
| 331 | "\0" t))) | ||
| 332 | ;; Unfortunately, 'ls-files --recurse-submodules' conflicts with '-o'. | ||
| 333 | (let* ((submodules (project--git-submodules)) | ||
| 334 | (sub-files | ||
| 335 | (mapcar | ||
| 336 | (lambda (module) | ||
| 337 | (when (file-directory-p module) | ||
| 338 | (project--vc-list-files | ||
| 339 | (concat default-directory module) | ||
| 340 | backend | ||
| 341 | extra-ignores))) | ||
| 342 | submodules))) | ||
| 343 | (setq files | ||
| 344 | (apply #'nconc files sub-files))) | ||
| 345 | files)) | ||
| 323 | (`Hg | 346 | (`Hg |
| 324 | (let ((default-directory (expand-file-name (file-name-as-directory dir))) | 347 | (let ((default-directory (expand-file-name (file-name-as-directory dir))) |
| 325 | args) | 348 | args) |
| @@ -337,6 +360,18 @@ backend implementation of `project-external-roots'.") | |||
| 337 | (lambda (s) (concat default-directory s)) | 360 | (lambda (s) (concat default-directory s)) |
| 338 | (split-string (buffer-string) "\0" t))))))) | 361 | (split-string (buffer-string) "\0" t))))))) |
| 339 | 362 | ||
| 363 | (defun project--git-submodules () | ||
| 364 | ;; 'git submodule foreach' is much slower. | ||
| 365 | (condition-case nil | ||
| 366 | (with-temp-buffer | ||
| 367 | (insert-file-contents ".gitmodules") | ||
| 368 | (let (res) | ||
| 369 | (goto-char (point-min)) | ||
| 370 | (while (re-search-forward "path *= *\\(.+\\)" nil t) | ||
| 371 | (push (match-string 1) res)) | ||
| 372 | (nreverse res))) | ||
| 373 | (file-missing nil))) | ||
| 374 | |||
| 340 | (cl-defmethod project-ignores ((project (head vc)) dir) | 375 | (cl-defmethod project-ignores ((project (head vc)) dir) |
| 341 | (let* ((root (cdr project)) | 376 | (let* ((root (cdr project)) |
| 342 | backend) | 377 | backend) |