diff options
author | Dmitry Gutov <dmitry@gutov.dev> | 2024-05-05 06:27:39 +0300 |
---|---|---|
committer | Dmitry Gutov <dmitry@gutov.dev> | 2024-05-05 06:27:55 +0300 |
commit | 370b216f08699bdd85b910868642df441c06306c (patch) | |
tree | f921865be391b559bc69ebc5ceabfa3b3869f792 | |
parent | e0993f5169ebf761d520b2e23630a3de7d13ccb3 (diff) | |
download | emacs-370b216f08699bdd85b910868642df441c06306c.tar.gz |
New variable 'project-files-relative-names'
* lisp/progmodes/project.el (project-files-relative-names):
New variable (bug#69233).
(project--files-in-directory): Honor it.
(project--vc-list-files): Here too.
(project-find-regexp): Use it to improve performance.
(project-or-external-find-regexp): Add a TODO.
(project-find-file): Use it here too.
(project--read-file-cpd-relative, project--read-file-absolute):
Try to handle file lists with absolute and relative files names.
(project-find-file-in): Set default-directory, so relative names
are interpreted correctly.
* lisp/progmodes/xref.el (xref-matches-in-files):
Consider that the first in FILES can be a relative file name.
* test/lisp/progmodes/project-tests.el (project-find-regexp):
New test.
* etc/NEWS: Mention it.
-rw-r--r-- | etc/NEWS | 4 | ||||
-rw-r--r-- | lisp/progmodes/project.el | 64 | ||||
-rw-r--r-- | lisp/progmodes/xref.el | 3 | ||||
-rw-r--r-- | test/lisp/progmodes/project-tests.el | 24 |
4 files changed, 78 insertions, 17 deletions
@@ -696,6 +696,10 @@ you can add this to your init script: (setopt project-switch-commands #'project-prefix-or-any-command) +*** New variable 'project-files-relative-names'. +Project backends can support it to improve the performance of their +'project-files' implementation when this variable is non-nil. + ** VC --- diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index 000a05804a8..b716d442aed 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -323,6 +323,12 @@ end it with `/'. DIR must be either `project-root' or one of (cl-defmethod project-root ((project (head transient))) (cdr project)) +(defvar project-files-relative-names nil + "When non-nil, `project-files' is allowed to return relative names. +The names will be relative to the project root. And this can only +happen when all returned files are in the same directory. Meaning, the +DIRS argument has to be nil or have only one element.") + (cl-defgeneric project-files (project &optional dirs) "Return a list of files in directories DIRS in PROJECT. DIRS is a list of absolute directories; it should be some @@ -345,7 +351,6 @@ to find the list of ignores for each directory." ;; expanded and not left for the shell command ;; to interpret. (localdir (file-name-unquote (file-local-name (expand-file-name dir)))) - (dfn (directory-file-name localdir)) (command (format "%s -H . %s -type f %s -print0" find-program (xref--find-ignores-arguments ignores "./") @@ -376,12 +381,14 @@ to find the list of ignores for each directory." (error "File listing failed: %s" (buffer-string)))) (goto-char pt) (while (search-forward "\0" nil t) - (push (buffer-substring-no-properties (1+ pt) (1- (point))) + (push (buffer-substring-no-properties (+ pt 2) (1- (point))) res) (setq pt (point))))) - (project--remote-file-names - (mapcar (lambda (s) (concat dfn s)) - (sort res #'string<))))) + (if project-files-relative-names + (sort res #'string<) + (project--remote-file-names + (mapcar (lambda (s) (concat localdir s)) + (sort res #'string<)))))) (defun project--remote-file-names (local-files) "Return LOCAL-FILES as if they were on the system of `default-directory'. @@ -689,7 +696,9 @@ See `project-vc-extra-root-markers' for the marker value format.") (mapcar (lambda (file) (unless (member file submodules) - (concat default-directory file))) + (if project-files-relative-names + file + (concat default-directory file)))) (split-string (apply #'vc-git--run-command-string nil "ls-files" args) "\0" t)))) @@ -716,7 +725,8 @@ See `project-vc-extra-root-markers' for the marker value format.") dir)) (args (list (concat "-mcard" (and include-untracked "u")) "--no-status" - "-0"))) + "-0")) + files) (when extra-ignores (setq args (nconc args (mapcan @@ -725,9 +735,12 @@ See `project-vc-extra-root-markers' for the marker value format.") extra-ignores)))) (with-temp-buffer (apply #'vc-hg-command t 0 "." "status" args) - (mapcar - (lambda (s) (concat default-directory s)) - (split-string (buffer-string) "\0" t))))))) + (setq files (split-string (buffer-string) "\0" t)) + (unless project-files-relative-names + (setq files (mapcar + (lambda (s) (concat default-directory s)) + files))) + files))))) (defun project--vc-merge-submodules-p (dir) (project--value-in-dir @@ -970,6 +983,7 @@ requires quoting, e.g. `\\[quoted-insert]<space>'." (let* ((caller-dir default-directory) (pr (project-current t)) (default-directory (project-root pr)) + (project-files-relative-names t) (files (if (not current-prefix-arg) (project-files pr) @@ -1000,6 +1014,8 @@ requires quoting, e.g. `\\[quoted-insert]<space>'." (require 'xref) (let* ((pr (project-current t)) (default-directory (project-root pr)) + ;; TODO: Make use of `project-files-relative-names' by + ;; searching each root separately (maybe in parallel, too). (files (project-files pr (cons (project-root pr) @@ -1054,7 +1070,8 @@ for VCS directories listed in `vc-directory-exclusion-list'." (interactive "P") (let* ((pr (project-current t)) (root (project-root pr)) - (dirs (list root))) + (dirs (list root)) + (project-files-relative-names t)) (project-find-file-in (or (thing-at-point 'filename) (and buffer-file-name (project--find-default-from buffer-file-name pr))) @@ -1130,7 +1147,12 @@ by the user at will." (if (> (length common-prefix) 0) (file-name-directory common-prefix)))) (cpd-length (length common-parent-directory)) - (prompt (if (zerop cpd-length) + (common-parent-directory (if (file-name-absolute-p (car all-files)) + common-parent-directory + (concat default-directory common-parent-directory))) + (prompt (if (and (zerop cpd-length) + all-files + (file-name-absolute-p (car all-files))) prompt (concat prompt (format " in %s" common-parent-directory)))) (included-cpd (when (member common-parent-directory all-files) @@ -1167,10 +1189,19 @@ by the user at will." (defun project--read-file-absolute (prompt all-files &optional predicate hist mb-default) - (project--completing-read-strict prompt - (project--file-completion-table all-files) - predicate - hist mb-default)) + (let* ((new-prompt (if (file-name-absolute-p (car all-files)) + prompt + (concat prompt " in " default-directory))) + ;; FIXME: Map relative names to absolute? + (ct (project--file-completion-table all-files)) + (file + (project--completing-read-strict new-prompt + ct + predicate + hist mb-default))) + (unless (file-name-absolute-p file) + (setq file (expand-file-name file))) + file)) (defun project--read-file-name ( project prompt all-files &optional predicate @@ -1215,6 +1246,7 @@ directories listed in `vc-directory-exclusion-list'." dirs) (project-files project dirs))) (completion-ignore-case read-file-name-completion-ignore-case) + (default-directory (project-root project)) (file (project--read-file-name project "Find file" all-files nil 'file-name-history diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el index 755c3db04fd..29fc6cd560f 100644 --- a/lisp/progmodes/xref.el +++ b/lisp/progmodes/xref.el @@ -1922,7 +1922,8 @@ to control which program to use when looking for matches." (hits nil) ;; Support for remote files. The assumption is that, if the ;; first file is remote, they all are, and on the same host. - (dir (file-name-directory (car files))) + (dir (or (file-name-directory (car files)) + default-directory)) (remote-id (file-remote-p dir)) ;; The 'auto' default would be fine too, but ripgrep can't handle ;; the options we pass in that case. diff --git a/test/lisp/progmodes/project-tests.el b/test/lisp/progmodes/project-tests.el index 04cdf1dea29..84a5d55f136 100644 --- a/test/lisp/progmodes/project-tests.el +++ b/test/lisp/progmodes/project-tests.el @@ -163,4 +163,28 @@ When `project-ignores' includes a name matching project dir." (should-not (null project)) (should (string-match-p "/test/lisp/progmodes/project-resources/\\'" (project-root project))))) +(ert-deftest project-find-regexp () + "Check the happy path." + (skip-unless (executable-find find-program)) + (skip-unless (executable-find "xargs")) + (skip-unless (executable-find "grep")) + (let* ((directory (ert-resource-directory)) + (project-find-functions nil) + (project (cons 'transient directory))) + (add-hook 'project-find-functions (lambda (_dir) project)) + (should (eq (project-current) project)) + (let* ((matches nil) + (xref-search-program 'grep) + (xref-show-xrefs-function + (lambda (fetcher _display) + (setq matches (funcall fetcher))))) + (project-find-regexp "etc") + (should (equal (mapcar (lambda (item) + (file-name-base + (xref-location-group (xref-item-location item)))) + matches) + '(".dir-locals" "etc"))) + (should (equal (sort (mapcar #'xref-item-summary matches) #'string<) + '("((nil . ((project-vc-ignores . (\"etc\")))))" "etc")))))) + ;;; project-tests.el ends here |