[Emacs-diffs] master 0896328: Add xref-find-regexp

[Dmitry Gutov]

branch: master
commit 089632800a1d408d2d2a9f0ecc5c52ce9c5319c6
Author: Dmitry Gutov <address@hidden>
Commit: Dmitry Gutov <address@hidden>

    Add xref-find-regexp
    
    * lisp/progmodes/xref.el (xref-find-function): Describe the
    `matches' action.
    (xref-find-regexp): New command, using it.
    (xref-collect-references): Rename to xref-collect-matches.
    (xref--collect-reference): Rename to xref--collect-match.
    (xref-collect-matches, xref--collect-match): Accept new argument,
    KIND.  Update accordingly.
    (xref--regexp-to-extended): New function.
    
    * lisp/progmodes/elisp-mode.el (elisp-xref-find): Support the
    `matches' action.
    (elisp--xref-find-matches): Accept new argument.  Resolve a FIXME.
    
    * lisp/progmodes/etags.el (etags-xref-find):
    Support the `matches' action.
    (etags--xref-find-matches): New function.
---
 lisp/progmodes/elisp-mode.el |   14 ++++++---
 lisp/progmodes/etags.el      |   21 ++++++++------
 lisp/progmodes/xref.el       |   59 +++++++++++++++++++++++++++++++++--------
 3 files changed, 68 insertions(+), 26 deletions(-)

diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el
index 7bc7798..e06b920 100644
--- a/lisp/progmodes/elisp-mode.el
+++ b/lisp/progmodes/elisp-mode.el
@@ -581,7 +581,7 @@ It can be quoted, or be inside a quoted form."
 (declare-function xref-make-elisp-location "xref" (symbol type file))
 (declare-function xref-make-bogus-location "xref" (message))
 (declare-function xref-make "xref" (description location))
-(declare-function xref-collect-references "xref" (name dir))
+(declare-function xref-collect-matches "xref" (input dir &optional kind))
 
 (defun elisp-xref-find (action id)
   (require 'find-func)
@@ -591,7 +591,9 @@ It can be quoted, or be inside a quoted form."
         (when sym
           (elisp--xref-find-definitions sym))))
     (`references
-     (elisp--xref-find-references id))
+     (elisp--xref-find-matches id 'symbol))
+    (`matches
+     (elisp--xref-find-matches id 'regexp))
     (`apropos
      (elisp--xref-find-apropos id))))
 
@@ -652,12 +654,14 @@ It can be quoted, or be inside a quoted form."
 
 (defvar package-user-dir)
 
