code.delx.au - gnu-emacs/blob - 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 (require 'project)
  58
  59 (defgroup xref nil "Cross-referencing commands"
  60   :group 'tools)
  61
  62 \f
  63 ;;; Locations
  64
  65 (defclass xref-location () ()
  66   :documentation "A location represents a position in a file or buffer.")
  67
  68 ;; If a backend decides to subclass xref-location it can provide
  69 ;; methods for some of the following functions:
  70 (cl-defgeneric xref-location-marker (location)
  71   "Return the marker for LOCATION.")
  72
  73 (cl-defgeneric xref-location-group (location)
  74   "Return a string used to group a set of locations.
  75 This is typically the filename.")
  76
  77 (cl-defgeneric xref-location-line (_location)
  78   "Return the line number corresponding to the location."
  79   nil)
  80
  81 ;;;; Commonly needed location classes are defined here:
  82
  83 ;; FIXME: might be useful to have an optional "hint" i.e. a string to
  84 ;; search for in case the line number is sightly out of date.
  85 (defclass xref-file-location (xref-location)
  86   ((file :type string :initarg :file)
  87    (line :type fixnum :initarg :line :reader xref-location-line)
  88    (column :type fixnum :initarg :column))
  89   :documentation "A file location is a file/line/column triple.
  90 Line numbers start from 1 and columns from 0.")
  91
  92 (defun xref-make-file-location (file line column)
  93   "Create and return a new xref-file-location."
  94   (make-instance 'xref-file-location :file file :line line :column column))
  95
  96 (cl-defmethod xref-location-marker ((l xref-file-location))
  97   (with-slots (file line column) l
  98     (with-current-buffer
  99         (or (get-file-buffer file)
 100             (let ((find-file-suppress-same-file-warnings t))
 101               (find-file-noselect file)))
 102       (save-restriction
 103         (widen)
 104         (save-excursion
 105           (goto-char (point-min))
 106           (beginning-of-line line)
 107           (move-to-column column)
 108           (point-marker))))))
 109
 110 (cl-defmethod xref-location-group ((l xref-file-location))
 111   (oref l file))
 112
 113 (defclass xref-buffer-location (xref-location)
 114   ((buffer :type buffer :initarg :buffer)
 115    (position :type fixnum :initarg :position)))
 116
 117 (defun xref-make-buffer-location (buffer position)
 118   "Create and return a new xref-buffer-location."
 119   (make-instance 'xref-buffer-location :buffer buffer :position position))
 120
 121 (cl-defmethod xref-location-marker ((l xref-buffer-location))
 122   (with-slots (buffer position) l
 123     (let ((m (make-marker)))
 124       (move-marker m position buffer))))
 125
 126 (cl-defmethod xref-location-group ((l xref-buffer-location))
 127   (with-slots (buffer) l
 128     (or (buffer-file-name buffer)
 129         (format "(buffer %s)" (buffer-name buffer)))))
 130
 131 (defclass xref-bogus-location (xref-location)
 132   ((message :type string :initarg :message
 133             :reader xref-bogus-location-message))
 134   :documentation "Bogus locations are sometimes useful to
 135 indicate errors, e.g. when we know that a function exists but the
 136 actual location is not known.")
 137
 138 (defun xref-make-bogus-location (message)
 139   "Create and return a new xref-bogus-location."
 140   (make-instance 'xref-bogus-location :message message))
 141
 142 (cl-defmethod xref-location-marker ((l xref-bogus-location))
 143   (user-error "%s" (oref l message)))
 144
 145 (cl-defmethod xref-location-group ((_ xref-bogus-location)) "(No location)")
 146
 147 \f
 148 ;;; Cross-reference
 149
 150 (defclass xref--xref ()
 151   ((description :type string :initarg :description
 152                 :reader xref--xref-description)
 153    (location :initarg :location
 154              :reader xref--xref-location))
 155   :comment "An xref is used to display and locate constructs like
 156 variables or functions.")
 157
 158 (defun xref-make (description location)
 159   "Create and return a new xref.
 160 DESCRIPTION is a short string to describe the xref.
 161 LOCATION is an `xref-location'."
 162   (make-instance 'xref--xref :description description :location location))
 163
 164 \f
 165 ;;; API
 166
 167 (declare-function etags-xref-find "etags" (action id))
 168 (declare-function tags-lazy-completion-table "etags" ())
 169
 170 ;; For now, make the etags backend the default.
 171 (defvar xref-find-function #'etags-xref-find
 172   "Function to look for cross-references.
 173 It can be called in several ways:
 174
 175  (definitions IDENTIFIER): Find definitions of IDENTIFIER.  The
 176 result must be a list of xref objects.  If no definitions can be
 177 found, return nil.
 178
 179  (references IDENTIFIER): Find references of IDENTIFIER.  The
 180 result must be a list of xref objects.  If no references can be
 181 found, return nil.
 182
 183  (apropos PATTERN): Find all symbols that match PATTERN.  PATTERN
 184 is a regexp.
 185
 186 IDENTIFIER can be any string returned by
 187 `xref-identifier-at-point-function', or from the table returned
 188 by `xref-identifier-completion-table-function'.
 189
 190 To create an xref object, call `xref-make'.")
 191
 192 (defvar xref-identifier-at-point-function #'xref-default-identifier-at-point
 193   "Function to get the relevant identifier at point.
 194
 195 The return value must be a string or nil.  nil means no
 196 identifier at point found.
 197
 198 If it's hard to determine the identifier precisely (e.g., because
 199 it's a method call on unknown type), the implementation can
 200 return a simple string (such as symbol at point) marked with a
 201 special text property which `xref-find-function' would recognize
 202 and then delegate the work to an external process.")
 203
 204 (defvar xref-identifier-completion-table-function #'tags-lazy-completion-table
 205   "Function that returns the completion table for identifiers.")
 206
 207 (defun xref-default-identifier-at-point ()
 208   (let ((thing (thing-at-point 'symbol)))
 209     (and thing (substring-no-properties thing))))
 210
 211 \f
 212 ;;; misc utilities
 213 (defun xref--alistify (list key test)
 214   "Partition the elements of LIST into an alist.
 215 KEY extracts the key from an element and TEST is used to compare
 216 keys."
 217   (let ((alist '()))
 218     (dolist (e list)
 219       (let* ((k (funcall key e))
 220              (probe (cl-assoc k alist :test test)))
 221         (if probe
 222             (setcdr probe (cons e (cdr probe)))
 223           (push (cons k (list e)) alist))))
 224     ;; Put them back in order.
 225     (cl-loop for (key . value) in (reverse alist)
 226              collect (cons key (reverse value)))))
 227
 228 (defun xref--insert-propertized (props &rest strings)
 229   "Insert STRINGS with text properties PROPS."
 230   (let ((start (point)))
 231     (apply #'insert strings)
 232     (add-text-properties start (point) props)))
 233
 234 (defun xref--search-property (property &optional backward)
 235     "Search the next text range where text property PROPERTY is non-nil.
 236 Return the value of PROPERTY.  If BACKWARD is non-nil, search
 237 backward."
 238   (let ((next (if backward
 239                   #'previous-single-char-property-change
 240                 #'next-single-char-property-change))
 241         (start (point))
 242         (value nil))
 243     (while (progn
 244              (goto-char (funcall next (point) property))
 245              (not (or (setq value (get-text-property (point) property))
 246                       (eobp)
 247                       (bobp)))))
 248     (cond (value)
 249           (t (goto-char start) nil))))
 250
 251 \f
 252 ;;; Marker stack  (M-. pushes, M-, pops)
 253
 254 (defcustom xref-marker-ring-length 16
 255   "Length of the xref marker ring."
 256   :type 'integer)
 257
 258 (defcustom xref-prompt-for-identifier '(not xref-find-definitions
 259                                             xref-find-definitions-other-window
 260                                             xref-find-definitions-other-frame)
 261   "When t, always prompt for the identifier name.
 262
 263 When nil, prompt only when there's no value at point we can use,
 264 or when the command has been called with the prefix argument.
 265
 266 Otherwise, it's a list of xref commands which will prompt
 267 anyway (the value at point, if any, will be used as the default).
 268
 269 If the list starts with `not', the meaning of the rest of the
 270 elements is negated."
 271   :type '(choice (const :tag "always" t)
 272                  (const :tag "auto" nil)
 273                  (set :menu-tag "command specific" :tag "commands"
 274                       :value (not)
 275                       (const :tag "Except" not)
 276                       (repeat :inline t (symbol :tag "command")))))
 277
 278 (defcustom xref-after-jump-hook '(recenter
 279                                   xref-pulse-momentarily)
 280   "Functions called after jumping to an xref."
 281   :type 'hook)
 282
 283 (defcustom xref-after-return-hook '(xref-pulse-momentarily)
 284   "Functions called after returning to a pre-jump location."
 285   :type 'hook)
 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       (run-hooks 'xref-after-return-hook))))
 307
 308 (defun xref-pulse-momentarily ()
 309   (let (beg end)
 310     (save-excursion
 311       (back-to-indentation)
 312       (if (eolp)
 313           (setq beg (line-beginning-position)
 314                 end (1+ (point)))
 315         (setq beg (point)
 316               end (line-end-position))))
 317     (pulse-momentary-highlight-region beg end 'next-error)))
 318
 319 ;; etags.el needs this
 320 (defun xref-clear-marker-stack ()
 321   "Discard all markers from the marker stack."
 322   (let ((ring xref--marker-ring))
 323     (while (not (ring-empty-p ring))
 324       (let ((marker (ring-remove ring)))
 325         (set-marker marker nil nil)))))
 326
 327 ;;;###autoload
 328 (defun xref-marker-stack-empty-p ()
 329   "Return t if the marker stack is empty; nil otherwise."
 330   (ring-empty-p xref--marker-ring))
 331
 332 \f
 333 (defun xref--goto-location (location)
 334   "Set buffer and point according to xref-location LOCATION."
 335   (let ((marker (xref-location-marker location)))
 336     (set-buffer (marker-buffer marker))
 337     (cond ((and (<= (point-min) marker) (<= marker (point-max))))
 338           (widen-automatically (widen))
 339           (t (error "Location is outside accessible part of buffer")))
 340     (goto-char marker)))
 341
 342 (defun xref--pop-to-location (location &optional window)
 343   "Goto xref-location LOCATION and display the buffer.
 344 WINDOW controls how the buffer is displayed:
 345   nil      -- switch-to-buffer
 346   'window  -- pop-to-buffer (other window)
 347   'frame   -- pop-to-buffer (other frame)"
 348   (xref--goto-location location)
 349   (cl-ecase window
 350     ((nil)  (switch-to-buffer (current-buffer)))
 351     (window (pop-to-buffer (current-buffer) t))
 352     (frame  (let ((pop-up-frames t)) (pop-to-buffer (current-buffer) t))))
 353   (run-hooks 'xref-after-jump-hook))
 354
 355 \f
 356 ;;; XREF buffer (part of the UI)
 357
 358 ;; The xref buffer is used to display a set of xrefs.
 359
 360 (defvar-local xref--display-history nil
 361   "List of pairs (BUFFER . WINDOW), for temporarily displayed buffers.")
 362
 363 (defvar-local xref--temporary-buffers nil
 364   "List of buffers created by xref code.")
 365
 366 (defvar-local xref--current nil
 367   "Non-nil if this buffer was once current, except while displaying xrefs.
 368 Used for temporary buffers.")
 369
 370 (defvar xref--inhibit-mark-current nil)
 371
 372 (defun xref--mark-selected ()
 373   (unless xref--inhibit-mark-current
 374     (setq xref--current t))
 375   (remove-hook 'buffer-list-update-hook #'xref--mark-selected t))
 376
 377 (defun xref--save-to-history (buf win)
 378   (let ((restore (window-parameter win 'quit-restore)))
 379     ;; Save the new entry if the window displayed another buffer
 380     ;; previously.
 381     (when (and restore (not (eq (car restore) 'same)))
 382       (push (cons buf win) xref--display-history))))
 383
 384 (defun xref--display-position (pos other-window xref-buf)
 385   ;; Show the location, but don't hijack focus.
 386   (with-selected-window (display-buffer (current-buffer) other-window)
 387     (goto-char pos)
 388     (run-hooks 'xref-after-jump-hook)
 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 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 faces.
 526   (cl-loop for ((group . xrefs) . more1) on xref-alist
 527            for max-line-width =
 528            (cl-loop for xref in xrefs
 529                     maximize (let ((line (xref-location-line
 530                                           (oref xref location))))
 531                                (length (and line (format "%d" line)))))
 532            for line-format = (and max-line-width
 533                                   (format "%%%dd: " max-line-width))
 534            do
 535            (xref--insert-propertized '(face compilation-info) group "\n")
 536            (cl-loop for (xref . more2) on xrefs do
 537                     (with-slots (description location) xref
 538                       (let* ((line (xref-location-line location))
 539                              (prefix
 540                               (if line
 541                                   (propertize (format line-format line)
 542                                               'face 'compilation-line-number)
 543                                 "  ")))
 544                         (xref--insert-propertized
 545                          (list 'xref-location location
 546                                ;; 'face 'font-lock-keyword-face
 547                                'mouse-face 'highlight
 548                                'keymap xref--button-map
 549                                'help-echo
 550                                (concat "mouse-2: display in another window, "
 551                                        "RET or mouse-1: follow reference"))
 552                          prefix description)))
 553                     (insert "\n"))))
 554
 555 (defun xref--analyze (xrefs)
 556   "Find common filenames in XREFS.
 557 Return an alist of the form ((FILENAME . (XREF ...)) ...)."
 558   (xref--alistify xrefs
 559                   (lambda (x)
 560                     (xref-location-group (xref--xref-location x)))
 561                   #'equal))
 562
 563 (defun xref--show-xref-buffer (xrefs alist)
 564   (let ((xref-alist (xref--analyze xrefs)))
 565     (with-current-buffer (get-buffer-create xref-buffer-name)
 566       (let ((inhibit-read-only t))
 567         (erase-buffer)
 568         (xref--insert-xrefs xref-alist)
 569         (xref--xref-buffer-mode)
 570         (pop-to-buffer (current-buffer))
 571         (goto-char (point-min))
 572         (setq xref--window (assoc-default 'window alist))
 573         (setq xref--temporary-buffers (assoc-default 'temporary-buffers alist))
 574         (dolist (buf xref--temporary-buffers)
 575           (with-current-buffer buf
 576             (add-hook 'buffer-list-update-hook #'xref--mark-selected nil t)))
 577         (current-buffer)))))
 578
 579 \f
 580 ;; This part of the UI seems fairly uncontroversial: it reads the
 581 ;; identifier and deals with the single definition case.
 582 ;;
 583 ;; The controversial multiple definitions case is handed off to
 584 ;; xref-show-xrefs-function.
 585
 586 (defvar xref-show-xrefs-function 'xref--show-xref-buffer
 587   "Function to display a list of xrefs.")
 588
 589 (defvar xref--read-identifier-history nil)
 590
 591 (defvar xref--read-pattern-history nil)
 592
 593 (defun xref--show-xrefs (input kind arg window)
 594   (let* ((bl (buffer-list))
 595          (xrefs (funcall xref-find-function kind arg))
 596          (tb (cl-set-difference (buffer-list) bl)))
 597     (cond
 598      ((null xrefs)
 599       (user-error "No %s found for: %s" (symbol-name kind) input))
 600      ((not (cdr xrefs))
 601       (xref-push-marker-stack)
 602       (xref--pop-to-location (xref--xref-location (car xrefs)) window))
 603      (t
 604       (xref-push-marker-stack)
 605       (funcall xref-show-xrefs-function xrefs
 606                `((window . ,window)
 607                  (temporary-buffers . ,tb)))))))
 608
 609 (defun xref--prompt-p (command)
 610   (or (eq xref-prompt-for-identifier t)
 611       (if (eq (car xref-prompt-for-identifier) 'not)
 612           (not (memq command (cdr xref-prompt-for-identifier)))
 613         (memq command xref-prompt-for-identifier))))
 614
 615 (defun xref--read-identifier (prompt)
 616   "Return the identifier at point or read it from the minibuffer."
 617   (let ((id (funcall xref-identifier-at-point-function)))
 618     (cond ((or current-prefix-arg
 619                (not id)
 620                (xref--prompt-p this-command))
 621            (completing-read (if id
 622                                 (format "%s (default %s): "
 623                                         (substring prompt 0 (string-match
 624                                                              "[ :]+\\'" prompt))
 625                                         id)
 626                               prompt)
 627                             (funcall xref-identifier-completion-table-function)
 628                             nil nil nil
 629                             'xref--read-identifier-history id))
 630           (t id))))
 631
 632 \f
 633 ;;; Commands
 634
 635 (defun xref--find-definitions (id window)
 636   (xref--show-xrefs id 'definitions id window))
 637
 638 ;;;###autoload
 639 (defun xref-find-definitions (identifier)
 640   "Find the definition of the identifier at point.
 641 With prefix argument or when there's no identifier at point,
 642 prompt for it."
 643   (interactive (list (xref--read-identifier "Find definitions of: ")))
 644   (xref--find-definitions identifier nil))
 645
 646 ;;;###autoload
 647 (defun xref-find-definitions-other-window (identifier)
 648   "Like `xref-find-definitions' but switch to the other window."
 649   (interactive (list (xref--read-identifier "Find definitions of: ")))
 650   (xref--find-definitions identifier 'window))
 651
 652 ;;;###autoload
 653 (defun xref-find-definitions-other-frame (identifier)
 654   "Like `xref-find-definitions' but switch to the other frame."
 655   (interactive (list (xref--read-identifier "Find definitions of: ")))
 656   (xref--find-definitions identifier 'frame))
 657
 658 ;;;###autoload
 659 (defun xref-find-references (identifier)
 660   "Find references to the identifier at point.
 661 With prefix argument, prompt for the identifier."
 662   (interactive (list (xref--read-identifier "Find references of: ")))
 663   (xref--show-xrefs identifier 'references identifier nil))
 664
 665 ;;;###autoload
 666 (defun xref-find-regexp (regexp)
 667   "Find all matches for REGEXP.
 668 With \\[universal-argument] prefix, you can specify the directory
 669 to search in, and the file name pattern to search for."
 670   (interactive (list (xref--read-identifier "Find regexp: ")))
 671   (let* ((proj (project-current))
 672          (files (if current-prefix-arg
 673                     (grep-read-files regexp)
 674                   "*.*"))
 675          (dirs (if current-prefix-arg
 676                    (list (read-directory-name "Base directory: "
 677                                               nil default-directory t))
 678                  (project--prune-directories
 679                   (nconc
 680                    (project-directories proj)
 681                    (project-search-path proj)))))
 682          (xref-find-function
 683           (lambda (_kind regexp)
 684             (cl-mapcan
 685              (lambda (dir)
 686                (xref-collect-matches regexp files dir (project-ignores proj)))
 687              dirs))))
 688     (xref--show-xrefs regexp 'matches regexp nil)))
 689
 690 (declare-function apropos-parse-pattern "apropos" (pattern))
 691
 692 ;;;###autoload
 693 (defun xref-find-apropos (pattern)
 694   "Find all meaningful symbols that match PATTERN.
 695 The argument has the same meaning as in `apropos'."
 696   (interactive (list (read-string
 697                       "Search for pattern (word list or regexp): "
 698                       nil 'xref--read-pattern-history)))
 699   (require 'apropos)
 700   (xref--show-xrefs pattern 'apropos
 701                     (apropos-parse-pattern
 702                      (if (string-equal (regexp-quote pattern) pattern)
 703                          ;; Split into words
 704                          (or (split-string pattern "[ \t]+" t)
 705                              (user-error "No word list given"))
 706                        pattern))
 707                     nil))
 708
 709 \f
 710 ;;; Key bindings
 711
 712 ;;;###autoload (define-key esc-map "." #'xref-find-definitions)
 713 ;;;###autoload (define-key esc-map "," #'xref-pop-marker-stack)
 714 ;;;###autoload (define-key esc-map "?" #'xref-find-references)
 715 ;;;###autoload (define-key esc-map [?\C-.] #'xref-find-apropos)
 716 ;;;###autoload (define-key ctl-x-4-map "." #'xref-find-definitions-other-window)
 717 ;;;###autoload (define-key ctl-x-5-map "." #'xref-find-definitions-other-frame)
 718
 719 \f
 720 ;;; Helper functions
 721
 722 (defvar xref-etags-mode--saved nil)
 723
 724 (define-minor-mode xref-etags-mode
 725   "Minor mode to make xref use etags again.
 726
 727 Certain major modes install their own mechanisms for listing
 728 identifiers and navigation.  Turn this on to undo those settings
 729 and just use etags."
 730   :lighter ""
 731   (if xref-etags-mode
 732       (progn
 733         (setq xref-etags-mode--saved
 734               (cons xref-find-function
 735                     xref-identifier-completion-table-function))
 736         (kill-local-variable 'xref-find-function)
 737         (kill-local-variable 'xref-identifier-completion-table-function))
 738     (setq-local xref-find-function (car xref-etags-mode--saved))
 739     (setq-local xref-identifier-completion-table-function
 740                 (cdr xref-etags-mode--saved))))
 741
 742 (declare-function semantic-symref-find-references-by-name "semantic/symref")
 743 (declare-function semantic-symref-find-text "semantic/symref")
 744 (declare-function semantic-find-file-noselect "semantic/fw")
 745 (declare-function grep-read-files "grep")
 746 (declare-function grep-expand-template "grep")
 747
 748 (defun xref-collect-references (symbol dir)
 749   "Collect references to SYMBOL inside DIR.
 750 This function uses the Semantic Symbol Reference API, see
 751 `semantic-symref-find-references-by-name' for details on which
 752 tools are used, and when."
 753   (cl-assert (directory-name-p dir))
 754   (require 'semantic/symref)
 755   (defvar semantic-symref-tool)
 756   (let* ((default-directory dir)
 757          (semantic-symref-tool 'detect)
 758          (res (semantic-symref-find-references-by-name symbol 'subdirs))
 759          (hits (and res (oref res hit-lines)))
 760          (orig-buffers (buffer-list)))
 761     (unwind-protect
 762         (delq nil
 763               (mapcar (lambda (hit) (xref--collect-match
 764                                 hit (format "\\_<%s\\_>" (regexp-quote symbol))))
 765                       hits))
 766       (mapc #'kill-buffer
 767             (cl-set-difference (buffer-list) orig-buffers)))))
 768
 769 (defun xref-collect-matches (regexp files dir ignores)
 770   "Collect matches for REGEXP inside FILES in DIR.
 771 FILES is a string with glob patterns separated by spaces.
 772 IGNORES is a list of glob patterns."
 773   (cl-assert (directory-name-p dir))
 774   (require 'semantic/fw)
 775   (grep-compute-defaults)
 776   (defvar grep-find-template)
 777   (defvar grep-highlight-matches)
 778   (let* ((grep-find-template (replace-regexp-in-string "-e " "-E "
 779                                                        grep-find-template t t))
 780          (grep-highlight-matches nil)
 781          (command (xref--rgrep-command (xref--regexp-to-extended regexp)
 782                                        files dir ignores))
 783          (orig-buffers (buffer-list))
 784          (buf (get-buffer-create " *xref-grep*"))
 785          (grep-re (caar grep-regexp-alist))
 786          hits)
 787     (with-current-buffer buf
 788       (erase-buffer)
 789       (call-process-shell-command command nil t)
 790       (goto-char (point-min))
 791       (while (re-search-forward grep-re nil t)
 792         (push (cons (string-to-number (match-string 2))
 793                     (match-string 1))
 794               hits)))
 795     (unwind-protect
 796         (delq nil
 797               (mapcar (lambda (hit) (xref--collect-match hit regexp))
 798                       (nreverse hits)))
 799       (mapc #'kill-buffer
 800             (cl-set-difference (buffer-list) orig-buffers)))))
 801
 802 (defun xref--rgrep-command (regexp files dir ignores)
 803   (require 'find-dired)      ; for `find-name-arg'
 804   (defvar grep-find-template)
 805   (defvar find-name-arg)
 806   (grep-expand-template
 807    grep-find-template
 808    regexp
 809    (concat (shell-quote-argument "(")
 810            " " find-name-arg " "
 811            (mapconcat
 812             #'shell-quote-argument
 813             (split-string files)
 814             (concat " -o " find-name-arg " "))
 815            " "
 816            (shell-quote-argument ")"))
 817    dir
 818    (concat
 819     (shell-quote-argument "(")
 820     " -path "
 821     (mapconcat
 822      (lambda (ignore)
 823        (when (string-match "\\(\\.\\)/" ignore)
 824          (setq ignore (replace-match dir t t ignore 1)))
 825        (when (string-match-p "/\\'" ignore)
 826          (setq ignore (concat ignore "*")))
 827        (unless (string-prefix-p "*" ignore)
 828          (setq ignore (concat "*/" ignore)))
 829        (shell-quote-argument ignore))
 830      ignores
 831      " -o -path ")
 832     " "
 833     (shell-quote-argument ")")
 834     " -prune -o ")))
 835
 836 (defun xref--regexp-to-extended (str)
 837   (replace-regexp-in-string
 838    ;; FIXME: Add tests.  Move to subr.el, make a public function.
 839    ;; Maybe error on Emacs-only constructs.
 840    "\\(?:\\\\\\\\\\)*\\(?:\\\\[][]\\)?\\(?:\\[.+?\\]\\|\\(\\\\?[(){}|]\\)\\)"
 841    (lambda (str)
 842      (cond
 843       ((not (match-beginning 1))
 844        str)
 845       ((eq (length (match-string 1 str)) 2)
 846        (concat (substring str 0 (match-beginning 1))
 847                (substring (match-string 1 str) 1 2)))
 848       (t
 849        (concat (substring str 0 (match-beginning 1))
 850                "\\"
 851                (match-string 1 str)))))
 852    str t t))
 853
 854 (defun xref--collect-match (hit regexp)
 855   (pcase-let* ((`(,line . ,file) hit)
 856                (buf (or (find-buffer-visiting file)
 857                         (semantic-find-file-noselect file))))
 858     (with-current-buffer buf
 859       (save-excursion
 860         (goto-char (point-min))
 861         (forward-line (1- line))
 862         (syntax-propertize (line-end-position))
 863         (when (re-search-forward regexp (line-end-position) t)
 864           (goto-char (match-beginning 0))
 865           (xref-make (buffer-substring
 866                       (line-beginning-position)
 867                       (line-end-position))
 868                      (xref-make-file-location file line
 869                                               (current-column))))))))
 870
 871 (provide 'xref)
 872
 873 ;;; xref.el ends here