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