Commit fe973fc2 authored by Dmitry Gutov's avatar Dmitry Gutov

Replace xref-match-bounds with xref-match-length

Relying on xref-location-marker to point to the beginning of the match

* lisp/progmodes/xref.el (xref-match-bounds): Remove.
(xref-match-length): Add.
(xref-make-match): Change the arguments.
(xref--match-buffer-bounds): Remove.
(xref-match-item): Store length, instead of end-column.
(xref--query-replace-1): Update accordingly.
(xref-query-replace): Ditto.  And check that the search results
are up-to-date.
parent 92a50102
......@@ -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."
(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."
;;;; 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
(cl-defmethod xref-match-bounds ((i xref-match-item))
(with-slots (end-column location) i
(cons (xref-file-location-column location)
(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)
(xref--match-buffer-bounds xref--current-item)
(let ((length (xref-match-length xref--current-item)))
(and length (cons (point) (+ (point) length))))
(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)
(let ((bounds (xref-match-bounds item)))
(when bounds
(cons (progn (move-to-column (car bounds))
(progn (move-to-column (cdr bounds))
;; 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:
(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)
;; 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
(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.
(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)))))
(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)))
;; 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
(- (match-end 0) (match-beginning 0)))))))))
(provide 'xref)
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment