[Emacs-diffs] emacs-25 36b0729 1/2: Add xref-based replacements for Dired search commands

[Dmitry Gutov]

branch: emacs-25
commit 36b0729ce765c132e04586be0e2deca405b4c313
Author: Dmitry Gutov <address@hidden>
Commit: Dmitry Gutov <address@hidden>

    Add xref-based replacements for Dired search commands
    
    * lisp/dired-aux.el (dired-do-find-regexp)
    (dired-do-find-regexp-and-replace): New commands.
    http://lists.gnu.org/archive/html/emacs-devel/2016-01/msg00864.html
    
    * lisp/dired.el (dired-mode-map): Change bindings for `A' and
    `Q' to the new commands.
    
    * lisp/progmodes/xref.el (xref-query-replace)
    (xref-collect-matches): Add progress reporters.
    (xref--find-ignores-arguments): Return nil for zero ignores.
    (xref--show-xrefs): Add an optional argument.
    (xref-collect-matches): Drop the assert.  'find' accepts a
    regular file in place of directory argument, too.
---
 lisp/dired-aux.el      |   35 +++++++++++++++++++++++++
 lisp/dired.el          |   16 +++++++++--
 lisp/progmodes/xref.el |   65 +++++++++++++++++++++++++++++++----------------
 3 files changed, 91 insertions(+), 25 deletions(-)

diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el
index a8c40b2..831278c 100644
--- a/lisp/dired-aux.el
+++ b/lisp/dired-aux.el
@@ -2713,6 +2713,41 @@ with the command \\[tags-loop-continue]."
   (tags-query-replace from to delimited
                      '(dired-get-marked-files nil nil 'dired-nondirectory-p)))
 
