From fbe87d0f8f8878b30b1dfe74f7eb369b569bab6b Mon Sep 17 00:00:00 2001 From: Dmitry Gutov Date: Fri, 18 Jan 2019 06:38:12 +0300 Subject: [PATCH] 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. --- lisp/progmodes/project.el | 139 +++++++++++++++++++++++++++++--------- 1 file 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]'." (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. -- 2.39.2