1 ;; xref.el --- Cross-referencing commands -*-lexical-binding:t-*-
3 ;; Copyright (C) 2014-2015 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 ;; This file provides a somewhat generic infrastructure for cross
23 ;; referencing commands, in particular "find-definition".
25 ;; Some part of the functionality must be implemented in a language
26 ;; dependent way and that's done by defining `xref-find-function',
27 ;; `xref-identifier-at-point-function' and
28 ;; `xref-identifier-completion-table-function', which see.
30 ;; A major mode should make these variables buffer-local first.
32 ;; `xref-find-function' can be called in several ways, see its
33 ;; description. It has to operate with "xref" and "location" values.
35 ;; One would usually call `make-xref' and `xref-make-file-location',
36 ;; `xref-make-buffer-location' or `xref-make-bogus-location' to create
37 ;; them. More generally, a location must be an instance of an EIEIO
38 ;; class inheriting from `xref-location' and implementing
39 ;; `xref-location-group' and `xref-location-marker'.
41 ;; Each identifier must be represented as a string. Implementers can
42 ;; use string properties to store additional information about the
43 ;; identifier, but they should keep in mind that values returned from
44 ;; `xref-identifier-completion-table-function' should still be
45 ;; distinct, because the user can't see the properties when making the
48 ;; See the functions `etags-xref-find' and `elisp-xref-find' for full
59 (defgroup xref nil "Cross-referencing commands"
65 (defclass xref-location () ()
66 :documentation "A location represents a position in a file or buffer.")
68 ;; If a backend decides to subclass xref-location it can provide
69 ;; methods for some of the following functions:
70 (cl-defgeneric xref-location-marker (location)
71 "Return the marker for LOCATION.")
73 (cl-defgeneric xref-location-group (location)
74 "Return a string used to group a set of locations.
75 This is typically the filename.")
77 (cl-defgeneric xref-location-line (_location)
78 "Return the line number corresponding to the location."
81 (cl-defgeneric xref-match-bounds (_item)
82 "Return a cons with columns of the beginning and end of the match."
85 ;;;; Commonly needed location classes are defined here:
87 ;; FIXME: might be useful to have an optional "hint" i.e. a string to
88 ;; search for in case the line number is sightly out of date.
89 (defclass xref-file-location (xref-location)
90 ((file :type string :initarg :file)
91 (line :type fixnum :initarg :line :reader xref-location-line)
92 (column :type fixnum :initarg :column :reader xref-file-location-column))
93 :documentation "A file location is a file/line/column triple.
94 Line numbers start from 1 and columns from 0.")
96 (defun xref-make-file-location (file line column)
97 "Create and return a new xref-file-location."
98 (make-instance 'xref-file-location :file file :line line :column column))
100 (cl-defmethod xref-location-marker ((l xref-file-location))
101 (with-slots (file line column) l
103 (or (get-file-buffer file)
104 (let ((find-file-suppress-same-file-warnings t))
105 (find-file-noselect file)))
109 (goto-char (point-min))
110 (beginning-of-line line)
111 (move-to-column column)
114 (cl-defmethod xref-location-group ((l xref-file-location))
117 (defclass xref-buffer-location (xref-location)
118 ((buffer :type buffer :initarg :buffer)
119 (position :type fixnum :initarg :position)))
121 (defun xref-make-buffer-location (buffer position)
122 "Create and return a new xref-buffer-location."
123 (make-instance 'xref-buffer-location :buffer buffer :position position))
125 (cl-defmethod xref-location-marker ((l xref-buffer-location))
126 (with-slots (buffer position) l
127 (let ((m (make-marker)))
128 (move-marker m position buffer))))
130 (cl-defmethod xref-location-group ((l xref-buffer-location))
131 (with-slots (buffer) l
132 (or (buffer-file-name buffer)
133 (format "(buffer %s)" (buffer-name buffer)))))
135 (defclass xref-bogus-location (xref-location)
136 ((message :type string :initarg :message
137 :reader xref-bogus-location-message))
138 :documentation "Bogus locations are sometimes useful to
139 indicate errors, e.g. when we know that a function exists but the
140 actual location is not known.")
142 (defun xref-make-bogus-location (message)
143 "Create and return a new xref-bogus-location."
144 (make-instance 'xref-bogus-location :message message))
146 (cl-defmethod xref-location-marker ((l xref-bogus-location))
147 (user-error "%s" (oref l message)))
149 (cl-defmethod xref-location-group ((_ xref-bogus-location)) "(No location)")
154 (defclass xref-item ()
155 ((summary :type string :initarg :summary
156 :reader xref-item-summary
157 :documentation "One line which will be displayed for
158 this item in the output buffer.")
159 (location :initarg :location
160 :reader xref-item-location
161 :documentation "An object describing how to navigate
162 to the reference's target."))
163 :comment "An xref item describes a reference to a location
166 (defun xref-make (summary location)
167 "Create and return a new xref item.
168 SUMMARY is a short string to describe the xref.
169 LOCATION is an `xref-location'."
170 (make-instance 'xref-item :summary summary :location location))
172 (defclass xref-match-item ()
173 ((summary :type string :initarg :summary
174 :reader xref-item-summary)
175 (location :initarg :location
176 :type xref-file-location
177 :reader xref-item-location)
178 (end-column :initarg :end-column))
179 :comment "An xref item describes a reference to a location
182 (cl-defmethod xref-match-bounds ((i xref-match-item))
183 (with-slots (end-column location) i
184 (cons (xref-file-location-column location)
187 (defun xref-make-match (summary end-column location)
188 "Create and return a new xref match item.
189 SUMMARY is a short string to describe the xref.
190 END-COLUMN is the match end column number inside SUMMARY.
191 LOCATION is an `xref-location'."
192 (make-instance 'xref-match-item :summary summary :location location
193 :end-column end-column))
198 (declare-function etags-xref-find "etags" (action id))
199 (declare-function tags-lazy-completion-table "etags" ())
201 ;; For now, make the etags backend the default.
202 (defvar xref-find-function #'etags-xref-find
203 "Function to look for cross-references.
204 It can be called in several ways:
206 (definitions IDENTIFIER): Find definitions of IDENTIFIER. The
207 result must be a list of xref objects. If no definitions can be
210 (references IDENTIFIER): Find references of IDENTIFIER. The
211 result must be a list of xref objects. If no references can be
214 (apropos PATTERN): Find all symbols that match PATTERN. PATTERN
217 IDENTIFIER can be any string returned by
218 `xref-identifier-at-point-function', or from the table returned
219 by `xref-identifier-completion-table-function'.
221 To create an xref object, call `xref-make'.")
223 (defvar xref-identifier-at-point-function #'xref-default-identifier-at-point
224 "Function to get the relevant identifier at point.
226 The return value must be a string or nil. nil means no
227 identifier at point found.
229 If it's hard to determine the identifier precisely (e.g., because
230 it's a method call on unknown type), the implementation can
231 return a simple string (such as symbol at point) marked with a
232 special text property which `xref-find-function' would recognize
233 and then delegate the work to an external process.")
235 (defvar xref-identifier-completion-table-function #'tags-lazy-completion-table
236 "Function that returns the completion table for identifiers.")
238 (defun xref-default-identifier-at-point ()
239 (let ((thing (thing-at-point 'symbol)))
240 (and thing (substring-no-properties thing))))
244 (defun xref--alistify (list key test)
245 "Partition the elements of LIST into an alist.
246 KEY extracts the key from an element and TEST is used to compare
250 (let* ((k (funcall key e))
251 (probe (cl-assoc k alist :test test)))
253 (setcdr probe (cons e (cdr probe)))
254 (push (cons k (list e)) alist))))
255 ;; Put them back in order.
256 (cl-loop for (key . value) in (reverse alist)
257 collect (cons key (reverse value)))))
259 (defun xref--insert-propertized (props &rest strings)
260 "Insert STRINGS with text properties PROPS."
261 (let ((start (point)))
262 (apply #'insert strings)
263 (add-text-properties start (point) props)))
265 (defun xref--search-property (property &optional backward)
266 "Search the next text range where text property PROPERTY is non-nil.
267 Return the value of PROPERTY. If BACKWARD is non-nil, search
269 (let ((next (if backward
270 #'previous-single-char-property-change
271 #'next-single-char-property-change))
275 (goto-char (funcall next (point) property))
276 (not (or (setq value (get-text-property (point) property))
280 (t (goto-char start) nil))))
283 ;;; Marker stack (M-. pushes, M-, pops)
285 (defcustom xref-marker-ring-length 16
286 "Length of the xref marker ring."
289 (defcustom xref-prompt-for-identifier '(not xref-find-definitions
290 xref-find-definitions-other-window
291 xref-find-definitions-other-frame)
292 "When t, always prompt for the identifier name.
294 When nil, prompt only when there's no value at point we can use,
295 or when the command has been called with the prefix argument.
297 Otherwise, it's a list of xref commands which will prompt
298 anyway (the value at point, if any, will be used as the default).
300 If the list starts with `not', the meaning of the rest of the
301 elements is negated."
302 :type '(choice (const :tag "always" t)
303 (const :tag "auto" nil)
304 (set :menu-tag "command specific" :tag "commands"
306 (const :tag "Except" not)
307 (repeat :inline t (symbol :tag "command")))))
309 (defcustom xref-after-jump-hook '(recenter
310 xref-pulse-momentarily)
311 "Functions called after jumping to an xref."
314 (defcustom xref-after-return-hook '(xref-pulse-momentarily)
315 "Functions called after returning to a pre-jump location."
318 (defvar xref--marker-ring (make-ring xref-marker-ring-length)
319 "Ring of markers to implement the marker stack.")
321 (defun xref-push-marker-stack (&optional m)
322 "Add point M (defaults to `point-marker') to the marker stack."
323 (ring-insert xref--marker-ring (or m (point-marker))))
326 (defun xref-pop-marker-stack ()
327 "Pop back to where \\[xref-find-definitions] was last invoked."
329 (let ((ring xref--marker-ring))
330 (when (ring-empty-p ring)
331 (error "Marker stack is empty"))
332 (let ((marker (ring-remove ring 0)))
333 (switch-to-buffer (or (marker-buffer marker)
334 (error "The marked buffer has been deleted")))
335 (goto-char (marker-position marker))
336 (set-marker marker nil nil)
337 (run-hooks 'xref-after-return-hook))))
339 (defvar xref--current-item nil)
341 (defun xref-pulse-momentarily ()
342 (pcase-let ((`(,beg . ,end)
345 (xref--match-buffer-bounds xref--current-item)
346 (back-to-indentation)
348 (cons (line-beginning-position) (1+ (point)))
349 (cons (point) (line-end-position)))))))
350 (pulse-momentary-highlight-region beg end 'next-error)))
352 (defun xref--match-buffer-bounds (item)
354 (let ((bounds (xref-match-bounds item)))
356 (cons (progn (move-to-column (car bounds))
358 (progn (move-to-column (cdr bounds))
361 ;; etags.el needs this
362 (defun xref-clear-marker-stack ()
363 "Discard all markers from the marker stack."
364 (let ((ring xref--marker-ring))
365 (while (not (ring-empty-p ring))
366 (let ((marker (ring-remove ring)))
367 (set-marker marker nil nil)))))
370 (defun xref-marker-stack-empty-p ()
371 "Return t if the marker stack is empty; nil otherwise."
372 (ring-empty-p xref--marker-ring))
375 (defun xref--goto-location (location)
376 "Set buffer and point according to xref-location LOCATION."
377 (let ((marker (xref-location-marker location)))
378 (set-buffer (marker-buffer marker))
379 (cond ((and (<= (point-min) marker) (<= marker (point-max))))
380 (widen-automatically (widen))
381 (t (error "Location is outside accessible part of buffer")))
384 (defun xref--pop-to-location (item &optional window)
385 "Go to the location of ITEM and display the buffer.
386 WINDOW controls how the buffer is displayed:
387 nil -- switch-to-buffer
388 'window -- pop-to-buffer (other window)
389 'frame -- pop-to-buffer (other frame)"
390 (xref--goto-location (xref-item-location item))
392 ((nil) (switch-to-buffer (current-buffer)))
393 (window (pop-to-buffer (current-buffer) t))
394 (frame (let ((pop-up-frames t)) (pop-to-buffer (current-buffer) t))))
395 (let ((xref--current-item item))
396 (run-hooks 'xref-after-jump-hook)))
399 ;;; XREF buffer (part of the UI)
401 ;; The xref buffer is used to display a set of xrefs.
403 (defvar-local xref--display-history nil
404 "List of pairs (BUFFER . WINDOW), for temporarily displayed buffers.")
406 (defvar-local xref--temporary-buffers nil
407 "List of buffers created by xref code.")
409 (defvar-local xref--current nil
410 "Non-nil if this buffer was once current, except while displaying xrefs.
411 Used for temporary buffers.")
413 (defvar xref--inhibit-mark-current nil)
415 (defun xref--mark-selected ()
416 (unless xref--inhibit-mark-current
417 (setq xref--current t))
418 (remove-hook 'buffer-list-update-hook #'xref--mark-selected t))
420 (defun xref--save-to-history (buf win)
421 (let ((restore (window-parameter win 'quit-restore)))
422 ;; Save the new entry if the window displayed another buffer
424 (when (and restore (not (eq (car restore) 'same)))
425 (push (cons buf win) xref--display-history))))
427 (defun xref--display-position (pos other-window xref-buf)
428 ;; Show the location, but don't hijack focus.
429 (with-selected-window (display-buffer (current-buffer) other-window)
431 (run-hooks 'xref-after-jump-hook)
432 (let ((buf (current-buffer))
433 (win (selected-window)))
434 (with-current-buffer xref-buf
435 (setq-local other-window-scroll-buffer buf)
436 (xref--save-to-history buf win)))))
438 (defun xref--show-location (location)
440 (let ((xref-buf (current-buffer))
442 (xref--inhibit-mark-current t))
443 (xref--goto-location location)
444 (let ((buf (current-buffer)))
445 (unless (memq buf bl)
447 (add-hook 'buffer-list-update-hook #'xref--mark-selected nil t)
448 (with-current-buffer xref-buf
449 (push buf xref--temporary-buffers))))
450 (xref--display-position (point) t xref-buf))
451 (user-error (message (error-message-string err)))))
453 (defun xref-show-location-at-point ()
454 "Display the source of xref at point in the other window, if any."
456 (let* ((xref (xref--item-at-point))
457 (xref--current-item xref))
459 (xref--show-location (xref-item-location xref)))))
461 (defun xref-next-line ()
462 "Move to the next xref and display its source in the other window."
464 (xref--search-property 'xref-item)
465 (xref-show-location-at-point))
467 (defun xref-prev-line ()
468 "Move to the previous xref and display its source in the other window."
470 (xref--search-property 'xref-item t)
471 (xref-show-location-at-point))
473 (defun xref--item-at-point ()
475 (back-to-indentation)
476 (get-text-property (point) 'xref-item)))
478 (defvar-local xref--window nil
479 "ACTION argument to call `display-buffer' with.")
481 (defun xref-goto-xref ()
482 "Jump to the xref on the current line and bury the xref buffer."
484 (let ((xref (or (xref--item-at-point)
485 (user-error "No reference at point")))
486 (window xref--window))
488 (xref--pop-to-location xref window)))
490 (defun xref-query-replace (from to)
491 "Perform interactive replacement in all current matches."
493 (list (read-regexp "Query replace regexp in matches" ".*")
494 (read-regexp "Replace with: ")))
499 (goto-char (point-min))
500 ;; TODO: Check that none of the matches are out of date;
501 ;; offer to re-scan otherwise. Note that saving the last
502 ;; modification tick won't work, as long as not all of the
503 ;; buffers are kept open.
504 (while (setq item (xref--search-property 'xref-item))
505 (when (xref-match-bounds item)
507 (xref--goto-location (xref-item-location item))
508 (let ((bounds (xref--match-buffer-bounds item))
511 (move-marker beg (car bounds))
512 (move-marker end (cdr bounds))
513 (push (cons beg end) pairs)))))
514 (setq pairs (nreverse pairs)))
515 (unless pairs (user-error "No suitable matches here"))
516 (xref--query-replace-1 from to pairs))
518 (move-marker (car pair) nil)
519 (move-marker (cdr pair) nil)))))
521 (defun xref--query-replace-1 (from to pairs)
522 (let* ((query-replace-lazy-highlight nil)
523 current-pair current-buf
524 ;; Counteract the "do the next match now" hack in
525 ;; `perform-replace'. And still, it'll report that those
526 ;; matches were "filtered out" at the end.
527 (isearch-filter-predicate
530 (eq (current-buffer) current-buf)
531 (>= beg (car current-pair))
532 (<= end (cdr current-pair)))))
533 (replace-re-search-function
534 (lambda (from &optional _bound noerror)
536 (while (and (not found) pairs)
537 (setq current-pair (pop pairs)
538 current-buf (marker-buffer (car current-pair)))
539 (pop-to-buffer current-buf)
540 (goto-char (car current-pair))
541 (when (re-search-forward from (cdr current-pair) noerror)
544 ;; FIXME: Despite this being a multi-buffer replacement, `N'
545 ;; doesn't work, because we're not using
546 ;; `multi-query-replace-map', and it would expect the below
547 ;; function to be called once per buffer.
548 (perform-replace from to t t nil)))
550 (defvar xref--xref-buffer-mode-map
551 (let ((map (make-sparse-keymap)))
552 (define-key map [remap quit-window] #'xref-quit)
553 (define-key map (kbd "n") #'xref-next-line)
554 (define-key map (kbd "p") #'xref-prev-line)
555 (define-key map (kbd "r") #'xref-query-replace)
556 (define-key map (kbd "RET") #'xref-goto-xref)
557 (define-key map (kbd "C-o") #'xref-show-location-at-point)
558 ;; suggested by Johan Claesson "to further reduce finger movement":
559 (define-key map (kbd ".") #'xref-next-line)
560 (define-key map (kbd ",") #'xref-prev-line)
563 (define-derived-mode xref--xref-buffer-mode special-mode "XREF"
564 "Mode for displaying cross-references."
565 (setq buffer-read-only t)
566 (setq next-error-function #'xref--next-error-function)
567 (setq next-error-last-buffer (current-buffer)))
569 (defun xref--next-error-function (n reset?)
571 (goto-char (point-min)))
572 (let ((backward (< n 0))
576 (setq xref (xref--search-property 'xref-item backward)))
578 (xref--pop-to-location xref))
580 (error "No %s xref" (if backward "previous" "next"))))))
582 (defun xref-quit (&optional kill)
583 "Bury temporarily displayed buffers, then quit the current window.
585 If KILL is non-nil, kill all buffers that were created in the
586 process of showing xrefs, and also kill the current buffer.
588 The buffers that the user has otherwise interacted with in the
589 meantime are preserved."
591 (let ((window (selected-window))
592 (history xref--display-history))
593 (setq xref--display-history nil)
594 (pcase-dolist (`(,buf . ,win) history)
595 (when (and (window-live-p win)
596 (eq buf (window-buffer win)))
597 (quit-window nil win)))
599 (let ((xref--inhibit-mark-current t)
600 kill-buffer-query-functions)
601 (dolist (buf xref--temporary-buffers)
602 (unless (buffer-local-value 'xref--current buf)
604 (setq xref--temporary-buffers nil)))
605 (quit-window kill window)))
607 (defconst xref-buffer-name "*xref*"
608 "The name of the buffer to show xrefs.")
610 (defvar xref--button-map
611 (let ((map (make-sparse-keymap)))
612 (define-key map [(control ?m)] #'xref-goto-xref)
613 (define-key map [mouse-1] #'xref-goto-xref)
614 (define-key map [mouse-2] #'xref--mouse-2)
617 (defun xref--mouse-2 (event)
618 "Move point to the button and show the xref definition."
620 (mouse-set-point event)
622 (xref--search-property 'xref-item)
623 (xref-show-location-at-point))
625 (defun xref--insert-xrefs (xref-alist)
626 "Insert XREF-ALIST in the current-buffer.
627 XREF-ALIST is of the form ((GROUP . (XREF ...)) ...). Where
628 GROUP is a string for decoration purposes and XREF is an
630 (require 'compile) ; For the compilation faces.
631 (cl-loop for ((group . xrefs) . more1) on xref-alist
633 (cl-loop for xref in xrefs
634 maximize (let ((line (xref-location-line
635 (oref xref location))))
636 (length (and line (format "%d" line)))))
637 for line-format = (and max-line-width
638 (format "%%%dd: " max-line-width))
640 (xref--insert-propertized '(face compilation-info) group "\n")
641 (cl-loop for (xref . more2) on xrefs do
642 (with-slots (summary location) xref
643 (let* ((line (xref-location-line location))
646 (propertize (format line-format line)
647 'face 'compilation-line-number)
649 (xref--insert-propertized
650 (list 'xref-item xref
651 ;; 'face 'font-lock-keyword-face
652 'mouse-face 'highlight
653 'keymap xref--button-map
655 (concat "mouse-2: display in another window, "
656 "RET or mouse-1: follow reference"))
660 (defun xref--analyze (xrefs)
661 "Find common filenames in XREFS.
662 Return an alist of the form ((FILENAME . (XREF ...)) ...)."
663 (xref--alistify xrefs
665 (xref-location-group (xref-item-location x)))
668 (defun xref--show-xref-buffer (xrefs alist)
669 (let ((xref-alist (xref--analyze xrefs)))
670 (with-current-buffer (get-buffer-create xref-buffer-name)
671 (let ((inhibit-read-only t))
673 (xref--insert-xrefs xref-alist)
674 (xref--xref-buffer-mode)
675 (pop-to-buffer (current-buffer))
676 (goto-char (point-min))
677 (setq xref--window (assoc-default 'window alist))
678 (setq xref--temporary-buffers (assoc-default 'temporary-buffers alist))
679 (dolist (buf xref--temporary-buffers)
680 (with-current-buffer buf
681 (add-hook 'buffer-list-update-hook #'xref--mark-selected nil t)))
685 ;; This part of the UI seems fairly uncontroversial: it reads the
686 ;; identifier and deals with the single definition case.
688 ;; The controversial multiple definitions case is handed off to
689 ;; xref-show-xrefs-function.
691 (defvar xref-show-xrefs-function 'xref--show-xref-buffer
692 "Function to display a list of xrefs.")
694 (defvar xref--read-identifier-history nil)
696 (defvar xref--read-pattern-history nil)
698 (defun xref--show-xrefs (input kind arg window)
699 (let* ((bl (buffer-list))
700 (xrefs (funcall xref-find-function kind arg))
701 (tb (cl-set-difference (buffer-list) bl)))
704 (user-error "No %s found for: %s" (symbol-name kind) input))
706 (xref-push-marker-stack)
707 (xref--pop-to-location (car xrefs) window))
709 (xref-push-marker-stack)
710 (funcall xref-show-xrefs-function xrefs
712 (temporary-buffers . ,tb)))))))
714 (defun xref--prompt-p (command)
715 (or (eq xref-prompt-for-identifier t)
716 (if (eq (car xref-prompt-for-identifier) 'not)
717 (not (memq command (cdr xref-prompt-for-identifier)))
718 (memq command xref-prompt-for-identifier))))
720 (defun xref--read-identifier (prompt)
721 "Return the identifier at point or read it from the minibuffer."
722 (let ((id (funcall xref-identifier-at-point-function)))
723 (cond ((or current-prefix-arg
725 (xref--prompt-p this-command))
726 (completing-read (if id
727 (format "%s (default %s): "
728 (substring prompt 0 (string-match
732 (funcall xref-identifier-completion-table-function)
734 'xref--read-identifier-history id))
740 (defun xref--find-definitions (id window)
741 (xref--show-xrefs id 'definitions id window))
744 (defun xref-find-definitions (identifier)
745 "Find the definition of the identifier at point.
746 With prefix argument or when there's no identifier at point,
748 (interactive (list (xref--read-identifier "Find definitions of: ")))
749 (xref--find-definitions identifier nil))
752 (defun xref-find-definitions-other-window (identifier)
753 "Like `xref-find-definitions' but switch to the other window."
754 (interactive (list (xref--read-identifier "Find definitions of: ")))
755 (xref--find-definitions identifier 'window))
758 (defun xref-find-definitions-other-frame (identifier)
759 "Like `xref-find-definitions' but switch to the other frame."
760 (interactive (list (xref--read-identifier "Find definitions of: ")))
761 (xref--find-definitions identifier 'frame))
764 (defun xref-find-references (identifier)
765 "Find references to the identifier at point.
766 With prefix argument, prompt for the identifier."
767 (interactive (list (xref--read-identifier "Find references of: ")))
768 (xref--show-xrefs identifier 'references identifier nil))
770 ;; TODO: Rename and move to project-find-regexp, as soon as idiomatic
771 ;; usage of xref from other packages has stabilized.
773 (defun xref-find-regexp (regexp)
774 "Find all matches for REGEXP.
775 With \\[universal-argument] prefix, you can specify the directory
776 to search in, and the file name pattern to search for."
777 (interactive (list (xref--read-identifier "Find regexp: ")))
779 (let* ((proj (project-current))
780 (files (if current-prefix-arg
781 (grep-read-files regexp)
783 (dirs (if current-prefix-arg
784 (list (read-directory-name "Base directory: "
785 nil default-directory t))
786 (project-prune-directories
789 (project-search-path proj)))))
791 (lambda (_kind regexp)
794 (xref-collect-matches regexp files dir
795 (project-ignores proj dir)))
797 (xref--show-xrefs regexp 'matches regexp nil)))
799 (declare-function apropos-parse-pattern "apropos" (pattern))
802 (defun xref-find-apropos (pattern)
803 "Find all meaningful symbols that match PATTERN.
804 The argument has the same meaning as in `apropos'."
805 (interactive (list (read-string
806 "Search for pattern (word list or regexp): "
807 nil 'xref--read-pattern-history)))
809 (xref--show-xrefs pattern 'apropos
810 (apropos-parse-pattern
811 (if (string-equal (regexp-quote pattern) pattern)
813 (or (split-string pattern "[ \t]+" t)
814 (user-error "No word list given"))
821 ;;;###autoload (define-key esc-map "." #'xref-find-definitions)
822 ;;;###autoload (define-key esc-map "," #'xref-pop-marker-stack)
823 ;;;###autoload (define-key esc-map "?" #'xref-find-references)
824 ;;;###autoload (define-key esc-map [?\C-.] #'xref-find-apropos)
825 ;;;###autoload (define-key ctl-x-4-map "." #'xref-find-definitions-other-window)
826 ;;;###autoload (define-key ctl-x-5-map "." #'xref-find-definitions-other-frame)
831 (defvar xref-etags-mode--saved nil)
833 (define-minor-mode xref-etags-mode
834 "Minor mode to make xref use etags again.
836 Certain major modes install their own mechanisms for listing
837 identifiers and navigation. Turn this on to undo those settings
842 (setq xref-etags-mode--saved
843 (cons xref-find-function
844 xref-identifier-completion-table-function))
845 (kill-local-variable 'xref-find-function)
846 (kill-local-variable 'xref-identifier-completion-table-function))
847 (setq-local xref-find-function (car xref-etags-mode--saved))
848 (setq-local xref-identifier-completion-table-function
849 (cdr xref-etags-mode--saved))))
851 (declare-function semantic-symref-find-references-by-name "semantic/symref")
852 (declare-function semantic-symref-find-text "semantic/symref")
853 (declare-function semantic-find-file-noselect "semantic/fw")
854 (declare-function grep-read-files "grep")
855 (declare-function grep-expand-template "grep")
857 (defun xref-collect-references (symbol dir)
858 "Collect references to SYMBOL inside DIR.
859 This function uses the Semantic Symbol Reference API, see
860 `semantic-symref-find-references-by-name' for details on which
861 tools are used, and when."
862 (cl-assert (directory-name-p dir))
863 (require 'semantic/symref)
864 (defvar semantic-symref-tool)
865 (let* ((default-directory dir)
866 (semantic-symref-tool 'detect)
867 (res (semantic-symref-find-references-by-name symbol 'subdirs))
868 (hits (and res (oref res hit-lines)))
869 (orig-buffers (buffer-list)))
872 (mapcar (lambda (hit) (xref--collect-match
873 hit (format "\\_<%s\\_>" (regexp-quote symbol))))
876 (cl-set-difference (buffer-list) orig-buffers)))))
878 (defun xref-collect-matches (regexp files dir ignores)
879 "Collect matches for REGEXP inside FILES in DIR.
880 FILES is a string with glob patterns separated by spaces.
881 IGNORES is a list of glob patterns."
882 (cl-assert (directory-name-p dir))
883 (require 'semantic/fw)
884 (grep-compute-defaults)
885 (defvar grep-find-template)
886 (defvar grep-highlight-matches)
887 (let* ((grep-find-template (replace-regexp-in-string "-e " "-E "
888 grep-find-template t t))
889 (grep-highlight-matches nil)
890 (command (xref--rgrep-command (xref--regexp-to-extended regexp)
892 (orig-buffers (buffer-list))
893 (buf (get-buffer-create " *xref-grep*"))
894 (grep-re (caar grep-regexp-alist))
896 (with-current-buffer buf
898 (call-process-shell-command command nil t)
899 (goto-char (point-min))
900 (while (re-search-forward grep-re nil t)
901 (push (cons (string-to-number (match-string 2))
906 (mapcar (lambda (hit) (xref--collect-match hit regexp))
909 (cl-set-difference (buffer-list) orig-buffers)))))
911 (defun xref--rgrep-command (regexp files dir ignores)
912 (require 'find-dired) ; for `find-name-arg'
913 (defvar grep-find-template)
914 (defvar find-name-arg)
915 (grep-expand-template
918 (concat (shell-quote-argument "(")
919 " " find-name-arg " "
921 #'shell-quote-argument
923 (concat " -o " find-name-arg " "))
925 (shell-quote-argument ")"))
928 (shell-quote-argument "(")
932 (when (string-match "\\(\\.\\)/" ignore)
933 (setq ignore (replace-match dir t t ignore 1)))
934 (when (string-match-p "/\\'" ignore)
935 (setq ignore (concat ignore "*")))
936 (unless (string-prefix-p "*" ignore)
937 (setq ignore (concat "*/" ignore)))
938 (shell-quote-argument ignore))
942 (shell-quote-argument ")")
945 (defun xref--regexp-to-extended (str)
946 (replace-regexp-in-string
947 ;; FIXME: Add tests. Move to subr.el, make a public function.
948 ;; Maybe error on Emacs-only constructs.
949 "\\(?:\\\\\\\\\\)*\\(?:\\\\[][]\\)?\\(?:\\[.+?\\]\\|\\(\\\\?[(){}|]\\)\\)"
952 ((not (match-beginning 1))
954 ((eq (length (match-string 1 str)) 2)
955 (concat (substring str 0 (match-beginning 1))
956 (substring (match-string 1 str) 1 2)))
958 (concat (substring str 0 (match-beginning 1))
960 (match-string 1 str)))))
963 (defun xref--collect-match (hit regexp)
964 (pcase-let* ((`(,line . ,file) hit)
965 (buf (or (find-buffer-visiting file)
966 (semantic-find-file-noselect file))))
967 (with-current-buffer buf
969 (goto-char (point-min))
970 (forward-line (1- line))
971 (syntax-propertize (line-end-position))
972 ;; TODO: Handle multiple matches per line.
973 (when (re-search-forward regexp (line-end-position) t)
974 (goto-char (match-beginning 0))
975 (let ((loc (xref-make-file-location file line
977 (goto-char (match-end 0))
978 (xref-make-match (buffer-substring
979 (line-beginning-position)
986 ;;; xref.el ends here