xref.el 51 KB
Newer Older
1 2
;; xref.el --- Cross-referencing commands              -*-lexical-binding:t-*-

Paul Eggert's avatar
Paul Eggert committed
3
;; Copyright (C) 2014-2019 Free Software Foundation, Inc.
4 5 6 7 8 9 10 11 12 13 14 15 16 17

;; This file is part of GNU Emacs.

;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
18
;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
19 20 21

;;; Commentary:

22 23
;; NOTE: The xref API is still experimental and can change in major,
;; backward-incompatible ways.  Everyone is encouraged to try it, and
Paul Eggert's avatar
Paul Eggert committed
24
;; report to us any problems or use cases we hadn't anticipated, by
25 26
;; sending an email to emacs-devel, or `M-x report-emacs-bug'.
;;
27 28 29 30
;; This file provides a somewhat generic infrastructure for cross
;; referencing commands, in particular "find-definition".
;;
;; Some part of the functionality must be implemented in a language
31
;; dependent way and that's done by defining an xref backend.
32
;;
33 34 35
;; That consists of a constructor function, which should return a
;; backend value, and a set of implementations for the generic
;; functions:
36
;;
37 38 39 40 41 42 43 44 45
;; `xref-backend-identifier-at-point',
;; `xref-backend-identifier-completion-table',
;; `xref-backend-definitions', `xref-backend-references',
;; `xref-backend-apropos', which see.
;;
;; A major mode would normally use `add-hook' to add the backend
;; constructor to `xref-backend-functions'.
;;
;; The last three methods operate with "xref" and "location" values.
46 47 48
;;
;; One would usually call `make-xref' and `xref-make-file-location',
;; `xref-make-buffer-location' or `xref-make-bogus-location' to create
49 50 51
;; them.  More generally, a location must be an instance of an EIEIO
;; class inheriting from `xref-location' and implementing
;; `xref-location-group' and `xref-location-marker'.
52
;;
53 54 55 56 57
;; 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.
;;
58 59 60
;; 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
61
;; `xref-backend-identifier-completion-table' should still be
62 63 64
;; distinct, because the user can't see the properties when making the
;; choice.
;;
65
;; See the etags and elisp-mode implementations for full examples.
66 67 68 69 70 71

;;; Code:

(require 'cl-lib)
(require 'eieio)
(require 'ring)
Dmitry Gutov's avatar
Dmitry Gutov committed
72
(require 'project)
73 74

(defgroup xref nil "Cross-referencing commands"
Glenn Morris's avatar
Glenn Morris committed
75
  :version "25.1"
76 77 78 79 80 81 82 83
  :group 'tools)


;;; Locations

(defclass xref-location () ()
  :documentation "A location represents a position in a file or buffer.")

84
(cl-defgeneric xref-location-marker (location)
85 86
  "Return the marker for LOCATION.")

87
(cl-defgeneric xref-location-group (location)
88 89 90
  "Return a string used to group a set of locations.
This is typically the filename.")

91 92 93 94
(cl-defgeneric xref-location-line (_location)
  "Return the line number corresponding to the location."
  nil)

95 96
(cl-defgeneric xref-match-length (_item)
  "Return the length of the match."
Dmitry Gutov's avatar
Dmitry Gutov committed
97 98
  nil)

99 100
;;;; Commonly needed location classes are defined here:

Stephen Leake's avatar
Stephen Leake committed
101
(defcustom xref-file-name-display 'abs
Eli Zaretskii's avatar
Eli Zaretskii committed
102 103 104 105 106
  "Style of file name display in *xref* buffers.
If the value is the symbol `abs', the default, show the file names
in their full absolute form.
If `nondirectory', show only the nondirectory (a.k.a. \"base name\")
part of the file name."
Stephen Leake's avatar
Stephen Leake committed
107 108 109 110
  :type '(choice (const :tag "absolute file name" abs)
                 (const :tag "nondirectory file name" nondirectory))
  :version "27.1")

111
;; FIXME: might be useful to have an optional "hint" i.e. a string to
Charles A. Roelli's avatar
Charles A. Roelli committed
112
;; search for in case the line number is slightly out of date.
113 114
(defclass xref-file-location (xref-location)
  ((file :type string :initarg :file)
115
   (line :type fixnum :initarg :line :reader xref-location-line)
Dmitry Gutov's avatar
Dmitry Gutov committed
116
   (column :type fixnum :initarg :column :reader xref-file-location-column))
117 118 119 120
  :documentation "A file location is a file/line/column triple.
Line numbers start from 1 and columns from 0.")

(defun xref-make-file-location (file line column)
121
  "Create and return a new `xref-file-location'."
