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, prompt for the identifier."
471 (interactive (list (xref--read-identifier "Find definitions of: ")))
472 (xref--find-definitions identifier nil))
475 (defun xref-find-definitions-other-window (identifier)
476 "Like `xref-find-definitions' but switch to the other window."
477 (interactive (list (xref--read-identifier "Find definitions of: ")))
478 (xref--find-definitions identifier 'window))
481 (defun xref-find-definitions-other-frame (identifier)
482 "Like `xref-find-definitions' but switch to the other frame."
483 (interactive (list (xref--read-identifier "Find definitions of: ")))
484 (xref--find-definitions identifier 'frame))
487 (defun xref-find-references (identifier)
488 "Find references to the identifier at point.
489 With prefix argument, prompt for the identifier."
490 (interactive (list (xref--read-identifier "Find references of: ")))
491 (xref--show-xrefs identifier "references"
492 (funcall xref-find-function 'references identifier)
496 (defun xref-find-apropos (pattern)
497 "Find all meaningful symbols that match PATTERN.
498 The argument has the same meaning as in `apropos'."
499 (interactive (list (read-from-minibuffer
500 "Search for pattern (word list or regexp): ")))
502 (xref--show-xrefs pattern "apropos"
503 (funcall xref-find-function 'apropos
504 (apropos-parse-pattern
505 (if (string-equal (regexp-quote pattern) pattern)
507 (or (split-string pattern "[ \t]+" t)
508 (user-error "No word list given"))
515 ;;;###autoload (define-key esc-map "." #'xref-find-definitions)
516 ;;;###autoload (define-key esc-map "," #'xref-pop-marker-stack)
517 ;;;###autoload (define-key esc-map [?\C-.] #'xref-find-apropos)
518 ;;;###autoload (define-key ctl-x-4-map "." #'xref-find-definitions-other-window)
519 ;;;###autoload (define-key ctl-x-5-map "." #'xref-find-definitions-other-frame)
524 ;;; xref.el ends here