1 ;; xref.el --- Cross-referencing commands -*-lexical-binding:t-*-
3 ;; Copyright (C) 2014-2016 Free Software Foundation, Inc.
5 ;; This file is part of GNU Emacs.
7 ;; GNU Emacs is free software: you can redistribute it and/or modify
8 ;; it under the terms of the GNU General Public License as published by
9 ;; the Free Software Foundation, either version 3 of the License, or
10 ;; (at your option) any later version.
12 ;; GNU Emacs is distributed in the hope that it will be useful,
13 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 ;; GNU General Public License for more details.
17 ;; You should have received a copy of the GNU General Public License
18 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
22 ;; NOTE: The xref API is still experimental and can change in major,
23 ;; backward-incompatible ways. Everyone is encouraged to try it, and
24 ;; report to us any problems or use cases we hadn't anticipated, by
25 ;; sending an email to emacs-devel, or `M-x report-emacs-bug'.
27 ;; This file provides a somewhat generic infrastructure for cross
28 ;; referencing commands, in particular "find-definition".
30 ;; Some part of the functionality must be implemented in a language
31 ;; dependent way and that's done by defining an xref backend.
33 ;; That consists of a constructor function, which should return a
34 ;; backend value, and a set of implementations for the generic
37 ;; `xref-backend-identifier-at-point',
38 ;; `xref-backend-identifier-completion-table',
39 ;; `xref-backend-definitions', `xref-backend-references',
40 ;; `xref-backend-apropos', which see.
42 ;; A major mode would normally use `add-hook' to add the backend
43 ;; constructor to `xref-backend-functions'.
45 ;; The last three methods operate with "xref" and "location" values.
47 ;; One would usually call `make-xref' and `xref-make-file-location',
48 ;; `xref-make-buffer-location' or `xref-make-bogus-location' to create
49 ;; them. More generally, a location must be an instance of an EIEIO
50 ;; class inheriting from `xref-location' and implementing
51 ;; `xref-location-group' and `xref-location-marker'.
53 ;; There's a special kind of xrefs we call "match xrefs", which
54 ;; correspond to search results. For these values,
55 ;; `xref-match-length' must be defined, and `xref-location-marker'
56 ;; must return the beginning of the match.
58 ;; Each identifier must be represented as a string. Implementers can
59 ;; use string properties to store additional information about the
60 ;; identifier, but they should keep in mind that values returned from
61 ;; `xref-backend-identifier-completion-table' should still be
62 ;; distinct, because the user can't see the properties when making the
65 ;; See the etags and elisp-mode implementations for full examples.
76 (require 'semantic/symref)) ;; for hit-lines slot
78 (defgroup xref nil "Cross-referencing commands"
85 (defclass xref-location () ()
86 :documentation "A location represents a position in a file or buffer.")
88 (cl-defgeneric xref-location-marker (location)
89 "Return the marker for LOCATION.")
91 (cl-defgeneric xref-location-group (location)
92 "Return a string used to group a set of locations.
93 This is typically the filename.")
95 (cl-defgeneric xref-location-line (_location)
96 "Return the line number corresponding to the location."
99 (cl-defgeneric xref-match-length (_item)
100 "Return the length of the match."
103 ;;;; Commonly needed location classes are defined here:
105 ;; FIXME: might be useful to have an optional "hint" i.e. a string to
106 ;; search for in case the line number is sightly out of date.
107 (defclass xref-file-location (xref-location)
108 ((file :type string :initarg :file)
109 (line :type fixnum :initarg :line :reader xref-location-line)
110 (column :type fixnum :initarg :column :reader xref-file-location-column))
111 :documentation "A file location is a file/line/column triple.
112 Line numbers start from 1 and columns from 0.")
114 (defun xref-make-file-location (file line column)
115 "Create and return a new `xref-file-location'."
116 (make-instance 'xref-file-location :file file :line line :column column))
118 (cl-defmethod xref-location-marker ((l xref-file-location))
119 (with-slots (file line column) l
121 (or (get-file-buffer file)
122 (let ((find-file-suppress-same-file-warnings t))
123 (find-file-noselect file)))
127 (goto-char (point-min))
128 (beginning-of-line line)
129 (forward-char column)
132 (cl-defmethod xref-location-group ((l xref-file-location))
135 (defclass xref-buffer-location (xref-location)
136 ((buffer :type buffer :initarg :buffer)
137 (position :type fixnum :initarg :position)))
139 (defun xref-make-buffer-location (buffer position)
140 "Create and return a new `xref-buffer-location'."
141 (make-instance 'xref-buffer-location :buffer buffer :position position))
143 (cl-defmethod xref-location-marker ((l xref-buffer-location))
144 (with-slots (buffer position) l
145 (let ((m (make-marker)))
146 (move-marker m position buffer))))
148 (cl-defmethod xref-location-group ((l xref-buffer-location))
149 (with-slots (buffer) l
150 (or (buffer-file-name buffer)
151 (format "(buffer %s)" (buffer-name buffer)))))
153 (defclass xref-bogus-location (xref-location)
154 ((message :type string :initarg :message
155 :reader xref-bogus-location-message))
156 :documentation "Bogus locations are sometimes useful to
157 indicate errors, e.g. when we know that a function exists but the
158 actual location is not known.")
160 (defun xref-make-bogus-location (message)
161 "Create and return a new `xref-bogus-location'."
162 (make-instance 'xref-bogus-location :message message))
164 (cl-defmethod xref-location-marker ((l xref-bogus-location))
165 (user-error "%s" (oref l message)))
167 (cl-defmethod xref-location-group ((_ xref-bogus-location)) "(No location)")
172 (defclass xref-item ()
173 ((summary :type string :initarg :summary
174 :reader xref-item-summary
175 :documentation "One line which will be displayed for
176 this item in the output buffer.")
177 (location :initarg :location
178 :reader xref-item-location
179 :documentation "An object describing how to navigate
180 to the reference's target."))
181 :comment "An xref item describes a reference to a location
184 (defun xref-make (summary location)
185 "Create and return a new `xref-item'.
186 SUMMARY is a short string to describe the xref.
187 LOCATION is an `xref-location'."
188 (make-instance 'xref-item :summary summary :location location))
190 (defclass xref-match-item ()
191 ((summary :type string :initarg :summary
192 :reader xref-item-summary)
193 (location :initarg :location
194 :type xref-file-location
195 :reader xref-item-location)
196 (length :initarg :length :reader xref-match-length))
197 :comment "A match xref item describes a search result.")
199 (defun xref-make-match (summary location length)
200 "Create and return a new `xref-match-item'.
201 SUMMARY is a short string to describe the xref.
202 LOCATION is an `xref-location'.
203 LENGTH is the match length, in characters."
204 (make-instance 'xref-match-item :summary summary
205 :location location :length length))
210 (defvar xref-backend-functions nil
211 "Special hook to find the xref backend for the current context.
212 Each function on this hook is called in turn with no arguments,
213 and should return either nil to mean that it is not applicable,
214 or an xref backend, which is a value to be used to dispatch the
217 ;; We make the etags backend the default for now, until something
218 ;; better comes along. Use APPEND so that any `add-hook' calls made
219 ;; before this package is loaded put new items before this one.
220 (add-hook 'xref-backend-functions #'etags--xref-backend t)
223 (defun xref-find-backend ()
224 (run-hook-with-args-until-success 'xref-backend-functions))
226 (cl-defgeneric xref-backend-definitions (backend identifier)
227 "Find definitions of IDENTIFIER.
229 The result must be a list of xref objects. If IDENTIFIER
230 contains sufficient information to determine a unique definition,
231 return only that definition. If there are multiple possible
232 definitions, return all of them. If no definitions can be found,
235 IDENTIFIER can be any string returned by
236 `xref-backend-identifier-at-point', or from the table returned by
237 `xref-backend-identifier-completion-table'.
239 To create an xref object, call `xref-make'.")
241 (cl-defgeneric xref-backend-references (_backend identifier)
242 "Find references of IDENTIFIER.
243 The result must be a list of xref objects. If no references can
244 be found, return nil.
246 The default implementation uses `semantic-symref-tool-alist' to
247 find a search tool; by default, this uses \"find | grep\" in the
248 `project-current' roots."
251 (xref-collect-references identifier dir))
252 (let ((pr (project-current t)))
255 (project-external-roots pr)))))
257 (cl-defgeneric xref-backend-apropos (backend pattern)
258 "Find all symbols that match PATTERN.
259 PATTERN is a regexp")
261 (cl-defgeneric xref-backend-identifier-at-point (_backend)
262 "Return the relevant identifier at point.
264 The return value must be a string or nil. nil means no
265 identifier at point found.
267 If it's hard to determine the identifier precisely (e.g., because
268 it's a method call on unknown type), the implementation can
269 return a simple string (such as symbol at point) marked with a
270 special text property which e.g. `xref-backend-definitions' would
271 recognize and then delegate the work to an external process."
272 (let ((thing (thing-at-point 'symbol)))
273 (and thing (substring-no-properties thing))))
275 (cl-defgeneric xref-backend-identifier-completion-table (backend)
276 "Returns the completion table for identifiers.")
280 (defun xref--alistify (list key test)
281 "Partition the elements of LIST into an alist.
282 KEY extracts the key from an element and TEST is used to compare
286 (let* ((k (funcall key e))
287 (probe (cl-assoc k alist :test test)))
289 (setcdr probe (cons e (cdr probe)))
290 (push (cons k (list e)) alist))))
291 ;; Put them back in order.
292 (cl-loop for (key . value) in (reverse alist)
293 collect (cons key (reverse value)))))
295 (defun xref--insert-propertized (props &rest strings)
296 "Insert STRINGS with text properties PROPS."
297 (let ((start (point)))
298 (apply #'insert strings)
299 (add-text-properties start (point) props)))
301 (defun xref--search-property (property &optional backward)
302 "Search the next text range where text property PROPERTY is non-nil.
303 Return the value of PROPERTY. If BACKWARD is non-nil, search
305 (let ((next (if backward
306 #'previous-single-char-property-change
307 #'next-single-char-property-change))
311 (goto-char (funcall next (point) property))
312 (not (or (setq value (get-text-property (point) property))
316 (t (goto-char start) nil))))
319 ;;; Marker stack (M-. pushes, M-, pops)
321 (defcustom xref-marker-ring-length 16
322 "Length of the xref marker ring."
325 (defcustom xref-prompt-for-identifier '(not xref-find-definitions
326 xref-find-definitions-other-window
327 xref-find-definitions-other-frame)
328 "When t, always prompt for the identifier name.
330 When nil, prompt only when there's no value at point we can use,
331 or when the command has been called with the prefix argument.
333 Otherwise, it's a list of xref commands which will prompt
334 anyway (the value at point, if any, will be used as the default).
336 If the list starts with `not', the meaning of the rest of the
337 elements is negated."
338 :type '(choice (const :tag "always" t)
339 (const :tag "auto" nil)
340 (set :menu-tag "command specific" :tag "commands"
342 (const :tag "Except" not)
343 (repeat :inline t (symbol :tag "command")))))
345 (defcustom xref-after-jump-hook '(recenter
346 xref-pulse-momentarily)
347 "Functions called after jumping to an xref."
350 (defcustom xref-after-return-hook '(xref-pulse-momentarily)
351 "Functions called after returning to a pre-jump location."
354 (defvar xref--marker-ring (make-ring xref-marker-ring-length)
355 "Ring of markers to implement the marker stack.")
357 (defun xref-push-marker-stack (&optional m)
358 "Add point M (defaults to `point-marker') to the marker stack."
359 (ring-insert xref--marker-ring (or m (point-marker))))
362 (defun xref-pop-marker-stack ()
363 "Pop back to where \\[xref-find-definitions] was last invoked."
365 (let ((ring xref--marker-ring))
366 (when (ring-empty-p ring)
367 (user-error "Marker stack is empty"))
368 (let ((marker (ring-remove ring 0)))
369 (switch-to-buffer (or (marker-buffer marker)
370 (user-error "The marked buffer has been deleted")))
371 (goto-char (marker-position marker))
372 (set-marker marker nil nil)
373 (run-hooks 'xref-after-return-hook))))
375 (defvar xref--current-item nil)
377 (defun xref-pulse-momentarily ()
378 (pcase-let ((`(,beg . ,end)
381 (let ((length (xref-match-length xref--current-item)))
382 (and length (cons (point) (+ (point) length))))
383 (back-to-indentation)
385 (cons (line-beginning-position) (1+ (point)))
386 (cons (point) (line-end-position)))))))
387 (pulse-momentary-highlight-region beg end 'next-error)))
389 ;; etags.el needs this
390 (defun xref-clear-marker-stack ()
391 "Discard all markers from the marker stack."
392 (let ((ring xref--marker-ring))
393 (while (not (ring-empty-p ring))
394 (let ((marker (ring-remove ring)))
395 (set-marker marker nil nil)))))
398 (defun xref-marker-stack-empty-p ()
399 "Return t if the marker stack is empty; nil otherwise."
400 (ring-empty-p xref--marker-ring))
404 (defun xref--goto-char (pos)
406 ((and (<= (point-min) pos) (<= pos (point-max))))
407 (widen-automatically (widen))
408 (t (user-error "Position is outside accessible part of buffer")))
411 (defun xref--goto-location (location)
412 "Set buffer and point according to xref-location LOCATION."
413 (let ((marker (xref-location-marker location)))
414 (set-buffer (marker-buffer marker))
415 (xref--goto-char marker)))
417 (defun xref--pop-to-location (item &optional action)
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 `frame' -- pop-to-buffer (other frame)
423 If SELECT is non-nil, select the target window."
424 (let* ((marker (save-excursion
425 (xref-location-marker (xref-item-location item))))
426 (buf (marker-buffer marker)))
428 ((nil) (switch-to-buffer buf))
429 (window (pop-to-buffer buf t))
430 (frame (let ((pop-up-frames t)) (pop-to-buffer buf t))))
431 (xref--goto-char marker))
432 (let ((xref--current-item item))
433 (run-hooks 'xref-after-jump-hook)))
436 ;;; XREF buffer (part of the UI)
438 ;; The xref buffer is used to display a set of xrefs.
440 (defmacro xref--with-dedicated-window (&rest body)
441 `(let* ((xref-w (get-buffer-window xref-buffer-name))
442 (xref-w-dedicated (window-dedicated-p xref-w)))
446 (set-window-dedicated-p xref-w 'soft))
449 (set-window-dedicated-p xref-w xref-w-dedicated)))))
451 (defun xref--show-pos-in-buf (pos buf select)
452 (let ((xref-buf (current-buffer))
454 (with-selected-window
455 (xref--with-dedicated-window
456 (display-buffer buf))
457 (xref--goto-char pos)
458 (run-hooks 'xref-after-jump-hook)
459 (let ((buf (current-buffer)))
460 (setq win (selected-window))
461 (with-current-buffer xref-buf
462 (setq-local other-window-scroll-buffer buf))))
464 (select-window win))))
466 (defun xref--show-location (location &optional select)
468 (let* ((marker (xref-location-marker location))
469 (buf (marker-buffer marker)))
470 (xref--show-pos-in-buf marker buf select))
471 (user-error (message (error-message-string err)))))
473 (defun xref-show-location-at-point ()
474 "Display the source of xref at point in the appropriate window, if any."
476 (let* ((xref (xref--item-at-point))
477 (xref--current-item xref))
479 ;; Try to avoid the window the current xref buffer was
480 ;; originally created from.
481 (if (window-live-p xref--window)
482 (with-selected-window xref--window
483 (xref--show-location (xref-item-location xref)))
484 (xref--show-location (xref-item-location xref))))))
486 (defun xref-next-line ()
487 "Move to the next xref and display its source in the appropriate window."
489 (xref--search-property 'xref-item)
490 (xref-show-location-at-point))
492 (defun xref-prev-line ()
493 "Move to the previous xref and display its source in the appropriate window."
495 (xref--search-property 'xref-item t)
496 (xref-show-location-at-point))
498 (defun xref--item-at-point ()
500 (back-to-indentation)
501 (get-text-property (point) 'xref-item)))
503 (defvar-local xref--window nil
504 "The original window this xref buffer was created from.")
506 (defun xref-goto-xref ()
507 "Jump to the xref on the current line and select its window."
509 (let ((xref (or (xref--item-at-point)
510 (user-error "No reference at point"))))
511 (xref--show-location (xref-item-location xref) t)))
513 (defun xref-query-replace-in-results (from to)
514 "Perform interactive replacement of FROM with TO in all displayed xrefs.
516 This command interactively replaces FROM with TO in the names of the
517 references displayed in the current *xref* buffer."
519 (let ((fr (read-regexp "Xref query-replace (regexp)" ".*")))
521 (read-regexp (format "Xref query-replace (regexp) %s with: " fr)))))
522 (let ((reporter (make-progress-reporter (format "Saving search results...")
523 0 (line-number-at-pos (point-max))))
529 (goto-char (point-min))
530 ;; TODO: This list should be computed on-demand instead.
531 ;; As long as the UI just iterates through matches one by
532 ;; one, there's no need to compute them all in advance.
533 ;; Then we can throw away the reporter.
534 (while (setq item (xref--search-property 'xref-item))
535 (when (xref-match-length item)
537 (let* ((loc (xref-item-location item))
538 (beg (xref-location-marker loc))
539 (end (move-marker (make-marker)
540 (+ beg (xref-match-length item))
541 (marker-buffer beg))))
542 ;; Perform sanity check first.
543 (xref--goto-location loc)
544 ;; FIXME: The check should probably be a generic
545 ;; function, instead of the assumption that all
546 ;; matches contain the full line as summary.
547 ;; TODO: Offer to re-scan otherwise.
548 (unless (equal (buffer-substring-no-properties
549 (line-beginning-position)
551 (xref-item-summary item))
552 (user-error "Search results out of date"))
553 (progress-reporter-update reporter (cl-incf counter))
554 (push (cons beg end) pairs)))))
555 (setq pairs (nreverse pairs)))
556 (unless pairs (user-error "No suitable matches here"))
557 (progress-reporter-done reporter)
558 (xref--query-replace-1 from to pairs))
560 (move-marker (car pair) nil)
561 (move-marker (cdr pair) nil)))))
563 ;; FIXME: Write a nicer UI.
564 (defun xref--query-replace-1 (from to pairs)
565 (let* ((query-replace-lazy-highlight nil)
566 current-beg current-end current-buf
567 ;; Counteract the "do the next match now" hack in
568 ;; `perform-replace'. And still, it'll report that those
569 ;; matches were "filtered out" at the end.
570 (isearch-filter-predicate
573 (eq (current-buffer) current-buf)
575 (<= end current-end))))
576 (replace-re-search-function
577 (lambda (from &optional _bound noerror)
579 (while (and (not found) pairs)
580 (setq pair (pop pairs)
581 current-beg (car pair)
582 current-end (cdr pair)
583 current-buf (marker-buffer current-beg))
584 (xref--with-dedicated-window
585 (pop-to-buffer current-buf))
586 (goto-char current-beg)
587 (when (re-search-forward from current-end noerror)
590 ;; FIXME: Despite this being a multi-buffer replacement, `N'
591 ;; doesn't work, because we're not using
592 ;; `multi-query-replace-map', and it would expect the below
593 ;; function to be called once per buffer.
594 (perform-replace from to t t nil)))
596 (defvar xref--xref-buffer-mode-map
597 (let ((map (make-sparse-keymap)))
598 (define-key map (kbd "n") #'xref-next-line)
599 (define-key map (kbd "p") #'xref-prev-line)
600 (define-key map (kbd "r") #'xref-query-replace-in-results)
601 (define-key map (kbd "RET") #'xref-goto-xref)
602 (define-key map (kbd "C-o") #'xref-show-location-at-point)
603 ;; suggested by Johan Claesson "to further reduce finger movement":
604 (define-key map (kbd ".") #'xref-next-line)
605 (define-key map (kbd ",") #'xref-prev-line)
608 (define-derived-mode xref--xref-buffer-mode special-mode "XREF"
609 "Mode for displaying cross-references."
610 (setq buffer-read-only t)
611 ;; FIXME: http://debbugs.gnu.org/20489
612 ;; (setq next-error-function #'xref--next-error-function)
613 ;; (setq next-error-last-buffer (current-buffer))
616 (defun xref--next-error-function (n reset?)
618 (goto-char (point-min)))
619 (let ((backward (< n 0))
623 (setq xref (xref--search-property 'xref-item backward)))
625 (xref--show-location (xref-item-location xref) t))
627 (error "No %s xref" (if backward "previous" "next"))))))
629 (defconst xref-buffer-name "*xref*"
630 "The name of the buffer to show xrefs.")
632 (defvar xref--button-map
633 (let ((map (make-sparse-keymap)))
634 (define-key map [(control ?m)] #'xref-goto-xref)
635 (define-key map [mouse-1] #'xref-goto-xref)
636 (define-key map [mouse-2] #'xref--mouse-2)
639 (defun xref--mouse-2 (event)
640 "Move point to the button and show the xref definition."
642 (mouse-set-point event)
644 (xref--search-property 'xref-item)
645 (xref-show-location-at-point))
647 (defun xref--insert-xrefs (xref-alist)
648 "Insert XREF-ALIST in the current-buffer.
649 XREF-ALIST is of the form ((GROUP . (XREF ...)) ...), where
650 GROUP is a string for decoration purposes and XREF is an
652 (require 'compile) ; For the compilation faces.
653 (cl-loop for ((group . xrefs) . more1) on xref-alist
655 (cl-loop for xref in xrefs
656 maximize (let ((line (xref-location-line
657 (oref xref location))))
658 (length (and line (format "%d" line)))))
659 for line-format = (and max-line-width
660 (format "%%%dd: " max-line-width))
662 (xref--insert-propertized '(face compilation-info) group "\n")
663 (cl-loop for (xref . more2) on xrefs do
664 (with-slots (summary location) xref
665 (let* ((line (xref-location-line location))
668 (propertize (format line-format line)
669 'face 'compilation-line-number)
671 (xref--insert-propertized
672 (list 'xref-item xref
673 ;; 'face 'font-lock-keyword-face
674 'mouse-face 'highlight
675 'keymap xref--button-map
677 (concat "mouse-2: display in another window, "
678 "RET or mouse-1: follow reference"))
682 (defun xref--analyze (xrefs)
683 "Find common filenames in XREFS.
684 Return an alist of the form ((FILENAME . (XREF ...)) ...)."
685 (xref--alistify xrefs
687 (xref-location-group (xref-item-location x)))
690 (defun xref--show-xref-buffer (xrefs alist)
691 (let ((xref-alist (xref--analyze xrefs)))
692 (with-current-buffer (get-buffer-create xref-buffer-name)
693 (let ((inhibit-read-only t))
695 (xref--insert-xrefs xref-alist)
696 (xref--xref-buffer-mode)
697 (pop-to-buffer (current-buffer))
698 (goto-char (point-min))
699 (setq xref--window (assoc-default 'window alist))
703 ;; This part of the UI seems fairly uncontroversial: it reads the
704 ;; identifier and deals with the single definition case.
705 ;; (FIXME: do we really want this case to be handled like that in
706 ;; "find references" and "find regexp searches"?)
708 ;; The controversial multiple definitions case is handed off to
709 ;; xref-show-xrefs-function.
711 (defvar xref-show-xrefs-function 'xref--show-xref-buffer
712 "Function to display a list of xrefs.")
714 (defvar xref--read-identifier-history nil)
716 (defvar xref--read-pattern-history nil)
718 (defun xref--show-xrefs (xrefs display-action &optional always-show-list)
720 ((and (not (cdr xrefs)) (not always-show-list))
721 (xref-push-marker-stack)
722 (xref--pop-to-location (car xrefs) display-action))
724 (xref-push-marker-stack)
725 (funcall xref-show-xrefs-function xrefs
726 `((window . ,(selected-window)))))))
728 (defun xref--prompt-p (command)
729 (or (eq xref-prompt-for-identifier t)
730 (if (eq (car xref-prompt-for-identifier) 'not)
731 (not (memq command (cdr xref-prompt-for-identifier)))
732 (memq command xref-prompt-for-identifier))))
734 (defun xref--read-identifier (prompt)
735 "Return the identifier at point or read it from the minibuffer."
736 (let* ((backend (xref-find-backend))
737 (id (xref-backend-identifier-at-point backend)))
738 (cond ((or current-prefix-arg
740 (xref--prompt-p this-command))
741 (completing-read (if id
742 (format "%s (default %s): "
743 (substring prompt 0 (string-match
747 (xref-backend-identifier-completion-table backend)
749 'xref--read-identifier-history id))
755 (defun xref--find-xrefs (input kind arg display-action)
756 (let ((xrefs (funcall (intern (format "xref-backend-%s" kind))
760 (user-error "No %s found for: %s" (symbol-name kind) input))
761 (xref--show-xrefs xrefs display-action)))
763 (defun xref--find-definitions (id display-action)
764 (xref--find-xrefs id 'definitions id display-action))
767 (defun xref-find-definitions (identifier)
768 "Find the definition of the identifier at point.
769 With prefix argument or when there's no identifier at point,
772 If sufficient information is available to determine a unique
773 definition for IDENTIFIER, display it in the selected window.
774 Otherwise, display the list of the possible definitions in a
775 buffer where the user can select from the list."
776 (interactive (list (xref--read-identifier "Find definitions of: ")))
777 (xref--find-definitions identifier nil))
780 (defun xref-find-definitions-other-window (identifier)
781 "Like `xref-find-definitions' but switch to the other window."
782 (interactive (list (xref--read-identifier "Find definitions of: ")))
783 (xref--find-definitions identifier 'window))
786 (defun xref-find-definitions-other-frame (identifier)
787 "Like `xref-find-definitions' but switch to the other frame."
788 (interactive (list (xref--read-identifier "Find definitions of: ")))
789 (xref--find-definitions identifier 'frame))
792 (defun xref-find-references (identifier)
793 "Find references to the identifier at point.
794 With prefix argument, prompt for the identifier."
795 (interactive (list (xref--read-identifier "Find references of: ")))
796 (xref--find-xrefs identifier 'references identifier nil))
798 (declare-function apropos-parse-pattern "apropos" (pattern))
801 (defun xref-find-apropos (pattern)
802 "Find all meaningful symbols that match PATTERN.
803 The argument has the same meaning as in `apropos'."
804 (interactive (list (read-string
805 "Search for pattern (word list or regexp): "
806 nil 'xref--read-pattern-history)))
808 (xref--find-xrefs pattern 'apropos
809 (apropos-parse-pattern
810 (if (string-equal (regexp-quote pattern) pattern)
812 (or (split-string pattern "[ \t]+" t)
813 (user-error "No word list given"))
820 ;;;###autoload (define-key esc-map "." #'xref-find-definitions)
821 ;;;###autoload (define-key esc-map "," #'xref-pop-marker-stack)
822 ;;;###autoload (define-key esc-map "?" #'xref-find-references)
823 ;;;###autoload (define-key esc-map [?\C-.] #'xref-find-apropos)
824 ;;;###autoload (define-key ctl-x-4-map "." #'xref-find-definitions-other-window)
825 ;;;###autoload (define-key ctl-x-5-map "." #'xref-find-definitions-other-frame)
830 (defvar xref-etags-mode--saved nil)
832 (define-minor-mode xref-etags-mode
833 "Minor mode to make xref use etags again.
835 Certain major modes install their own mechanisms for listing
836 identifiers and navigation. Turn this on to undo those settings
841 (setq xref-etags-mode--saved xref-backend-functions)
842 (kill-local-variable 'xref-backend-functions))
843 (setq-local xref-backend-functions xref-etags-mode--saved)))
845 (declare-function semantic-symref-find-references-by-name "semantic/symref")
846 (declare-function semantic-find-file-noselect "semantic/fw")
847 (declare-function grep-expand-template "grep")
848 (defvar ede-minor-mode) ;; ede.el
850 (defun xref-collect-references (symbol dir)
851 "Collect references to SYMBOL inside DIR.
852 This function uses the Semantic Symbol Reference API, see
853 `semantic-symref-find-references-by-name' for details on which
854 tools are used, and when."
855 (cl-assert (directory-name-p dir))
856 (require 'semantic/symref)
857 (defvar semantic-symref-tool)
859 ;; Some symref backends use `ede-project-root-directory' as the root
860 ;; directory for the search, rather than `default-directory'. Since
861 ;; the caller has specified `dir', we bind `ede-minor-mode' to nil
862 ;; to force the backend to use `default-directory'.
863 (let* ((ede-minor-mode nil)
864 (default-directory dir)
865 (semantic-symref-tool 'detect)
866 (res (semantic-symref-find-references-by-name symbol 'subdirs))
867 (hits (and res (oref res hit-lines)))
868 (orig-buffers (buffer-list)))
870 (cl-mapcan (lambda (hit) (xref--collect-matches
871 hit (format "\\_<%s\\_>" (regexp-quote symbol))))
873 ;; TODO: Implement "lightweight" buffer visiting, so that we
874 ;; don't have to kill them.
876 (cl-set-difference (buffer-list) orig-buffers)))))
879 (defun xref-collect-matches (regexp files dir ignores)
880 "Collect matches for REGEXP inside FILES in DIR.
881 FILES is a string with glob patterns separated by spaces.
882 IGNORES is a list of glob patterns."
883 ;; DIR can also be a regular file for now; let's not advertise that.
884 (require 'semantic/fw)
885 (grep-compute-defaults)
886 (defvar grep-find-template)
887 (defvar grep-highlight-matches)
888 (let* ((grep-find-template (replace-regexp-in-string "-e " "-E "
889 grep-find-template t t))
890 (grep-highlight-matches nil)
891 (command (xref--rgrep-command (xref--regexp-to-extended regexp)
893 (expand-file-name dir)
895 (orig-buffers (buffer-list))
896 (buf (get-buffer-create " *xref-grep*"))
897 (grep-re (caar grep-regexp-alist))
901 (with-current-buffer buf
903 (call-process-shell-command command nil t)
904 (goto-char (point-min))
905 (while (re-search-forward grep-re nil t)
906 (push (cons (string-to-number (match-string 2))
909 (setq reporter (make-progress-reporter
910 (format "Collecting search results...")
913 (cl-mapcan (lambda (hit)
915 (progress-reporter-update reporter counter)
917 (xref--collect-matches hit regexp))
919 (progress-reporter-done reporter)
920 ;; TODO: Same as above.
922 (cl-set-difference (buffer-list) orig-buffers)))))
924 (defun xref--rgrep-command (regexp files dir ignores)
925 (require 'find-dired) ; for `find-name-arg'
926 (defvar grep-find-template)
927 (defvar find-name-arg)
928 (grep-expand-template
931 (concat (shell-quote-argument "(")
932 " " find-name-arg " "
934 #'shell-quote-argument
936 (concat " -o " find-name-arg " "))
938 (shell-quote-argument ")"))
940 (xref--find-ignores-arguments ignores dir)))
942 (defun xref--find-ignores-arguments (ignores dir)
943 "Convert IGNORES and DIR to a list of arguments for 'find'.
944 IGNORES is a list of glob patterns. DIR is an absolute
945 directory, used as the root of the ignore globs."
946 ;; `shell-quote-argument' quotes the tilde as well.
947 (cl-assert (not (string-match-p "\\`~" dir)))
950 (shell-quote-argument "(")
954 (when (string-match-p "/\\'" ignore)
955 (setq ignore (concat ignore "*")))
956 (if (string-match "\\`\\./" ignore)
957 (setq ignore (replace-match dir t t ignore))
958 (unless (string-prefix-p "*" ignore)
959 (setq ignore (concat "*/" ignore))))
960 (shell-quote-argument ignore))
964 (shell-quote-argument ")")
967 (defun xref--regexp-to-extended (str)
968 (replace-regexp-in-string
969 ;; FIXME: Add tests. Move to subr.el, make a public function.
970 ;; Maybe error on Emacs-only constructs.
971 "\\(?:\\\\\\\\\\)*\\(?:\\\\[][]\\)?\\(?:\\[.+?\\]\\|\\(\\\\?[(){}|]\\)\\)"
974 ((not (match-beginning 1))
976 ((eq (length (match-string 1 str)) 2)
977 (concat (substring str 0 (match-beginning 1))
978 (substring (match-string 1 str) 1 2)))
980 (concat (substring str 0 (match-beginning 1))
982 (match-string 1 str)))))
985 (defun xref--collect-matches (hit regexp)
986 (pcase-let* ((`(,line . ,file) hit)
987 (buf (or (find-buffer-visiting file)
988 (semantic-find-file-noselect file))))
989 (with-current-buffer buf
991 (goto-char (point-min))
992 (forward-line (1- line))
993 (let ((line-end (line-end-position))
994 (line-beg (line-beginning-position))
996 (syntax-propertize line-end)
997 ;; FIXME: This results in several lines with the same
998 ;; summary. Solve with composite pattern?
999 (while (re-search-forward regexp line-end t)
1000 (let* ((beg-column (- (match-beginning 0) line-beg))
1001 (end-column (- (match-end 0) line-beg))
1002 (loc (xref-make-file-location file line beg-column))
1003 (summary (buffer-substring line-beg line-end)))
1004 (add-face-text-property beg-column end-column 'highlight
1006 (push (xref-make-match summary loc (- end-column beg-column))
1008 (nreverse matches))))))
1012 ;;; xref.el ends here