122 123
  (make-instance 'xref-file-location :file file :line line :column column))

124
(cl-defmethod xref-location-marker ((l xref-file-location))
125 126 127 128 129 130 131 132 133
  (with-slots (file line column) l
    (with-current-buffer
        (or (get-file-buffer file)
            (let ((find-file-suppress-same-file-warnings t))
              (find-file-noselect file)))
      (save-restriction
        (widen)
        (save-excursion
          (goto-char (point-min))
134 135 136 137 138 139 140
          (ignore-errors
            ;; xref location may be out of date; it may be past the
            ;; end of the current file, or the file may have been
            ;; deleted. Return a reasonable location; the user will
            ;; figure it out.
            (beginning-of-line line)
            (forward-char column))
141 142
          (point-marker))))))

143
(cl-defmethod xref-location-group ((l xref-file-location))
Stephen Leake's avatar
Stephen Leake committed
144 145 146
  (cl-ecase xref-file-name-display
    (abs (oref l file))
    (nondirectory (file-name-nondirectory (oref l file)))))
147 148 149 150 151 152

(defclass xref-buffer-location (xref-location)
  ((buffer :type buffer :initarg :buffer)
   (position :type fixnum :initarg :position)))

(defun xref-make-buffer-location (buffer position)
153
  "Create and return a new `xref-buffer-location'."
154 155
  (make-instance 'xref-buffer-location :buffer buffer :position position))

156
(cl-defmethod xref-location-marker ((l xref-buffer-location))
157 158 159 160
  (with-slots (buffer position) l
    (let ((m (make-marker)))
      (move-marker m position buffer))))

161
(cl-defmethod xref-location-group ((l xref-buffer-location))
162 163 164 165 166 167 168 169 170 171 172 173
  (with-slots (buffer) l
    (or (buffer-file-name buffer)
        (format "(buffer %s)" (buffer-name buffer)))))

(defclass xref-bogus-location (xref-location)
  ((message :type string :initarg :message
            :reader xref-bogus-location-message))
  :documentation "Bogus locations are sometimes useful to
indicate errors, e.g. when we know that a function exists but the
actual location is not known.")

(defun xref-make-bogus-location (message)
174
  "Create and return a new `xref-bogus-location'."
175 176
  (make-instance 'xref-bogus-location :message message))

177
(cl-defmethod xref-location-marker ((l xref-bogus-location))
178
  (user-error "%s" (oref l message)))
179

180
(cl-defmethod xref-location-group ((_ xref-bogus-location)) "(No location)")
181 182 183 184


;;; Cross-reference

Dmitry Gutov's avatar
Dmitry Gutov committed
185
(defclass xref-item ()
186
  ((summary :type string :initarg :summary
Dmitry Gutov's avatar
Dmitry Gutov committed
187 188 189
            :reader xref-item-summary
            :documentation "One line which will be displayed for
this item in the output buffer.")
190
   (location :initarg :location
Dmitry Gutov's avatar
Dmitry Gutov committed
191 192 193 194 195
             :reader xref-item-location
             :documentation "An object describing how to navigate
to the reference's target."))
  :comment "An xref item describes a reference to a location
somewhere.")
196

197
(defun xref-make (summary location)
198
  "Create and return a new `xref-item'.
199
SUMMARY is a short string to describe the xref.
200
LOCATION is an `xref-location'."
Dmitry Gutov's avatar
Dmitry Gutov committed
201
  (make-instance 'xref-item :summary summary :location location))
202

Dmitry Gutov's avatar
Dmitry Gutov committed
203 204 205 206 207 208
(defclass xref-match-item ()
  ((summary :type string :initarg :summary
            :reader xref-item-summary)
   (location :initarg :location
             :type xref-file-location
             :reader xref-item-location)
209 210
   (length :initarg :length :reader xref-match-length))
  :comment "A match xref item describes a search result.")
Dmitry Gutov's avatar
Dmitry Gutov committed
211

212
(defun xref-make-match (summary location length)
213
  "Create and return a new `xref-match-item'.
Dmitry Gutov's avatar
Dmitry Gutov committed
214
SUMMARY is a short string to describe the xref.
215 216 217 218
LOCATION is an `xref-location'.
LENGTH is the match length, in characters."
  (make-instance 'xref-match-item :summary summary
                 :location location :length length))
Dmitry Gutov's avatar
Dmitry Gutov committed
219

220 221 222

;;; API

223
(defvar xref-backend-functions nil
224
  "Special hook to find the xref backend for the current context.
225
Each function on this hook is called in turn with no arguments,
226 227 228
and should return either nil to mean that it is not applicable,
or an xref backend, which is a value to be used to dispatch the
generic functions.")
229

230
;; We make the etags backend the default for now, until something
231 232 233
;; better comes along.  Use APPEND so that any `add-hook' calls made
;; before this package is loaded put new items before this one.
(add-hook 'xref-backend-functions #'etags--xref-backend t)
234

235
;;;###autoload
236 237
(defun xref-find-backend ()
  (run-hook-with-args-until-success 'xref-backend-functions))
238

239 240
(cl-defgeneric xref-backend-definitions (backend identifier)
  "Find definitions of IDENTIFIER.
241

242 243 244 245 246
The result must be a list of xref objects.  If IDENTIFIER
contains sufficient information to determine a unique definition,
return only that definition. If there are multiple possible
definitions, return all of them.  If no definitions can be found,
return nil.
247 248

IDENTIFIER can be any string returned by
249 250
`xref-backend-identifier-at-point', or from the table returned by
`xref-backend-identifier-completion-table'.
251 252 253

To create an xref object, call `xref-make'.")

254
(cl-defgeneric xref-backend-references (_backend identifier)
255 256
  "Find references of IDENTIFIER.
The result must be a list of xref objects.  If no references can
257 258
be found, return nil.

Stephen Leake's avatar
Stephen Leake committed
259 260 261
The default implementation uses `semantic-symref-tool-alist' to
find a search tool; by default, this uses \"find | grep\" in the
`project-current' roots."
262 263 264 265 266 267
  (cl-mapcan
   (lambda (dir)
     (xref-collect-references identifier dir))
   (let ((pr (project-current t)))
     (append
      (project-roots pr)
268
      (project-external-roots pr)))))
269 270

(cl-defgeneric xref-backend-apropos (backend pattern)
Charles A. Roelli's avatar
Charles A. Roelli committed
271
  "Find all symbols that match regexp PATTERN.")
272 273 274

(cl-defgeneric xref-backend-identifier-at-point (_backend)
  "Return the relevant identifier at point.
275

276 277
The return value must be a string, or nil meaning no identifier
at point found.
278

Paul Eggert's avatar
Paul Eggert committed
279
If it's hard to determine the identifier precisely (e.g., because
280 281
it's a method call on unknown type), the implementation can
return a simple string (such as symbol at point) marked with a
282 283
special text property which e.g. `xref-backend-definitions' would
recognize and then delegate the work to an external process."
284 285 286
  (let ((thing (thing-at-point 'symbol)))
    (and thing (substring-no-properties thing))))

287
(cl-defgeneric xref-backend-identifier-completion-table (backend)
288
  "Return the completion table for identifiers.")
289

290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333

;;; misc utilities
(defun xref--alistify (list key test)
  "Partition the elements of LIST into an alist.
KEY extracts the key from an element and TEST is used to compare
keys."
  (let ((alist '()))
    (dolist (e list)
      (let* ((k (funcall key e))
             (probe (cl-assoc k alist :test test)))
        (if probe
            (setcdr probe (cons e (cdr probe)))
          (push (cons k (list e)) alist))))
    ;; Put them back in order.
    (cl-loop for (key . value) in (reverse alist)
             collect (cons key (reverse value)))))

(defun xref--insert-propertized (props &rest strings)
  "Insert STRINGS with text properties PROPS."
  (let ((start (point)))
    (apply #'insert strings)
    (add-text-properties start (point) props)))

(defun xref--search-property (property &optional backward)
    "Search the next text range where text property PROPERTY is non-nil.
Return the value of PROPERTY.  If BACKWARD is non-nil, search
backward."
  (let ((next (if backward
                  #'previous-single-char-property-change
                #'next-single-char-property-change))
        (start (point))
        (value nil))
    (while (progn
             (goto-char (funcall next (point) property))
             (not (or (setq value (get-text-property (point) property))
                      (eobp)
                      (bobp)))))
    (cond (value)
          (t (goto-char start) nil))))


;;; Marker stack  (M-. pushes, M-, pops)

(defcustom xref-marker-ring-length 16
334 335 336 337 338 339
  "Length of the xref marker ring.
If this variable is not set through Customize, you must call
`xref-set-marker-ring-length' for changes to take effect."
  :type 'integer
  :initialize #'custom-initialize-default
  :set #'xref-set-marker-ring-length)
340

341 342 343
(defcustom xref-prompt-for-identifier '(not xref-find-definitions
                                            xref-find-definitions-other-window
                                            xref-find-definitions-other-frame)
344 345 346
  "If non-nil, prompt for the identifier to find.

When t, always prompt for the identifier name.
347

348 349 350
When nil, prompt only when there's no value at point we can use,
or when the command has been called with the prefix argument.

351 352
Otherwise, it's a list of xref commands which will always prompt,
with the identifier at point, if any, used as the default.
353
If the list starts with `not', the meaning of the rest of the
354 355 356 357 358
elements is negated: these commands will NOT prompt."
  :type '(choice (const :tag "Always prompt for identifier" t)
                 (const :tag "Prompt if no identifier at point" nil)
                 (set :menu-tag "Prompt according to command"
                      :tag "Prompt according to command"
359
		      :value (not)
360
		      (const :tag "Except for commands listed below" not)
361
		      (repeat :inline t (symbol :tag "command")))))
362

363 364 365 366 367 368 369 370
(defcustom xref-after-jump-hook '(recenter
                                  xref-pulse-momentarily)
  "Functions called after jumping to an xref."
  :type 'hook)

(defcustom xref-after-return-hook '(xref-pulse-momentarily)
  "Functions called after returning to a pre-jump location."
  :type 'hook)
Dmitry Gutov's avatar
Dmitry Gutov committed
371

372 373 374
(defvar xref--marker-ring (make-ring xref-marker-ring-length)
  "Ring of markers to implement the marker stack.")

375 376 377 378 379 380 381 382
(defun xref-set-marker-ring-length (var val)
  "Set `xref-marker-ring-length'.
VAR is the symbol `xref-marker-ring-length' and VAL is the new
value."
  (set-default var val)
  (if (ring-p xref--marker-ring)
      (ring-resize xref--marker-ring val)))

383 384 385
(defun xref-push-marker-stack (&optional m)
  "Add point M (defaults to `point-marker') to the marker stack."
  (ring-insert xref--marker-ring (or m (point-marker))))
386 387 388 389 390 391 392

;;;###autoload
(defun xref-pop-marker-stack ()
  "Pop back to where \\[xref-find-definitions] was last invoked."
  (interactive)
  (let ((ring xref--marker-ring))
    (when (ring-empty-p ring)
393
      (user-error "Marker stack is empty"))
394 395
    (let ((marker (ring-remove ring 0)))
      (switch-to-buffer (or (marker-buffer marker)
396
                            (user-error "The marked buffer has been deleted")))
397
      (goto-char (marker-position marker))
Dmitry Gutov's avatar
Dmitry Gutov committed
398
      (set-marker marker nil nil)
399 400
      (run-hooks 'xref-after-return-hook))))

Dmitry Gutov's avatar
Dmitry Gutov committed
401 402
(defvar xref--current-item nil)

403
(defun xref-pulse-momentarily ()
Dmitry Gutov's avatar
Dmitry Gutov committed
404 405 406
  (pcase-let ((`(,beg . ,end)
               (save-excursion
                 (or
407 408
                  (let ((length (xref-match-length xref--current-item)))
                    (and length (cons (point) (+ (point) length))))
Dmitry Gutov's avatar
Dmitry Gutov committed
409 410 411 412
                  (back-to-indentation)
                  (if (eolp)
                      (cons (line-beginning-position) (1+ (point)))
                    (cons (point) (line-end-position)))))))
413
    (pulse-momentary-highlight-region beg end 'next-error)))
414 415 416 417 418 419 420 421 422

;; etags.el needs this
(defun xref-clear-marker-stack ()
  "Discard all markers from the marker stack."
  (let ((ring xref--marker-ring))
    (while (not (ring-empty-p ring))
      (let ((marker (ring-remove ring)))
        (set-marker marker nil nil)))))

423
;;;###autoload
424 425 426 427
(defun xref-marker-stack-empty-p ()
  "Return t if the marker stack is empty; nil otherwise."
  (ring-empty-p xref--marker-ring))

428

429 430 431 432 433 434 435 436

(defun xref--goto-char (pos)
  (cond
   ((and (<= (point-min) pos) (<= pos (point-max))))
   (widen-automatically (widen))
   (t (user-error "Position is outside accessible part of buffer")))
  (goto-char pos))

437 438 439 440
(defun xref--goto-location (location)
  "Set buffer and point according to xref-location LOCATION."
  (let ((marker (xref-location-marker location)))
    (set-buffer (marker-buffer marker))
441
    (xref--goto-char marker)))
442

443
(defun xref-pop-to-location (item &optional action)
Dmitry Gutov's avatar
Dmitry Gutov committed
444
  "Go to the location of ITEM and display the buffer.
445
ACTION controls how the buffer is displayed:
446
  nil      -- switch-to-buffer
447
  `window' -- pop-to-buffer (other window)
448 449
  `frame'  -- pop-to-buffer (other frame)
If SELECT is non-nil, select the target window."
450 451 452
  (let* ((marker (save-excursion
                   (xref-location-marker (xref-item-location item))))
         (buf (marker-buffer marker)))
453
    (cl-ecase action
454 455 456 457
      ((nil)  (switch-to-buffer buf))
      (window (pop-to-buffer buf t))
      (frame  (let ((pop-up-frames t)) (pop-to-buffer buf t))))
    (xref--goto-char marker))
Dmitry Gutov's avatar
Dmitry Gutov committed
458 459
  (let ((xref--current-item item))
    (run-hooks 'xref-after-jump-hook)))
460 461 462 463 464


;;; XREF buffer (part of the UI)

;; The xref buffer is used to display a set of xrefs.
465 466
(defconst xref-buffer-name "*xref*"
  "The name of the buffer to show xrefs.")
467

Juri Linkov's avatar
Juri Linkov committed
468 469 470 471 472 473 474 475 476 477 478 479
(defface xref-file-header '((t :inherit compilation-info))
  "Face used to highlight file header in the xref buffer."
  :version "27.1")

(defface xref-line-number '((t :inherit compilation-line-number))
  "Face for displaying line numbers in the xref buffer."
  :version "27.1")

(defface xref-match '((t :inherit highlight))
  "Face used to highlight matches in the xref buffer."
  :version "27.1")

480 481 482 483 484 485 486 487 488 489 490
(defmacro xref--with-dedicated-window (&rest body)
  `(let* ((xref-w (get-buffer-window xref-buffer-name))
          (xref-w-dedicated (window-dedicated-p xref-w)))
     (unwind-protect
         (progn
           (when xref-w
             (set-window-dedicated-p xref-w 'soft))
           ,@body)
       (when xref-w
         (set-window-dedicated-p xref-w xref-w-dedicated)))))

491 492 493 494 495 496
(defvar-local xref--original-window-intent nil
  "Original window-switching intent before xref buffer creation.")

(defvar-local xref--original-window nil
  "The original window this xref buffer was created from.")

497 498 499
(defvar-local xref--fetcher nil
  "The original function to call to fetch the list of xrefs.")

500 501 502 503 504 505 506 507 508
(defun xref--show-pos-in-buf (pos buf)
  "Goto and display position POS of buffer BUF in a window.
Honor `xref--original-window-intent', run `xref-after-jump-hook'
and finally return the window."
  (let* ((xref-buf (current-buffer))
         (pop-up-frames
          (or (eq xref--original-window-intent 'frame)
              pop-up-frames))
         (action
509
          (cond ((eq xref--original-window-intent 'frame)
510
                 t)
511
                ((eq xref--original-window-intent 'window)
512 513
                 `((xref--display-buffer-in-other-window)
                   (window . ,xref--original-window)))
514 515 516 517
                ((and
                  (window-live-p xref--original-window)
                  (or (not (window-dedicated-p xref--original-window))
                      (eq (window-buffer xref--original-window) buf)))
518 519
                 `((xref--display-buffer-in-window)
                   (window . ,xref--original-window))))))
520
    (with-selected-window (display-buffer buf action)
521 522
      (xref--goto-char pos)
      (run-hooks 'xref-after-jump-hook)
523
      (let ((buf (current-buffer)))
524
        (with-current-buffer xref-buf
525 526
          (setq-local other-window-scroll-buffer buf)))
      (selected-window))))
527

528 529 530 531 532 533 534 535 536 537 538 539 540
(defun xref--display-buffer-in-other-window (buffer alist)
  (let ((window (assoc-default 'window alist)))
    (cl-assert window)
    (xref--with-dedicated-window
     (with-selected-window window
       (display-buffer buffer t)))))

(defun xref--display-buffer-in-window (buffer alist)
  (let ((window (assoc-default 'window alist)))
    (cl-assert window)
    (with-selected-window window
      (display-buffer buffer '(display-buffer-same-window)))))

541
(defun xref--show-location (location &optional select)
542 543 544
  "Help `xref-show-xref' and `xref-goto-xref' do their job.
Go to LOCATION and if SELECT is non-nil select its window.  If
SELECT is `quit', also quit the *xref* window."
545
  (condition-case err
546
      (let* ((marker (xref-location-marker location))
547 548
             (buf (marker-buffer marker))
             (xref-buffer (current-buffer)))
549
        (cond (select
550
               (if (eq select 'quit) (quit-window nil nil))
551 552 553
               (select-window
                (with-current-buffer xref-buffer
                  (xref--show-pos-in-buf marker buf))))
554 555 556 557
              (t
               (save-selected-window
                 (xref--with-dedicated-window
                  (xref--show-pos-in-buf marker buf))))))
558 559
    (user-error (message (error-message-string err)))))

560
(defun xref-show-location-at-point ()
561
  "Display the source of xref at point in the appropriate window, if any."
562
  (interactive)
Dmitry Gutov's avatar
Dmitry Gutov committed
563 564 565
  (let* ((xref (xref--item-at-point))
         (xref--current-item xref))
    (when xref
566
      (xref--show-location (xref-item-location xref)))))
567

568
(defun xref-next-line ()
569
  "Move to the next xref and display its source in the appropriate window."
570
  (interactive)
Dmitry Gutov's avatar
Dmitry Gutov committed
571
  (xref--search-property 'xref-item)
572
  (xref-show-location-at-point))
573 574

(defun xref-prev-line ()
575
  "Move to the previous xref and display its source in the appropriate window."
576
  (interactive)
Dmitry Gutov's avatar
Dmitry Gutov committed
577
  (xref--search-property 'xref-item t)
578
  (xref-show-location-at-point))
579

Dmitry Gutov's avatar
Dmitry Gutov committed
580
(defun xref--item-at-point ()
581 582
  (save-excursion
    (back-to-indentation)
Dmitry Gutov's avatar
Dmitry Gutov committed
583
    (get-text-property (point) 'xref-item)))
584

585 586 587 588
(defun xref-goto-xref (&optional quit)
  "Jump to the xref on the current line and select its window.
Non-interactively, non-nil QUIT means to first quit the *xref*
buffer."
589
  (interactive)
590 591 592 593
  (let* ((buffer (current-buffer))
         (xref (or (xref--item-at-point)
                   (user-error "No reference at point")))
         (xref--current-item xref))
594 595
    (xref--show-location (xref-item-location xref) (if quit 'quit t))
    (next-error-found buffer (current-buffer))))
596 597 598 599 600

(defun xref-quit-and-goto-xref ()
  "Quit *xref* buffer, then jump to xref on current line."
  (interactive)
  (xref-goto-xref t))
601

602
(defun xref-query-replace-in-results (from to)
603 604 605 606
  "Perform interactive replacement of FROM with TO in all displayed xrefs.

This command interactively replaces FROM with TO in the names of the
references displayed in the current *xref* buffer."
607
  (interactive
608 609 610
   (let ((fr (read-regexp "Xref query-replace (regexp)" ".*")))
     (list fr
           (read-regexp (format "Xref query-replace (regexp) %s with: " fr)))))
611 612 613 614 615
  (let* (item xrefs iter)
    (save-excursion
      (while (setq item (xref--search-property 'xref-item))
        (when (xref-match-length item)
          (push item xrefs))))
616 617
    (unwind-protect
        (progn
618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659
          (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))))))))
660
           (cons file-buf (nreverse pairs))))
661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677
        (: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)))))
678

679
;; FIXME: Write a nicer UI.
680
(defun xref--query-replace-1 (from to iter)
681
  (let* ((query-replace-lazy-highlight nil)
682 683 684
         (continue t)
         did-it-once buf-pairs pairs
         current-beg current-end
685 686 687 688 689
         ;; 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)
690 691
            (and current-beg
                 (>= beg current-beg)
692
                 (<= end current-end))))
693 694
         (replace-re-search-function
          (lambda (from &optional _bound noerror)
695
            (let (found pair)
696
              (while (and (not found) pairs)
697 698
                (setq pair (pop pairs)
                      current-beg (car pair)
699
                      current-end (cdr pair))
700
                (goto-char current-beg)
701
                (when (re-search-forward from current-end noerror)
702 703
                  (setq found t)))
              found))))
704 705 706 707 708 709 710 711 712 713
    (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)))
714 715 716
    (unless did-it-once (user-error "No suitable matches here"))
    (when (and continue (not buf-pairs))
      (message "All results processed"))))
717

718 719 720 721
(defvar xref--xref-buffer-mode-map
  (let ((map (make-sparse-keymap)))
    (define-key map (kbd "n") #'xref-next-line)
    (define-key map (kbd "p") #'xref-prev-line)
722
    (define-key map (kbd "r") #'xref-query-replace-in-results)
723
    (define-key map (kbd "RET") #'xref-goto-xref)
724
    (define-key map (kbd "TAB")  #'xref-quit-and-goto-xref)
725 726 727 728
    (define-key map (kbd "C-o") #'xref-show-location-at-point)
    ;; suggested by Johan Claesson "to further reduce finger movement":
    (define-key map (kbd ".") #'xref-next-line)
    (define-key map (kbd ",") #'xref-prev-line)
729
    (define-key map (kbd "g") #'xref-revert-buffer)
730 731 732
    map))

(define-derived-mode xref--xref-buffer-mode special-mode "XREF"
Paul Eggert's avatar
Paul Eggert committed
733
  "Mode for displaying cross-references."
734
  (setq buffer-read-only t)
735
  (setq next-error-function #'xref--next-error-function)
Damien Cassou's avatar
Damien Cassou committed
736 737 738 739 740
  (setq next-error-last-buffer (current-buffer))
  (setq imenu-prev-index-position-function
        #'xref--imenu-prev-index-position)
  (setq imenu-extract-index-name-function
        #'xref--imenu-extract-index-name))
741

742 743 744 745 746 747 748 749 750 751
(defvar xref--transient-buffer-mode-map
  (let ((map (make-sparse-keymap)))
    (define-key map (kbd "RET") #'xref-quit-and-goto-xref)
    (set-keymap-parent map xref--xref-buffer-mode-map)
    map))

(define-derived-mode xref--transient-buffer-mode
  xref--xref-buffer-mode
  "XREF Transient")

Damien Cassou's avatar
Damien Cassou committed
752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767
(defun xref--imenu-prev-index-position ()
  "Move point to previous line in `xref' buffer.
This function is used as a value for
`imenu-prev-index-position-function'."
  (if (bobp)
      nil
    (xref--search-property 'xref-group t)))

(defun xref--imenu-extract-index-name ()
  "Return imenu name for line at point.
This function is used as a value for
`imenu-extract-index-name-function'.  Point should be at the
beginning of the line."
  (buffer-substring-no-properties (line-beginning-position)
                                  (line-end-position)))

768 769 770 771 772
(defun xref--next-error-function (n reset?)
  (when reset?
    (goto-char (point-min)))
  (let ((backward (< n 0))
        (n (abs n))
Dmitry Gutov's avatar
Dmitry Gutov committed
773
        (xref nil))
774 775 776 777
    (if (= n 0)
        (setq xref (get-text-property (point) 'xref-item))
      (dotimes (_ n)
        (setq xref (xref--search-property 'xref-item backward))))
Dmitry Gutov's avatar
Dmitry Gutov committed
778
    (cond (xref
779 780 781 782
           ;; Save the current position (when the buffer is visible,
           ;; it gets reset to that window's point from time to time).
           (let ((win (get-buffer-window (current-buffer))))
             (and win (set-window-point win (point))))
783
           (xref--show-location (xref-item-location xref) t))
784 785
          (t
           (error "No %s xref" (if backward "previous" "next"))))))
786

Dmitry Gutov's avatar
Dmitry Gutov committed
787 788 789 790 791 792 793 794 795 796 797
(defvar xref--button-map
  (let ((map (make-sparse-keymap)))
    (define-key map [mouse-1] #'xref-goto-xref)
    (define-key map [mouse-2] #'xref--mouse-2)
    map))

(defun xref--mouse-2 (event)
  "Move point to the button and show the xref definition."
  (interactive "e")
  (mouse-set-point event)
  (forward-line 0)
798 799
  (or (get-text-property (point) 'xref-item)
      (xref--search-property 'xref-item))
Dmitry Gutov's avatar
Dmitry Gutov committed
800 801
  (xref-show-location-at-point))

802 803
(defun xref--insert-xrefs (xref-alist)
  "Insert XREF-ALIST in the current-buffer.
804
XREF-ALIST is of the form ((GROUP . (XREF ...)) ...), where
805
GROUP is a string for decoration purposes and XREF is an
Dmitry Gutov's avatar
Dmitry Gutov committed
806
`xref-item' object."
Dmitry Gutov's avatar
Dmitry Gutov committed
807
  (require 'compile) ; For the compilation faces.
808 809 810 811
  (cl-loop for ((group . xrefs) . more1) on xref-alist
           for max-line-width =
           (cl-loop for xref in xrefs
                    maximize (let ((line (xref-location-line
812
                                          (oref xref location))))
813 814 815 816
                               (length (and line (format "%d" line)))))
           for line-format = (and max-line-width
                                  (format "%%%dd: " max-line-width))
           do
817
           (xref--insert-propertized '(face xref-file-header xref-group t)
Damien Cassou's avatar
Damien Cassou committed
818
                                     group "\n")
819
           (cl-loop for (xref . more2) on xrefs do
820
                    (with-slots (summary location) xref
821 822 823 824
                      (let* ((line (xref-location-line location))
                             (prefix
                              (if line
                                  (propertize (format line-format line)
Juri Linkov's avatar
Juri Linkov committed
825
                                              'face 'xref-line-number)
826 827
                                "  ")))
                        (xref--insert-propertized
Dmitry Gutov's avatar
Dmitry Gutov committed
828
                         (list 'xref-item xref
829 830 831 832 833
                               'mouse-face 'highlight
                               'keymap xref--button-map
                               'help-echo
                               (concat "mouse-2: display in another window, "
                                       "RET or mouse-1: follow reference"))
834
                         prefix summary)))
835
                    (insert "\n"))))
836 837 838 839 840 841

(defun xref--analyze (xrefs)
  "Find common filenames in XREFS.
Return an alist of the form ((FILENAME . (XREF ...)) ...)."
  (xref--alistify xrefs
                  (lambda (x)
Dmitry Gutov's avatar
Dmitry Gutov committed
842
                    (xref-location-group (xref-item-location x)))
843 844
                  #'equal))

845
(defun xref--show-xref-buffer (fetcher alist)
846 847 848 849 850
  (cl-assert (functionp fetcher))
  (let* ((xrefs
          (or
           (assoc-default 'fetched-xrefs alist)
           (funcall fetcher)))
851
         (xref-alist (xref--analyze xrefs)))
852
    (with-current-buffer (get-buffer-create xref-buffer-name)
853
      (xref--xref-buffer-mode)
854
      (xref--show-common-initialize xref-alist fetcher alist)
855 856 857 858 859 860 861 862 863 864 865 866 867
      (pop-to-buffer (current-buffer))
      (current-buffer))))

(defun xref--show-common-initialize (xref-alist fetcher alist)
  (setq buffer-undo-list nil)
  (let ((inhibit-read-only t)
        (buffer-undo-list t))
    (erase-buffer)
    (xref--insert-xrefs xref-alist)
    (goto-char (point-min))
    (setq xref--original-window (assoc-default 'window alist)
          xref--original-window-intent (assoc-default 'display-action alist))
    (setq xref--fetcher fetcher)))
868

869
(defun xref-revert-buffer ()
870
  "Refresh the search results in the current buffer."
871 872 873 874 875 876 877 878 879 880 881 882 883 884 885
  (interactive)
  (let ((inhibit-read-only t)
        (buffer-undo-list t))
    (save-excursion
      (erase-buffer)
      (condition-case err
          (xref--insert-xrefs
           (xref--analyze (funcall xref--fetcher)))
        (user-error
         (insert
          (propertize
           (error-message-string err)
           'face 'error))))
      (goto-char (point-min)))))

886 887 888 889
(defun xref--show-defs-buffer (fetcher alist)
  (let ((xrefs (funcall fetcher)))
    (cond
     ((not (cdr xrefs))
890 891
      (xref-pop-to-location (car xrefs)
                            (assoc-default 'display-action alist)))
892 893 894 895
     (t
      (xref--show-xref-buffer fetcher
                              (cons (cons 'fetched-xrefs xrefs)
                                    alist))))))
896

897 898 899 900 901 902 903 904
(defun xref--show-defs-buffer-at-bottom (fetcher alist)
  "Show definitions list in a window at the bottom.
When there is more than one definition, split the selected window
and show the list in a small window at the bottom.  And use a
local keymap that binds `RET' to `xref-quit-and-goto-xref'."
  (let ((xrefs (funcall fetcher)))
    (cond
     ((not (cdr xrefs))
905 906
      (xref-pop-to-location (car xrefs)
                            (assoc-default 'display-action alist)))
907 908 909
     (t
      (with-current-buffer (get-buffer-create xref-buffer-name)
        (xref--transient-buffer-mode)
910
        (xref--show-common-initialize (xref--analyze xrefs) fetcher alist)
911 912 913 914
        (pop-to-buffer (current-buffer)
                       '(display-buffer-in-direction . ((direction . below))))
        (current-buffer))))))

915

916
(defcustom xref-show-xrefs-function 'xref--show-xref-buffer
Dmitry Gutov's avatar
Dmitry Gutov committed
917 918 919 920 921 922 923 924
  "Function to display a list of search results.

It should accept two arguments: FETCHER and ALIST.

FETCHER is a function of no arguments that returns a list of xref
values.  It must not depend on the current buffer or selected
window.

925
ALIST can include, but limited to, the following keys:
Dmitry Gutov's avatar
Dmitry Gutov committed
926 927 928 929 930 931

WINDOW for the window that was selected before the current
command was called.

DISPLAY-ACTION indicates where the target location should be
displayed.  The possible values are nil, `window' meaning the
932 933
other window, or `frame' meaning the other frame."
  :type 'function)
934

935
(defcustom xref-show-definitions-function 'xref--show-defs-buffer
Dmitry Gutov's avatar
Dmitry Gutov committed
936 937
  "Function to display a list of definitions.

938 939
Accepts the same arguments as `xref-show-xrefs-function'."
  :type 'function)
940

941 942 943 944
(defvar xref--read-identifier-history nil)

(defvar xref--read-pattern-history nil)

945
(defun xref--show-xrefs (fetcher display-action)
946
  (xref--push-markers)
947
  (funcall xref-show-xrefs-function fetcher
948 949 950 951
           `((window . ,(selected-window))
             (display-action . ,display-action))))

(defun xref--show-defs (xrefs display-action)
952 953 954 955 956 957
  (xref--push-markers)
  (funcall xref-show-definitions-function xrefs
           `((window . ,(selected-window))
             (display-action . ,display-action))))

(defun xref--push-markers ()
958
  (unless (region-active-p) (push-mark nil t))
959
  (xref-push-marker-stack))
960

961 962 963 964 965 966
(defun xref--prompt-p (command)
  (or (eq xref-prompt-for-identifier t)
      (if (eq (car xref-prompt-for-identifier) 'not)
          (not (memq command (cdr xref-prompt-for-identifier)))
        (memq command xref-prompt-for-identifier))))

967 968
(defun xref--read-identifier (prompt)
  "Return the identifier at point or read it from the minibuffer."
969
  (let* ((backend (xref-find-backend))
970
         (def (xref-backend-identifier-at-point backend)))
971
    (cond ((or current-prefix-arg
972
               (not def)
973
               (xref--prompt-p this-command))
974 975 976 977 978 979 980 981 982 983 984 985
           (let ((id
                  (completing-read
                   (if def
                       (format "%s (default %s): "
                               (substring prompt 0 (string-match
                                                    "[ :]+\\'" prompt))
                               def)
                     prompt)
                   (xref-backend-identifier-completion-table backend)
                   nil nil nil
                   'xref--read-identifier-history def)))
             (if (equal id "")
Juri Linkov's avatar
Juri Linkov committed
986
                 (or def (user-error "There is no default identifier"))
987 988
               id)))
          (t def))))
989 990 991 992


;;; Commands

993
(defun xref--find-xrefs (input kind arg display-action)
994 995 996 997 998 999 1000 1001 1002 1003
  (xref--show-xrefs
   (xref--create-fetcher input kind arg)
   display-action))

(defun xref--find-definitions (id display-action)
  (xref--show-defs
   (xref--create-fetcher id 'definitions id)
   display-action))

(defun xref--create-fetcher (input kind arg)
Dmitry Gutov's avatar
Dmitry Gutov committed
1004 1005 1006 1007
  "Return an xref list fetcher function.

It revisits the saved position and delegates the finding logic to
the xref backend method indicated by KIND and passes ARG to it."
1008 1009 1010
  (let* ((orig-buffer (current-buffer))
         (orig-position (point))
         (backend (xref-find-backend))
1011 1012 1013
         (method (intern (format "xref-backend-%s" kind))))
    (lambda ()
      (save-excursion
1014 1015 1016 1017 1018 1019
        ;; Xref methods are generally allowed to depend on the text
        ;; around point, not just on their explicit arguments.
        ;;
        ;; There is only so much we can do, however, to recreate that
        ;; context, given that the user is free to change the buffer
        ;; contents freely in the meantime.
1020 1021 1022 1023 1024 1025 1026
        (when (buffer-live-p orig-buffer)
          (set-buffer orig-buffer)
          (ignore-errors (goto-char orig-position)))
        (let ((xrefs (funcall method backend arg)))
          (unless xrefs
            (xref--not-found-error kind input))
          xrefs)))))
1027 1028 1029

(defun xref--not-found-error (kind input)
  (user-error "No %s found for: %s" (symbol-name kind) input))
1030 1031 1032 1033

;;;###autoload
(defun xref-find-definitions (identifier)
  "Find the definition of the identifier at point.
1034
With prefix argument or when there's no identifier at point,
1035 1036
prompt for it.

1037 1038 1039 1040
If sufficient information is available to determine a unique
definition for IDENTIFIER, display it in the selected window.
Otherwise, display the list of the possible definitions in a
buffer where the user can select from the list."
1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058
  (interactive (list (xref--read-identifier "Find definitions of: ")))
  (xref--find-definitions identifier nil))

;;;###autoload
(defun xref-find-definitions-other-window (identifier)
  "Like `xref-find-definitions' but switch to the other window."
  (interactive (list (xref--read-identifier "Find definitions of: ")))
  (xref--find-definitions identifier 'window))

;;;###autoload
(defun xref-find-definitions-other-frame (identifier)
  "Like `xref-find-definitions' but switch to the other frame."
  (interactive (list (xref--read-identifier "Find definitions of: ")))
  (xref--find-definitions identifier 'frame))

;;;###autoload
(defun xref-find-references (identifier)
  "Find references to the identifier at point.
Eli Zaretskii's avatar
Eli Zaretskii committed
1059 1060 1061 1062 1063
This command might prompt for the identifier as needed, perhaps
offering the symbol at point as the default.
With prefix argument, or if `xref-prompt-for-identifier' is t,
always prompt for the identifier.  If `xref-prompt-for-identifier'
is nil, prompt only if there's no usable symbol at point."
1064
  (interactive (list (xref--read-identifier "Find references of: ")))
1065
  (xref--find-xrefs identifier 'references identifier nil))
Dmitry Gutov's avatar
Dmitry Gutov committed
1066

1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079
;;;###autoload
(defun xref-find-definitions-at-mouse (event)
  "Find the definition of identifier at or around mouse click.
This command is intended to be bound to a mouse event."
  (interactive "e")
  (let ((identifier
         (save-excursion
           (mouse-set-point event)
           (xref-backend-identifier-at-point (xref-find-backend)))))
    (if identifier
        (xref-find-definitions identifier)
      (user-error "No identifier here"))))

1080 1081
(declare-function apropos-parse-pattern "apropos" (pattern))

1082 1083 1084 1085
;;;###autoload
(defun xref-find-apropos (pattern)
  "Find all meaningful symbols that match PATTERN.
The argument has the same meaning as in `apropos'."
1086
  (interactive (list (read-string
1087
                      "Search for pattern (word list or regexp): "