Rebase project-find-regexp on top of project-files

* lisp/progmodes/project.el (project--files-in-directory):
New function.
(project-files, project-find-regexp): Use it.
(project--dir-ignores): New function.
(project--find-regexp-in): Remove.
(project--process-file-region): New function.
(project--find-regexp-in-files): New function.
(project-find-regexp, project-or-external-find-regexp): Use it, and
project-files as well.

1 files changed, 107 insertions, 32 deletions

diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el
index c16b2578ebf..f795c36fa06 100644
--- a/lisp/progmodes/project.el
+++ b/lisp/progmodes/project.el
@@ -184,17 +184,30 @@ to find the list of ignores for each directory."
   (require 'xref)
   (cl-mapcan
    (lambda (dir)
-     (let ((command
-            (format "%s %s %s -type f -print0"
-                    find-program
-                    (shell-quote-argument
-                     (expand-file-name dir))
-                    (xref--find-ignores-arguments
-                     (project-ignores project dir)
-                     (expand-file-name dir)))))
-       (split-string (shell-command-to-string command) "\0" t)))
+     (project--files-in-directory dir (project-ignores project dir)))
    (or dirs (project-roots project))))
 
+(defun project--files-in-directory (dir ignores &optional files)
+  (require 'find-dired)
+  (defvar find-name-arg)
+  (let ((command (format "%s %s %s -type f %s -print0"
+                         find-program
+                         dir
+                         (xref--find-ignores-arguments
+                          ignores
+                          (expand-file-name dir))
+                         (if files
+                             (concat (shell-quote-argument "(")
+                                     " " find-name-arg " "
+                                     (mapconcat
+                                      #'shell-quote-argument
+                                      (split-string files)
+                                      (concat " -o " find-name-arg " "))
+                                     " "
+                                     (shell-quote-argument ")"))"")
+                         )))
+    (split-string (shell-command-to-string command) "\0" t)))
+
 (defgroup project-vc nil
   "Project implementation using the VC package."
   :version "25.1"
@@ -320,11 +333,26 @@ triggers completion when entering a pattern, including it
 requires quoting, e.g. `\\[quoted-insert]<space>'."
   (interactive (list (project--read-regexp)))
   (let* ((pr (project-current t))
-         (dirs (if current-prefix-arg
-                   (list (read-directory-name "Base directory: "
-                                              nil default-directory t))
-                 (project-roots pr))))
-    (project--find-regexp-in dirs regexp pr)))
+         (files
+          (if (not current-prefix-arg)
+              (project-files pr (project-roots pr))
+            (let ((dir (read-directory-name "Base directory: "
+                                            nil default-directory t)))
+              (project--files-in-directory dir
+                                           (project--dir-ignores pr dir)
+                                           (grep-read-files regexp))))))
+    (project--find-regexp-in-files regexp files)))
+
+(defun project--dir-ignores (project dir)
+  (let* ((roots (project-roots project))
+         (root (cl-find dir roots :test #'file-in-directory-p)))
+    (when root
+      (let ((ignores (project-ignores project root)))
+        (if (file-equal-p root dir)
+            ignores
+          ;; FIXME: Update the "rooted" ignores to relate to DIR instead.
+          (cl-delete-if (lambda (str) (string-prefix-p "./" str))
+                        ignores))))))
 
 ;;;###autoload
 (defun project-or-external-find-regexp (regexp)
@@ -333,29 +361,76 @@ With \\[universal-argument] prefix, you can specify the file name
 pattern to search for."
   (interactive (list (project--read-regexp)))
   (let* ((pr (project-current t))
-         (dirs (append
-                (project-roots pr)
-                (project-external-roots pr))))
-    (project--find-regexp-in dirs regexp pr)))
+         (files
+          (project-files pr (append
+                             (project-roots pr)
+                             (project-external-roots pr)))))
+    (project--find-regexp-in-files regexp files)))
+
+(defun project--find-regexp-in-files (regexp files)
+  (pcase-let*
+      ((output (get-buffer-create " *project grep output*"))
+       (`(,grep-re ,file-group ,line-group . ,_) (car grep-regexp-alist))
+       (status nil)
+       (hits nil)
+       (xrefs nil)
+       (command (format "xargs -0 grep %s -nHe %s"
+                        (if (and case-fold-search
+                                 (isearch-no-upper-case-p regexp t))
+                            "-i"
+                          "")
+                        (shell-quote-argument (xref--regexp-to-extended regexp)))))
+    (with-current-buffer output
+      (erase-buffer)
+      (with-temp-buffer
+        (insert (mapconcat #'identity files "\0"))
+        (setq status
+              (project--process-file-region (point-min)
+                                            (point-max)
+                                            shell-file-name
+                                            output
+                                            nil
+                                            shell-command-switch
+                                            command)))
+      (goto-char (point-min))
+      (when (and (/= (point-min) (point-max))
+                 (not (looking-at grep-re))
+                 ;; TODO: Show these matches as well somehow?
+                 (not (looking-at "Binary file .* matches")))
+        (user-error "Search failed with status %d: %s" status
+                    (buffer-substring (point-min) (line-end-position))))
+      (while (re-search-forward grep-re nil t)
+        (push (list (string-to-number (match-string line-group))
+                    (match-string file-group)
+                    (buffer-substring-no-properties (point) (line-end-position)))
+              hits)))
+    (setq xrefs (xref--convert-hits (nreverse hits) regexp))
+    (unless xrefs
+      (user-error "No matches for: %s" regexp))
+    (xref--show-xrefs xrefs nil)))
+
+(defun project--process-file-region (start end program
+                                     &optional buffer display
+                                     &rest args)
+  ;; FIXME: This branching shouldn't be necessary, but
+  ;; call-process-region *is* measurably faster, even for a program
+  ;; doing some actual work (for a period of time). Even though
+  ;; call-process-region also creates a temp file internally
+  ;; (http://lists.gnu.org/archive/html/emacs-devel/2019-01/msg00211.html).
+  (if (not (file-remote-p default-directory))
+      (apply #'call-process-region
+             start end program nil buffer display args)
+    (let ((infile (make-temp-file "ppfr")))
+      (unwind-protect
+          (progn
+            (write-region start end infile nil 'silent)
+            (apply #'process-file program infile buffer display args))
+        (delete-file infile)))))
 
 (defun project--read-regexp ()
   (let ((id (xref-backend-identifier-at-point (xref-find-backend))))
     (read-regexp "Find regexp" (and id (regexp-quote id)))))
 
-(defun project--find-regexp-in (dirs regexp project)
-  (require 'grep)
-  (let* ((files (if current-prefix-arg
-                    (grep-read-files regexp)
-                  "*"))
-         (xrefs (cl-mapcan
-                 (lambda (dir)
-                   (xref-collect-matches regexp files dir
-                                         (project-ignores project dir)))
-                 dirs)))
-    (unless xrefs
-      (user-error "No matches for: %s" regexp))
-    (xref--show-xrefs xrefs nil)))
-
 ;;;###autoload
 (defun project-find-file ()
   "Visit a file (with completion) in the current project's roots.