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

Paul Eggert's avatar
Paul Eggert committed
3
;; Copyright (C) 2014-2018 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 75 76
(eval-when-compile
  (require 'semantic/symref)) ;; for hit-lines slot

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


;;; Locations

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

87
(cl-defgeneric xref-location-marker (location)
88 89
  "Return the marker for LOCATION.")

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

94 95 96 97
(cl-defgeneric xref-location-line (_location)
  "Return the line number corresponding to the location."
  nil)

98 99
(cl-defgeneric xref-match-length (_item)
  "Return the length of the match."
Dmitry Gutov's avatar
Dmitry Gutov committed
100 101
  nil)

102 103 104
;;;; Commonly needed location classes are defined here:

;; FIXME: might be useful to have an optional "hint" i.e. a string to
Charles A. Roelli's avatar
Charles A. Roelli committed
105
;; search for in case the line number is slightly out of date.
106 107
(defclass xref-file-location (xref-location)
  ((file :type string :initarg :file)
108
   (line :type fixnum :initarg :line :reader xref-location-line)
Dmitry Gutov's avatar
Dmitry Gutov committed
109
   (column :type fixnum :initarg :column :reader xref-file-location-column))
110 111 112 113
  :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)
114
  "Create and return a new `xref-file-location'."
115 116
  (make-instance 'xref-file-location :file file :line line :column column))

117
(cl-defmethod xref-location-marker ((l xref-file-location))
118 119 120 121 122 123 124 125 126 127
  (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))
          (beginning-of-line line)
128
          (forward-char column)
129 130
          (point-marker))))))

131
(cl-defmethod xref-location-group ((l xref-file-location))
132
  (oref l file))
133 134 135 136 137 138

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

