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 (cl-defgeneric xref-location-line (_location)
  77   "Return the line number corresponding to the location."
  78   nil)
  79
  80 ;;;; Commonly needed location classes are defined here:
  81
  82 ;; FIXME: might be useful to have an optional "hint" i.e. a string to
  83 ;; search for in case the line number is sightly out of date.
  84 (defclass xref-file-location (xref-location)
  85   ((file :type string :initarg :file)
  86    (line :type fixnum :initarg :line :reader xref-location-line)
  87    (column :type fixnum :initarg :column))
  88   :documentation "A file location is a file/line/column triple.
  89 Line numbers start from 1 and columns from 0.")
  90
  91 (defun xref-make-file-location (file line column)
  92   "Create and return a new xref-file-location."
  93   (make-instance 'xref-file-location :file file :line line :column column))
  94
  95 (cl-defmethod xref-location-marker ((l xref-file-location))
  96   (with-slots (file line column) l
  97     (with-current-buffer
  98         (or (get-file-buffer file)
  99             (let ((find-file-suppress-same-file-warnings t))
 100               (find-file-noselect file)))
 101       (save-restriction
 102         (widen)
 103         (save-excursion
 104           (goto-char (point-min))
 105           (beginning-of-line line)
 106           (move-to-column column)
 107           (point-marker))))))
 108
 109 (cl-defmethod xref-location-group ((l xref-file-location))
 110   (oref l file))
 111
 112 (defclass xref-buffer-location (xref-location)
 113   ((buffer :type buffer :initarg :buffer)
 114    (position :type fixnum :initarg :position)))
 115
 116 (defun xref-make-buffer-location (buffer position)
 117   "Create and return a new xref-buffer-location."
 118   (make-instance 'xref-buffer-location :buffer buffer :position position))
 119
 120 (cl-defmethod xref-location-marker ((l xref-buffer-location))
 121   (with-slots (buffer position) l
 122     (let ((m (make-marker)))
 123       (move-marker m position buffer))))
 124
 125 (cl-defmethod xref-location-group ((l xref-buffer-location))
 126   (with-slots (buffer) l
 127     (or (buffer-file-name buffer)
 128         (format "(buffer %s)" (buffer-name buffer)))))
 129
 130 (defclass xref-bogus-location (xref-location)
 131   ((message :type string :initarg :message
 132             :reader xref-bogus-location-message))
 133   :documentation "Bogus locations are sometimes useful to
 134 indicate errors, e.g. when we know that a function exists but the
 135 actual location is not known.")
 136
 137 (defun xref-make-bogus-location (message)
 138   "Create and return a new xref-bogus-location."
 139   (make-instance 'xref-bogus-location :message message))
 140
 141 (cl-defmethod xref-location-marker ((l xref-bogus-location))
 142   (user-error "%s" (oref l message)))
 143
 144 (cl-defmethod xref-location-group ((_ xref-bogus-location)) "(No location)")
 145
 146 \f
 147 ;;; Cross-reference
 148
 149 (defclass xref--xref ()
 150   ((description :type string :initarg :description
 151                 :reader xref--xref-description)
 152    (location :initarg :location
 153              :reader xref--xref-location))
 154   :comment "An xref is used to display and locate constructs like
 155 variables or functions.")
 156
 157 (defun xref-make (description location)
 158   "Create and return a new xref.
 159 DESCRIPTION is a short string to describe the xref.
 160 LOCATION is an `xref-location'."
 161   (make-instance 'xref--xref :description description :location location))
 162
 163 \f
 164 ;;; API
 165
 166 (declare-function etags-xref-find "etags" (action id))
 167 (declare-function tags-lazy-completion-table "etags" ())
 168
 169 ;; For now, make the etags backend the default.
 170 (defvar xref-find-function #'etags-xref-find
 171   "Function to look for cross-references.
 172 It can be called in several ways:
 173
 174  (definitions IDENTIFIER): Find definitions of IDENTIFIER.  The
 175 result must be a list of xref objects.  If no definitions can be
 176 found, return nil.
 177
 178  (references IDENTIFIER): Find references of IDENTIFIER.  The
 179 result must be a list of xref objects.  If no references can be
 180 found, return nil.
 181
 182  (apropos PATTERN): Find all symbols that match PATTERN.  PATTERN
 183 is a regexp.
 184
 185  (matches REGEXP): Find all matches for REGEXP in the related
 186 files.  REGEXP is an Emacs regular expression.
 187
 188 IDENTIFIER can be any string returned by
 189 `xref-identifier-at-point-function', or from the table returned
 190 by `xref-identifier-completion-table-function'.
 191
 192 To create an xref object, call `xref-make'.")
 193
 194 (defvar xref-identifier-at-point-function #'xref-default-identifier-at-point
 195   "Function to get the relevant identifier at point.
 196
 197 The return value must be a string or nil.  nil means no
 198 identifier at point found.
 199
 200 If it's hard to determine the identifier precisely (e.g., because
 201 it's a method call on unknown type), the implementation can
 202 return a simple string (such as symbol at point) marked with a
 203 special text property which `xref-find-function' would recognize
 204 and then delegate the work to an external process.")
 205
 206 (defvar xref-identifier-completion-table-function #'tags-lazy-completion-table
 207   "Function that returns the completion table for identifiers.")
 208
 209 (defun xref-default-identifier-at-point ()
 210   (let ((thing (thing-at-point 'symbol)))
 211     (and thing (substring-no-properties thing))))
 212
 213 \f
 214 ;;; misc utilities
 215 (defun xref--alistify (list key test)
 216   "Partition the elements of LIST into an alist.
 217 KEY extracts the key from an element and TEST is used to compare
 218 keys."
 219   (let ((alist '()))
 220     (dolist (e list)
 221       (let* ((k (funcall key e))
 222              (probe (cl-assoc k alist :test test)))
 223         (if probe
 224             (setcdr probe (cons e (cdr probe)))
 225           (push (cons k (list e)) alist))))
 226     ;; Put them back in order.
 227     (cl-loop for (key . value) in (reverse alist)
 228              collect (cons key (reverse value)))))
 229
 230 (defun xref--insert-propertized (props &rest strings)
 231   "Insert STRINGS with text properties PROPS."
 232   (let ((start (point)))
 233     (apply #'insert strings)
 234     (add-text-properties start (point) props)))
 235
 236 (defun xref--search-property (property &optional backward)
 237     "Search the next text range where text property PROPERTY is non-nil.
 238 Return the value of PROPERTY.  If BACKWARD is non-nil, search
 239 backward."
 240   (let ((next (if backward
 241                   #'previous-single-char-property-change
 242                 #'next-single-char-property-change))
 243         (start (point))
 244         (value nil))
 245     (while (progn
 246              (goto-char (funcall next (point) property))
 247              (not (or (setq value (get-text-property (point) property))
 248                       (eobp)
 249                       (bobp)))))
 250     (cond (value)
 251           (t (goto-char start) nil))))
 252
 253 \f
 254 ;;; Marker stack  (M-. pushes, M-, pops)
 255
 256 (defcustom xref-marker-ring-length 16
 257   "Length of the xref marker ring."
 258   :type 'integer
 259   :version "25.1")
 260
 261 (defcustom xref-prompt-for-identifier '(not xref-find-definitions
 262                                             xref-find-definitions-other-window
 263                                             xref-find-definitions-other-frame)
 264   "When t, always prompt for the identifier name.
 265
 266 When nil, prompt only when there's no value at point we can use,
 267 or when the command has been called with the prefix argument.
 268
 269 Otherwise, it's a list of xref commands which will prompt
 270 anyway (the value at point, if any, will be used as the default).
 271
 272 If the list starts with `not', the meaning of the rest of the
 273 elements is negated."
 274   :type '(choice (const :tag "always" t)
 275                  (const :tag "auto" nil)
 276                  (set :menu-tag "command specific" :tag "commands"
 277                       :value (not)
 278                       (const :tag "Except" not)
 279                       (repeat :inline t (symbol :tag "command"))))
 280   :version "25.1")
 281
 282 (defcustom xref-pulse-on-jump t
 283   "When non-nil, momentarily highlight jump locations."
 284   :type 'boolean
 285   :version "25.1")
 286
 287 (defvar xref--marker-ring (make-ring xref-marker-ring-length)
 288   "Ring of markers to implement the marker stack.")
 289
 290 (defun xref-push-marker-stack (&optional m)
 291   "Add point M (defaults to `point-marker') to the marker stack."
 292   (ring-insert xref--marker-ring (or m (point-marker))))
 293
 294 ;;;###autoload
 295 (defun xref-pop-marker-stack ()
 296   "Pop back to where \\[xref-find-definitions] was last invoked."
 297   (interactive)
 298   (let ((ring xref--marker-ring))
 299     (when (ring-empty-p ring)
 300       (error "Marker stack is empty"))
 301     (let ((marker (ring-remove ring 0)))
 302       (switch-to-buffer (or (marker-buffer marker)
 303                             (error "The marked buffer has been deleted")))
 304       (goto-char (marker-position marker))
 305       (set-marker marker nil nil)
 306       (xref--maybe-pulse))))
 307
 308 (defun xref--maybe-pulse ()
 309   (when xref-pulse-on-jump
 310     (let (beg end)
 311       (save-excursion
 312         (back-to-indentation)
 313         (if (eolp)
 314             (setq beg (line-beginning-position)
 315                   end (1+ (point)))
 316           (setq beg (point)
 317                 end (line-end-position))))
 318       (pulse-momentary-highlight-region beg end 'next-error))))
 319
 320 ;; etags.el needs this
 321 (defun xref-clear-marker-stack ()
 322   "Discard all markers from the marker stack."
 323   (let ((ring xref--marker-ring))
 324     (while (not (ring-empty-p ring))
 325       (let ((marker (ring-remove ring)))
 326         (set-marker marker nil nil)))))
 327
 328 ;;;###autoload
 329 (defun xref-marker-stack-empty-p ()
 330   "Return t if the marker stack is empty; nil otherwise."
 331   (ring-empty-p xref--marker-ring))
 332
 333 \f
 334 (defun xref--goto-location (location)
 335   "Set buffer and point according to xref-location LOCATION."
 336   (let ((marker (xref-location-marker location)))
 337     (set-buffer (marker-buffer marker))
 338     (cond ((and (<= (point-min) marker) (<= marker (point-max))))
 339           (widen-automatically (widen))
 340           (t (error "Location is outside accessible part of buffer")))
 341     (goto-char marker)))
 342
 343 (defun xref--pop-to-location (location &optional window)
 344   "Goto xref-location LOCATION and display the buffer.
 345 WINDOW controls how the buffer is displayed:
 346   nil      -- switch-to-buffer
 347   'window  -- pop-to-buffer (other window)
 348   'frame   -- pop-to-buffer (other frame)"
 349   (xref--goto-location location)
 350   (cl-ecase window
 351     ((nil)  (switch-to-buffer (current-buffer)))
 352     (window (pop-to-buffer (current-buffer) t))
 353     (frame  (let ((pop-up-frames t)) (pop-to-buffer (current-buffer) t))))
 354   (xref--maybe-pulse))
 355
 356 \f
 357 ;;; XREF buffer (part of the UI)
 358
 359 ;; The xref buffer is used to display a set of xrefs.
 360
 361 (defvar-local xref--display-history nil
 362   "List of pairs (BUFFER . WINDOW), for temporarily displayed buffers.")
 363
 364 (defvar-local xref--temporary-buffers nil
 365   "List of buffers created by xref code.")
 366
 367 (defvar-local xref--current nil
 368   "Non-nil if this buffer was once current, except while displaying xrefs.
 369 Used for temporary buffers.")
 370
 371 (defvar xref--inhibit-mark-current nil)
 372
 373 (defun xref--mark-selected ()
 374   (unless xref--inhibit-mark-current
 375     (setq xref--current t))
 376   (remove-hook 'buffer-list-update-hook #'xref--mark-selected t))
 377
 378 (defun xref--save-to-history (buf win)
 379   (let ((restore (window-parameter win 'quit-restore)))
 380     ;; Save the new entry if the window displayed another buffer
 381     ;; previously.
 382     (when (and restore (not (eq (car restore) 'same)))
 383       (push (cons buf win) xref--display-history))))
 384
 385 (defun xref--display-position (pos other-window recenter-arg xref-buf)
 386   ;; Show the location, but don't hijack focus.
 387   (with-selected-window (display-buffer (current-buffer) other-window)
 388     (goto-char pos)
 389     (recenter recenter-arg)
 390     (xref--maybe-pulse)
 391     (let ((buf (current-buffer))
 392           (win (selected-window)))
 393       (with-current-buffer xref-buf
 394         (setq-local other-window-scroll-buffer buf)
 395         (xref--save-to-history buf win)))))
 396
 397 (defun xref--show-location (location)
 398   (condition-case err
 399       (let ((xref-buf (current-buffer))
 400             (bl (buffer-list))
 401             (xref--inhibit-mark-current t))
 402         (xref--goto-location location)
 403         (let ((buf (current-buffer)))
 404           (unless (memq buf bl)
 405             ;; Newly created.
 406             (add-hook 'buffer-list-update-hook #'xref--mark-selected nil t)
 407             (with-current-buffer xref-buf
 408               (push buf xref--temporary-buffers))))
 409         (xref--display-position (point) t 1 xref-buf))
 410     (user-error (message (error-message-string err)))))
 411
 412 (defun xref-show-location-at-point ()
 413   "Display the source of xref at point in the other window, if any."
 414   (interactive)
 415   (let ((loc (xref--location-at-point)))
 416     (when loc
 417       (xref--show-location loc))))
 418
 419 (defun xref-next-line ()
 420   "Move to the next xref and display its source in the other window."
 421   (interactive)
 422   (xref--search-property 'xref-location)
 423   (xref-show-location-at-point))
 424
 425 (defun xref-prev-line ()
 426   "Move to the previous xref and display its source in the other window."
 427   (interactive)
 428   (xref--search-property 'xref-location t)
 429   (xref-show-location-at-point))
 430
 431 (defun xref--location-at-point ()
 432   (save-excursion
 433     (back-to-indentation)
 434     (get-text-property (point) 'xref-location)))
 435
 436 (defvar-local xref--window nil
 437   "ACTION argument to call `display-buffer' with.")
 438
 439 (defun xref-goto-xref ()
 440   "Jump to the xref on the current line and bury the xref buffer."
 441   (interactive)
 442   (let ((loc (or (xref--location-at-point)
 443                  (user-error "No reference at point")))
 444         (window xref--window))
 445     (xref-quit)
 446     (xref--pop-to-location loc window)))
 447
 448 (defvar xref--xref-buffer-mode-map
 449   (let ((map (make-sparse-keymap)))
 450     (define-key map [remap quit-window] #'xref-quit)
 451     (define-key map (kbd "n") #'xref-next-line)
 452     (define-key map (kbd "p") #'xref-prev-line)
 453     (define-key map (kbd "RET") #'xref-goto-xref)
 454     (define-key map (kbd "C-o") #'xref-show-location-at-point)
 455     ;; suggested by Johan Claesson "to further reduce finger movement":
 456     (define-key map (kbd ".") #'xref-next-line)
 457     (define-key map (kbd ",") #'xref-prev-line)
 458     map))
 459
 460 (define-derived-mode xref--xref-buffer-mode special-mode "XREF"
 461   "Mode for displaying cross-references."
 462   (setq buffer-read-only t)
 463   (setq next-error-function #'xref--next-error-function)
 464   (setq next-error-last-buffer (current-buffer)))
 465
 466 (defun xref--next-error-function (n reset?)
 467   (when reset?
 468     (goto-char (point-min)))
 469   (let ((backward (< n 0))
 470         (n (abs n))
 471         (loc nil))
 472     (dotimes (_ n)
 473       (setq loc (xref--search-property 'xref-location backward)))
 474     (cond (loc
 475            (xref--pop-to-location loc))
 476           (t
 477            (error "No %s xref" (if backward "previous" "next"))))))
 478
 479 (defun xref-quit (&optional kill)
 480   "Bury temporarily displayed buffers, then quit the current window.
 481
 482 If KILL is non-nil, kill all buffers that were created in the
 483 process of showing xrefs, and also kill the current buffer.
 484
 485 The buffers that the user has otherwise interacted with in the
 486 meantime are preserved."
 487   (interactive "P")
 488   (let ((window (selected-window))
 489         (history xref--display-history))
 490     (setq xref--display-history nil)
 491     (pcase-dolist (`(,buf . ,win) history)
 492       (when (and (window-live-p win)
 493                  (eq buf (window-buffer win)))
 494         (quit-window nil win)))
 495     (when kill
 496       (let ((xref--inhibit-mark-current t)
 497             kill-buffer-query-functions)
 498         (dolist (buf xref--temporary-buffers)
 499           (unless (buffer-local-value 'xref--current buf)
 500             (kill-buffer buf)))
 501         (setq xref--temporary-buffers nil)))
 502     (quit-window kill window)))
 503
 504 (defconst xref-buffer-name "*xref*"
 505   "The name of the buffer to show xrefs.")
 506
 507 (defvar xref--button-map
 508   (let ((map (make-sparse-keymap)))
 509     (define-key map [(control ?m)] #'xref-goto-xref)
 510     (define-key map [mouse-1] #'xref-goto-xref)
 511     (define-key map [mouse-2] #'xref--mouse-2)
 512     map))
 513
 514 (defun xref--mouse-2 (event)
 515   "Move point to the button and show the xref definition."
 516   (interactive "e")
 517   (mouse-set-point event)
 518   (forward-line 0)
 519   (xref--search-property 'xref-location)
 520   (xref-show-location-at-point))
 521
 522 (defun xref--insert-xrefs (xref-alist)
 523   "Insert XREF-ALIST in the current-buffer.
 524 XREF-ALIST is of the form ((GROUP . (XREF ...)) ...).  Where
 525 GROUP is a string for decoration purposes and XREF is an
 526 `xref--xref' object."
 527   (require 'compile) ; For the compilation faces.
 528   (cl-loop for ((group . xrefs) . more1) on xref-alist
 529            for max-line-width =
 530            (cl-loop for xref in xrefs
 531                     maximize (let ((line (xref-location-line
 532                                           (oref xref location))))
 533                                (length (and line (format "%d" line)))))
 534            for line-format = (and max-line-width
 535                                   (format "%%%dd: " max-line-width))
 536            do
 537            (xref--insert-propertized '(face compilation-info) group "\n")
 538            (cl-loop for (xref . more2) on xrefs do
 539                     (with-slots (description location) xref
 540                       (let* ((line (xref-location-line location))
 541                              (prefix
 542                               (if line
 543                                   (propertize (format line-format line)
 544                                               'face 'compilation-line-number)
 545                                 "  ")))
 546                         (xref--insert-propertized
 547                          (list 'xref-location location
 548                                ;; 'face 'font-lock-keyword-face
 549                                'mouse-face 'highlight
 550                                'keymap xref--button-map
 551                                'help-echo
 552                                (concat "mouse-2: display in another window, "
 553                                        "RET or mouse-1: follow reference"))
 554                          prefix description)))
 555                     (insert "\n"))))
 556
 557 (defun xref--analyze (xrefs)
 558   "Find common filenames in XREFS.
 559 Return an alist of the form ((FILENAME . (XREF ...)) ...)."
 560   (xref--alistify xrefs
 561                   (lambda (x)
 562                     (xref-location-group (xref--xref-location x)))
 563                   #'equal))
 564
 565 (defun xref--show-xref-buffer (xrefs alist)
 566   (let ((xref-alist (xref--analyze xrefs)))
 567     (with-current-buffer (get-buffer-create xref-buffer-name)
 568       (let ((inhibit-read-only t))
 569         (erase-buffer)
 570         (xref--insert-xrefs xref-alist)
 571         (xref--xref-buffer-mode)
 572         (pop-to-buffer (current-buffer))
 573         (goto-char (point-min))
 574         (setq xref--window (assoc-default 'window alist))
 575         (setq xref--temporary-buffers (assoc-default 'temporary-buffers alist))
 576         (dolist (buf xref--temporary-buffers)
 577           (with-current-buffer buf
 578             (add-hook 'buffer-list-update-hook #'xref--mark-selected nil t)))
 579         (current-buffer)))))
 580
 581 \f
 582 ;; This part of the UI seems fairly uncontroversial: it reads the
 583 ;; identifier and deals with the single definition case.
 584 ;;
 585 ;; The controversial multiple definitions case is handed off to
 586 ;; xref-show-xrefs-function.
 587
 588 (defvar xref-show-xrefs-function 'xref--show-xref-buffer
 589   "Function to display a list of xrefs.")
 590
 591 (defvar xref--read-identifier-history nil)
 592
 593 (defvar xref--read-pattern-history nil)
 594
 595 (defun xref--show-xrefs (input kind arg window)
 596   (let* ((bl (buffer-list))
 597          (xrefs (funcall xref-find-function kind arg))
 598          (tb (cl-set-difference (buffer-list) bl)))
 599     (cond
 600      ((null xrefs)
 601       (user-error "No known %s for: %s" (symbol-name kind) input))
 602      ((not (cdr xrefs))
 603       (xref-push-marker-stack)
 604       (xref--pop-to-location (xref--xref-location (car xrefs)) window))
 605      (t
 606       (xref-push-marker-stack)
 607       (funcall xref-show-xrefs-function xrefs
 608                `((window . ,window)
 609                  (temporary-buffers . ,tb)))))))
 610
 611 (defun xref--prompt-p (command)
 612   (or (eq xref-prompt-for-identifier t)
 613       (if (eq (car xref-prompt-for-identifier) 'not)
 614           (not (memq command (cdr xref-prompt-for-identifier)))
 615         (memq command xref-prompt-for-identifier))))
 616
 617 (defun xref--read-identifier (prompt)
 618   "Return the identifier at point or read it from the minibuffer."
 619   (let ((id (funcall xref-identifier-at-point-function)))
 620     (cond ((or current-prefix-arg
 621                (not id)
 622                (xref--prompt-p this-command))
 623            (completing-read prompt
 624                             (funcall xref-identifier-completion-table-function)
 625                             nil nil nil
 626                             'xref--read-identifier-history id))
 627           (t id))))
 628
 629 \f
 630 ;;; Commands
 631
 632 (defun xref--find-definitions (id window)
 633   (xref--show-xrefs id 'definitions id window))
 634
 635 ;;;###autoload
 636 (defun xref-find-definitions (identifier)
 637   "Find the definition of the identifier at point.
 638 With prefix argument or when there's no identifier at point,
 639 prompt for it."
 640   (interactive (list (xref--read-identifier "Find definitions of: ")))
 641   (xref--find-definitions identifier nil))
 642
 643 ;;;###autoload
 644 (defun xref-find-definitions-other-window (identifier)
 645   "Like `xref-find-definitions' but switch to the other window."
 646   (interactive (list (xref--read-identifier "Find definitions of: ")))
 647   (xref--find-definitions identifier 'window))
 648
 649 ;;;###autoload
 650 (defun xref-find-definitions-other-frame (identifier)
 651   "Like `xref-find-definitions' but switch to the other frame."
 652   (interactive (list (xref--read-identifier "Find definitions of: ")))
 653   (xref--find-definitions identifier 'frame))
 654
 655 ;;;###autoload
 656 (defun xref-find-references (identifier)
 657   "Find references to the identifier at point.
 658 With prefix argument, prompt for the identifier."
 659   (interactive (list (xref--read-identifier "Find references of: ")))
 660   (xref--show-xrefs identifier 'references identifier nil))
 661
 662 ;;;###autoload
 663 (defun xref-find-regexp (regexp)
 664   "Find all matches for REGEXP."
 665   ;; FIXME: Prompt for directory.
 666   (interactive (list (xref--read-identifier "Find regexp: ")))
 667   (xref--show-xrefs regexp 'matches regexp nil))
 668
 669 (declare-function apropos-parse-pattern "apropos" (pattern))
 670
 671 ;;;###autoload
 672 (defun xref-find-apropos (pattern)
 673   "Find all meaningful symbols that match PATTERN.
 674 The argument has the same meaning as in `apropos'."
 675   (interactive (list (read-string
 676                       "Search for pattern (word list or regexp): "
 677                       nil 'xref--read-pattern-history)))
 678   (require 'apropos)
 679   (xref--show-xrefs pattern 'apropos
 680                     (apropos-parse-pattern
 681                      (if (string-equal (regexp-quote pattern) pattern)
 682                          ;; Split into words
 683                          (or (split-string pattern "[ \t]+" t)
 684                              (user-error "No word list given"))
 685                        pattern))
 686                     nil))
 687
 688 \f
 689 ;;; Key bindings
 690
 691 ;;;###autoload (define-key esc-map "." #'xref-find-definitions)
 692 ;;;###autoload (define-key esc-map "," #'xref-pop-marker-stack)
 693 ;;;###autoload (define-key esc-map [?\C-.] #'xref-find-apropos)
 694 ;;;###autoload (define-key ctl-x-4-map "." #'xref-find-definitions-other-window)
 695 ;;;###autoload (define-key ctl-x-5-map "." #'xref-find-definitions-other-frame)
 696
 697 \f
 698 ;;; Helper functions
 699
 700 (defvar xref-etags-mode--saved nil)
 701
 702 (define-minor-mode xref-etags-mode
 703   "Minor mode to make xref use etags again.
 704
 705 Certain major modes install their own mechanisms for listing
 706 identifiers and navigation.  Turn this on to undo those settings
 707 and just use etags."
 708   :lighter ""
 709   (if xref-etags-mode
 710       (progn
 711         (setq xref-etags-mode--saved
 712               (cons xref-find-function
 713                     xref-identifier-completion-table-function))
 714         (kill-local-variable 'xref-find-function)
 715         (kill-local-variable 'xref-identifier-completion-table-function))
 716     (setq-local xref-find-function (car xref-etags-mode--saved))
 717     (setq-local xref-identifier-completion-table-function
 718                 (cdr xref-etags-mode--saved))))
 719
 720 (declare-function semantic-symref-find-references-by-name "semantic/symref")
 721 (declare-function semantic-symref-find-text "semantic/symref")
 722 (declare-function semantic-find-file-noselect "semantic/fw")
 723 (declare-function rgrep-default-command "grep")
 724
 725 (defun xref-collect-references (symbol dir)
 726   "Collect references to SYMBOL inside DIR.
 727 This function uses the Semantic Symbol Reference API, see
 728 `semantic-symref-find-references-by-name' for details on which
 729 tools are used, and when."
 730   (cl-assert (directory-name-p dir))
 731   (require 'semantic/symref)
 732   (defvar semantic-symref-tool)
 733   (let* ((default-directory dir)
 734          (semantic-symref-tool 'detect)
 735          (res (semantic-symref-find-references-by-name symbol 'subdirs))
 736          (hits (and res (oref res hit-lines)))
 737          (orig-buffers (buffer-list)))
 738     (unwind-protect
 739         (delq nil
 740               (mapcar (lambda (hit) (xref--collect-match
 741                                 hit (format "\\_<%s\\_>" (regexp-quote symbol))))
 742                       hits))
 743       (mapc #'kill-buffer
 744             (cl-set-difference (buffer-list) orig-buffers)))))
 745
 746 (defun xref-collect-matches (regexp dir)
 747   "Collect matches for REGEXP inside DIR using rgrep."
 748   (cl-assert (directory-name-p dir))
 749   (require 'semantic/fw)
 750   (grep-compute-defaults)
 751   (defvar grep-find-template)
 752   (let* ((grep-find-template (replace-regexp-in-string "-e " "-E "
 753                                                        grep-find-template t t))
 754          (command (rgrep-default-command (xref--regexp-to-extended regexp)
 755                                          "*.*" dir))
 756          (orig-buffers (buffer-list))
 757          (buf (get-buffer-create " *xref-grep*"))
 758          (grep-re (caar grep-regexp-alist))
 759          hits)
 760     (with-current-buffer buf
 761       (erase-buffer)
 762       (when (eq (call-process-shell-command command nil t) 0)
 763         (goto-char (point-min))
 764         (while (re-search-forward grep-re nil t)
 765           (push (cons (string-to-number (match-string 2))
 766                       (match-string 1))
 767                 hits))))
 768     (unwind-protect
 769         (delq nil
 770               (mapcar (lambda (hit) (xref--collect-match hit regexp)) hits))
 771       (mapc #'kill-buffer
 772             (cl-set-difference (buffer-list) orig-buffers)))))
 773
 774 (defun xref--regexp-to-extended (str)
 775   (replace-regexp-in-string
 776    ;; FIXME: Add tests.  Move to subr.el, make a public function.
 777    ;; Maybe error on Emacs-only constructs.
 778    "\\(?:\\\\\\\\\\)*\\(?:\\\\[][]\\)?\\(?:\\[.+?\\]\\|\\(\\\\?[(){}|]\\)\\)"
 779    (lambda (str)
 780      (cond
 781       ((not (match-beginning 1))
 782        str)
 783       ((eq (length (match-string 1 str)) 2)
 784        (concat (substring str 0 (match-beginning 1))
 785                (substring (match-string 1 str) 1 2)))
 786       (t
 787        (concat (substring str 0 (match-beginning 1))
 788                "\\"
 789                (match-string 1 str)))))
 790    str t t))
 791
 792 (defun xref--collect-match (hit regexp)
 793   (pcase-let* ((`(,line . ,file) hit)
 794                (buf (or (find-buffer-visiting file)
 795                         (semantic-find-file-noselect file))))
 796     (with-current-buffer buf
 797       (save-excursion
 798         (goto-char (point-min))
 799         (forward-line (1- line))
 800         (when (re-search-forward regexp (line-end-position) t)
 801           (goto-char (match-beginning 0))
 802           (xref-make (buffer-substring
 803                       (line-beginning-position)
 804                       (line-end-position))
 805                      (xref-make-file-location file line
 806                                               (current-column))))))))
 807
 808 \f
 809 (provide 'xref)
 810
 811 ;;; xref.el ends here