Commit fbe87d0f authored by Dmitry Gutov's avatar Dmitry Gutov

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.
parent afc8a41f
Pipeline #558 passed with stage
in 46 minutes and 52 seconds
......@@ -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.
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment