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
58 (defgroup xref nil
"Cross-referencing commands"
64 (defclass xref-location
() ()
65 :documentation
"A location represents a position in a file or buffer.")
67 ;; If a backend decides to subclass xref-location it can provide
68 ;; methods for some of the following functions:
69 (defgeneric xref-location-marker
(location)
70 "Return the marker for LOCATION.")
72 (defgeneric xref-location-group
(location)
73 "Return a string used to group a set of locations.
74 This is typically the filename.")
76 ;;;; Commonly needed location classes are defined here:
78 ;; FIXME: might be useful to have an optional "hint" i.e. a string to
79 ;; search for in case the line number is sightly out of date.
80 (defclass xref-file-location
(xref-location)
81 ((file :type string
:initarg
:file
)
82 (line :type fixnum
:initarg
:line
)
83 (column :type fixnum
:initarg
:column
))
84 :documentation
"A file location is a file/line/column triple.
85 Line numbers start from 1 and columns from 0.")
87 (defun xref-make-file-location (file line column
)
88 "Create and return a new xref-file-location."
89 (make-instance 'xref-file-location
:file file
:line line
:column column
))
91 (defmethod xref-location-marker ((l xref-file-location
))
92 (with-slots (file line column
) l
94 (or (get-file-buffer file
)
95 (let ((find-file-suppress-same-file-warnings t
))
96 (find-file-noselect file
)))
100 (goto-char (point-min))
101 (beginning-of-line line
)
102 (move-to-column column
)
105 (defmethod xref-location-group ((l xref-file-location
))
108 (defclass xref-buffer-location
(xref-location)
109 ((buffer :type buffer
:initarg
:buffer
)
110 (position :type fixnum
:initarg
:position
)))
112 (defun xref-make-buffer-location (buffer position
)
113 "Create and return a new xref-buffer-location."
114 (make-instance 'xref-buffer-location
:buffer buffer
:position position
))
116 (defmethod xref-location-marker ((l xref-buffer-location
))
117 (with-slots (buffer position
) l
118 (let ((m (make-marker)))
119 (move-marker m position buffer
))))
121 (defmethod xref-location-group ((l xref-buffer-location
))
122 (with-slots (buffer) l
123 (or (buffer-file-name buffer
)
124 (format "(buffer %s)" (buffer-name buffer
)))))
126 (defclass xref-bogus-location
(xref-location)
127 ((message :type string
:initarg
:message
128 :reader xref-bogus-location-message
))
129 :documentation
"Bogus locations are sometimes useful to
130 indicate errors, e.g. when we know that a function exists but the
131 actual location is not known.")
133 (defun xref-make-bogus-location (message)
134 "Create and return a new xref-bogus-location."
135 (make-instance 'xref-bogus-location
:message message
))
137 (defmethod xref-location-marker ((l xref-bogus-location
))
138 (user-error "%s" (oref l
:message
)))
140 (defmethod xref-location-group ((_ xref-bogus-location
)) "(No location)")
142 ;; This should be in elisp-mode.el, but it's preloaded, and we can't
143 ;; preload defclass and defmethod (at least, not yet).
144 (defclass xref-elisp-location
(xref-location)
145 ((symbol :type symbol
:initarg
:symbol
)
146 (type :type symbol
:initarg
:type
)
147 (file :type string
:initarg
:file
148 :reader xref-location-group
))
149 :documentation
"Location of an Emacs Lisp symbol definition.")
151 (defun xref-make-elisp-location (symbol type file
)
152 (make-instance 'xref-elisp-location
:symbol symbol
:type type
:file file
))
154 (defmethod xref-location-marker ((l xref-elisp-location
))
155 (with-slots (symbol type file
) l
158 (`defun
(find-function-search-for-symbol symbol nil file
))
159 ((or `defvar
`defface
)
160 (find-function-search-for-symbol symbol type file
))
162 (cons (find-file-noselect file
) 1)))))
163 (with-current-buffer (car buffer-point
)
164 (goto-char (or (cdr buffer-point
) (point-min)))
170 (defclass xref--xref
()
171 ((description :type string
:initarg
:description
172 :reader xref--xref-description
)
173 (location :type xref-location
:initarg
:location
174 :reader xref--xref-location
))
175 :comment
"An xref is used to display and locate constructs like
176 variables or functions.")
178 (defun xref-make (description location
)
179 "Create and return a new xref.
180 DESCRIPTION is a short string to describe the xref.
181 LOCATION is an `xref-location'."
182 (make-instance 'xref--xref
:description description
:location location
))
187 (declare-function etags-xref-find
"etags" (action id
))
188 (declare-function tags-lazy-completion-table
"etags" ())
190 ;; For now, make the etags backend the default.
191 (defvar xref-find-function
#'etags-xref-find
192 "Function to look for cross-references.
193 It can be called in several ways:
195 (definitions IDENTIFIER): Find definitions of IDENTIFIER. The
196 result must be a list of xref objects. If no definitions can be
199 (references IDENTIFIER): Find references of IDENTIFIER. The
200 result must be a list of xref objects. If no references can be
203 (apropos PATTERN): Find all symbols that match PATTERN. PATTERN
206 IDENTIFIER can be any string returned by
207 `xref-identifier-at-point-function', or from the table returned
208 by `xref-identifier-completion-table-function'.
210 To create an xref object, call `xref-make'.")
212 (defvar xref-identifier-at-point-function
#'xref-default-identifier-at-point
213 "Function to get the relevant identifier at point.
215 The return value must be a string or nil. nil means no
216 identifier at point found.
218 If it's hard to determine the identifier precisely (e.g., because
219 it's a method call on unknown type), the implementation can
220 return a simple string (such as symbol at point) marked with a
221 special text property which `xref-find-function' would recognize
222 and then delegate the work to an external process.")
224 (defvar xref-identifier-completion-table-function
#'tags-lazy-completion-table
225 "Function that returns the completion table for identifiers.")
227 (defun xref-default-identifier-at-point ()
228 (let ((thing (thing-at-point 'symbol
)))
229 (and thing
(substring-no-properties thing
))))
233 (defun xref--alistify (list key test
)
234 "Partition the elements of LIST into an alist.
235 KEY extracts the key from an element and TEST is used to compare
239 (let* ((k (funcall key e
))
240 (probe (cl-assoc k alist
:test test
)))
242 (setcdr probe
(cons e
(cdr probe
)))
243 (push (cons k
(list e
)) alist
))))
244 ;; Put them back in order.
245 (cl-loop for
(key . value
) in
(reverse alist
)
246 collect
(cons key
(reverse value
)))))
248 (defun xref--insert-propertized (props &rest strings
)
249 "Insert STRINGS with text properties PROPS."
250 (let ((start (point)))
251 (apply #'insert strings
)
252 (add-text-properties start
(point) props
)))
254 (defun xref--search-property (property &optional backward
)
255 "Search the next text range where text property PROPERTY is non-nil.
256 Return the value of PROPERTY. If BACKWARD is non-nil, search
258 (let ((next (if backward
259 #'previous-single-char-property-change
260 #'next-single-char-property-change
))
264 (goto-char (funcall next
(point) property
))
265 (not (or (setq value
(get-text-property (point) property
))
269 (t (goto-char start
) nil
))))
272 ;;; Marker stack (M-. pushes, M-, pops)
274 (defcustom xref-marker-ring-length
16
275 "Length of the xref marker ring."
279 (defvar xref--marker-ring
(make-ring xref-marker-ring-length
)
280 "Ring of markers to implement the marker stack.")
282 (defun xref-push-marker-stack ()
283 "Add point to the marker stack."
284 (ring-insert xref--marker-ring
(point-marker)))
287 (defun xref-pop-marker-stack ()
288 "Pop back to where \\[xref-find-definitions] was last invoked."
290 (let ((ring xref--marker-ring
))
291 (when (ring-empty-p ring
)
292 (error "Marker stack is empty"))
293 (let ((marker (ring-remove ring
0)))
294 (switch-to-buffer (or (marker-buffer marker
)
295 (error "The marked buffer has been deleted")))
296 (goto-char (marker-position marker
))
297 (set-marker marker nil nil
))))
299 ;; etags.el needs this
300 (defun xref-clear-marker-stack ()
301 "Discard all markers from the marker stack."
302 (let ((ring xref--marker-ring
))
303 (while (not (ring-empty-p ring
))
304 (let ((marker (ring-remove ring
)))
305 (set-marker marker nil nil
)))))
308 (defun xref-marker-stack-empty-p ()
309 "Return t if the marker stack is empty; nil otherwise."
310 (ring-empty-p xref--marker-ring
))
313 (defun xref--goto-location (location)
314 "Set buffer and point according to xref-location LOCATION."
315 (let ((marker (xref-location-marker location
)))
316 (set-buffer (marker-buffer marker
))
317 (cond ((and (<= (point-min) marker
) (<= marker
(point-max))))
318 (widen-automatically (widen))
319 (t (error "Location is outside accessible part of buffer")))
322 (defun xref--pop-to-location (location &optional window
)
323 "Goto xref-location LOCATION and display the buffer.
324 WINDOW controls how the buffer is displayed:
325 nil -- switch-to-buffer
326 'window -- pop-to-buffer (other window)
327 'frame -- pop-to-buffer (other frame)"
328 (xref--goto-location location
)
330 ((nil) (switch-to-buffer (current-buffer)))
331 (window (pop-to-buffer (current-buffer) t
))
332 (frame (let ((pop-up-frames t
)) (pop-to-buffer (current-buffer) t
)))))
335 ;;; XREF buffer (part of the UI)
337 ;; The xref buffer is used to display a set of xrefs.
339 (defvar-local xref--display-history nil
340 "List of pairs (BUFFER . WINDOW), for temporarily displayed buffers.")
342 (defun xref--save-to-history (buf win
)
343 (let ((restore (window-parameter win
'quit-restore
)))
344 ;; Save the new entry if the window displayed another buffer
346 (when (and restore
(not (eq (car restore
) 'same
)))
347 (push (cons buf win
) xref--display-history
))))
349 (defun xref--display-position (pos other-window recenter-arg xref-buf
)
350 ;; Show the location, but don't hijack focus.
351 (with-selected-window (display-buffer (current-buffer) other-window
)
353 (recenter recenter-arg
)
354 (let ((buf (current-buffer))
355 (win (selected-window)))
356 (with-current-buffer xref-buf
357 (setq-local other-window-scroll-buffer buf
)
358 (xref--save-to-history buf win
)))))
360 (defun xref--show-location (location)
362 (let ((xref-buf (current-buffer)))
363 (xref--goto-location location
)
364 (xref--display-position (point) t
1 xref-buf
))
365 (user-error (message (error-message-string err
)))))
367 (defun xref-show-location-at-point ()
368 "Display the source of xref at point in the other window, if any."
370 (let ((loc (xref--location-at-point)))
372 (xref--show-location loc
))))
374 (defun xref-next-line ()
375 "Move to the next xref and display its source in the other window."
377 (xref--search-property 'xref-location
)
378 (xref-show-location-at-point))
380 (defun xref-prev-line ()
381 "Move to the previous xref and display its source in the other window."
383 (xref--search-property 'xref-location t
)
384 (xref-show-location-at-point))
386 (defun xref--location-at-point ()
387 (get-text-property (point) 'xref-location
))
389 (defvar-local xref--window nil
)
391 (defun xref-goto-xref ()
392 "Jump to the xref on the current line and bury the xref buffer."
394 (back-to-indentation)
395 (let ((loc (or (xref--location-at-point)
396 (user-error "No reference at point")))
397 (window xref--window
))
399 (xref--pop-to-location loc window
)))
401 (define-derived-mode xref--xref-buffer-mode fundamental-mode
"XREF"
402 "Mode for displaying cross-references."
403 (setq buffer-read-only t
))
405 (let ((map xref--xref-buffer-mode-map
))
406 (define-key map
(kbd "q") #'xref--quit
)
407 (define-key map
(kbd "n") #'xref-next-line
)
408 (define-key map
(kbd "p") #'xref-prev-line
)
409 (define-key map
(kbd "RET") #'xref-goto-xref
)
410 (define-key map
(kbd "C-o") #'xref-show-location-at-point
)
412 ;; suggested by Johan Claesson "to further reduce finger movement":
413 (define-key map
(kbd ".") #'xref-next-line
)
414 (define-key map
(kbd ",") #'xref-prev-line
))
417 "Quit all windows in `xref--display-history', then quit current window."
419 (let ((window (selected-window))
420 (history xref--display-history
))
421 (setq xref--display-history nil
)
422 (pcase-dolist (`(,buf .
,win
) history
)
423 (when (and (window-live-p win
)
424 (eq buf
(window-buffer win
)))
425 (quit-window nil win
)))
426 (quit-window nil window
)))
428 (defconst xref-buffer-name
"*xref*"
429 "The name of the buffer to show xrefs.")
431 (defvar xref--button-map
432 (let ((map (make-sparse-keymap)))
433 (define-key map
[(control ?m
)] #'xref-goto-xref
)
434 (define-key map
[mouse-1
] #'xref-goto-xref
)
435 (define-key map
[mouse-2
] #'xref--mouse-2
)
438 (defun xref--mouse-2 (event)
439 "Move point to the button and show the xref definition."
441 (mouse-set-point event
)
443 (xref--search-property 'xref-location
)
444 (xref-show-location-at-point))
446 (defun xref--insert-xrefs (xref-alist)
447 "Insert XREF-ALIST in the current-buffer.
448 XREF-ALIST is of the form ((GROUP . (XREF ...)) ...). Where
449 GROUP is a string for decoration purposes and XREF is an
450 `xref--xref' object."
451 (cl-loop for
((group . xrefs
) . more1
) on xref-alist do
452 (xref--insert-propertized '(face bold
) group
"\n")
453 (cl-loop for
(xref . more2
) on xrefs do
455 (with-slots (description location
) xref
456 (xref--insert-propertized
457 (list 'xref-location location
458 'face
'font-lock-keyword-face
459 'mouse-face
'highlight
460 'keymap xref--button-map
461 'help-echo
"mouse-2: display in another window, RET or mouse-1: navigate")
463 (when (or more1 more2
)
466 (defun xref--analyze (xrefs)
467 "Find common filenames in XREFS.
468 Return an alist of the form ((FILENAME . (XREF ...)) ...)."
469 (xref--alistify xrefs
471 (xref-location-group (xref--xref-location x
)))
474 (defun xref--show-xref-buffer (xrefs window
)
475 (let ((xref-alist (xref--analyze xrefs
)))
476 (with-current-buffer (get-buffer-create xref-buffer-name
)
477 (let ((inhibit-read-only t
))
479 (xref--insert-xrefs xref-alist
)
480 (xref--xref-buffer-mode)
481 (pop-to-buffer (current-buffer))
482 (goto-char (point-min))
483 (setq xref--window window
)
487 ;; This part of the UI seems fairly uncontroversial: it reads the
488 ;; identifier and deals with the single definition case.
490 ;; The controversial multiple definitions case is handed off to
491 ;; xref-show-xrefs-function.
493 (defvar xref-show-xrefs-function
'xref--show-xref-buffer
494 "Function to display a list of xrefs.")
496 (defun xref--show-xrefs (id kind xrefs window
)
499 (user-error "No known %s for: %s" kind id
))
501 (xref-push-marker-stack)
502 (xref--pop-to-location (xref--xref-location (car xrefs
)) window
))
504 (xref-push-marker-stack)
505 (funcall xref-show-xrefs-function xrefs window
))))
507 (defun xref--read-identifier (prompt)
508 "Return the identifier at point or read it from the minibuffer."
509 (let ((id (funcall xref-identifier-at-point-function
)))
510 (cond ((or current-prefix-arg
(not id
))
511 (completing-read prompt
512 (funcall xref-identifier-completion-table-function
)
519 (defun xref--find-definitions (id window
)
520 (xref--show-xrefs id
"definitions"
521 (funcall xref-find-function
'definitions id
)
525 (defun xref-find-definitions (identifier)
526 "Find the definition of the identifier at point.
527 With prefix argument or when there's no identifier at point,
529 (interactive (list (xref--read-identifier "Find definitions of: ")))
530 (xref--find-definitions identifier nil
))
533 (defun xref-find-definitions-other-window (identifier)
534 "Like `xref-find-definitions' but switch to the other window."
535 (interactive (list (xref--read-identifier "Find definitions of: ")))
536 (xref--find-definitions identifier
'window
))
539 (defun xref-find-definitions-other-frame (identifier)
540 "Like `xref-find-definitions' but switch to the other frame."
541 (interactive (list (xref--read-identifier "Find definitions of: ")))
542 (xref--find-definitions identifier
'frame
))
545 (defun xref-find-references (identifier)
546 "Find references to the identifier at point.
547 With prefix argument, prompt for the identifier."
548 (interactive (list (xref--read-identifier "Find references of: ")))
549 (xref--show-xrefs identifier
"references"
550 (funcall xref-find-function
'references identifier
)
554 (defun xref-find-apropos (pattern)
555 "Find all meaningful symbols that match PATTERN.
556 The argument has the same meaning as in `apropos'."
557 (interactive (list (read-from-minibuffer
558 "Search for pattern (word list or regexp): ")))
560 (xref--show-xrefs pattern
"apropos"
561 (funcall xref-find-function
'apropos
562 (apropos-parse-pattern
563 (if (string-equal (regexp-quote pattern
) pattern
)
565 (or (split-string pattern
"[ \t]+" t
)
566 (user-error "No word list given"))
573 ;;;###autoload (define-key esc-map "." #'xref-find-definitions)
574 ;;;###autoload (define-key esc-map "," #'xref-pop-marker-stack)
575 ;;;###autoload (define-key esc-map [?\C-.] #'xref-find-apropos)
576 ;;;###autoload (define-key ctl-x-4-map "." #'xref-find-definitions-other-window)
577 ;;;###autoload (define-key ctl-x-5-map "." #'xref-find-definitions-other-frame)
582 ;;; xref.el ends here