;; 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
"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:
(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))
\f
;;; API
(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."
(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'
(xref-make-match (buffer-substring
(line-beginning-position)
(line-end-position))
- (current-column)
- loc)))))))
+ loc
+ (- (match-end 0) (match-beginning 0)))))))))
(provide 'xref)
projects / emacs.git / commitdiff