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.
This commit is contained in:
Dmitry Gutov
parent
afc8a41f48
commit
fbe87d0f8f
1 changed files with 107 additions and 32 deletions
|
|
@ -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.
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue