]> code.delx.au - gnu-emacs/blob - lisp/progmodes/xref.el
Add xref-pulse-on-jump
[gnu-emacs] / lisp / progmodes / xref.el
1 ;; xref.el --- Cross-referencing commands -*-lexical-binding:t-*-
2
3 ;; Copyright (C) 2014-2015 Free Software Foundation, Inc.
4
5 ;; This file is part of GNU Emacs.
6
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.
11
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.
16
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/>.
19
20 ;;; Commentary:
21
22 ;; This file provides a somewhat generic infrastructure for cross
23 ;; referencing commands, in particular "find-definition".
24 ;;
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.
29 ;;
30 ;; A major mode should make these variables buffer-local first.
31 ;;
32 ;; `xref-find-function' can be called in several ways, see its
33 ;; description. It has to operate with "xref" and "location" values.
34 ;;
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'.
40 ;;
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
46 ;; choice.
47 ;;
48 ;; See the functions `etags-xref-find' and `elisp-xref-find' for full
49 ;; examples.
50
51 ;;; Code:
52
53 (require 'cl-lib)
54 (require 'eieio)
55 (require 'ring)
56 (require 'pcase)
57
58 (defgroup xref nil "Cross-referencing commands"
59 :group 'tools)
60
61 \f
62 ;;; Locations
63
64 (defclass xref-location () ()
65 :documentation "A location represents a position in a file or buffer.")
66
67 ;; If a backend decides to subclass xref-location it can provide
68 ;; methods for some of the following functions:
69 (cl-defgeneric xref-location-marker (location)
70 "Return the marker for LOCATION.")
71
72 (cl-defgeneric xref-location-group (location)
73 "Return a string used to group a set of locations.
74 This is typically the filename.")
75
76 ;;;; Commonly needed location classes are defined here:
77
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.")
86
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))
90
91 (cl-defmethod xref-location-marker ((l xref-file-location))
92 (with-slots (file line column) l
93 (with-current-buffer
94 (or (get-file-buffer file)
95 (let ((find-file-suppress-same-file-warnings t))
96 (find-file-noselect file)))
97 (save-restriction
98 (widen)
99 (save-excursion
100 (goto-char (point-min))
101 (beginning-of-line line)
102 (move-to-column column)
103 (point-marker))))))
104
105 (cl-defmethod xref-location-group ((l xref-file-location))
106 (oref l :file))
107
108 (defclass xref-buffer-location (xref-location)
109 ((buffer :type buffer :initarg :buffer)
110 (position :type fixnum :initarg :position)))
111
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))
115
116 (cl-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))))
120
121 (cl-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)))))
125
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.")
132
133 (defun xref-make-bogus-location (message)
134 "Create and return a new xref-bogus-location."
135 (make-instance 'xref-bogus-location :message message))
136
137 (cl-defmethod xref-location-marker ((l xref-bogus-location))
138 (user-error "%s" (oref l :message)))
139
140 (cl-defmethod xref-location-group ((_ xref-bogus-location)) "(No location)")
141
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.")
150
151 (defun xref-make-elisp-location (symbol type file)
152 (make-instance 'xref-elisp-location :symbol symbol :type type :file file))
153
154 (cl-defmethod xref-location-marker ((l xref-elisp-location))
155 (with-slots (symbol type file) l
156 (let ((buffer-point
157 (pcase type
158 (`defun (find-function-search-for-symbol symbol nil file))
159 ((or `defvar `defface)
160 (find-function-search-for-symbol symbol type file))
161 (`feature
162 (cons (find-file-noselect file) 1)))))
163 (with-current-buffer (car buffer-point)
164 (goto-char (or (cdr buffer-point) (point-min)))
165 (point-marker)))))
166
167 \f
168 ;;; Cross-reference
169
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.")
177
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))
183
184 \f
185 ;;; API
186
187 (declare-function etags-xref-find "etags" (action id))
188 (declare-function tags-lazy-completion-table "etags" ())
189
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:
194
195 (definitions IDENTIFIER): Find definitions of IDENTIFIER. The
196 result must be a list of xref objects. If no definitions can be
197 found, return nil.
198
199 (references IDENTIFIER): Find references of IDENTIFIER. The
200 result must be a list of xref objects. If no references can be
201 found, return nil.
202
203 (apropos PATTERN): Find all symbols that match PATTERN. PATTERN
204 is a regexp.
205
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'.
209
210 To create an xref object, call `xref-make'.")
211
212 (defvar xref-identifier-at-point-function #'xref-default-identifier-at-point
213 "Function to get the relevant identifier at point.
214
215 The return value must be a string or nil. nil means no
216 identifier at point found.
217
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.")
223
224 (defvar xref-identifier-completion-table-function #'tags-lazy-completion-table
225 "Function that returns the completion table for identifiers.")
226
227 (defun xref-default-identifier-at-point ()
228 (let ((thing (thing-at-point 'symbol)))
229 (and thing (substring-no-properties thing))))
230
231 \f
232 ;;; misc utilities
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
236 keys."
237 (let ((alist '()))
238 (dolist (e list)
239 (let* ((k (funcall key e))
240 (probe (cl-assoc k alist :test test)))
241 (if probe
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)))))
247
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)))
253
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
257 backward."
258 (let ((next (if backward
259 #'previous-single-char-property-change
260 #'next-single-char-property-change))
261 (start (point))
262 (value nil))
263 (while (progn
264 (goto-char (funcall next (point) property))
265 (not (or (setq value (get-text-property (point) property))
266 (eobp)
267 (bobp)))))
268 (cond (value)
269 (t (goto-char start) nil))))
270
271 \f
272 ;;; Marker stack (M-. pushes, M-, pops)
273
274 (defcustom xref-marker-ring-length 16
275 "Length of the xref marker ring."
276 :type 'integer
277 :version "25.1")
278
279 (defcustom xref-prompt-for-identifier nil
280 "When non-nil, always prompt for the identifier name.
281
282 Otherwise, only prompt when there's no value at point we can use,
283 or when the command has been called with the prefix argument."
284 :type '(choice (const :tag "always" t)
285 (const :tag "auto" nil))
286 :version "25.1")
287
288 (defcustom xref-pulse-on-jump t
289 "When non-nil, momentarily highlight jump locations."
290 :type 'boolean
291 :version "25.1")
292
293 (defvar xref--marker-ring (make-ring xref-marker-ring-length)
294 "Ring of markers to implement the marker stack.")
295
296 (defun xref-push-marker-stack (&optional m)
297 "Add point M (defaults to `point-marker') to the marker stack."
298 (ring-insert xref--marker-ring (or m (point-marker))))
299
300 ;;;###autoload
301 (defun xref-pop-marker-stack ()
302 "Pop back to where \\[xref-find-definitions] was last invoked."
303 (interactive)
304 (let ((ring xref--marker-ring))
305 (when (ring-empty-p ring)
306 (error "Marker stack is empty"))
307 (let ((marker (ring-remove ring 0)))
308 (switch-to-buffer (or (marker-buffer marker)
309 (error "The marked buffer has been deleted")))
310 (goto-char (marker-position marker))
311 (set-marker marker nil nil)
312 (xref--maybe-pulse))))
313
314 (defun xref--maybe-pulse ()
315 (when xref-pulse-on-jump
316 (pulse-momentary-highlight-one-line (point))))
317
318 ;; etags.el needs this
319 (defun xref-clear-marker-stack ()
320 "Discard all markers from the marker stack."
321 (let ((ring xref--marker-ring))
322 (while (not (ring-empty-p ring))
323 (let ((marker (ring-remove ring)))
324 (set-marker marker nil nil)))))
325
326 ;;;###autoload
327 (defun xref-marker-stack-empty-p ()
328 "Return t if the marker stack is empty; nil otherwise."
329 (ring-empty-p xref--marker-ring))
330
331 \f
332 (defun xref--goto-location (location)
333 "Set buffer and point according to xref-location LOCATION."
334 (let ((marker (xref-location-marker location)))
335 (set-buffer (marker-buffer marker))
336 (cond ((and (<= (point-min) marker) (<= marker (point-max))))
337 (widen-automatically (widen))
338 (t (error "Location is outside accessible part of buffer")))
339 (goto-char marker)))
340
341 (defun xref--pop-to-location (location &optional window)
342 "Goto xref-location LOCATION and display the buffer.
343 WINDOW controls how the buffer is displayed:
344 nil -- switch-to-buffer
345 'window -- pop-to-buffer (other window)
346 'frame -- pop-to-buffer (other frame)"
347 (xref--goto-location location)
348 (cl-ecase window
349 ((nil) (switch-to-buffer (current-buffer)))
350 (window (pop-to-buffer (current-buffer) t))
351 (frame (let ((pop-up-frames t)) (pop-to-buffer (current-buffer) t))))
352 (xref--maybe-pulse))
353
354 \f
355 ;;; XREF buffer (part of the UI)
356
357 ;; The xref buffer is used to display a set of xrefs.
358
359 (defvar-local xref--display-history nil
360 "List of pairs (BUFFER . WINDOW), for temporarily displayed buffers.")
361
362 (defvar-local xref--temporary-buffers nil
363 "List of buffers created by xref code.")
364
365 (defvar-local xref--current nil
366 "Non-nil if this buffer was once current, except while displaying xrefs.
367 Used for temporary buffers.")
368
369 (defvar xref--inhibit-mark-current nil)
370
371 (defun xref--mark-selected ()
372 (unless xref--inhibit-mark-current
373 (setq xref--current t))
374 (remove-hook 'buffer-list-update-hook #'xref--mark-selected t))
375
376 (defun xref--save-to-history (buf win)
377 (let ((restore (window-parameter win 'quit-restore)))
378 ;; Save the new entry if the window displayed another buffer
379 ;; previously.
380 (when (and restore (not (eq (car restore) 'same)))
381 (push (cons buf win) xref--display-history))))
382
383 (defun xref--display-position (pos other-window recenter-arg xref-buf)
384 ;; Show the location, but don't hijack focus.
385 (with-selected-window (display-buffer (current-buffer) other-window)
386 (goto-char pos)
387 (recenter recenter-arg)
388 (xref--maybe-pulse)
389 (let ((buf (current-buffer))
390 (win (selected-window)))
391 (with-current-buffer xref-buf
392 (setq-local other-window-scroll-buffer buf)
393 (xref--save-to-history buf win)))))
394
395 (defun xref--show-location (location)
396 (condition-case err
397 (let ((xref-buf (current-buffer))
398 (bl (buffer-list))
399 (xref--inhibit-mark-current t))
400 (xref--goto-location location)
401 (let ((buf (current-buffer)))
402 (unless (memq buf bl)
403 ;; Newly created.
404 (add-hook 'buffer-list-update-hook #'xref--mark-selected nil t)
405 (with-current-buffer xref-buf
406 (push buf xref--temporary-buffers))))
407 (xref--display-position (point) t 1 xref-buf))
408 (user-error (message (error-message-string err)))))
409
410 (defun xref-show-location-at-point ()
411 "Display the source of xref at point in the other window, if any."
412 (interactive)
413 (let ((loc (xref--location-at-point)))
414 (when loc
415 (xref--show-location loc))))
416
417 (defun xref-next-line ()
418 "Move to the next xref and display its source in the other window."
419 (interactive)
420 (xref--search-property 'xref-location)
421 (xref-show-location-at-point))
422
423 (defun xref-prev-line ()
424 "Move to the previous xref and display its source in the other window."
425 (interactive)
426 (xref--search-property 'xref-location t)
427 (xref-show-location-at-point))
428
429 (defun xref--location-at-point ()
430 (save-excursion
431 (back-to-indentation)
432 (get-text-property (point) 'xref-location)))
433
434 (defvar-local xref--window nil
435 "ACTION argument to call `display-buffer' with.")
436
437 (defun xref-goto-xref ()
438 "Jump to the xref on the current line and bury the xref buffer."
439 (interactive)
440 (let ((loc (or (xref--location-at-point)
441 (user-error "No reference at point")))
442 (window xref--window))
443 (xref-quit)
444 (xref--pop-to-location loc window)))
445
446 (defvar xref--xref-buffer-mode-map
447 (let ((map (make-sparse-keymap)))
448 (define-key map [remap quit-window] #'xref-quit)
449 (define-key map (kbd "n") #'xref-next-line)
450 (define-key map (kbd "p") #'xref-prev-line)
451 (define-key map (kbd "RET") #'xref-goto-xref)
452 (define-key map (kbd "C-o") #'xref-show-location-at-point)
453 ;; suggested by Johan Claesson "to further reduce finger movement":
454 (define-key map (kbd ".") #'xref-next-line)
455 (define-key map (kbd ",") #'xref-prev-line)
456 map))
457
458 (define-derived-mode xref--xref-buffer-mode special-mode "XREF"
459 "Mode for displaying cross-references."
460 (setq buffer-read-only t)
461 (setq next-error-function #'xref--next-error-function)
462 (setq next-error-last-buffer (current-buffer)))
463
464 (defun xref--next-error-function (n reset?)
465 (when reset?
466 (goto-char (point-min)))
467 (let ((backward (< n 0))
468 (n (abs n))
469 (loc nil))
470 (dotimes (_ n)
471 (setq loc (xref--search-property 'xref-location backward)))
472 (cond (loc
473 (xref--pop-to-location loc))
474 (t
475 (error "No %s xref" (if backward "previous" "next"))))))
476
477 (defun xref-quit (&optional kill)
478 "Bury temporarily displayed buffers, then quit the current window.
479
480 If KILL is non-nil, kill all buffers that were created in the
481 process of showing xrefs, and also kill the current buffer.
482
483 The buffers that the user has otherwise interacted with in the
484 meantime are preserved."
485 (interactive "P")
486 (let ((window (selected-window))
487 (history xref--display-history))
488 (setq xref--display-history nil)
489 (pcase-dolist (`(,buf . ,win) history)
490 (when (and (window-live-p win)
491 (eq buf (window-buffer win)))
492 (quit-window nil win)))
493 (when kill
494 (let ((xref--inhibit-mark-current t)
495 kill-buffer-query-functions)
496 (dolist (buf xref--temporary-buffers)
497 (unless (buffer-local-value 'xref--current buf)
498 (kill-buffer buf)))
499 (setq xref--temporary-buffers nil)))
500 (quit-window kill window)))
501
502 (defconst xref-buffer-name "*xref*"
503 "The name of the buffer to show xrefs.")
504
505 (defvar xref--button-map
506 (let ((map (make-sparse-keymap)))
507 (define-key map [(control ?m)] #'xref-goto-xref)
508 (define-key map [mouse-1] #'xref-goto-xref)
509 (define-key map [mouse-2] #'xref--mouse-2)
510 map))
511
512 (defun xref--mouse-2 (event)
513 "Move point to the button and show the xref definition."
514 (interactive "e")
515 (mouse-set-point event)
516 (forward-line 0)
517 (xref--search-property 'xref-location)
518 (xref-show-location-at-point))
519
520 (defun xref--insert-xrefs (xref-alist)
521 "Insert XREF-ALIST in the current-buffer.
522 XREF-ALIST is of the form ((GROUP . (XREF ...)) ...). Where
523 GROUP is a string for decoration purposes and XREF is an
524 `xref--xref' object."
525 (require 'compile) ;; For the compilation-info face.
526 (cl-loop for ((group . xrefs) . more1) on xref-alist do
527 (xref--insert-propertized '(face compilation-info) group "\n")
528 (cl-loop for (xref . more2) on xrefs do
529 (insert " ")
530 (with-slots (description location) xref
531 (xref--insert-propertized
532 (list 'xref-location location
533 ;; 'face 'font-lock-keyword-face
534 'mouse-face 'highlight
535 'keymap xref--button-map
536 'help-echo
537 (concat "mouse-2: display in another window, "
538 "RET or mouse-1: follow reference"))
539 description))
540 (insert "\n"))))
541
542 (defun xref--analyze (xrefs)
543 "Find common filenames in XREFS.
544 Return an alist of the form ((FILENAME . (XREF ...)) ...)."
545 (xref--alistify xrefs
546 (lambda (x)
547 (xref-location-group (xref--xref-location x)))
548 #'equal))
549
550 (defun xref--show-xref-buffer (xrefs alist)
551 (let ((xref-alist (xref--analyze xrefs)))
552 (with-current-buffer (get-buffer-create xref-buffer-name)
553 (let ((inhibit-read-only t))
554 (erase-buffer)
555 (xref--insert-xrefs xref-alist)
556 (xref--xref-buffer-mode)
557 (pop-to-buffer (current-buffer))
558 (goto-char (point-min))
559 (setq xref--window (assoc-default 'window alist))
560 (setq xref--temporary-buffers (assoc-default 'temporary-buffers alist))
561 (dolist (buf xref--temporary-buffers)
562 (with-current-buffer buf
563 (add-hook 'buffer-list-update-hook #'xref--mark-selected nil t)))
564 (current-buffer)))))
565
566 \f
567 ;; This part of the UI seems fairly uncontroversial: it reads the
568 ;; identifier and deals with the single definition case.
569 ;;
570 ;; The controversial multiple definitions case is handed off to
571 ;; xref-show-xrefs-function.
572
573 (defvar xref-show-xrefs-function 'xref--show-xref-buffer
574 "Function to display a list of xrefs.")
575
576 (defvar xref--read-identifier-history nil)
577
578 (defvar xref--read-pattern-history nil)
579
580 (defun xref--show-xrefs (input kind arg window)
581 (let* ((bl (buffer-list))
582 (xrefs (funcall xref-find-function kind arg))
583 (tb (cl-set-difference (buffer-list) bl)))
584 (cond
585 ((null xrefs)
586 (user-error "No known %s for: %s" (symbol-name kind) input))
587 ((not (cdr xrefs))
588 (xref-push-marker-stack)
589 (xref--pop-to-location (xref--xref-location (car xrefs)) window))
590 (t
591 (xref-push-marker-stack)
592 (funcall xref-show-xrefs-function xrefs
593 `((window . ,window)
594 (temporary-buffers . ,tb)))))))
595
596 (defun xref--read-identifier (prompt)
597 "Return the identifier at point or read it from the minibuffer."
598 (let ((id (funcall xref-identifier-at-point-function)))
599 (cond ((or current-prefix-arg xref-prompt-for-identifier (not id))
600 (completing-read prompt
601 (funcall xref-identifier-completion-table-function)
602 nil t nil
603 'xref--read-identifier-history id))
604 (t id))))
605
606 \f
607 ;;; Commands
608
609 (defun xref--find-definitions (id window)
610 (xref--show-xrefs id 'definitions id window))
611
612 ;;;###autoload
613 (defun xref-find-definitions (identifier)
614 "Find the definition of the identifier at point.
615 With prefix argument or when there's no identifier at point,
616 prompt for it."
617 (interactive (list (xref--read-identifier "Find definitions of: ")))
618 (xref--find-definitions identifier nil))
619
620 ;;;###autoload
621 (defun xref-find-definitions-other-window (identifier)
622 "Like `xref-find-definitions' but switch to the other window."
623 (interactive (list (xref--read-identifier "Find definitions of: ")))
624 (xref--find-definitions identifier 'window))
625
626 ;;;###autoload
627 (defun xref-find-definitions-other-frame (identifier)
628 "Like `xref-find-definitions' but switch to the other frame."
629 (interactive (list (xref--read-identifier "Find definitions of: ")))
630 (xref--find-definitions identifier 'frame))
631
632 ;;;###autoload
633 (defun xref-find-references (identifier)
634 "Find references to the identifier at point.
635 With prefix argument, prompt for the identifier."
636 (interactive (list (xref--read-identifier "Find references of: ")))
637 (xref--show-xrefs identifier 'references identifier nil))
638
639 (declare-function apropos-parse-pattern "apropos" (pattern))
640
641 ;;;###autoload
642 (defun xref-find-apropos (pattern)
643 "Find all meaningful symbols that match PATTERN.
644 The argument has the same meaning as in `apropos'."
645 (interactive (list (read-from-minibuffer
646 "Search for pattern (word list or regexp): "
647 nil nil nil 'xref--read-pattern-history)))
648 (require 'apropos)
649 (xref--show-xrefs pattern 'apropos
650 (apropos-parse-pattern
651 (if (string-equal (regexp-quote pattern) pattern)
652 ;; Split into words
653 (or (split-string pattern "[ \t]+" t)
654 (user-error "No word list given"))
655 pattern))
656 nil))
657
658 \f
659 ;;; Key bindings
660
661 ;;;###autoload (define-key esc-map "." #'xref-find-definitions)
662 ;;;###autoload (define-key esc-map "," #'xref-pop-marker-stack)
663 ;;;###autoload (define-key esc-map [?\C-.] #'xref-find-apropos)
664 ;;;###autoload (define-key ctl-x-4-map "." #'xref-find-definitions-other-window)
665 ;;;###autoload (define-key ctl-x-5-map "." #'xref-find-definitions-other-frame)
666
667 \f
668 ;;; Helper functions
669
670 (defvar xref-etags-mode--saved nil)
671
672 (define-minor-mode xref-etags-mode
673 "Minor mode to make xref use etags again.
674
675 Certain major modes install their own mechanisms for listing
676 identifiers and navigation. Turn this on to undo those settings
677 and just use etags."
678 :lighter ""
679 (if xref-etags-mode
680 (progn
681 (setq xref-etags-mode--saved
682 (cons xref-find-function
683 xref-identifier-completion-table-function))
684 (kill-local-variable 'xref-find-function)
685 (kill-local-variable 'xref-identifier-completion-table-function))
686 (setq-local xref-find-function (car xref-etags-mode--saved))
687 (setq-local xref-identifier-completion-table-function
688 (cdr xref-etags-mode--saved))))
689
690 (declare-function semantic-symref-find-references-by-name "semantic/symref")
691 (declare-function semantic-find-file-noselect "semantic/fw")
692
693 (defun xref-collect-references (name dir)
694 "Collect mentions of NAME inside DIR.
695 Uses the Semantic Symbol Reference API, see
696 `semantic-symref-find-references-by-name' for details on which
697 tools are used, and when."
698 (require 'semantic/symref)
699 (defvar semantic-symref-tool)
700 (cl-assert (directory-name-p dir))
701 (let* ((default-directory dir)
702 (semantic-symref-tool 'detect)
703 (res (semantic-symref-find-references-by-name name 'subdirs))
704 (hits (and res (oref res :hit-lines)))
705 (orig-buffers (buffer-list)))
706 (unwind-protect
707 (delq nil
708 (mapcar (lambda (hit) (xref--collect-reference hit name)) hits))
709 (mapc #'kill-buffer
710 (cl-set-difference (buffer-list) orig-buffers)))))
711
712 (defun xref--collect-reference (hit name)
713 (pcase-let* ((`(,line . ,file) hit)
714 (buf (or (find-buffer-visiting file)
715 (semantic-find-file-noselect file))))
716 (with-current-buffer buf
717 (save-excursion
718 (goto-char (point-min))
719 (forward-line (1- line))
720 (when (re-search-forward (format "\\_<%s\\_>"
721 (regexp-quote name))
722 (line-end-position) t)
723 (goto-char (match-beginning 0))
724 (xref-make (format
725 "%d: %s"
726 line
727 (buffer-substring
728 (line-beginning-position)
729 (line-end-position)))
730 (xref-make-file-location file line
731 (current-column))))))))
732
733 \f
734 (provide 'xref)
735
736 ;;; xref.el ends here