From: Dmitry Gutov Date: Wed, 4 May 2016 23:52:34 +0000 (+0300) Subject: Rework xref-query-replace-in-results X-Git-Tag: emacs-25.0.94~31 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=922c7a3;p=emacs.git Rework xref-query-replace-in-results * lisp/progmodes/xref.el (xref-query-replace-in-results): Collect all xrefs from the buffer first, then delegate most of the processing to the value returned by xref--buf-pairs-iterator. (xref--buf-pairs-iterator): New function. Return an "iterator" which partitions returned markers into buffers, and only processes markers from one buffer at a time. When an xref is out of date, skip it with a message instead of signaling error (bug#23284). (xref--outdated-p): Extract from xref--buf-pairs-iterator. Trim CR from both strings before comparing. (xref--query-replace-1): Remove the variable current-buf, no need to track it anymore. Simplify the filter-predicate and search functions accordingly. Iterate over buffer-markers pairs returned by the iterator, and call `perform-replace' for each of them. Use multi-query-replace-map (bug#23284). Use `switch-to-buffer' every time after the first, in order not to jump between windows. * test/automated/xref-tests.el (xref--buf-pairs-iterator-groups-markers-by-buffers-1) (xref--buf-pairs-iterator-groups-markers-by-buffers-2) (xref--buf-pairs-iterator-cleans-up-markers): New tests. --- diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el index 62cef235988..17bfdb69f8f 100644 --- a/lisp/progmodes/xref.el +++ b/lisp/progmodes/xref.el @@ -521,58 +521,86 @@ 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 ((reporter (make-progress-reporter (format "Saving search results...") - 0 (line-number-at-pos (point-max)))) - (counter 0) - pairs item) + (let* (item xrefs iter) + (save-excursion + (while (setq item (xref--search-property 'xref-item)) + (when (xref-match-length item) + (push item xrefs)))) (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 - (let* ((loc (xref-item-location item)) - (beg (xref-location-marker loc)) - (end (move-marker (make-marker) - (+ beg (xref-match-length item)) - (marker-buffer beg)))) - ;; Perform sanity check first. - (xref--goto-location loc) - ;; FIXME: The check should probably be a generic - ;; function, instead of the assumption that all - ;; matches contain the full line as summary. - ;; TODO: Offer to re-scan otherwise. - (unless (equal (buffer-substring-no-properties - (line-beginning-position) - (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) - (move-marker (cdr pair) nil))))) + (goto-char (point-min)) + (setq iter (xref--buf-pairs-iterator (nreverse xrefs))) + (xref--query-replace-1 from to iter)) + (funcall iter :cleanup)))) + +(defun xref--buf-pairs-iterator (xrefs) + (let (chunk-done item next-pair file-buf pairs all-pairs) + (lambda (action) + (pcase action + (:next + (when (or xrefs next-pair) + (setq chunk-done nil) + (when next-pair + (setq file-buf (marker-buffer (car next-pair)) + pairs (list next-pair) + next-pair nil)) + (while (and (not chunk-done) + (setq item (pop xrefs))) + (save-excursion + (let* ((loc (xref-item-location item)) + (beg (xref-location-marker loc)) + (end (move-marker (make-marker) + (+ beg (xref-match-length item)) + (marker-buffer beg)))) + (let ((pair (cons beg end))) + (push pair all-pairs) + ;; Perform sanity check first. + (xref--goto-location loc) + (if (xref--outdated-p item + (buffer-substring-no-properties + (line-beginning-position) + (line-end-position))) + (message "Search result out of date, skipping") + (cond + ((null file-buf) + (setq file-buf (marker-buffer beg)) + (push pair pairs)) + ((equal file-buf (marker-buffer beg)) + (push pair pairs)) + (t + (setq chunk-done t + next-pair pair)))))))) + (cons file-buf pairs))) + (:cleanup + (dolist (pair all-pairs) + (move-marker (car pair) nil) + (move-marker (cdr pair) nil))))))) + +(defun xref--outdated-p (item line-text) + ;; FIXME: The check should probably be a generic function instead of + ;; the assumption that all matches contain the full line as summary. + (let ((summary (xref-item-summary item)) + (strip (lambda (s) (if (string-match "\r\\'" s) + (substring-no-properties s 0 -1) + s)))) + (not + ;; Sometimes buffer contents include ^M, and sometimes Grep + ;; output includes it, and they don't always match. + (equal (funcall strip line-text) + (funcall strip summary))))) ;; FIXME: Write a nicer UI. -(defun xref--query-replace-1 (from to pairs) +(defun xref--query-replace-1 (from to iter) (let* ((query-replace-lazy-highlight nil) - current-beg current-end current-buf + (continue t) + did-it-once buf-pairs pairs + current-beg current-end ;; Counteract the "do the next match now" hack in ;; `perform-replace'. And still, it'll report that those ;; matches were "filtered out" at the end. (isearch-filter-predicate (lambda (beg end) (and current-beg - (eq (current-buffer) current-buf) (>= beg current-beg) (<= end current-end)))) (replace-re-search-function @@ -581,19 +609,22 @@ references displayed in the current *xref* buffer." (while (and (not found) pairs) (setq pair (pop pairs) current-beg (car pair) - current-end (cdr pair) - current-buf (marker-buffer current-beg)) - (xref--with-dedicated-window - (pop-to-buffer current-buf)) + current-end (cdr pair)) (goto-char current-beg) (when (re-search-forward from current-end noerror) (setq found t))) found)))) - ;; FIXME: Despite this being a multi-buffer replacement, `N' - ;; doesn't work, because we're not using - ;; `multi-query-replace-map', and it would expect the below - ;; function to be called once per buffer. - (perform-replace from to t t nil))) + (while (and continue (setq buf-pairs (funcall iter :next))) + (if did-it-once + ;; Reuse the same window for subsequent buffers. + (switch-to-buffer (car buf-pairs)) + (xref--with-dedicated-window + (pop-to-buffer (car buf-pairs))) + (setq did-it-once t)) + (setq pairs (cdr buf-pairs)) + (setq continue + (perform-replace from to t t nil nil multi-query-replace-map))) + (unless did-it-once (user-error "No suitable matches here")))) (defvar xref--xref-buffer-mode-map (let ((map (make-sparse-keymap))) diff --git a/test/automated/xref-tests.el b/test/automated/xref-tests.el index b288e2d7584..079b196aa8b 100644 --- a/test/automated/xref-tests.el +++ b/test/automated/xref-tests.el @@ -60,3 +60,32 @@ (should (string-match-p "file2\\.txt\\'" (xref-location-group (nth 0 locs)))) (should (equal 1 (xref-location-line (nth 0 locs)))) (should (equal 0 (xref-file-location-column (nth 0 locs)))))) + +(ert-deftest xref--buf-pairs-iterator-groups-markers-by-buffers-1 () + (let* ((xrefs (xref-collect-matches "foo" "*" xref-tests-data-dir nil)) + (iter (xref--buf-pairs-iterator xrefs)) + (cons (funcall iter :next))) + (should (null (funcall iter :next))) + (should (string-match "file1\\.txt\\'" (buffer-file-name (car cons)))) + (should (= 2 (length (cdr cons)))))) + +(ert-deftest xref--buf-pairs-iterator-groups-markers-by-buffers-2 () + (let* ((xrefs (xref-collect-matches "bar" "*" xref-tests-data-dir nil)) + (iter (xref--buf-pairs-iterator xrefs)) + (cons1 (funcall iter :next)) + (cons2 (funcall iter :next))) + (should (null (funcall iter :next))) + (should-not (equal (car cons1) (car cons2))) + (should (= 1 (length (cdr cons1)))) + (should (= 1 (length (cdr cons2)))))) + +(ert-deftest xref--buf-pairs-iterator-cleans-up-markers () + (let* ((xrefs (xref-collect-matches "bar" "*" xref-tests-data-dir nil)) + (iter (xref--buf-pairs-iterator xrefs)) + (cons1 (funcall iter :next)) + (cons2 (funcall iter :next))) + (funcall iter :cleanup) + (should (null (marker-position (car (nth 0 (cdr cons1)))))) + (should (null (marker-position (cdr (nth 0 (cdr cons1)))))) + (should (null (marker-position (car (nth 0 (cdr cons2)))))) + (should (null (marker-position (cdr (nth 0 (cdr cons2))))))))