bug#69188: 30.0.50; project-files + project-find-file is slow in large repositories

[Dmitry Gutov <dmitry@gutov.dev>]

[-- Attachment #1: Type: text/plain, Size: 812 bytes --]

On 13/04/2024 05:34, Dmitry Gutov wrote:
> Both options are relatively clunky, and the second one might also fail 
> to work when DIRS is non-nil (or would have to fall back to absolute 
> names anyway), so I'm leaning toward the first one. It might also allow 
> certain code to be written supporting both relative and absolute names 
> (e.g. a process call both binds default-directory to root and keeps the 
> file names as-is -- the relative ones would be interpreted as such, the 
> rest just as they are interpreted now).

Here's how that change can look.

The patch should demonstrate both the performance improvements for 
project-find-file and project-find-regexp, and some awkwardness in the 
implementation, chiefly due to backward compatibility.

Guess more tests will be required, at the very least.

[-- Attachment #2: project-files-relative-names.diff --]
[-- Type: text/x-patch, Size: 6189 bytes --]

diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el
index 000a05804a8..567a25e0906 100644
--- a/lisp/progmodes/project.el
+++ b/lisp/progmodes/project.el
@@ -323,6 +323,12 @@ project--file-completion-table
 (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
@@ -380,8 +386,10 @@ project--files-in-directory
                 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<)
+       (mapcar (lambda (s) (concat dfn 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 +697,9 @@ project--vc-list-files
                    (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 +726,8 @@ project--vc-list-files
                                 dir))
             (args (list (concat "-mcard" (and include-untracked "u"))
                         "--no-status"
-                        "-0")))
+                        "-0"))
+            files)
        (when extra-ignores
          (setq args (nconc args
                            (mapcan
@@ -725,9 +736,12 @@ project--vc-list-files
                             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 +984,7 @@ project-find-regexp
   (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 +1015,8 @@ project-or-external-find-regexp
   (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 +1071,8 @@ project-find-file
   (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 +1148,12 @@ project--read-file-cpd-relative
             (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)
@@ -1168,6 +1191,7 @@ project--read-file-absolute
                                     all-files &optional predicate
                                     hist mb-default)
   (project--completing-read-strict prompt
+                                   ;; FIXME: Map relative names to absolute?
                                    (project--file-completion-table all-files)
                                    predicate
                                    hist mb-default))
@@ -1215,6 +1239,7 @@ project-find-file-in
                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 @@ xref-matches-in-files
        (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.