1 ;; xref.el --- Cross-referencing commands -*-lexical-binding:t-*-
3 ;; Copyright (C) 2014 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
39 ;; Each identifier must be represented as a string. Implementers can
40 ;; use string properties to store additional information about the
41 ;; identifier, but they should keep in mind that values returned from
42 ;; `xref-identifier-completion-table-function' should still be
43 ;; distinct, because the user can't see the properties when making the
46 ;; See the functions `etags-xref-find' and `elisp-xref-find' for full
55 (defgroup xref nil
"Cross-referencing commands"
61 (defclass xref-location
() ()
62 :documentation
"A location represents a position in a file or buffer.")
64 ;; If a backend decides to subclass xref-location it can provide
65 ;; methods for some of the following functions:
66 (defgeneric xref-location-marker
(location)
67 "Return the marker for LOCATION.")
69 (defgeneric xref-location-group
(location)
70 "Return a string used to group a set of locations.
71 This is typically the filename.")
73 ;;;; Commonly needed location classes are defined here:
75 ;; FIXME: might be useful to have an optional "hint" i.e. a string to
76 ;; search for in case the line number is sightly out of date.
77 (defclass xref-file-location
(xref-location)
78 ((file :type string
:initarg
:file
)
79 (line :type fixnum
:initarg
:line
)
80 (column :type fixnum
:initarg
:column
))
81 :documentation
"A file location is a file/line/column triple.
82 Line numbers start from 1 and columns from 0.")
84 (defun xref-make-file-location (file line column
)
85 "Create and return a new xref-file-location."
86 (make-instance 'xref-file-location
:file file
:line line
:column column
))
88 (defmethod xref-location-marker ((l xref-file-location
))
89 (with-slots (file line column
) l
91 (or (get-file-buffer file
)
92 (let ((find-file-suppress-same-file-warnings t
))
93 (find-file-noselect file
)))
97 (goto-char (point-min))
98 (beginning-of-line line
)
99 (move-to-column column
)
102 (defmethod xref-location-group ((l xref-file-location
))
105 (defclass xref-buffer-location
(xref-location)
106 ((buffer :type buffer
:initarg
:buffer
)
107 (position :type fixnum
:initarg
:position
)))
109 (defun xref-make-buffer-location (buffer position
)
110 "Create and return a new xref-buffer-location."
111 (make-instance 'xref-buffer-location
:buffer buffer
:position position
))
113 (defmethod xref-location-marker ((l xref-buffer-location
))
114 (with-slots (buffer position
) l
115 (let ((m (make-marker)))
116 (move-marker m position buffer
))))
118 (defmethod xref-location-group ((l xref-buffer-location
))
119 (with-slots (buffer) l
120 (or (buffer-file-name buffer
)
121 (format "(buffer %s)" (buffer-name buffer
)))))
123 (defclass xref-bogus-location
(xref-location)
124 ((message :type string
:initarg
:message
125 :reader xref-bogus-location-message
))
126 :documentation
"Bogus locations are sometimes useful to
127 indicate errors, e.g. when we know that a function exists but the
128 actual location is not known.")
130 (defun xref-make-bogus-location (message)
131 "Create and return a new xref-bogus-location."
132 (make-instance 'xref-bogus-location
:message message
))
134 (defmethod xref-location-marker ((l xref-bogus-location
))
135 (user-error "%s" (oref l
:message
)))
137 (defmethod xref-location-group ((_ xref-bogus-location
)) "(No location)")
139 ;; This should be in elisp-mode.el, but it's preloaded, and we can't
140 ;; preload defclass and defmethod (at least, not yet).
141 (defclass xref-elisp-location
(xref-location)
142 ((symbol :type symbol
:initarg
:symbol
)
143 (type :type symbol
:initarg
:type
)
144 (file :type string
:initarg
:file
145 :reader xref-location-group
))
146 :documentation
"Location of an Emacs Lisp symbol definition.")
148 (defun xref-make-elisp-location (symbol type file
)
149 (make-instance 'xref-elisp-location
:symbol symbol
:type type
:file file
))
151 (defmethod xref-location-marker ((l xref-elisp-location
))
152 (with-slots (symbol type file
) l
155 (`defun
(find-function-search-for-symbol symbol nil file
))
156 ((or `defvar
`defface
)
157 (find-function-search-for-symbol symbol type file
))
159 (cons (find-file-noselect file
) 1)))))
160 (with-current-buffer (car buffer-point
)
161 (goto-char (or (cdr buffer-point
) (point-min)))
167 (defclass xref--xref
()
168 ((description :type string
:initarg
:description
169 :reader xref--xref-description
)
170 (location :type xref-location
:initarg
:location
171 :reader xref--xref-location
))
172 :comment
"An xref is used to display and locate constructs like
173 variables or functions.")
175 (defun xref-make (description location
)
176 "Create and return a new xref.
177 DESCRIPTION is a short string to describe the xref.
178 LOCATION is an `xref-location'."
179 (make-instance 'xref--xref
:description description
:location location
))
184 (declare-function etags-xref-find
"etags" (action id
))
185 (declare-function tags-lazy-completion-table
"etags" ())
187 ;; For now, make the etags backend the default.
188 (defvar xref-find-function
#'etags-xref-find
189 "Function to look for cross-references.
190 It can be called in several ways:
192 (definitions IDENTIFIER): Find definitions of IDENTIFIER. The
193 result must be a list of xref objects. If no definitions can be
196 (references IDENTIFIER): Find references of IDENTIFIER. The
197 result must be a list of xref objects. If no references can be
200 (apropos PATTERN): Find all symbols that match PATTERN. PATTERN
203 IDENTIFIER can be any string returned by
204 `xref-identifier-at-point-function', or from the table returned
205 by `xref-identifier-completion-table-function'.
207 To create an xref object, call `xref-make'.")
209 (defvar xref-identifier-at-point-function
#'xref-default-identifier-at-point
210 "Function to get the relevant identifier at point.
212 The return value must be a string or nil. nil means no
213 identifier at point found.
215 If it's hard to determine the identifier precisely (e.g., because
216 it's a method call on unknown type), the implementation can
217 return a simple string (such as symbol at point) marked with a
218 special text property which `xref-find-function' would recognize
219 and then delegate the work to an external process.")
221 (defvar xref-identifier-completion-table-function
#'tags-lazy-completion-table
222 "Function that returns the completion table for identifiers.")
224 (defun xref-default-identifier-at-point ()
225 (let ((thing (thing-at-point 'symbol
)))
226 (and thing
(substring-no-properties thing
))))
230 (defun xref--alistify (list key test
)
231 "Partition the elements of LIST into an alist.
232 KEY extracts the key from an element and TEST is used to compare
236 (let* ((k (funcall key e
))
237 (probe (cl-assoc k alist
:test test
)))
239 (setcdr probe
(cons e
(cdr probe
)))
240 (push (cons k
(list e
)) alist
))))
241 ;; Put them back in order.
242 (cl-loop for
(key . value
) in
(reverse alist
)
243 collect
(cons key
(reverse value
)))))
245 (defun xref--insert-propertized (props &rest strings
)
246 "Insert STRINGS with text properties PROPS."
247 (let ((start (point)))
248 (apply #'insert strings
)
249 (add-text-properties start
(point) props
)))
251 (defun xref--search-property (property &optional backward
)
252 "Search the next text range where text property PROPERTY is non-nil.
253 Return the value of PROPERTY. If BACKWARD is non-nil, search
255 (let ((next (if backward
256 #'previous-single-char-property-change
257 #'next-single-char-property-change
))
261 (goto-char (funcall next
(point) property
))
262 (not (or (setq value
(get-text-property (point) property
))
266 (t (goto-char start
) nil
))))
269 ;;; Marker stack (M-. pushes, M-, pops)
271 (defcustom xref-marker-ring-length
16
272 "Length of the xref marker ring."
276 (defvar xref--marker-ring
(make-ring xref-marker-ring-length
)
277 "Ring of markers to implement the marker stack.")
279 (defun xref-push-marker-stack ()
280 "Add point to the marker stack."
281 (ring-insert xref--marker-ring
(point-marker)))
284 (defun xref-pop-marker-stack ()
285 "Pop back to where \\[xref-find-definitions] was last invoked."
287 (let ((ring xref--marker-ring
))
288 (when (ring-empty-p ring
)
289 (error "Marker stack is empty"))
290 (let ((marker (ring-remove ring
0)))
291 (switch-to-buffer (or (marker-buffer marker
)
292 (error "The marked buffer has been deleted")))
293 (goto-char (marker-position marker
))
294 (set-marker marker nil nil
))))
296 ;; etags.el needs this
297 (defun xref-clear-marker-stack ()
298 "Discard all markers from the marker stack."
299 (let ((ring xref--marker-ring
))
300 (while (not (ring-empty-p ring
))
301 (let ((marker (ring-remove ring
)))
302 (set-marker marker nil nil
)))))
305 (defun xref--goto-location (location)
306 "Set buffer and point according to xref-location LOCATION."
307 (let ((marker (xref-location-marker location
)))
308 (set-buffer (marker-buffer marker
))
309 (cond ((and (<= (point-min) marker
) (<= marker
(point-max))))
310 (widen-automatically (widen))
311 (t (error "Location is outside accessible part of buffer")))
314 (defun xref--pop-to-location (location &optional window
)
315 "Goto xref-location LOCATION and display the buffer.
316 WINDOW controls how the buffer is displayed:
317 nil -- switch-to-buffer
318 'window -- pop-to-buffer (other window)
319 'frame -- pop-to-buffer (other frame)"
320 (xref--goto-location location
)
322 ((nil) (switch-to-buffer (current-buffer)))
323 (window (pop-to-buffer (current-buffer) t
))
324 (frame (let ((pop-up-frames t
)) (pop-to-buffer (current-buffer) t
)))))
327 ;;; XREF buffer (part of the UI)
329 ;; The xref buffer is used to display a set of xrefs.
331 (defun xref--display-position (pos other-window recenter-arg
)
332 ;; show the location, but don't hijack focus.
333 (with-selected-window (display-buffer (current-buffer) other-window
)
335 (recenter recenter-arg
)))
337 (defun xref--show-location (location)
340 (xref--goto-location location
)
341 (xref--display-position (point) t
1))
342 (user-error (message (error-message-string err
)))))
344 (defun xref--next-line (backward)
345 (let ((loc (xref--search-property 'xref-location backward
)))
347 (save-window-excursion
348 (xref--show-location loc
)
349 (sit-for most-positive-fixnum
)))))
351 (defun xref-next-line ()
352 "Move to the next xref and display its source in the other window."
354 (xref--next-line nil
))
356 (defun xref-prev-line ()
357 "Move to the previous xref and display its source in the other window."
361 (defun xref--location-at-point ()
362 (or (get-text-property (point) 'xref-location
)
363 (error "No reference at point")))
365 (defvar-local xref--window nil
)
367 (defun xref-goto-xref ()
368 "Jump to the xref at point and bury the xref buffer."
370 (let ((loc (xref--location-at-point))
371 (window xref--window
))
373 (xref--pop-to-location loc window
)))
375 (define-derived-mode xref--xref-buffer-mode fundamental-mode
"XREF"
376 "Mode for displaying cross-references."
377 (setq buffer-read-only t
))
379 (let ((map xref--xref-buffer-mode-map
))
380 (define-key map
(kbd "q") #'quit-window
)
381 (define-key map
[remap next-line
] #'xref-next-line
)
382 (define-key map
[remap previous-line
] #'xref-prev-line
)
383 (define-key map
(kbd "RET") #'xref-goto-xref
)
385 ;; suggested by Johan Claesson "to further reduce finger movement":
386 (define-key map
(kbd ".") #'xref-next-line
)
387 (define-key map
(kbd ",") #'xref-prev-line
))
389 (defconst xref-buffer-name
"*xref*"
390 "The name of the buffer to show xrefs.")
392 (defun xref--insert-xrefs (xref-alist)
393 "Insert XREF-ALIST in the current-buffer.
394 XREF-ALIST is of the form ((GROUP . (XREF ...)) ...). Where
395 GROUP is a string for decoration purposes and XREF is an
396 `xref--xref' object."
397 (cl-loop for
((group . xrefs
) . more1
) on xref-alist do
398 (xref--insert-propertized '(face bold
) group
"\n")
399 (cl-loop for
(xref . more2
) on xrefs do
401 (with-slots (description location
) xref
402 (xref--insert-propertized
403 (list 'xref-location location
404 'face
'font-lock-keyword-face
)
406 (when (or more1 more2
)
409 (defun xref--analyze (xrefs)
410 "Find common filenames in XREFS.
411 Return an alist of the form ((FILENAME . (XREF ...)) ...)."
412 (xref--alistify xrefs
414 (xref-location-group (xref--xref-location x
)))
417 (defun xref--show-xref-buffer (xrefs window
)
418 (let ((xref-alist (xref--analyze xrefs
)))
419 (with-current-buffer (get-buffer-create xref-buffer-name
)
420 (let ((inhibit-read-only t
))
422 (xref--insert-xrefs xref-alist
)
423 (xref--xref-buffer-mode)
424 (pop-to-buffer (current-buffer))
425 (goto-char (point-min))
426 (setq xref--window window
)
430 ;; This part of the UI seems fairly uncontroversial: it reads the
431 ;; identifier and deals with the single definition case.
433 ;; The controversial multiple definitions case is handed off to
434 ;; xref-show-xrefs-function.
436 (defvar xref-show-xrefs-function
'xref--show-xref-buffer
437 "Function to display a list of xrefs.")
439 (defun xref--show-xrefs (id kind xrefs window
)
442 (user-error "No known %s for: %s" kind id
))
444 (xref-push-marker-stack)
445 (xref--pop-to-location (xref--xref-location (car xrefs
)) window
))
447 (xref-push-marker-stack)
448 (funcall xref-show-xrefs-function xrefs window
))))
450 (defun xref--read-identifier (prompt)
451 "Return the identifier at point or read it from the minibuffer."
452 (let ((id (funcall xref-identifier-at-point-function
)))
453 (cond ((or current-prefix-arg
(not id
))
454 (completing-read prompt
455 (funcall xref-identifier-completion-table-function
)
462 (defun xref--find-definitions (id window
)
463 (xref--show-xrefs id
"definitions"
464 (funcall xref-find-function
'definitions id
)
468 (defun xref-find-definitions (identifier)
469 "Find the definition of the identifier at point.
470 With prefix argument or when there's no identifier at point,
472 (interactive (list (xref--read-identifier "Find definitions of: ")))
473 (xref--find-definitions identifier nil
))
476 (defun xref-find-definitions-other-window (identifier)
477 "Like `xref-find-definitions' but switch to the other window."
478 (interactive (list (xref--read-identifier "Find definitions of: ")))
479 (xref--find-definitions identifier
'window
))
482 (defun xref-find-definitions-other-frame (identifier)
483 "Like `xref-find-definitions' but switch to the other frame."
484 (interactive (list (xref--read-identifier "Find definitions of: ")))
485 (xref--find-definitions identifier
'frame
))
488 (defun xref-find-references (identifier)
489 "Find references to the identifier at point.
490 With prefix argument, prompt for the identifier."
491 (interactive (list (xref--read-identifier "Find references of: ")))
492 (xref--show-xrefs identifier
"references"
493 (funcall xref-find-function
'references identifier
)
497 (defun xref-find-apropos (pattern)
498 "Find all meaningful symbols that match PATTERN.
499 The argument has the same meaning as in `apropos'."
500 (interactive (list (read-from-minibuffer
501 "Search for pattern (word list or regexp): ")))
503 (xref--show-xrefs pattern
"apropos"
504 (funcall xref-find-function
'apropos
505 (apropos-parse-pattern
506 (if (string-equal (regexp-quote pattern
) pattern
)
508 (or (split-string pattern
"[ \t]+" t
)
509 (user-error "No word list given"))
516 ;;;###autoload (define-key esc-map "." #'xref-find-definitions)
517 ;;;###autoload (define-key esc-map "," #'xref-pop-marker-stack)
518 ;;;###autoload (define-key esc-map [?\C-.] #'xref-find-apropos)
519 ;;;###autoload (define-key ctl-x-4-map "." #'xref-find-definitions-other-window)
520 ;;;###autoload (define-key ctl-x-5-map "." #'xref-find-definitions-other-frame)
525 ;;; xref.el ends here