-(defun elisp--xref-find-references (symbol)
+(defun elisp--xref-find-matches (symbol kind)
   (let* ((dirs (sort
                 (mapcar
                  (lambda (dir)
                    (file-name-as-directory (expand-file-name dir)))
-                 ;; FIXME: Why add package-user-dir?
+                 ;; It's one level above a number of `load-path'
+                 ;; elements (one for each installed package).
+                 ;; Save us some process calls.
                  (cons package-user-dir load-path))
                 #'string<))
          (ref dirs))
@@ -669,7 +673,7 @@ It can be quoted, or be inside a quoted form."
     (cl-mapcan
      (lambda (dir)
        (and (file-exists-p dir)
-            (xref-collect-references symbol dir)))
+            (xref-collect-matches symbol dir kind)))
      dirs)))
 
 (defun elisp--xref-find-apropos (regexp)
diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el
index 9a93176..7a87377 100644
--- a/lisp/progmodes/etags.el
+++ b/lisp/progmodes/etags.el
@@ -2082,17 +2082,20 @@ for \\[find-tag] (which see)."
 (defun etags-xref-find (action id)
   (pcase action
     (`definitions (etags--xref-find-definitions id))
-    (`references
-     (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-references id dir))
-        dirs)))
+    (`references (etags--xref-find-matches id 'symbol))
+    (`matches (etags--xref-find-matches id 'regexp))
     (`apropos (etags--xref-find-definitions id t))))
 
+(defun etags--xref-find-matches (input kind)
+  (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)))
+
 (defun etags--xref-find-definitions (pattern &optional regexp?)
   ;; This emulates the behaviour of `find-tag-in-order' but instead of
   ;; returning one match at a time all matches are returned as list.
diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el
index f6faaf6..ef46e34 100644
--- a/lisp/progmodes/xref.el
+++ b/lisp/progmodes/xref.el
@@ -207,6 +207,9 @@ found, return nil.
  (apropos PATTERN): Find all symbols that match PATTERN.  PATTERN
 is a regexp.
 
+ (matches REGEXP): Find all matches for REGEXP in the related
+files.  REGEXP is an Emacs regular expression.
+
 IDENTIFIER can be any string returned by
 `xref-identifier-at-point-function', or from the table returned
 by `xref-identifier-completion-table-function'.
@@ -661,6 +664,12 @@ With prefix argument, prompt for the identifier."
   (interactive (list (xref--read-identifier "Find references of: ")))
   (xref--show-xrefs identifier 'references identifier nil))
 
+;;;###autoload
+(defun xref-find-regexp (regexp)
+  "Find all matches for REGEXP."
+  (interactive (list (xref--read-identifier "Find regexp: ")))
+  (xref--show-xrefs regexp 'matches regexp nil))
+
 (declare-function apropos-parse-pattern "apropos" (pattern))
 
 ;;;###autoload
@@ -713,38 +722,64 @@ and just use etags."
                 (cdr xref-etags-mode--saved))))
 
 (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")
 
-(defun xref-collect-references (name dir)
-  "Collect mentions of NAME inside DIR.
-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-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."
   (require 'semantic/symref)
   (defvar semantic-symref-tool)
   (cl-assert (directory-name-p dir))
+  (when (null kind)
+    (setq input (regexp-quote input)))
   (let* ((default-directory dir)
          (semantic-symref-tool 'detect)
-         (res (semantic-symref-find-references-by-name name 'subdirs))
+         (res (if (eq kind 'symbol)
+                  (semantic-symref-find-references-by-name input 'subdirs)
+                (semantic-symref-find-text (xref--regexp-to-extended input)
+                                           'subdirs)))
          (hits (and res (oref res :hit-lines)))
          (orig-buffers (buffer-list)))
     (unwind-protect
         (delq nil
-              (mapcar (lambda (hit) (xref--collect-reference hit name)) hits))
+              (mapcar (lambda (hit) (xref--collect-match hit input kind)) 
hits))
       (mapc #'kill-buffer
             (cl-set-difference (buffer-list) orig-buffers)))))
 
-(defun xref--collect-reference (hit name)
+(defun xref--regexp-to-extended (str)
+  (replace-regexp-in-string
+   ;; FIXME: Add tests.  Move to subr.el, make a public function.
+   ;; Maybe error on Emacs-only constructs.
+   "\\(?:\\\\\\\\\\)*\\(?:\\\\[][]\\)?\\(?:\\[.+?\\]\\|\\(\\\\?[(){}|]\\)\\)"
+   (lambda (str)
+     (cond
+      ((not (match-beginning 1))
+       str)
+      ((eq (length (match-string 1 str)) 2)
+       (concat (substring str 0 (match-beginning 1))
+               (substring (match-string 1 str) 1 2)))
+      (t
+       (concat (substring str 0 (match-beginning 1))
+               "\\"
+               (match-string 1 str)))))
+   str t t))
+
+(defun xref--collect-match (hit input kind)
   (pcase-let* ((`(,line . ,file) hit)
                (buf (or (find-buffer-visiting file)
-                        (semantic-find-file-noselect file))))
+                        (semantic-find-file-noselect file)))
+               (input (if (eq kind 'symbol)
+                          (format "\\_<%s\\_>" (regexp-quote input))
+                        input)))
     (with-current-buffer buf
       (save-excursion
         (goto-char (point-min))
         (forward-line (1- line))
-        (when (re-search-forward (format "\\_<%s\\_>"
-                                         (regexp-quote name))
-                                 (line-end-position) t)
+        (when (re-search-forward input (line-end-position) t)
           (goto-char (match-beginning 0))
           (xref-make (buffer-substring
                       (line-beginning-position)