From: Dmitry Gutov Date: Tue, 2 Jun 2015 15:46:42 +0000 (+0300) Subject: Reuse rgrep mechanics in xref-find-regexp X-Git-Tag: emacs-25.0.90~1893 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=7f01832e1360b5203695d48605a45228f1362b42;p=emacs.git Reuse rgrep mechanics in xref-find-regexp * lisp/progmodes/grep.el (rgrep-default-command): Extract from `rgrep'. * lisp/progmodes/xref.el (xref-collect-references): Split from `xref-collect-matches'. Only handle the case of symbol search. (xref-collect-matches): Instead of Semantic Symref, use `rgrep-default-command', to take advantage of its directory and file ignore settings. (xref--collect-match): Remove the last argument, leaving the regexp construction up to the caller. * lisp/progmodes/elisp-mode.el (elisp--xref-find-matches): Change to take the xref-collect- function to use as an argument. (elisp-xref-find): Update accordingly. * lisp/progmodes/etags.el (etags--xref-find-matches) (etags-xref-find): Same. --- diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index 968bb21f08a..61709c326d6 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -591,9 +591,9 @@ It can be quoted, or be inside a quoted form." (when sym (elisp--xref-find-definitions sym)))) (`references - (elisp--xref-find-matches id 'symbol)) + (elisp--xref-find-matches id #'xref-collect-references)) (`matches - (elisp--xref-find-matches id 'regexp)) + (elisp--xref-find-matches id #'xref-collect-matches)) (`apropos (elisp--xref-find-apropos id)))) @@ -654,7 +654,7 @@ It can be quoted, or be inside a quoted form." (defvar package-user-dir) -(defun elisp--xref-find-matches (symbol kind) +(defun elisp--xref-find-matches (symbol fun) (let* ((dirs (sort (mapcar (lambda (dir) @@ -673,7 +673,7 @@ It can be quoted, or be inside a quoted form." (cl-mapcan (lambda (dir) (and (file-exists-p dir) - (xref-collect-matches symbol dir kind))) + (funcall fun symbol dir))) dirs))) (defun elisp--xref-find-apropos (regexp) diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el index d03032d0abb..bf57770a3dd 100644 --- a/lisp/progmodes/etags.el +++ b/lisp/progmodes/etags.el @@ -2087,19 +2087,18 @@ for \\[find-tag] (which see)." (defun etags-xref-find (action id) (pcase action (`definitions (etags--xref-find-definitions id)) - (`references (etags--xref-find-matches id 'symbol)) - (`matches (etags--xref-find-matches id 'regexp)) + (`references + (etags--xref-find-matches id #'xref-collect-references)) + (`matches + (etags--xref-find-matches id #'xref-collect-matches)) (`apropos (etags--xref-find-definitions id t)))) -(defun etags--xref-find-matches (input kind) +(defun etags--xref-find-matches (input fun) (let ((dirs (if tags-table-list (mapcar #'file-name-directory tags-table-list) ;; If no tags files are loaded, prompt for the dir. (list (read-directory-name "In directory: " nil nil t))))) - (cl-mapcan - (lambda (dir) - (xref-collect-matches input dir kind)) - dirs))) + (cl-mapcan (lambda (dir) (funcall fun input dir)) dirs))) (defun etags--xref-find-definitions (pattern &optional regexp?) ;; This emulates the behaviour of `find-tag-in-order' but instead of diff --git a/lisp/progmodes/grep.el b/lisp/progmodes/grep.el index 048fa1180a9..6981d38ee5f 100644 --- a/lisp/progmodes/grep.el +++ b/lisp/progmodes/grep.el @@ -992,58 +992,7 @@ to specify a command to run." grep-find-command))) (compilation-start regexp 'grep-mode)) (setq dir (file-name-as-directory (expand-file-name dir))) - (require 'find-dired) ; for `find-name-arg' - (let ((command (grep-expand-template - grep-find-template - regexp - (concat (shell-quote-argument "(") - " " find-name-arg " " - (mapconcat - #'shell-quote-argument - (split-string files) - (concat " -o " find-name-arg " ")) - " " - (shell-quote-argument ")")) - dir - (concat - (and grep-find-ignored-directories - (concat "-type d " - (shell-quote-argument "(") - ;; we should use shell-quote-argument here - " -path " - (mapconcat - #'(lambda (ignore) - (cond ((stringp ignore) - (shell-quote-argument - (concat "*/" ignore))) - ((consp ignore) - (and (funcall (car ignore) dir) - (shell-quote-argument - (concat "*/" - (cdr ignore))))))) - grep-find-ignored-directories - " -o -path ") - " " - (shell-quote-argument ")") - " -prune -o ")) - (and grep-find-ignored-files - (concat (shell-quote-argument "!") " -type d " - (shell-quote-argument "(") - ;; we should use shell-quote-argument here - " -name " - (mapconcat - #'(lambda (ignore) - (cond ((stringp ignore) - (shell-quote-argument ignore)) - ((consp ignore) - (and (funcall (car ignore) dir) - (shell-quote-argument - (cdr ignore)))))) - grep-find-ignored-files - " -o -name ") - " " - (shell-quote-argument ")") - " -prune -o ")))))) + (let ((command (rgrep-default-command regexp files dir))) (when command (if confirm (setq command @@ -1056,6 +1005,61 @@ to specify a command to run." (if (eq next-error-last-buffer (current-buffer)) (setq default-directory dir))))))) +(defun rgrep-default-command (regexp files dir) + "Compute the command for \\[rgrep] to use by default." + (require 'find-dired) ; for `find-name-arg' + (grep-expand-template + grep-find-template + regexp + (concat (shell-quote-argument "(") + " " find-name-arg " " + (mapconcat + #'shell-quote-argument + (split-string files) + (concat " -o " find-name-arg " ")) + " " + (shell-quote-argument ")")) + dir + (concat + (and grep-find-ignored-directories + (concat "-type d " + (shell-quote-argument "(") + ;; we should use shell-quote-argument here + " -path " + (mapconcat + #'(lambda (ignore) + (cond ((stringp ignore) + (shell-quote-argument + (concat "*/" ignore))) + ((consp ignore) + (and (funcall (car ignore) dir) + (shell-quote-argument + (concat "*/" + (cdr ignore))))))) + grep-find-ignored-directories + " -o -path ") + " " + (shell-quote-argument ")") + " -prune -o ")) + (and grep-find-ignored-files + (concat (shell-quote-argument "!") " -type d " + (shell-quote-argument "(") + ;; we should use shell-quote-argument here + " -name " + (mapconcat + #'(lambda (ignore) + (cond ((stringp ignore) + (shell-quote-argument ignore)) + ((consp ignore) + (and (funcall (car ignore) dir) + (shell-quote-argument + (cdr ignore)))))) + grep-find-ignored-files + " -o -name ") + " " + (shell-quote-argument ")") + " -prune -o "))))) + ;;;###autoload (defun zrgrep (regexp &optional files dir confirm template) "Recursively grep for REGEXP in gzipped FILES in tree rooted at DIR. diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el index 3bc66f884eb..d6f6ba89ab9 100644 --- a/lisp/progmodes/xref.el +++ b/lisp/progmodes/xref.el @@ -720,32 +720,59 @@ and just use etags." (declare-function semantic-symref-find-references-by-name "semantic/symref") (declare-function semantic-symref-find-text "semantic/symref") (declare-function semantic-find-file-noselect "semantic/fw") +(declare-function rgrep-default-command "grep") -(defun xref-collect-matches (input dir &optional kind) - "Collect KIND matches for INPUT inside DIR according. -KIND can be `symbol', `regexp' or nil, the last of which means -literal matches. This function uses the Semantic Symbol -Reference API, see `semantic-symref-find-references-by-name' for -details on which tools are used, and when." +(defun xref-collect-references (symbol dir) + "Collect references to SYMBOL inside DIR. +This function uses the Semantic Symbol Reference API, see +`semantic-symref-find-references-by-name' for details on which +tools are used, and when." + (cl-assert (directory-name-p dir)) (require 'semantic/symref) (defvar semantic-symref-tool) - (cl-assert (directory-name-p dir)) - (when (null kind) - (setq input (regexp-quote input))) - ;; FIXME: When regexp, search in all files, except - ;; `grep-find-ignored-directories' and `grep-find-ignored-files', - ;; like `rgrep' does. (let* ((default-directory dir) (semantic-symref-tool 'detect) - (res (if (eq kind 'symbol) - (semantic-symref-find-references-by-name input 'subdirs) - (semantic-symref-find-text (xref--regexp-to-extended input) - 'subdirs))) + (res (semantic-symref-find-references-by-name symbol 'subdirs)) (hits (and res (oref res :hit-lines))) (orig-buffers (buffer-list))) (unwind-protect (delq nil - (mapcar (lambda (hit) (xref--collect-match hit input kind)) hits)) + (mapcar (lambda (hit) (xref--collect-match + hit (format "\\_<%s\\_>" (regexp-quote symbol)))) + hits)) + (mapc #'kill-buffer + (cl-set-difference (buffer-list) orig-buffers))))) + +(defun xref-collect-matches (regexp dir) + "Collect matches for REGEXP inside DIR using rgrep." + (cl-assert (directory-name-p dir)) + (require 'semantic/fw) + (grep-compute-defaults) + (defvar grep-find-template) + (let* ((grep-find-template (replace-regexp-in-string "-e " "-E " + grep-find-template t t)) + (command (rgrep-default-command (xref--regexp-to-extended regexp) + "*.*" dir)) + (orig-buffers (buffer-list)) + (buf (get-buffer-create " *xref-grep*")) + (grep-re (caar grep-regexp-alist)) + hits) + ;; http://debbugs.gnu.org/20719 + ;; We want to pass the exact directory to `find', because then + ;; `grep' output features absolute file names. + (when (string-match "find \\(\\.\\)" command) + (setq command (replace-match (shell-quote-argument dir) t t command 1))) + (with-current-buffer buf + (erase-buffer) + (when (eq (call-process-shell-command command nil t) 0) + (goto-char (point-min)) + (while (re-search-forward grep-re nil t) + (push (cons (string-to-number (match-string 2)) + (match-string 1)) + hits)))) + (unwind-protect + (delq nil + (mapcar (lambda (hit) (xref--collect-match hit regexp)) hits)) (mapc #'kill-buffer (cl-set-difference (buffer-list) orig-buffers))))) @@ -767,18 +794,15 @@ details on which tools are used, and when." (match-string 1 str))))) str t t)) -(defun xref--collect-match (hit input kind) +(defun xref--collect-match (hit regexp) (pcase-let* ((`(,line . ,file) hit) (buf (or (find-buffer-visiting file) - (semantic-find-file-noselect file))) - (input (if (eq kind 'symbol) - (format "\\_<%s\\_>" (regexp-quote input)) - input))) + (semantic-find-file-noselect file)))) (with-current-buffer buf (save-excursion (goto-char (point-min)) (forward-line (1- line)) - (when (re-search-forward input (line-end-position) t) + (when (re-search-forward regexp (line-end-position) t) (goto-char (match-beginning 0)) (xref-make (buffer-substring (line-beginning-position)