From: Dmitry Gutov Date: Sun, 5 May 2024 03:27:39 +0000 (+0300) Subject: New variable 'project-files-relative-names' X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=cda94c4607be25aeab93454b23ab6ca72b124ed6;p=emacs.git 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. (cherry picked from commit 370b216f08699bdd85b910868642df441c06306c) --- diff --git a/etc/NEWS b/etc/NEWS index 07d0dc6e2a8..f8430c25efe 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -699,6 +699,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 4958cb06bb3..66ce548add9 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -318,6 +318,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 @@ -340,7 +346,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 "./") @@ -371,12 +376,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'. @@ -684,7 +691,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)))) @@ -711,7 +720,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 @@ -720,9 +730,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 @@ -959,15 +972,20 @@ The following commands are available: (cl-defmethod xref-backend-restore ((_backend (head project-dir)) _context)) (cl-defmethod xref-backend-apropos ((backend (head project-dir)) pattern) (project--find-regexp-in-files - pattern (project--files-in-directory (nth 1 backend) nil (nth 2 backend)))) + pattern + (let ((project-files-relative-names t)) + (project--files-in-directory (nth 1 backend) nil (nth 2 backend))))) (cl-defmethod xref-backend-context ((_backend (head project-ext)) _id _kind)) (cl-defmethod xref-backend-restore ((_backend (head project-ext)) _context)) (cl-defmethod xref-backend-apropos ((backend (head project-ext)) pattern) (let ((pr (cdr backend))) (project--find-regexp-in-files - pattern (project-files pr (cons (project-root pr) - (project-external-roots pr)))))) + pattern + ;; TODO: Make use of `project-files-relative-names' by + ;; searching each root separately (maybe in parallel, too). + (project-files pr (cons (project-root pr) + (project-external-roots pr)))))) ;;;###autoload (defun project-find-regexp (regexp &optional dir pattern) @@ -1054,7 +1072,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 +1149,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 +1191,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 +1248,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 6e0fc9c08dd..f1446954c02 100644 --- a/lisp/progmodes/xref.el +++ b/lisp/progmodes/xref.el @@ -2063,7 +2063,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