(defun xref-make-buffer-location (buffer position)
139
  "Create and return a new `xref-buffer-location'."
140 141
  (make-instance 'xref-buffer-location :buffer buffer :position position))

142
(cl-defmethod xref-location-marker ((l xref-buffer-location))
143 144 145 146
  (with-slots (buffer position) l
    (let ((m (make-marker)))
      (move-marker m position buffer))))

147
(cl-defmethod xref-location-group ((l xref-buffer-location))
148 149 150 151 152 153 154 155 156 157 158 159
  (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)
160
  "Create and return a new `xref-bogus-location'."
161 162
  (make-instance 'xref-bogus-location :message message))

163
(cl-defmethod xref-location-marker ((l xref-bogus-location))
164
  (user-error "%s" (oref l message)))
165

166
(cl-defmethod xref-location-group ((_ xref-bogus-location)) "(No location)")
167 168 169 170


;;; Cross-reference

Dmitry Gutov's avatar
Dmitry Gutov committed
171
(defclass xref-item ()
172
  ((summary :type string :initarg :summary
Dmitry Gutov's avatar
Dmitry Gutov committed
173 174 175
            :reader xref-item-summary
            :documentation "One line which will be displayed for
this item in the output buffer.")
176
   (location :initarg :location
Dmitry Gutov's avatar
Dmitry Gutov committed
177 178 179 180 181
             :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.")
182

183
(defun xref-make (summary location)
184
  "Create and return a new `xref-item'.
185
SUMMARY is a short string to describe the xref.
186
LOCATION is an `xref-location'."
Dmitry Gutov's avatar
Dmitry Gutov committed
187
  (make-instance 'xref-item :summary summary :location location))
188

Dmitry Gutov's avatar
Dmitry Gutov committed
189 190 191 192 193 194
(defclass xref-match-item ()
  ((summary :type string :initarg :summary
            :reader xref-item-summary)
   (location :initarg :location
             :type xref-file-location
             :reader xref-item-location)
195 196
   (length :initarg :length :reader xref-match-length))
  :comment "A match xref item describes a search result.")
Dmitry Gutov's avatar
Dmitry Gutov committed
197

198
(defun xref-make-match (summary location length)
199
  "Create and return a new `xref-match-item'.
Dmitry Gutov's avatar
Dmitry Gutov committed
200
SUMMARY is a short string to describe the xref.
201 202 203 204
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
205

206 207 208

;;; API

209
(defvar xref-backend-functions nil
210
  "Special hook to find the xref backend for the current context.
211
Each function on this hook is called in turn with no arguments,
212 213 214
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.")
215

216
;; We make the etags backend the default for now, until something
217 218 219
;; 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)
220

221
;;;###autoload
222 223
(defun xref-find-backend ()
  (run-hook-with-args-until-success 'xref-backend-functions))
224

225 226
(cl-defgeneric xref-backend-definitions (backend identifier)
  "Find definitions of IDENTIFIER.
227

228 229 230 231 232
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.
233 234

IDENTIFIER can be any string returned by
235 236
`xref-backend-identifier-at-point', or from the table returned by
`xref-backend-identifier-completion-table'.
237 238 239

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

240
(cl-defgeneric xref-backend-references (_backend identifier)
241 242
  "Find references of IDENTIFIER.
The result must be a list of xref objects.  If no references can
243 244
be found, return nil.

Stephen Leake's avatar
Stephen Leake committed
245 246 247
The default implementation uses `semantic-symref-tool-alist' to
find a search tool; by default, this uses \"find | grep\" in the
`project-current' roots."
248 249 250 251 252 253
  (cl-mapcan
   (lambda (dir)
     (xref-collect-references identifier dir))
   (let ((pr (project-current t)))
     (append
      (project-roots pr)
254
      (project-external-roots pr)))))
255 256

(cl-defgeneric xref-backend-apropos (backend pattern)
Charles A. Roelli's avatar
Charles A. Roelli committed
257
  "Find all symbols that match regexp PATTERN.")
258 259 260

(cl-defgeneric xref-backend-identifier-at-point (_backend)
  "Return the relevant identifier at point.
261 262 263 264

The return value must be a string or nil.  nil means no
identifier at point found.

Paul Eggert's avatar
Paul Eggert committed
265
If it's hard to determine the identifier precisely (e.g., because
266 267
it's a method call on unknown type), the implementation can
return a simple string (such as symbol at point) marked with a
268 269
special text property which e.g. `xref-backend-definitions' would
recognize and then delegate the work to an external process."
270 271 272
  (let ((thing (thing-at-point 'symbol)))
    (and thing (substring-no-properties thing))))

273 274 275
(cl-defgeneric xref-backend-identifier-completion-table (backend)
  "Returns the completion table for identifiers.")

276 277 278 279 280 281 282 283 284 285 286 287 288 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

;;; 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
  "Length of the xref marker ring."
321
  :type 'integer)
322

323 324 325
(defcustom xref-prompt-for-identifier '(not xref-find-definitions
                                            xref-find-definitions-other-window
                                            xref-find-definitions-other-frame)
326 327 328
  "If non-nil, prompt for the identifier to find.

When t, always prompt for the identifier name.
329

330 331 332
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.

333 334
Otherwise, it's a list of xref commands which will always prompt,
with the identifier at point, if any, used as the default.
335
If the list starts with `not', the meaning of the rest of the
336 337 338 339 340
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"
341
		      :value (not)
342
		      (const :tag "Except for commands listed below" not)
343
		      (repeat :inline t (symbol :tag "command")))))
344

345 346 347 348 349 350 351 352
(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
353

354 355 356
(defvar xref--marker-ring (make-ring xref-marker-ring-length)
  "Ring of markers to implement the marker stack.")

357 358 359
(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))))
360 361 362 363 364 365 366

;;;###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)
367
      (user-error "Marker stack is empty"))
368 369
    (let ((marker (ring-remove ring 0)))
      (switch-to-buffer (or (marker-buffer marker)
370
                            (user-error "The marked buffer has been deleted")))
371
      (goto-char (marker-position marker))
Dmitry Gutov's avatar
Dmitry Gutov committed
372
      (set-marker marker nil nil)
373 374
      (run-hooks 'xref-after-return-hook))))

Dmitry Gutov's avatar
Dmitry Gutov committed
375 376
(defvar xref--current-item nil)

377
(defun xref-pulse-momentarily ()
Dmitry Gutov's avatar
Dmitry Gutov committed
378 379 380
  (pcase-let ((`(,beg . ,end)
               (save-excursion
                 (or
381 382
                  (let ((length (xref-match-length xref--current-item)))
                    (and length (cons (point) (+ (point) length))))
Dmitry Gutov's avatar
Dmitry Gutov committed
383 384 385 386
                  (back-to-indentation)
                  (if (eolp)
                      (cons (line-beginning-position) (1+ (point)))
                    (cons (point) (line-end-position)))))))
387
    (pulse-momentary-highlight-region beg end 'next-error)))
388 389 390 391 392 393 394 395 396

;; 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)))))

397
;;;###autoload
398 399 400 401
(defun xref-marker-stack-empty-p ()
  "Return t if the marker stack is empty; nil otherwise."
  (ring-empty-p xref--marker-ring))

402

403 404 405 406 407 408 409 410

(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))

411 412 413 414
(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))
415
    (xref--goto-char marker)))
416

417
(defun xref--pop-to-location (item &optional action)
Dmitry Gutov's avatar
Dmitry Gutov committed
418
  "Go to the location of ITEM and display the buffer.
419
ACTION controls how the buffer is displayed:
420
  nil      -- switch-to-buffer
421
  `window' -- pop-to-buffer (other window)
422 423
  `frame'  -- pop-to-buffer (other frame)
If SELECT is non-nil, select the target window."
424 425 426
  (let* ((marker (save-excursion
                   (xref-location-marker (xref-item-location item))))
         (buf (marker-buffer marker)))
427
    (cl-ecase action
428 429 430 431
      ((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
432 433
  (let ((xref--current-item item))
    (run-hooks 'xref-after-jump-hook)))
434 435 436 437 438


;;; XREF buffer (part of the UI)

;; The xref buffer is used to display a set of xrefs.
439 440
(defconst xref-buffer-name "*xref*"
  "The name of the buffer to show xrefs.")
441

442 443 444 445 446 447 448 449 450 451 452
(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)))))

453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478
(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.")

(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
          (cond ((memq
                  xref--original-window-intent
                  '(window frame))
                 t)
                ((and
                  (window-live-p xref--original-window)
                  (or (not (window-dedicated-p xref--original-window))
                      (eq (window-buffer xref--original-window) buf)))
                 `(,(lambda (buf _alist)
                      (set-window-buffer xref--original-window buf)
                      xref--original-window))))))
479
    (with-selected-window
480 481 482 483 484 485 486 487 488
        (with-selected-window
            ;; Just before `display-buffer', place ourselves in the
            ;; original window to suggest preserving it. Of course, if
            ;; user has deleted the original window, all bets are off,
            ;; just use the selected one.
            (or (and (window-live-p xref--original-window)
                     xref--original-window)
                (selected-window))
          (display-buffer buf action))
489 490
      (xref--goto-char pos)
      (run-hooks 'xref-after-jump-hook)
491
      (let ((buf (current-buffer)))
492
        (with-current-buffer xref-buf
493 494
          (setq-local other-window-scroll-buffer buf)))
      (selected-window))))
495

496
(defun xref--show-location (location &optional select)
497 498 499
  "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."
500
  (condition-case err
501
      (let* ((marker (xref-location-marker location))
502 503
             (buf (marker-buffer marker))
             (xref-buffer (current-buffer)))
504
        (cond (select
505 506 507
               (if (eq select 'quit) (quit-window nil nil))
               (with-current-buffer xref-buffer
                 (select-window (xref--show-pos-in-buf marker buf))))
508 509 510 511
              (t
               (save-selected-window
                 (xref--with-dedicated-window
                  (xref--show-pos-in-buf marker buf))))))
512 513
    (user-error (message (error-message-string err)))))

514
(defun xref-show-location-at-point ()
515
  "Display the source of xref at point in the appropriate window, if any."
516
  (interactive)
Dmitry Gutov's avatar
Dmitry Gutov committed
517 518 519
  (let* ((xref (xref--item-at-point))
         (xref--current-item xref))
    (when xref
520
      (xref--show-location (xref-item-location xref)))))
521

522
(defun xref-next-line ()
523
  "Move to the next xref and display its source in the appropriate window."
524
  (interactive)
Dmitry Gutov's avatar
Dmitry Gutov committed
525
  (xref--search-property 'xref-item)
526
  (xref-show-location-at-point))
527 528

(defun xref-prev-line ()
529
  "Move to the previous xref and display its source in the appropriate window."
530
  (interactive)
Dmitry Gutov's avatar
Dmitry Gutov committed
531
  (xref--search-property 'xref-item t)
532
  (xref-show-location-at-point))
533

Dmitry Gutov's avatar
Dmitry Gutov committed
534
(defun xref--item-at-point ()
535 536
  (save-excursion
    (back-to-indentation)
Dmitry Gutov's avatar
Dmitry Gutov committed
537
    (get-text-property (point) 'xref-item)))
538

539 540 541 542
(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."
543
  (interactive)
Dmitry Gutov's avatar
Dmitry Gutov committed
544
  (let ((xref (or (xref--item-at-point)
545
                  (user-error "No reference at point"))))
546 547 548 549 550 551
    (xref--show-location (xref-item-location xref) (if quit 'quit t))))

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

553
(defun xref-query-replace-in-results (from to)
554 555 556 557
  "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."
558
  (interactive
559 560 561
   (let ((fr (read-regexp "Xref query-replace (regexp)" ".*")))
     (list fr
           (read-regexp (format "Xref query-replace (regexp) %s with: " fr)))))
562 563 564 565 566
  (let* (item xrefs iter)
    (save-excursion
      (while (setq item (xref--search-property 'xref-item))
        (when (xref-match-length item)
          (push item xrefs))))
567 568
    (unwind-protect
        (progn
569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610
          (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))))))))
611
           (cons file-buf (nreverse pairs))))
612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628
        (: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)))))
629

630
;; FIXME: Write a nicer UI.
631
(defun xref--query-replace-1 (from to iter)
632
  (let* ((query-replace-lazy-highlight nil)
633 634 635
         (continue t)
         did-it-once buf-pairs pairs
         current-beg current-end
636 637 638 639 640
         ;; 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)
641 642
            (and current-beg
                 (>= beg current-beg)
643
                 (<= end current-end))))
644 645
         (replace-re-search-function
          (lambda (from &optional _bound noerror)
646
            (let (found pair)
647
              (while (and (not found) pairs)
648 649
                (setq pair (pop pairs)
                      current-beg (car pair)
650
                      current-end (cdr pair))
651
                (goto-char current-beg)
652
                (when (re-search-forward from current-end noerror)
653 654
                  (setq found t)))
              found))))
655 656 657 658 659 660 661 662 663 664
    (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)))
665 666 667
    (unless did-it-once (user-error "No suitable matches here"))
    (when (and continue (not buf-pairs))
      (message "All results processed"))))
668

669 670 671 672
(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)
673
    (define-key map (kbd "r") #'xref-query-replace-in-results)
674
    (define-key map (kbd "RET") #'xref-goto-xref)
675
    (define-key map (kbd "TAB")  #'xref-quit-and-goto-xref)
676 677 678 679 680 681 682
    (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)
    map))

(define-derived-mode xref--xref-buffer-mode special-mode "XREF"
Paul Eggert's avatar
Paul Eggert committed
683
  "Mode for displaying cross-references."
684
  (setq buffer-read-only t)
685 686
  (setq next-error-function #'xref--next-error-function)
  (setq next-error-last-buffer (current-buffer)))
687 688 689 690 691 692

(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
693
        (xref nil))
694
    (dotimes (_ n)
Dmitry Gutov's avatar
Dmitry Gutov committed
695
      (setq xref (xref--search-property 'xref-item backward)))
Dmitry Gutov's avatar
Dmitry Gutov committed
696
    (cond (xref
697 698 699 700
           ;; 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))))
701
           (xref--show-location (xref-item-location xref) t))
702 703
          (t
           (error "No %s xref" (if backward "previous" "next"))))))
704

Dmitry Gutov's avatar
Dmitry Gutov committed
705 706 707 708 709 710 711 712 713 714 715 716
(defvar xref--button-map
  (let ((map (make-sparse-keymap)))
    (define-key map [(control ?m)] #'xref-goto-xref)
    (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)
Dmitry Gutov's avatar
Dmitry Gutov committed
717
  (xref--search-property 'xref-item)
Dmitry Gutov's avatar
Dmitry Gutov committed
718 719
  (xref-show-location-at-point))

720 721
(defun xref--insert-xrefs (xref-alist)
  "Insert XREF-ALIST in the current-buffer.
722
XREF-ALIST is of the form ((GROUP . (XREF ...)) ...), where
723
GROUP is a string for decoration purposes and XREF is an
Dmitry Gutov's avatar
Dmitry Gutov committed
724
`xref-item' object."
Dmitry Gutov's avatar
Dmitry Gutov committed
725
  (require 'compile) ; For the compilation faces.
726 727 728 729
  (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
730
                                          (oref xref location))))
731 732 733 734
                               (length (and line (format "%d" line)))))
           for line-format = (and max-line-width
                                  (format "%%%dd: " max-line-width))
           do
735
           (xref--insert-propertized '(face compilation-info) group "\n")
736
           (cl-loop for (xref . more2) on xrefs do
737
                    (with-slots (summary location) xref
738 739 740 741 742 743 744
                      (let* ((line (xref-location-line location))
                             (prefix
                              (if line
                                  (propertize (format line-format line)
                                              'face 'compilation-line-number)
                                "  ")))
                        (xref--insert-propertized
Dmitry Gutov's avatar
Dmitry Gutov committed
745
                         (list 'xref-item xref
746 747 748 749 750 751
                               ;; 'face 'font-lock-keyword-face
                               'mouse-face 'highlight
                               'keymap xref--button-map
                               'help-echo
                               (concat "mouse-2: display in another window, "
                                       "RET or mouse-1: follow reference"))
752
                         prefix summary)))
753
                    (insert "\n"))))
754 755 756 757 758 759

(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
760
                    (xref-location-group (xref-item-location x)))
761 762
                  #'equal))

763
(defun xref--show-xref-buffer (xrefs alist)
764 765
  (let ((xref-alist (xref--analyze xrefs)))
    (with-current-buffer (get-buffer-create xref-buffer-name)
766 767 768
      (setq buffer-undo-list nil)
      (let ((inhibit-read-only t)
            (buffer-undo-list t))
769 770 771 772 773
        (erase-buffer)
        (xref--insert-xrefs xref-alist)
        (xref--xref-buffer-mode)
        (pop-to-buffer (current-buffer))
        (goto-char (point-min))
774 775
        (setq xref--original-window (assoc-default 'window alist)
              xref--original-window-intent (assoc-default 'display-action alist))
776 777 778 779 780
        (current-buffer)))))


;; This part of the UI seems fairly uncontroversial: it reads the
;; identifier and deals with the single definition case.
781 782
;; (FIXME: do we really want this case to be handled like that in
;; "find references" and "find regexp searches"?)
783 784 785 786 787 788 789
;;
;; The controversial multiple definitions case is handed off to
;; xref-show-xrefs-function.

(defvar xref-show-xrefs-function 'xref--show-xref-buffer
  "Function to display a list of xrefs.")

790 791 792 793
(defvar xref--read-identifier-history nil)

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

794
(defun xref--show-xrefs (xrefs display-action &optional always-show-list)
795
  (cond
796
   ((and (not (cdr xrefs)) (not always-show-list))
797
    (xref-push-marker-stack)
798
    (xref--pop-to-location (car xrefs) display-action))
799 800 801
   (t
    (xref-push-marker-stack)
    (funcall xref-show-xrefs-function xrefs
802 803
             `((window . ,(selected-window))
               (display-action . ,display-action))))))
804

805 806 807 808 809 810
(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))))

811 812
(defun xref--read-identifier (prompt)
  "Return the identifier at point or read it from the minibuffer."
813 814
  (let* ((backend (xref-find-backend))
         (id (xref-backend-identifier-at-point backend)))
815 816 817
    (cond ((or current-prefix-arg
               (not id)
               (xref--prompt-p this-command))
818 819 820 821 822 823
           (completing-read (if id
                                (format "%s (default %s): "
                                        (substring prompt 0 (string-match
                                                             "[ :]+\\'" prompt))
                                        id)
                              prompt)
824
                            (xref-backend-identifier-completion-table backend)
Dmitry Gutov's avatar
Dmitry Gutov committed
825
                            nil nil nil
826
                            'xref--read-identifier-history id))
827 828 829 830 831
          (t id))))


;;; Commands

832
(defun xref--find-xrefs (input kind arg display-action)
833 834 835
  (let ((xrefs (funcall (intern (format "xref-backend-%s" kind))
                        (xref-find-backend)
                        arg)))
836 837
    (unless xrefs
      (user-error "No %s found for: %s" (symbol-name kind) input))
838
    (xref--show-xrefs xrefs display-action)))
839

840 841
(defun xref--find-definitions (id display-action)
  (xref--find-xrefs id 'definitions id display-action))
842 843 844 845

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

849 850 851 852
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."
853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870
  (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
871 872 873 874 875
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."
876
  (interactive (list (xref--read-identifier "Find references of: ")))
877
  (xref--find-xrefs identifier 'references identifier nil))
Dmitry Gutov's avatar
Dmitry Gutov committed
878

879 880
(declare-function apropos-parse-pattern "apropos" (pattern))

881 882 883 884
;;;###autoload
(defun xref-find-apropos (pattern)
  "Find all meaningful symbols that match PATTERN.
The argument has the same meaning as in `apropos'."
885
  (interactive (list (read-string
886
                      "Search for pattern (word list or regexp): "
887
                      nil 'xref--read-pattern-history)))
888
  (require 'apropos)
889
  (xref--find-xrefs pattern 'apropos
890 891 892 893 894 895
                    (apropos-parse-pattern
                     (if (string-equal (regexp-quote pattern) pattern)
                         ;; Split into words
                         (or (split-string pattern "[ \t]+" t)
                             (user-error "No word list given"))
                       pattern))
896 897 898 899 900 901 902
                    nil))


;;; Key bindings

;;;###autoload (define-key esc-map "." #'xref-find-definitions)
;;;###autoload (define-key esc-map "," #'xref-pop-marker-stack)
903
;;;###autoload (define-key esc-map "?" #'xref-find-references)
904 905 906 907
;;;###autoload (define-key esc-map [?\C-.] #'xref-find-apropos)
;;;###autoload (define-key ctl-x-4-map "." #'xref-find-definitions-other-window)
;;;###autoload (define-key ctl-x-5-map "." #'xref-find-definitions-other-frame)

Dmitry Gutov's avatar
Dmitry Gutov committed
908 909 910 911 912 913 914 915 916 917 918 919 920 921

;;; Helper functions

(defvar xref-etags-mode--saved nil)

(define-minor-mode xref-etags-mode
  "Minor mode to make xref use etags again.

Certain major modes install their own mechanisms for listing
identifiers and navigation.  Turn this on to undo those settings
and just use etags."
  :lighter ""
  (if xref-etags-mode
      (progn
922 923 924
        (setq xref-etags-mode--saved xref-backend-functions)
        (kill-local-variable 'xref-backend-functions))
    (setq-local xref-backend-functions xref-etags-mode--saved)))
Dmitry Gutov's avatar
Dmitry Gutov committed
925

926 927
(declare-function semantic-symref-instantiate "semantic/symref")
(declare-function semantic-symref-perform-search "semantic/symref")
928
(declare-function grep-expand-template "grep")
Stephen Leake's avatar
Stephen Leake committed
929
(defvar ede-minor-mode) ;; ede.el
930

931 932 933
(defun xref-collect-references (symbol dir)
  "Collect references to SYMBOL inside DIR.
This function uses the Semantic Symbol Reference API, see
934 935
`semantic-symref-tool-alist' for details on which tools are used,
and when."
936
  (cl-assert (directory-name-p dir))
937 938
  (require 'semantic/symref)
  (defvar semantic-symref-tool)
939 940 941 942 943 944 945

  ;; Some symref backends use `ede-project-root-directory' as the root
  ;; directory for the search, rather than `default-directory'. Since
  ;; the caller has specified `dir', we bind `ede-minor-mode' to nil
  ;; to force the backend to use `default-directory'.
  (let* ((ede-minor-mode nil)
         (default-directory dir)
946 947 948 949 950
         ;; FIXME: Remove CScope and Global from the recognized tools?
         ;; The current implementations interpret the symbol search as
         ;; "find all calls to the given function", but not function
         ;; definition. And they return nothing when passed a variable
         ;; name, even a global one.
951
         (semantic-symref-tool 'detect)
952
         (case-fold-search nil)
953 954 955 956 957 958
         (inst (semantic-symref-instantiate :searchfor symbol
                                            :searchtype 'symbol
                                            :searchscope 'subdirs
                                            :resulttype 'line-and-text)))
    (xref--convert-hits (semantic-symref-perform-search inst)
                        (format "\\_<%s\\_>" (regexp-quote symbol)))))
959

960
;;;###autoload
961 962 963 964
(defun xref-collect-matches (regexp files dir ignores)
  "Collect matches for REGEXP inside FILES in DIR.
FILES is a string with glob patterns separated by spaces.
IGNORES is a list of glob patterns."
965
  ;; DIR can also be a regular file for now; let's not advertise that.
966 967 968
  (require 'semantic/fw)
  (grep-compute-defaults)
  (defvar grep-find-template)
969
  (defvar grep-highlight-matches)
970 971 972 973 974 975 976 977 978 979 980
  (pcase-let*
      ((grep-find-template (replace-regexp-in-string "<C>" "<C> -E"
                                                     grep-find-template t t))
       (grep-highlight-matches nil)
       ;; TODO: Sanitize the regexp to remove Emacs-specific terms,
       ;; so that Grep can search for the "relaxed" version.  Can we
       ;; do that reliably enough, without creating false negatives?
       (command (xref--rgrep-command (xref--regexp-to-extended regexp)
                                     files
                                     (expand-file-name dir)
                                     ignores))
981
       (def default-directory)
982
       (buf (get-buffer-create " *xref-grep*"))
983
       (`(,grep-re ,file-group ,line-group . ,_) (car grep-regexp-alist))
984 985
       (status nil)
       (hits nil))
986 987
    (with-current-buffer buf
      (erase-buffer)
988
      (setq default-directory def)
989 990
      (setq status
            (call-process-shell-command command nil t))
991
      (goto-char (point-min))
992 993 994 995 996 997 998
      ;; Can't use the exit status: Grep exits with 1 to mean "no
      ;; matches found".  Find exits with 1 if any of the invocations
      ;; exit with non-zero. "No matches" and "Grep program not found"
      ;; are all the same to it.
      (when (and (/= (point-min) (point-max))
                 (not (looking-at grep-re)))
        (user-error "Search failed with status %d: %s" status (buffer-string)))
999
      (while (re-search-forward grep-re nil t)
1000 1001
        (push (list (string-to-number (match-string line-group))
                    (match-string file-group)
1002
                    (buffer-substring-no-properties (point) (line-end-position)))
1003
              hits)))
1004
    (xref--convert-hits (nreverse hits) regexp)))
1005

Dmitry Gutov's avatar
Dmitry Gutov committed
1006 1007 1008 1009
(defun xref--rgrep-command (regexp files dir ignores)
  (require 'find-dired)      ; for `find-name-arg'
  (defvar grep-find-template)
  (defvar find-name-arg)
1010 1011
  ;; `shell-quote-argument' quotes the tilde as well.
  (cl-assert (not (string-match-p "\\`~" dir)))
Dmitry Gutov's avatar
Dmitry Gutov committed
1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022
  (grep-expand-template
   grep-find-template
   regexp
   (concat (shell-quote-argument "(")
           " " find-name-arg " "
           (mapconcat
            #'shell-quote-argument
            (split-string files)
            (concat " -o " find-name-arg " "))
           " "
           (shell-quote-argument ")"))
1023
   (shell-quote-argument dir)
1024 1025 1026
   (xref--find-ignores-arguments ignores dir)))

(defun xref--find-ignores-arguments (ignores dir)
Stephen Leake's avatar
Stephen Leake committed
1027 1028 1029
  "Convert IGNORES and DIR to a list of arguments for 'find'.
IGNORES is a list of glob patterns.  DIR is an absolute
directory, used as the root of the ignore globs."
1030
  (cl-assert (not (string-match-p "\\`~" dir)))
1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048
  (when ignores
    (concat
     (shell-quote-argument "(")
     " -path "
     (mapconcat
      (lambda (ignore)
        (when (string-match-p "/\\'" ignore)
          (setq ignore (concat ignore "*")))
        (if (string-match "\\`\\./" ignore)
            (setq ignore (replace-match dir t t ignore))
          (unless (string-prefix-p "*" ignore)
            (setq ignore (concat "*/" ignore))))
        (shell-quote-argument ignore))
      ignores
      " -o -path ")
     " "
     (shell-quote-argument ")")
     " -prune -o ")))
Dmitry Gutov's avatar
Dmitry Gutov committed
1049

Dmitry Gutov's avatar
Dmitry Gutov committed
1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067
(defun xref--regexp-to-extended (str)
  (replace-regexp-in-string
   ;; FIXME: Add tests.  Move to subr.el, make a public function.
   ;; Maybe error on Emacs-only constructs.
   "\\(?:\\\\\\\\\\)*\\(?:\\\\[][]\\)?\\(?:\\[.+?\\]\\|\\(\\\\?[(){}|]\\)\\)"
   (lambda (str)
     (cond
      ((not (match-beginning 1))
       str)
      ((eq (length (match-string 1 str)) 2)
       (concat (substring str 0 (match-beginning 1))
               (substring (match-string 1 str) 1 2)))
      (t
       (concat (substring str 0 (match-beginning 1))
               "\\"
               (match-string 1 str)))))
   str t t))

1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078
(defun xref--regexp-syntax-dependent-p (str)
  "Return non-nil when STR depends on the buffer's syntax.
Such as the current syntax table and the applied syntax properties."