mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2025-01-23 18:47:57 +00:00
Extract xref-matches-in-files from project--find-regexp-in-files
* lisp/progmodes/xref.el (xref-matches-in-files): Extract from project--find-regexp-in-files. * lisp/dired-aux.el (dired-do-find-regexp): Also use it here.
This commit is contained in:
parent
65af18d86e
commit
43f66c3368
@ -2958,7 +2958,6 @@ with the command \\[tags-loop-continue]."
|
|||||||
(declare-function xref--show-xrefs "xref")
|
(declare-function xref--show-xrefs "xref")
|
||||||
(declare-function xref-query-replace-in-results "xref")
|
(declare-function xref-query-replace-in-results "xref")
|
||||||
(declare-function project--files-in-directory "project")
|
(declare-function project--files-in-directory "project")
|
||||||
(declare-function project--find-regexp-in-files "project")
|
|
||||||
|
|
||||||
;;;###autoload
|
;;;###autoload
|
||||||
(defun dired-do-find-regexp (regexp)
|
(defun dired-do-find-regexp (regexp)
|
||||||
@ -2994,7 +2993,7 @@ REGEXP should use constructs supported by your local `grep' command."
|
|||||||
(push mark files)))
|
(push mark files)))
|
||||||
(nreverse marks))
|
(nreverse marks))
|
||||||
(setq xrefs
|
(setq xrefs
|
||||||
(project--find-regexp-in-files regexp files))
|
(xref-matches-in-files regexp files))
|
||||||
(unless xrefs
|
(unless xrefs
|
||||||
(user-error "No matches for: %s" regexp))
|
(user-error "No matches for: %s" regexp))
|
||||||
xrefs))))
|
xrefs))))
|
||||||
|
@ -425,8 +425,6 @@ DIRS must contain directory names."
|
|||||||
(declare-function grep-read-files "grep")
|
(declare-function grep-read-files "grep")
|
||||||
(declare-function xref--show-xrefs "xref")
|
(declare-function xref--show-xrefs "xref")
|
||||||
(declare-function xref--find-ignores-arguments "xref")
|
(declare-function xref--find-ignores-arguments "xref")
|
||||||
(declare-function xref--regexp-to-extended "xref")
|
|
||||||
(declare-function xref--convert-hits "xref")
|
|
||||||
|
|
||||||
;;;###autoload
|
;;;###autoload
|
||||||
(defun project-find-regexp (regexp)
|
(defun project-find-regexp (regexp)
|
||||||
@ -479,51 +477,7 @@ pattern to search for."
|
|||||||
nil)))
|
nil)))
|
||||||
|
|
||||||
(defun project--find-regexp-in-files (regexp files)
|
(defun project--find-regexp-in-files (regexp files)
|
||||||
(pcase-let*
|
(let ((xrefs (xref-matches-in-files regexp files)))
|
||||||
((output (get-buffer-create " *project grep output*"))
|
|
||||||
(`(,grep-re ,file-group ,line-group . ,_) (car grep-regexp-alist))
|
|
||||||
(status nil)
|
|
||||||
(hits nil)
|
|
||||||
(xrefs 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)))
|
|
||||||
(remote-id (file-remote-p dir))
|
|
||||||
;; 'git ls-files' can output broken symlinks.
|
|
||||||
(command (format "xargs -0 grep %s -snHE -e %s"
|
|
||||||
(if (and case-fold-search
|
|
||||||
(isearch-no-upper-case-p regexp t))
|
|
||||||
"-i"
|
|
||||||
"")
|
|
||||||
(shell-quote-argument (xref--regexp-to-extended regexp)))))
|
|
||||||
(when remote-id
|
|
||||||
(setq files (mapcar #'file-local-name files)))
|
|
||||||
(with-current-buffer output
|
|
||||||
(erase-buffer)
|
|
||||||
(with-temp-buffer
|
|
||||||
(insert (mapconcat #'identity files "\0"))
|
|
||||||
(setq default-directory dir)
|
|
||||||
(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
|
(unless xrefs
|
||||||
(user-error "No matches for: %s" regexp))
|
(user-error "No matches for: %s" regexp))
|
||||||
xrefs))
|
xrefs))
|
||||||
|
@ -1217,6 +1217,56 @@ IGNORES is a list of glob patterns for files to ignore."
|
|||||||
#'xref-matches-in-directory
|
#'xref-matches-in-directory
|
||||||
"27.1")
|
"27.1")
|
||||||
|
|
||||||
|
;;;###autoload
|
||||||
|
(defun xref-matches-in-files (regexp files)
|
||||||
|
"Find all matches for REGEXP in FILES.
|
||||||
|
Return a list of xref values.
|
||||||
|
FILES must be a list of absolute file names."
|
||||||
|
(pcase-let*
|
||||||
|
((output (get-buffer-create " *project grep output*"))
|
||||||
|
(`(,grep-re ,file-group ,line-group . ,_) (car grep-regexp-alist))
|
||||||
|
(status nil)
|
||||||
|
(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)))
|
||||||
|
(remote-id (file-remote-p dir))
|
||||||
|
;; 'git ls-files' can output broken symlinks.
|
||||||
|
(command (format "xargs -0 grep %s -snHE -e %s"
|
||||||
|
(if (and case-fold-search
|
||||||
|
(isearch-no-upper-case-p regexp t))
|
||||||
|
"-i"
|
||||||
|
"")
|
||||||
|
(shell-quote-argument (xref--regexp-to-extended regexp)))))
|
||||||
|
(when remote-id
|
||||||
|
(setq files (mapcar #'file-local-name files)))
|
||||||
|
(with-current-buffer output
|
||||||
|
(erase-buffer)
|
||||||
|
(with-temp-buffer
|
||||||
|
(insert (mapconcat #'identity files "\0"))
|
||||||
|
(setq default-directory dir)
|
||||||
|
(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)))
|
||||||
|
(xref--convert-hits (nreverse hits) regexp)))
|
||||||
|
|
||||||
(defun xref--rgrep-command (regexp files dir ignores)
|
(defun xref--rgrep-command (regexp files dir ignores)
|
||||||
(require 'find-dired) ; for `find-name-arg'
|
(require 'find-dired) ; for `find-name-arg'
|
||||||
(defvar grep-find-template)
|
(defvar grep-find-template)
|
||||||
|
Loading…
Reference in New Issue
Block a user