+(declare-function xref--show-xrefs "xref")
+(declare-function xref-query-replace "xref")
+
+;;;###autoload
+(defun dired-do-find-regexp (regexp)
+  "Find all matches for REGEXP in all marked files, recursively."
+  (interactive "sSearch marked files (regexp): ")
+  (require 'grep)
+  (defvar grep-find-ignored-files)
+  (let* ((files (dired-get-marked-files))
+         (ignores (nconc (mapcar
+                          (lambda (s) (concat s "/"))
+                          vc-directory-exclusion-list)
+                         grep-find-ignored-files))
+         (xrefs (cl-mapcan
+                 (lambda (file)
+                   (xref-collect-matches regexp "*" file
+                                         (and (file-directory-p file)
+                                              ignores)))
+                 files)))
+    (unless xrefs
+      (user-error "No matches for: %s" regexp))
+    (xref--show-xrefs xrefs nil t)))
+
+;;;###autoload
+(defun dired-do-find-regexp-and-replace (from to)
+  "Replace matches of FROM with TO, in all marked files, recursively."
+  (interactive
+   (let ((common
+          (query-replace-read-args
+           "Query replace regexp in marked files" t t)))
+     (list (nth 0 common) (nth 1 common))))
+  (with-current-buffer (dired-do-find-regexp from)
+    (xref-query-replace from to)))
+
 (defun dired-nondirectory-p (file)
   (not (file-directory-p file)))
 
diff --git a/lisp/dired.el b/lisp/dired.el
index d7bc318..0ca14b3 100644
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -1450,7 +1450,7 @@ Do so according to the former subdir alist 
OLD-SUBDIR-ALIST."
     (define-key map "." 'dired-clean-directory)
     (define-key map "~" 'dired-flag-backup-files)
     ;; Upper case keys (except !) for operating on the marked files
-    (define-key map "A" 'dired-do-search)
+    (define-key map "A" 'dired-do-find-regexp)
     (define-key map "C" 'dired-do-copy)
     (define-key map "B" 'dired-do-byte-compile)
     (define-key map "D" 'dired-do-delete)
@@ -1460,7 +1460,7 @@ Do so according to the former subdir alist 
OLD-SUBDIR-ALIST."
     (define-key map "M" 'dired-do-chmod)
     (define-key map "O" 'dired-do-chown)
     (define-key map "P" 'dired-do-print)
-    (define-key map "Q" 'dired-do-query-replace-regexp)
+    (define-key map "Q" 'dired-do-find-regexp-and-replace)
     (define-key map "R" 'dired-do-rename)
     (define-key map "S" 'dired-do-symlink)
     (define-key map "T" 'dired-do-touch)
@@ -3905,7 +3905,7 @@ Ask means pop up a menu for the user to select one of 
copy, move or link."
 
 ;;; Start of automatically extracted autoloads.
 
-;;;### (autoloads nil "dired-aux" "dired-aux.el" 
"7b7e39be8bcaf5f35b2735c3f5635f40")
+;;;### (autoloads nil "dired-aux" "dired-aux.el" 
"ab7321f16a90251f12f0031ddd6a710c")
 ;;; Generated autoloads from dired-aux.el
 
 (autoload 'dired-diff "dired-aux" "\
@@ -4408,6 +4408,16 @@ with the command \\[tags-loop-continue].
 
 \(fn FROM TO &optional DELIMITED)" t nil)
 
+(autoload 'dired-do-find-regexp "dired-aux" "\
+Find all matches for REGEXP in all marked files, recursively.
+
+\(fn REGEXP)" t nil)
+
+(autoload 'dired-do-find-regexp-and-replace "dired-aux" "\
+Replace matches of FROM with TO, in all marked files, recursively.
+
+\(fn FROM TO)" t nil)
+
 (autoload 'dired-show-file-type "dired-aux" "\
 Print the type of FILE, according to the `file' command.
 If you give a prefix to this command, and FILE is a symbolic
diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el
index 6220b4c..2bccd85 100644
--- a/lisp/progmodes/xref.el
+++ b/lisp/progmodes/xref.el
@@ -511,11 +511,18 @@ references displayed in the current *xref* buffer."
    (let ((fr (read-regexp "Xref query-replace (regexp)" ".*")))
      (list fr
            (read-regexp (format "Xref query-replace (regexp) %s with: " fr)))))
-  (let (pairs item)
+  (let ((reporter (make-progress-reporter (format "Saving search results...")
+                                          0 (line-number-at-pos (point-max))))
+        (counter 0)
+        pairs item)
     (unwind-protect
         (progn
           (save-excursion
             (goto-char (point-min))
+            ;; TODO: This list should be computed on-demand instead.
+            ;; As long as the UI just iterates through matches one by
+            ;; one, there's no need to compute them all in advance.
+            ;; Then we can throw away the reporter.
             (while (setq item (xref--search-property 'xref-item))
               (when (xref-match-length item)
                 (save-excursion
@@ -535,9 +542,11 @@ references displayed in the current *xref* buffer."
                                     (line-end-position))
                                    (xref-item-summary item))
                       (user-error "Search results out of date"))
+                    (progress-reporter-update reporter (cl-incf counter))
                     (push (cons beg end) pairs)))))
             (setq pairs (nreverse pairs)))
           (unless pairs (user-error "No suitable matches here"))
+          (progress-reporter-done reporter)
           (xref--query-replace-1 from to pairs))
       (dolist (pair pairs)
         (move-marker (car pair) nil)
@@ -713,9 +722,9 @@ Return an alist of the form ((FILENAME . (XREF ...)) ...)."
 
 (defvar xref--read-pattern-history nil)
 
-(defun xref--show-xrefs (xrefs window)
+(defun xref--show-xrefs (xrefs window &optional always-show-list)
   (cond
-   ((not (cdr xrefs))
+   ((and (not (cdr xrefs)) (not always-show-list))
     (xref-push-marker-stack)
     (xref--pop-to-location (car xrefs) window))
    (t
@@ -866,11 +875,12 @@ tools are used, and when."
       (mapc #'kill-buffer
             (cl-set-difference (buffer-list) orig-buffers)))))
 
+;;;###autoload
 (defun xref-collect-matches (regexp files dir ignores)
   "Collect matches for REGEXP inside FILES in DIR.
 FILES is a string with glob patterns separated by spaces.
 IGNORES is a list of glob patterns."
-  (cl-assert (directory-name-p dir))
+  ;; DIR can also be a regular file for now; let's not advertise that.
   (require 'semantic/fw)
   (grep-compute-defaults)
   (defvar grep-find-template)
@@ -885,6 +895,8 @@ IGNORES is a list of glob patterns."
          (orig-buffers (buffer-list))
          (buf (get-buffer-create " *xref-grep*"))
          (grep-re (caar grep-regexp-alist))
+         (counter 0)
+         reporter
          hits)
     (with-current-buffer buf
       (erase-buffer)
@@ -894,9 +906,17 @@ IGNORES is a list of glob patterns."
         (push (cons (string-to-number (match-string 2))
                     (match-string 1))
               hits)))
+    (setq reporter (make-progress-reporter
+                    (format "Collecting search results...")
+                    0 (length hits)))
     (unwind-protect
-        (cl-mapcan (lambda (hit) (xref--collect-matches hit regexp))
+        (cl-mapcan (lambda (hit)
+                     (prog1
+                         (progress-reporter-update reporter counter)
+                       (cl-incf counter))
+                     (xref--collect-matches hit regexp))
                    (nreverse hits))
+      (progress-reporter-done reporter)
       ;; TODO: Same as above.
       (mapc #'kill-buffer
             (cl-set-difference (buffer-list) orig-buffers)))))
@@ -922,23 +942,24 @@ IGNORES is a list of glob patterns."
 (defun xref--find-ignores-arguments (ignores dir)
   ;; `shell-quote-argument' quotes the tilde as well.
   (cl-assert (not (string-match-p "\\`~" dir)))
-  (concat
-   (shell-quote-argument "(")
-   " -path "
-   (mapconcat
-    (lambda (ignore)
-      (when (string-match-p "/\\'" ignore)
-        (setq ignore (concat ignore "*")))
-      (if (string-match "\\`\\./" ignore)
-          (setq ignore (replace-match dir t t ignore))
-        (unless (string-prefix-p "*" ignore)
-          (setq ignore (concat "*/" ignore))))
-      (shell-quote-argument ignore))
-    ignores
-    " -o -path ")
-   " "
-   (shell-quote-argument ")")
-   " -prune -o "))
+  (when ignores
+    (concat
+     (shell-quote-argument "(")
+     " -path "
+     (mapconcat
+      (lambda (ignore)
+        (when (string-match-p "/\\'" ignore)
+          (setq ignore (concat ignore "*")))
+        (if (string-match "\\`\\./" ignore)
+            (setq ignore (replace-match dir t t ignore))
+          (unless (string-prefix-p "*" ignore)
+            (setq ignore (concat "*/" ignore))))
+        (shell-quote-argument ignore))
+      ignores
+      " -o -path ")
+     " "
+     (shell-quote-argument ")")
+     " -prune -o ")))
 
 (defun xref--regexp-to-extended (str)
   (replace-regexp-in-string