[Emacs-diffs] scratch/xref-next eddace3 1/2: Replace xref-match-bounds with xref-match-length

[Dmitry Gutov]

branch: scratch/xref-next
commit eddace3c0ec5c7eb412494e0dc9cc5b3dc415617
Author: Dmitry Gutov <address@hidden>
Commit: Dmitry Gutov <address@hidden>

    Replace xref-match-bounds with xref-match-length
---
 lisp/progmodes/xref.el |   99 +++++++++++++++++++++++-------------------------
 1 files changed, 47 insertions(+), 52 deletions(-)

diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el
index 89a0604..c6af6c2 100644
--- a/lisp/progmodes/xref.el
+++ b/lisp/progmodes/xref.el
@@ -38,6 +38,11 @@
 ;; class inheriting from `xref-location' and implementing
 ;; `xref-location-group' and `xref-location-marker'.
 ;;
+;; There's a special kind of xrefs we call "match xrefs", which
+;; correspond to search results.  For these values,
+;; `xref-match-length' must be defined, and `xref-location-marker'
+;; must return the beginning of the match.
+;;
 ;; Each identifier must be represented as a string.  Implementers can
 ;; use string properties to store additional information about the
 ;; identifier, but they should keep in mind that values returned from
@@ -79,8 +84,8 @@ This is typically the filename.")
   "Return the line number corresponding to the location."
   nil)
 
-(cl-defgeneric xref-match-bounds (_item)
-  "Return a cons with columns of the beginning and end of the match."
+(cl-defgeneric xref-match-length (_item)
+  "Return the length of the match."
   nil)
 
 ;;;; Commonly needed location classes are defined here:
@@ -176,22 +181,16 @@ LOCATION is an `xref-location'."
    (location :initarg :location
              :type xref-file-location
              :reader xref-item-location)
-   (end-column :initarg :end-column))
-  :comment "An xref item describes a reference to a location
-somewhere.")
-
-(cl-defmethod xref-match-bounds ((i xref-match-item))
-  (with-slots (end-column location) i
-    (cons (xref-file-location-column location)
-          end-column)))
+   (length :initarg :length :reader xref-match-length))
+  :comment "A match xref item describes a search result.")
 
-(defun xref-make-match (summary end-column location)
+(defun xref-make-match (summary location length)
   "Create and return a new `xref-match-item'.
 SUMMARY is a short string to describe the xref.
-END-COLUMN is the match end column number inside SUMMARY.
-LOCATION is an `xref-location'."
-  (make-instance 'xref-match-item :summary summary :location location
-                 :end-column end-column))
+LOCATION is an `xref-location'.
+LENGTH is the match length, in characters."
+  (make-instance 'xref-match-item :summary summary
+                 :location location :length length))
 
 
 ;;; API
@@ -345,22 +344,14 @@ elements is negated."
   (pcase-let ((`(,beg . ,end)
                (save-excursion
                  (or
-                  (xref--match-buffer-bounds xref--current-item)
+                  (let ((length (xref-match-length xref--current-item)))
+                    (and length (cons (point) (+ (point) length))))
                   (back-to-indentation)
                   (if (eolp)
                       (cons (line-beginning-position) (1+ (point)))
                     (cons (point) (line-end-position)))))))
     (pulse-momentary-highlight-region beg end 'next-error)))
 
-(defun xref--match-buffer-bounds (item)
-  (save-excursion
-    (let ((bounds (xref-match-bounds item)))
-      (when bounds
-        (cons (progn (move-to-column (car bounds))
-                     (point))
-              (progn (move-to-column (cdr bounds))
-                     (point)))))))
-
 ;; etags.el needs this
 (defun xref-clear-marker-stack ()
   "Discard all markers from the marker stack."
@@ -487,50 +478,54 @@ WINDOW controls how the buffer is displayed:
         (progn
           (save-excursion
             (goto-char (point-min))
-            ;; TODO: Check that none of the matches are out of date;
-            ;; offer to re-scan otherwise.  Note that saving the last
-            ;; modification tick won't work, as long as not all of the
-            ;; buffers are kept open.
             (while (setq item (xref--search-property 'xref-item))
-              (when (xref-match-bounds item)
+              (when (xref-match-length item)
                 (save-excursion
-                  ;; FIXME: Get rid of xref--goto-location, by making
-                  ;; xref-match-bounds return markers already.
-                  (xref--goto-location (xref-item-location item))
-                  (let ((bounds (xref--match-buffer-bounds item))
-                        (beg (make-marker))
-                        (end (make-marker)))
-                    (move-marker beg (car bounds))
-                    (move-marker end (cdr bounds))
-                    (push (cons beg end) pairs)))))
+                  (let* ((loc (xref-item-location item))
+                         (beg (xref-location-marker loc))
+                         (len (xref-match-length item)))
+                    ;; 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"))
+                    (push (cons beg len) pairs)))))
             (setq pairs (nreverse pairs)))
           (unless pairs (user-error "No suitable matches here"))
           (xref--query-replace-1 from to pairs))
       (dolist (pair pairs)
-        (move-marker (car pair) nil)
-        (move-marker (cdr pair) nil)))))
+        (move-marker (car pair) nil)))))
 
+;; FIXME: Write a nicer UI.
 (defun xref--query-replace-1 (from to pairs)
   (let* ((query-replace-lazy-highlight nil)
-         current-pair current-buf
+         current-beg current-len current-buf
          ;; 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-pair
+            (and current-beg
                  (eq (current-buffer) current-buf)
-                 (>= beg (car current-pair))
-                 (<= end (cdr current-pair)))))
+                 (>= beg current-beg)
+                 (<= end (+ current-beg current-len)))))
          (replace-re-search-function
           (lambda (from &optional _bound noerror)
-            (let (found)
+            (let (found pair)
               (while (and (not found) pairs)
-                (setq current-pair (pop pairs)
-                      current-buf  (marker-buffer (car current-pair)))
+                (setq pair (pop pairs)
+                      current-beg (car pair)
+                      current-len (cdr pair)
+                      current-buf (marker-buffer current-beg))
                 (pop-to-buffer current-buf)
-                (goto-char (car current-pair))
-                (when (re-search-forward from (cdr current-pair) noerror)
+                (goto-char current-beg)
+                (when (re-search-forward from (+ current-beg current-len) 
noerror)
                   (setq found t)))
               found))))
     ;; FIXME: Despite this being a multi-buffer replacement, `N'
@@ -936,8 +931,8 @@ IGNORES is a list of glob patterns."
             (xref-make-match (buffer-substring
                               (line-beginning-position)
                               (line-end-position))
-                             (current-column)
-                             loc)))))))
+                             loc
+                             (- (match-end 0) (match-beginning 0)))))))))
 
 (provide 'xref)