dotemacs

My Emacs configuration
git clone git://git.entf.net/dotemacs
Log | Files | Refs | LICENSE

xref.el (84373B)


      1 ;;; xref.el --- Cross-referencing commands              -*-lexical-binding:t-*-
      2 
      3 ;; Copyright (C) 2014-2023 Free Software Foundation, Inc.
      4 ;; Version: 1.6.3
      5 ;; Package-Requires: ((emacs "26.1"))
      6 
      7 ;; This is a GNU ELPA :core package.  Avoid functionality that is not
      8 ;; compatible with the version of Emacs recorded above.
      9 
     10 ;; This file is part of GNU Emacs.
     11 
     12 ;; GNU Emacs is free software: you can redistribute it and/or modify
     13 ;; it under the terms of the GNU General Public License as published by
     14 ;; the Free Software Foundation, either version 3 of the License, or
     15 ;; (at your option) any later version.
     16 
     17 ;; GNU Emacs is distributed in the hope that it will be useful,
     18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
     19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     20 ;; GNU General Public License for more details.
     21 
     22 ;; You should have received a copy of the GNU General Public License
     23 ;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
     24 
     25 ;;; Commentary:
     26 
     27 ;; This file provides a somewhat generic infrastructure for cross
     28 ;; referencing commands, in particular "find-definition".
     29 ;;
     30 ;; Some part of the functionality must be implemented in a language
     31 ;; dependent way and that's done by defining an xref backend.
     32 ;;
     33 ;; That consists of a constructor function, which should return a
     34 ;; backend value, and a set of implementations for the generic
     35 ;; functions:
     36 ;;
     37 ;; `xref-backend-identifier-at-point',
     38 ;; `xref-backend-identifier-completion-table',
     39 ;; `xref-backend-definitions', `xref-backend-references',
     40 ;; `xref-backend-apropos', which see.
     41 ;;
     42 ;; A major mode would normally use `add-hook' to add the backend
     43 ;; constructor to `xref-backend-functions'.
     44 ;;
     45 ;; The last three methods operate with "xref" and "location" values.
     46 ;;
     47 ;; One would usually call `xref-make' and `xref-make-file-location',
     48 ;; `xref-make-buffer-location' or `xref-make-bogus-location' to create
     49 ;; them.  More generally, a location must be an instance of a type for
     50 ;; which methods `xref-location-group' and `xref-location-marker' are
     51 ;; implemented.
     52 ;;
     53 ;; There's a special kind of xrefs we call "match xrefs", which
     54 ;; correspond to search results.  For these values,
     55 ;; `xref-match-length' must be defined, and `xref-location-marker'
     56 ;; must return the beginning of the match.
     57 ;;
     58 ;; Each identifier must be represented as a string.  Implementers can
     59 ;; use string properties to store additional information about the
     60 ;; identifier, but they should keep in mind that values returned from
     61 ;; `xref-backend-identifier-completion-table' should still be
     62 ;; distinct, because the user can't see the properties when making the
     63 ;; choice.
     64 ;;
     65 ;; Older versions of Xref used EIEIO for implementation of the
     66 ;; built-in types, and included a class called `xref-location' which
     67 ;; was supposed to be inherited from.  Neither is true anymore.
     68 ;;
     69 ;; See the etags and elisp-mode implementations for full examples.
     70 
     71 ;;; Code:
     72 
     73 (require 'cl-lib)
     74 (require 'ring)
     75 (require 'project)
     76 
     77 (eval-and-compile
     78   (when (version< emacs-version "28.0.60")
     79     ;; etags.el in Emacs 26 and 27 uses EIEIO, and its location type
     80     ;; inherits from `xref-location'.
     81     (require 'eieio)
     82 
     83     ;; Suppressing byte-compilation warnings (in Emacs 28+) about
     84     ;; `defclass' not being defined, which happens because the
     85     ;; `require' statement above is not evaluated either.
     86     ;; FIXME: Use `with-suppressed-warnings' when we stop supporting Emacs 26.
     87     (with-no-warnings
     88       (defclass xref-location () ()
     89         :documentation "(Obsolete) location represents a position in a file or buffer."))))
     90 
     91 (defgroup xref nil "Cross-referencing commands."
     92   :version "25.1"
     93   :group 'tools)
     94 
     95 
     96 ;;; Locations
     97 
     98 (cl-defgeneric xref-location-marker (location)
     99   "Return the marker for LOCATION.")
    100 
    101 (cl-defgeneric xref-location-group (location)
    102   "Return a string used to group a set of locations.
    103 This is typically a file name, but can also be a package name, or
    104 some other label.
    105 
    106 When it is a file name, it should be the \"expanded\" version.")
    107 
    108 (cl-defgeneric xref-location-line (_location)
    109   "Return the line number corresponding to the location."
    110   nil)
    111 
    112 (cl-defgeneric xref-match-length (_item)
    113   "Return the length of the match."
    114   nil)
    115 
    116 ;;;; Commonly needed location types are defined here:
    117 
    118 (defcustom xref-file-name-display 'project-relative
    119   "Style of file name display in *xref* buffers.
    120 
    121 If the value is the symbol `abs', show the file names in their
    122 full absolute form.
    123 
    124 If `nondirectory', show only the nondirectory (a.k.a. \"base name\")
    125 part of the file name.
    126 
    127 If `project-relative', the default, show only the file name
    128 relative to the current project root.  If there is no current
    129 project, or if the file resides outside of its root, show that
    130 particular file name in its full absolute form."
    131   :type '(choice (const :tag "absolute file name" abs)
    132                  (const :tag "nondirectory file name" nondirectory)
    133                  (const :tag "relative to project root" project-relative))
    134   :version "27.1")
    135 
    136 ;; FIXME: might be useful to have an optional "hint" i.e. a string to
    137 ;; search for in case the line number is slightly out of date.
    138 (cl-defstruct (xref-file-location
    139                (:constructor xref-make-file-location (file line column)))
    140   "A file location is a file/line/column triple.
    141 Line numbers start from 1 and columns from 0."
    142   file line column)
    143 
    144 (cl-defmethod xref-location-group ((l xref-file-location))
    145   (xref-file-location-file l))
    146 
    147 (cl-defmethod xref-location-line ((l xref-file-location))
    148   (xref-file-location-line l))
    149 
    150 (cl-defmethod xref-location-marker ((l xref-file-location))
    151   (pcase-let (((cl-struct xref-file-location file line column) l))
    152     (with-current-buffer
    153         (or (get-file-buffer file)
    154             (let ((find-file-suppress-same-file-warnings t))
    155               (find-file-noselect file)))
    156       (save-restriction
    157         (widen)
    158         (save-excursion
    159           (goto-char (point-min))
    160           (ignore-errors
    161             ;; xref location may be out of date; it may be past the
    162             ;; end of the current file, or the file may have been
    163             ;; deleted. Return a reasonable location; the user will
    164             ;; figure it out.
    165             (beginning-of-line line)
    166             (forward-char column))
    167           (point-marker))))))
    168 
    169 (cl-defstruct (xref-buffer-location
    170                (:constructor xref-make-buffer-location (buffer position)))
    171   buffer position)
    172 
    173 (cl-defmethod xref-location-marker ((l xref-buffer-location))
    174   (pcase-let (((cl-struct xref-buffer-location buffer position) l))
    175     (let ((m (make-marker)))
    176       (move-marker m position buffer))))
    177 
    178 (cl-defmethod xref-location-group ((l xref-buffer-location))
    179   (pcase-let (((cl-struct xref-buffer-location buffer) l))
    180     (or (buffer-file-name buffer)
    181         (format "(buffer %s)" (buffer-name buffer)))))
    182 
    183 (cl-defstruct (xref-bogus-location
    184                (:constructor xref-make-bogus-location (message)))
    185   "Bogus locations are sometimes useful to indicate errors,
    186 e.g. when we know that a function exists but the actual location
    187 is not known."
    188   message)
    189 
    190 (cl-defmethod xref-location-marker ((l xref-bogus-location))
    191   (user-error "%s" (xref-bogus-location-message l)))
    192 
    193 (cl-defmethod xref-location-group ((_ xref-bogus-location)) "(No location)")
    194 
    195 
    196 ;;; Cross-reference
    197 
    198 (defmacro xref--defstruct (name &rest fields)
    199   (declare (indent 1))
    200   `(cl-defstruct ,(if (>= emacs-major-version 27)
    201                       name
    202                     (remq (assq :noinline name) name))
    203      ,@fields))
    204 
    205 (xref--defstruct (xref-item
    206                   (:constructor xref-make (summary location))
    207                   (:noinline t))
    208   "An xref item describes a reference to a location somewhere."
    209   (summary nil :documentation "String which describes the location.
    210 
    211 When `xref-location-line' returns non-nil (a number), the summary
    212 is implied to be the contents of a file or buffer line containing
    213 the location.  When multiple locations in a row report the same
    214 line, in the same group (corresponding to the case of multiple
    215 locations on one line), the summaries are concatenated in the
    216 Xref output buffer.  Consequently, any code that creates xref
    217 values should take care to slice the summary values when several
    218 locations point to the same line.
    219 
    220 This behavior is new in Emacs 28.")
    221   location)
    222 
    223 (xref--defstruct (xref-match-item
    224                   (:include xref-item)
    225                   (:constructor xref-make-match (summary location length))
    226                   (:noinline t))
    227   "A match xref item describes a search result."
    228   length)
    229 
    230 (cl-defmethod xref-match-length ((item xref-match-item))
    231   "Return the length of the match."
    232   (xref-match-item-length item))
    233 
    234 
    235 ;;; API
    236 
    237 (defvar xref-backend-functions nil
    238   "Special hook to find the xref backend for the current context.
    239 Each function on this hook is called in turn with no arguments,
    240 and should return either nil to mean that it is not applicable,
    241 or an xref backend, which is a value to be used to dispatch the
    242 generic functions.")
    243 
    244 ;; We make the etags backend the default for now, until something
    245 ;; better comes along.  Use APPEND so that any `add-hook' calls made
    246 ;; before this package is loaded put new items before this one.
    247 (add-hook 'xref-backend-functions #'etags--xref-backend t)
    248 
    249 ;;;###autoload
    250 (defun xref-find-backend ()
    251   (run-hook-with-args-until-success 'xref-backend-functions))
    252 
    253 (cl-defgeneric xref-backend-definitions (backend identifier)
    254   "Find definitions of IDENTIFIER.
    255 
    256 The result must be a list of xref objects.  If IDENTIFIER
    257 contains sufficient information to determine a unique definition,
    258 return only that definition.  If there are multiple possible
    259 definitions, return all of them.  If no definitions can be found,
    260 return nil.
    261 
    262 IDENTIFIER can be any string returned by
    263 `xref-backend-identifier-at-point', or from the table returned by
    264 `xref-backend-identifier-completion-table'.
    265 
    266 To create an xref object, call `xref-make'.")
    267 
    268 (cl-defgeneric xref-backend-references (_backend identifier)
    269   "Find references of IDENTIFIER.
    270 The result must be a list of xref objects.  If no references can
    271 be found, return nil.
    272 
    273 The default implementation uses `semantic-symref-tool-alist' to
    274 find a search tool; by default, this uses \"find | grep\" in the
    275 current project's main and external roots."
    276   (mapcan
    277    (lambda (dir)
    278      (message "Searching %s..." dir)
    279      (redisplay)
    280      (prog1
    281          (xref-references-in-directory identifier dir)
    282        (message "Searching %s... done" dir)))
    283    (let ((pr (project-current t)))
    284      (cons
    285       (xref--project-root pr)
    286       (project-external-roots pr)))))
    287 
    288 (cl-defgeneric xref-backend-apropos (backend pattern)
    289   "Find all symbols that match PATTERN string.
    290 The second argument has the same meaning as in `apropos'.
    291 
    292 If BACKEND is implemented in Lisp, it can use
    293 `xref-apropos-regexp' to convert the pattern to regexp.")
    294 
    295 (cl-defgeneric xref-backend-identifier-at-point (_backend)
    296   "Return the relevant identifier at point.
    297 
    298 The return value must be a string, or nil meaning no identifier
    299 at point found.
    300 
    301 If it's hard to determine the identifier precisely (e.g., because
    302 it's a method call on unknown type), the implementation can
    303 return a simple string (such as symbol at point) marked with a
    304 special text property which e.g. `xref-backend-definitions' would
    305 recognize and then delegate the work to an external process."
    306   (let ((thing (thing-at-point 'symbol)))
    307     (and thing (substring-no-properties thing))))
    308 
    309 (cl-defgeneric xref-backend-identifier-completion-table (backend)
    310   "Return the completion table for identifiers.")
    311 
    312 (cl-defgeneric xref-backend-identifier-completion-ignore-case (_backend)
    313   "Return t if case is not significant in identifier completion."
    314   completion-ignore-case)
    315 
    316 
    317 ;;; misc utilities
    318 (defun xref--alistify (list key)
    319   "Partition the elements of LIST into an alist.
    320 KEY extracts the key from an element."
    321   (let ((table (make-hash-table :test #'equal)))
    322     (dolist (e list)
    323       (let* ((k (funcall key e))
    324              (probe (gethash k table)))
    325         (if probe
    326             (puthash k (cons e probe) table)
    327           (puthash k (list e) table))))
    328     ;; Put them back in order.
    329     (cl-loop for key being hash-keys of table using (hash-values value)
    330              collect (cons key (nreverse value)))))
    331 
    332 (defun xref--insert-propertized (props &rest strings)
    333   "Insert STRINGS with text properties PROPS."
    334   (let ((start (point)))
    335     (apply #'insert strings)
    336     (add-text-properties start (point) props)))
    337 
    338 (defun xref--search-property (property &optional backward)
    339     "Search the next text range where text property PROPERTY is non-nil.
    340 Return the value of PROPERTY.  If BACKWARD is non-nil, search
    341 backward."
    342   (let ((next (if backward
    343                   #'previous-single-char-property-change
    344                 #'next-single-char-property-change))
    345         (start (point))
    346         (value nil))
    347     (while (progn
    348              (goto-char (funcall next (point) property))
    349              (not (or (and
    350                        (memq (get-char-property (point) 'invisible) '(ellipsis nil))
    351                        (setq value (get-text-property (point) property)))
    352                       (eobp)
    353                       (bobp)))))
    354     (cond (value)
    355           (t (goto-char start) nil))))
    356 
    357 
    358 ;; Dummy variable retained for compatibility.
    359 (defvar xref-marker-ring-length 16)
    360 (make-obsolete-variable 'xref-marker-ring-length nil "29.1")
    361 
    362 (defcustom xref-prompt-for-identifier '(not xref-find-definitions
    363                                             xref-find-definitions-other-window
    364                                             xref-find-definitions-other-frame)
    365   "If non-nil, prompt for the identifier to find.
    366 
    367 When t, always prompt for the identifier name.
    368 
    369 When nil, prompt only when there's no value at point we can use,
    370 or when the command has been called with the prefix argument.
    371 
    372 Otherwise, it's a list of xref commands which will always prompt,
    373 with the identifier at point, if any, used as the default.
    374 If the list starts with `not', the meaning of the rest of the
    375 elements is negated: these commands will NOT prompt."
    376   :type '(choice (const :tag "Always prompt for identifier" t)
    377                  (const :tag "Prompt if no identifier at point" nil)
    378                  (set :menu-tag "Prompt according to command"
    379                       :tag "Prompt according to command"
    380 		      :value (not)
    381 		      (const :tag "Except for commands listed below" not)
    382 		      (repeat :inline t (symbol :tag "command")))))
    383 
    384 (defcustom xref-after-jump-hook '(recenter
    385                                   xref-pulse-momentarily)
    386   "Functions called after jumping to an xref.
    387 Also see `xref-current-item'."
    388   :type 'hook)
    389 
    390 (defcustom xref-after-return-hook '(xref-pulse-momentarily)
    391   "Functions called after returning to a pre-jump location."
    392   :type 'hook)
    393 
    394 (defcustom xref-after-update-hook nil
    395   "Functions called after the xref buffer is updated."
    396   :type 'hook
    397   :version "28.1"
    398   :package-version '(xref . "1.0.4"))
    399 
    400 (defcustom xref-auto-jump-to-first-definition nil
    401   "If t, `xref-find-definitions' always jumps to the first result.
    402 `show' means to show the first result's location, but keep the
    403 focus on the Xref buffer's window.
    404 `move' means to only move point to the first result.
    405 This variable also affects the variants of `xref-find-definitions',
    406 such as `xref-find-definitions-other-window'."
    407   :type '(choice (const :tag "Jump" t)
    408                  (const :tag "Show" show)
    409                  (const :tag "Move point only" move)
    410                  (const :tag "No auto-jump" nil))
    411   :version "28.1"
    412   :package-version '(xref . "1.2.0"))
    413 
    414 (defcustom xref-auto-jump-to-first-xref nil
    415   "If t, `xref-find-references' always jumps to the first result.
    416 `show' means to show the first result's location, but keep the
    417 focus on the Xref buffer's window.
    418 `move' means to only move point to the first result.
    419 This variable also affects commands similar to `xref-find-references',
    420 such as `xref-find-references-at-mouse', `xref-find-apropos',
    421 and `project-find-regexp'.
    422 
    423 Please be careful when changing the value if you are using Emacs 27
    424 or earlier: it can break `dired-do-find-regexp-and-replace'."
    425   :type '(choice (const :tag "Jump" t)
    426                  (const :tag "Show" show)
    427                  (const :tag "Move point only" move)
    428                  (const :tag "No auto-jump" nil))
    429   :version "28.1"
    430   :package-version '(xref . "1.2.0"))
    431 
    432 (defcustom xref-history-storage #'xref-global-history
    433   "Function that returns xref history.
    434 
    435 The following functions that can be used as this variable's value
    436 are predefined:
    437 
    438 - `xref-global-history'
    439     Return a single, global history used across the entire Emacs
    440     session.  This is the default.
    441 - `xref-window-local-history'
    442     Return separate xref histories, one per window.  Allows
    443     independent navigation of code in each window.  A new
    444     xref history is created for every new window."
    445   :type '(radio
    446           (function-item :tag "Per-window history" xref-window-local-history)
    447           (function-item :tag "Global history for Emacs session"
    448                          xref-global-history)
    449           (function :tag "Other"))
    450   :version "29.1"
    451   :package-version '(xref . "1.6.0"))
    452 
    453 (make-obsolete-variable 'xref--marker-ring 'xref--history "29.1")
    454 
    455 (defun xref-set-marker-ring-length (_var _val)
    456   (declare (obsolete nil "29.1"))
    457   nil)
    458 
    459 (defun xref--make-xref-history ()
    460   "Return a new xref history."
    461   (cons nil nil))
    462 
    463 (defvar xref--history (xref--make-xref-history)
    464   "(BACKWARD-STACK . FORWARD-STACK) of markers to visited Xref locations.")
    465 
    466 (defun xref-global-history (&optional new-value)
    467   "Return the xref history that is global for the current Emacs session.
    468 
    469 Override existing value with NEW-VALUE if NEW-VALUE is set."
    470   (if new-value
    471       (setq xref--history new-value)
    472     xref--history))
    473 
    474 (defun xref-window-local-history (&optional new-value)
    475   "Return window-local xref history for the selected window.
    476 
    477 Override existing value with NEW-VALUE if NEW-VALUE is set."
    478   (let ((w (selected-window)))
    479     (if new-value
    480         (set-window-parameter w 'xref--history new-value)
    481       (or (window-parameter w 'xref--history)
    482           (set-window-parameter w 'xref--history (xref--make-xref-history))))))
    483 
    484 (defun xref--get-history ()
    485   "Return xref history using xref-history-storage."
    486   (funcall xref-history-storage))
    487 
    488 (defun xref--push-backward (m)
    489   "Push marker M onto the backward history stack."
    490   (let ((history (xref--get-history)))
    491     (unless (equal m (caar history))
    492       (push m (car history)))))
    493 
    494 (defun xref--push-forward (m)
    495   "Push marker M onto the forward history stack."
    496   (let ((history (xref--get-history)))
    497     (unless (equal m (cadr history))
    498       (push m (cdr history)))))
    499 
    500 (defun xref-push-marker-stack (&optional m)
    501   "Add point M (defaults to `point-marker') to the marker stack.
    502 The future stack is erased."
    503   (xref--push-backward (or m (point-marker)))
    504   (let ((history (xref--get-history)))
    505     (dolist (mk (cdr history))
    506       (set-marker mk nil nil))
    507     (setcdr history nil)))
    508 
    509 ;;;###autoload
    510 (define-obsolete-function-alias 'xref-pop-marker-stack #'xref-go-back "29.1")
    511 
    512 ;;;###autoload
    513 (defun xref-go-back ()
    514   "Go back to the previous position in xref history.
    515 To undo, use \\[xref-go-forward]."
    516   (interactive)
    517   (let ((history (xref--get-history)))
    518     (if (null (car history))
    519         (user-error "At start of xref history")
    520       (let ((marker (pop (car history))))
    521         (xref--push-forward (point-marker))
    522         (switch-to-buffer (or (marker-buffer marker)
    523                               (user-error "The marked buffer has been deleted")))
    524         (goto-char (marker-position marker))
    525         (set-marker marker nil nil)
    526         (run-hooks 'xref-after-return-hook)))))
    527 
    528 ;;;###autoload
    529 (defun xref-go-forward ()
    530   "Got to the point where a previous \\[xref-go-back] was invoked."
    531   (interactive)
    532   (let ((history (xref--get-history)))
    533     (if (null (cdr history))
    534         (user-error "At end of xref history")
    535       (let ((marker (pop (cdr history))))
    536         (xref--push-backward (point-marker))
    537         (switch-to-buffer (or (marker-buffer marker)
    538                               (user-error "The marked buffer has been deleted")))
    539         (goto-char (marker-position marker))
    540         (set-marker marker nil nil)
    541         (run-hooks 'xref-after-return-hook)))))
    542 
    543 (define-obsolete-variable-alias
    544   'xref--current-item
    545   'xref-current-item
    546   "29.1")
    547 
    548 (defvar xref-current-item nil
    549   "Dynamically bound to the current item being processed.
    550 This can be used from `xref-after-jump-hook', for instance.")
    551 
    552 (defun xref-pulse-momentarily ()
    553   (pcase-let ((`(,beg . ,end)
    554                (save-excursion
    555                  (or
    556                   (let ((length (xref-match-length xref-current-item)))
    557                     (and length (cons (point) (+ (point) length))))
    558                   (back-to-indentation)
    559                   (if (eolp)
    560                       (cons (line-beginning-position) (1+ (point)))
    561                     (cons (point) (line-end-position)))))))
    562     (pulse-momentary-highlight-region beg end 'next-error)))
    563 
    564 ;; etags.el needs this
    565 (defun xref-clear-marker-stack ()
    566   "Discard all markers from the xref history."
    567   (let ((history (xref--get-history)))
    568     (dolist (l (list (car history) (cdr history)))
    569       (dolist (m l)
    570         (set-marker m nil nil)))
    571     (setcar history nil)
    572     (setcdr history nil))
    573   nil)
    574 
    575 ;;;###autoload
    576 (defun xref-marker-stack-empty-p ()
    577   "Whether the xref back-history is empty."
    578   (null (car (xref--get-history))))
    579 ;; FIXME: rename this to `xref-back-history-empty-p'.
    580 
    581 ;;;###autoload
    582 (defun xref-forward-history-empty-p ()
    583   "Whether the xref forward-history is empty."
    584   (null (cdr (xref--get-history))))
    585 
    586 
    587 (defun xref--goto-char (pos)
    588   (cond
    589    ((and (<= (point-min) pos) (<= pos (point-max))))
    590    (widen-automatically (widen))
    591    (t (user-error "Position is outside accessible part of buffer")))
    592   (goto-char pos))
    593 
    594 (defun xref--goto-location (location)
    595   "Set buffer and point according to `xref-location' LOCATION."
    596   (let ((marker (xref-location-marker location)))
    597     (set-buffer (marker-buffer marker))
    598     (xref--goto-char marker)))
    599 
    600 (defun xref-pop-to-location (item &optional action)
    601   "Go to the location of ITEM and display the buffer.
    602 ACTION controls how the buffer is displayed:
    603   nil      -- `switch-to-buffer'
    604   `window' -- `pop-to-buffer' (other window)
    605   `frame'  -- `pop-to-buffer' (other frame)
    606 If SELECT is non-nil, select the target window."
    607   (let* ((marker (save-excursion
    608                    (xref-location-marker (xref-item-location item))))
    609          (buf (marker-buffer marker)))
    610     (cl-ecase action
    611       ((nil)  (switch-to-buffer buf))
    612       (window (pop-to-buffer buf t))
    613       (frame  (let ((pop-up-frames t)) (pop-to-buffer buf t))))
    614     (xref--goto-char marker))
    615   (let ((xref-current-item item))
    616     (run-hooks 'xref-after-jump-hook)))
    617 
    618 
    619 ;;; XREF buffer (part of the UI)
    620 
    621 ;; The xref buffer is used to display a set of xrefs.
    622 (defconst xref-buffer-name "*xref*"
    623   "The name of the buffer to show xrefs.")
    624 
    625 (defface xref-file-header '((t :inherit compilation-info))
    626   "Face used to highlight file header in the xref buffer."
    627   :version "27.1")
    628 
    629 (defface xref-line-number '((t :inherit compilation-line-number))
    630   "Face for displaying line numbers in the xref buffer."
    631   :version "27.1")
    632 
    633 (defface xref-match '((t :inherit match))
    634   "Face used to highlight matches in the xref buffer."
    635   :version "27.1")
    636 
    637 (defmacro xref--with-dedicated-window (&rest body)
    638   `(let* ((xref-w (get-buffer-window xref-buffer-name))
    639           (xref-w-dedicated (window-dedicated-p xref-w)))
    640      (unwind-protect
    641          (progn
    642            (when xref-w
    643              (set-window-dedicated-p xref-w 'soft))
    644            ,@body)
    645        (when xref-w
    646          (set-window-dedicated-p xref-w xref-w-dedicated)))))
    647 
    648 (defvar-local xref--original-window-intent nil
    649   "Original window-switching intent before xref buffer creation.")
    650 
    651 (defvar-local xref--original-window nil
    652   "The original window this xref buffer was created from.")
    653 
    654 (defvar-local xref--fetcher nil
    655   "The original function to call to fetch the list of xrefs.")
    656 
    657 (defun xref--show-pos-in-buf (pos buf)
    658   "Goto and display position POS of buffer BUF in a window.
    659 Honor `xref--original-window-intent', run `xref-after-jump-hook'
    660 and finally return the window."
    661   (let* ((pop-up-frames
    662           (or (eq xref--original-window-intent 'frame)
    663               pop-up-frames))
    664          (action
    665           (cond ((eq xref--original-window-intent 'frame)
    666                  t)
    667                 ((eq xref--original-window-intent 'window)
    668                  `((xref--display-buffer-in-other-window)
    669                    (window . ,xref--original-window)))
    670                 ((and
    671                   (window-live-p xref--original-window)
    672                   (or (not (window-dedicated-p xref--original-window))
    673                       (eq (window-buffer xref--original-window) buf)))
    674                  `((xref--display-buffer-in-window)
    675                    (window . ,xref--original-window))))))
    676     (with-selected-window (display-buffer buf action)
    677       (xref--goto-char pos)
    678       (run-hooks 'xref-after-jump-hook)
    679       (selected-window))))
    680 
    681 (defun xref--display-buffer-in-other-window (buffer alist)
    682   (let ((window (assoc-default 'window alist)))
    683     (cl-assert window)
    684     (xref--with-dedicated-window
    685      (with-selected-window window
    686        (display-buffer buffer t)))))
    687 
    688 (defun xref--display-buffer-in-window (buffer alist)
    689   (let ((window (assoc-default 'window alist)))
    690     (cl-assert window)
    691     (with-selected-window window
    692       (display-buffer buffer '(display-buffer-same-window)))))
    693 
    694 (defun xref--show-location (location &optional select)
    695   "Help `xref-show-xref' and `xref-goto-xref' do their job.
    696 Go to LOCATION and if SELECT is non-nil select its window.
    697 If SELECT is `quit', also quit the *xref* window."
    698   (condition-case err
    699       (let* ((marker (xref-location-marker location))
    700              (buf (marker-buffer marker))
    701              (xref-buffer (current-buffer)))
    702         (cond (select
    703                (if (eq select 'quit) (quit-window nil nil))
    704                (let* ((old-frame (selected-frame))
    705                       (window (with-current-buffer xref-buffer
    706                                 (xref--show-pos-in-buf marker buf)))
    707                       (frame (window-frame window)))
    708                  ;; If we chose another frame, make sure it gets input
    709                  ;; focus.
    710                  (unless (eq frame old-frame)
    711                    (select-frame-set-input-focus frame))
    712                  (select-window window)))
    713               (t
    714                (save-selected-window
    715                  (xref--with-dedicated-window
    716                   (xref--show-pos-in-buf marker buf))))))
    717     (user-error (message (error-message-string err)))))
    718 
    719 (defun xref--set-arrow ()
    720   "Set the overlay arrow at the line at point."
    721   (setq overlay-arrow-position
    722         (set-marker (or overlay-arrow-position (make-marker))
    723                     (line-beginning-position))))
    724 
    725 (defun xref-show-location-at-point ()
    726   "Display the source of xref at point in the appropriate window, if any."
    727   (interactive)
    728   (let* ((xref (xref--item-at-point))
    729          (xref-current-item xref))
    730     (when xref
    731       (xref--set-arrow)
    732       (xref--show-location (xref-item-location xref)))))
    733 
    734 (defun xref-next-line-no-show ()
    735   "Move to the next xref but don't display its source."
    736   (interactive)
    737   (xref--search-property 'xref-item))
    738 
    739 (defun xref-next-line ()
    740   "Move to the next xref and display its source in the appropriate window."
    741   (interactive)
    742   (xref-next-line-no-show)
    743   (xref-show-location-at-point))
    744 
    745 (defun xref-prev-line-no-show ()
    746   "Move to the previous xref but don't display its source."
    747   (interactive)
    748   (xref--search-property 'xref-item t))
    749 
    750 (defun xref-prev-line ()
    751   "Move to the previous xref and display its source in the appropriate window."
    752   (interactive)
    753   (xref-prev-line-no-show)
    754   (xref-show-location-at-point))
    755 
    756 (defun xref-next-group ()
    757   "Move to the first item of the next xref group and display its source."
    758   (interactive)
    759   (xref--search-property 'xref-group)
    760   (xref--search-property 'xref-item)
    761   (xref-show-location-at-point))
    762 
    763 (defun xref-prev-group ()
    764   "Move to the first item of the previous xref group and display its source."
    765   (interactive)
    766   ;; Search for the xref group of the current item, provided that the
    767   ;; point is not already in an xref group.
    768   (unless (plist-member (text-properties-at (point)) 'xref-group)
    769     (xref--search-property 'xref-group t))
    770   ;; Search for the previous xref group.
    771   (xref--search-property 'xref-group t)
    772   (xref--search-property 'xref-item)
    773   (xref-show-location-at-point))
    774 
    775 (defun xref--item-at-point ()
    776   (get-text-property
    777    (if (eolp) (1- (point)) (point))
    778    'xref-item))
    779 
    780 (defun xref-goto-xref (&optional quit)
    781   "Jump to the xref on the current line and select its window.
    782 If QUIT is non-nil (interactively, with prefix argument), also
    783 quit the *xref* buffer."
    784   (interactive "P")
    785   (let* ((buffer (current-buffer))
    786          (xref (or (xref--item-at-point)
    787                    (user-error "Choose a reference to visit")))
    788          (xref-current-item xref))
    789     (xref--set-arrow)
    790     (xref--show-location (xref-item-location xref) (if quit 'quit t))
    791     (if (fboundp 'next-error-found)
    792         (next-error-found buffer (current-buffer))
    793       ;; Emacs < 27
    794       (setq next-error-last-buffer buffer))))
    795 
    796 (defun xref-quit-and-goto-xref ()
    797   "Quit *xref* buffer, then jump to xref on current line."
    798   (interactive)
    799   (xref-goto-xref t))
    800 
    801 (defun xref-quit-and-pop-marker-stack ()
    802   "Quit *xref* buffer, then pop the xref marker stack."
    803   (interactive)
    804   (quit-window)
    805   (xref-go-back))
    806 
    807 (defun xref-query-replace-in-results (from to)
    808   "Perform interactive replacement of FROM with TO in all displayed xrefs.
    809 
    810 This function interactively replaces FROM with TO in the names of the
    811 references displayed in the current *xref* buffer.
    812 
    813 When called interactively, it uses '.*' as FROM, which means replace
    814 the whole name, and prompts the user for TO.
    815 If invoked with prefix argument, it prompts the user for both FROM and TO.
    816 
    817 As each match is found, the user must type a character saying
    818 what to do with it.  Type SPC or `y' to replace the match,
    819 DEL or `n' to skip and go to the next match.  For more directions,
    820 type \\[help-command] at that time.
    821 
    822 Note that this function cannot be used in *xref* buffers that show
    823 a partial list of all references, such as the *xref* buffer created
    824 by \\[xref-find-definitions] and its variants, since those list only
    825 some of the references to the identifiers."
    826   (interactive
    827    (let* ((fr
    828            (if current-prefix-arg
    829                (read-regexp "Query-replace (regexp)" ".*")
    830              ".*"))
    831           (prompt (if current-prefix-arg
    832                       (format "Query-replace (regexp) %s with: " fr)
    833                     "Query-replace all matches with: ")))
    834      (list fr (read-regexp prompt))))
    835   (let* (item xrefs iter)
    836     (save-excursion
    837       (while (setq item (xref--search-property 'xref-item))
    838         (when (xref-match-length item)
    839           (push item xrefs))))
    840     (unwind-protect
    841         (progn
    842           (goto-char (point-min))
    843           (setq iter (xref--buf-pairs-iterator (nreverse xrefs)))
    844           (xref--query-replace-1 from to iter))
    845       (funcall iter :cleanup))))
    846 
    847 (defun xref--buf-pairs-iterator (xrefs)
    848   (let (chunk-done item next-pair file-buf pairs all-pairs)
    849     (lambda (action)
    850       (pcase action
    851         (:next
    852          (when (or xrefs next-pair)
    853            (setq chunk-done nil)
    854            (when next-pair
    855              (setq file-buf (marker-buffer (car next-pair))
    856                    pairs (list next-pair)
    857                    next-pair nil))
    858            (while (and (not chunk-done)
    859                        (setq item (pop xrefs)))
    860              (save-excursion
    861                (let* ((loc (xref-item-location item))
    862                       (beg (xref-location-marker loc))
    863                       (end (move-marker (make-marker)
    864                                         (+ beg (xref-match-length item))
    865                                         (marker-buffer beg))))
    866                  (let ((pair (cons beg end)))
    867                    (push pair all-pairs)
    868                    ;; Perform sanity check first.
    869                    (xref--goto-location loc)
    870                    (if (xref--outdated-p item)
    871                        (message "Search result out of date, skipping")
    872                      (cond
    873                       ((null file-buf)
    874                        (setq file-buf (marker-buffer beg))
    875                        (push pair pairs))
    876                       ((equal file-buf (marker-buffer beg))
    877                        (push pair pairs))
    878                       (t
    879                        (setq chunk-done t
    880                              next-pair pair))))))))
    881            (cons file-buf (nreverse pairs))))
    882         (:cleanup
    883          (dolist (pair all-pairs)
    884            (move-marker (car pair) nil)
    885            (move-marker (cdr pair) nil)))))))
    886 
    887 (defun xref--outdated-p (item)
    888   "Check that the match location at current position is up-to-date.
    889 
    890 ITEM is an xref item which is expected to be produced by a search
    891 command and have summary that matches buffer contents near point.
    892 Depending on whether it's the first of the matches on the line,
    893 the summary should either start from bol, or only match after
    894 point."
    895   ;; FIXME: The check should most likely be a generic function instead
    896   ;; of the assumption that all matches' summaries relate to the
    897   ;; buffer text in a particular way.
    898   (let* ((summary (xref-item-summary item))
    899          ;; Sometimes buffer contents include ^M, and sometimes Grep
    900          ;; output includes it, and they don't always match.
    901          (strip (lambda (s) (if (string-match "\r\\'" s)
    902                            (substring-no-properties s 0 -1)
    903                          s)))
    904          (stripped-summary (funcall strip summary))
    905          (lendpos (line-end-position))
    906          (check (lambda ()
    907                   (let ((comparison-end
    908                          (+ (point) (length stripped-summary))))
    909                     (and (>= lendpos comparison-end)
    910                          (equal stripped-summary
    911                                 (buffer-substring-no-properties
    912                                  (point) comparison-end)))))))
    913     (not
    914      (or
    915       ;; Either summary contains match text and after
    916       ;; (2nd+ match on the line)...
    917       (funcall check)
    918       ;; ...or it starts at bol, includes the match and after.
    919       (and (< (point) (+ (line-beginning-position)
    920                          (length stripped-summary)))
    921            (save-excursion
    922              (forward-line 0)
    923              (funcall check)))))))
    924 
    925 ;; FIXME: Write a nicer UI.
    926 (defun xref--query-replace-1 (from to iter)
    927   (let* ((query-replace-lazy-highlight nil)
    928          (continue t)
    929          did-it-once buf-pairs pairs
    930          current-beg current-end
    931          ;; Counteract the "do the next match now" hack in
    932          ;; `perform-replace'.  And still, it'll report that those
    933          ;; matches were "filtered out" at the end.
    934          (isearch-filter-predicate
    935           (lambda (beg end)
    936             (and current-beg
    937                  (>= beg current-beg)
    938                  (<= end current-end))))
    939          (replace-re-search-function
    940           (lambda (from &optional _bound noerror)
    941             (let (found pair)
    942               (while (and (not found) pairs)
    943                 (setq pair (pop pairs)
    944                       current-beg (car pair)
    945                       current-end (cdr pair))
    946                 (goto-char current-beg)
    947                 (when (re-search-forward from current-end noerror)
    948                   (setq found t)))
    949               found))))
    950     (while (and continue (setq buf-pairs (funcall iter :next)))
    951       (if did-it-once
    952           ;; Reuse the same window for subsequent buffers.
    953           (switch-to-buffer (car buf-pairs))
    954         (xref--with-dedicated-window
    955          (pop-to-buffer (car buf-pairs)))
    956         (setq did-it-once t))
    957       (setq pairs (cdr buf-pairs))
    958       (setq continue
    959             (perform-replace from to t t nil nil multi-query-replace-map)))
    960     (unless did-it-once
    961       (user-error
    962        "Cannot perform global renaming of symbols using find-definition results"))
    963     (when (and continue (not buf-pairs))
    964       (message "All results processed"))))
    965 
    966 (defvar xref--xref-buffer-mode-map
    967   (let ((map (make-sparse-keymap)))
    968     (define-key map (kbd "n") #'xref-next-line)
    969     (define-key map (kbd "p") #'xref-prev-line)
    970     (define-key map (kbd "N") #'xref-next-group)
    971     (define-key map (kbd "P") #'xref-prev-group)
    972     (define-key map (kbd "r") #'xref-query-replace-in-results)
    973     (define-key map (kbd "RET") #'xref-goto-xref)
    974     (define-key map (kbd "TAB")  #'xref-quit-and-goto-xref)
    975     (define-key map (kbd "C-o") #'xref-show-location-at-point)
    976     ;; suggested by Johan Claesson "to further reduce finger movement":
    977     (define-key map (kbd ".") #'xref-next-line)
    978     (define-key map (kbd ",") #'xref-prev-line)
    979     (define-key map (kbd "g") #'xref-revert-buffer)
    980     (define-key map (kbd "M-,") #'xref-quit-and-pop-marker-stack)
    981     map))
    982 
    983 (declare-function outline-search-text-property "outline"
    984                   (property &optional value bound move backward looking-at))
    985 
    986 (define-derived-mode xref--xref-buffer-mode special-mode "XREF"
    987   "Mode for displaying cross-references."
    988   (setq buffer-read-only t)
    989   (setq next-error-function #'xref--next-error-function)
    990   (setq next-error-last-buffer (current-buffer))
    991   (setq imenu-prev-index-position-function
    992         #'xref--imenu-prev-index-position)
    993   (setq imenu-extract-index-name-function
    994         #'xref--imenu-extract-index-name)
    995   (setq-local add-log-current-defun-function
    996               #'xref--add-log-current-defun)
    997   (setq-local outline-minor-mode-cycle t)
    998   (setq-local outline-minor-mode-use-buttons 'insert)
    999   (setq-local outline-search-function
   1000               (lambda (&optional bound move backward looking-at)
   1001                 (outline-search-text-property
   1002                  'xref-group nil bound move backward looking-at)))
   1003   (setq-local outline-level (lambda () 1)))
   1004 
   1005 (defvar xref--transient-buffer-mode-map
   1006   (let ((map (make-sparse-keymap)))
   1007     (define-key map (kbd "RET") #'xref-quit-and-goto-xref)
   1008     (set-keymap-parent map xref--xref-buffer-mode-map)
   1009     map))
   1010 
   1011 (define-derived-mode xref--transient-buffer-mode
   1012   xref--xref-buffer-mode
   1013   "XREF Transient.")
   1014 
   1015 (defun xref--imenu-prev-index-position ()
   1016   "Move point to previous line in `xref' buffer.
   1017 This function is used as a value for
   1018 `imenu-prev-index-position-function'."
   1019   (if (bobp)
   1020       nil
   1021     (xref--search-property 'xref-group t)))
   1022 
   1023 (defun xref--imenu-extract-index-name ()
   1024   "Return imenu name for line at point.
   1025 This function is used as a value for
   1026 `imenu-extract-index-name-function'.  Point should be at the
   1027 beginning of the line."
   1028   (buffer-substring-no-properties (line-beginning-position)
   1029                                   (line-end-position)))
   1030 
   1031 (defun xref--add-log-current-defun ()
   1032   "Return the string used to group a set of locations.
   1033 This function is used as a value for `add-log-current-defun-function'."
   1034   (xref--group-name-for-display
   1035    (if-let (item (xref--item-at-point))
   1036        (xref-location-group (xref-match-item-location item))
   1037      (xref--imenu-extract-index-name))
   1038    (xref--project-root (project-current))))
   1039 
   1040 (defun xref--next-error-function (n reset?)
   1041   (when reset?
   1042     (goto-char (point-min)))
   1043   (let ((backward (< n 0))
   1044         (n (abs n))
   1045         (xref nil))
   1046     (if (= n 0)
   1047         (setq xref (get-text-property (point) 'xref-item))
   1048       (dotimes (_ n)
   1049         (setq xref (xref--search-property 'xref-item backward))))
   1050     (cond (xref
   1051            ;; Save the current position (when the buffer is visible,
   1052            ;; it gets reset to that window's point from time to time).
   1053            (let ((win (get-buffer-window (current-buffer))))
   1054              (and win (set-window-point win (point))))
   1055            (xref--set-arrow)
   1056            (let ((xref-current-item xref))
   1057              (xref--show-location (xref-item-location xref) t)))
   1058           (t
   1059            (error "No %s xref" (if backward "previous" "next"))))))
   1060 
   1061 (defvar xref--button-map
   1062   (let ((map (make-sparse-keymap)))
   1063     (define-key map [follow-link] 'mouse-face)
   1064     (define-key map [mouse-2] #'xref-goto-xref)
   1065     map))
   1066 
   1067 (defun xref-select-and-show-xref (event)
   1068   "Move point to the button and show the xref definition.
   1069 The window showing the xref buffer will be selected."
   1070   (interactive "e")
   1071   (mouse-set-point event)
   1072   (forward-line 0)
   1073   (or (get-text-property (point) 'xref-item)
   1074       (xref--search-property 'xref-item))
   1075   (xref-show-location-at-point))
   1076 
   1077 (define-obsolete-function-alias
   1078   'xref--mouse-2 #'xref-select-and-show-xref "28.1")
   1079 
   1080 (defcustom xref-truncation-width 400
   1081   "The column to visually \"truncate\" each Xref buffer line to."
   1082   :type '(choice
   1083           (integer :tag "Number of columns")
   1084           (const :tag "Disable truncation" nil)))
   1085 
   1086 (defun xref--apply-truncation ()
   1087   (let ((bol (line-beginning-position))
   1088         (eol (line-end-position))
   1089         (inhibit-read-only t)
   1090         pos adjusted-bol)
   1091     (when (and xref-truncation-width
   1092                (> (- eol bol) xref-truncation-width)
   1093                ;; Either truncation not applied yet, or it hides the current
   1094                ;; position: need to refresh.
   1095                (or (and (null (get-text-property (1- eol) 'invisible))
   1096                         (null (get-text-property bol 'invisible)))
   1097                    (get-text-property (point) 'invisible)))
   1098       (setq adjusted-bol
   1099             (cond
   1100              ((eq (get-text-property bol 'face) 'xref-line-number)
   1101               (next-single-char-property-change bol 'face))
   1102              (t bol)))
   1103       (cond
   1104        ((< (- (point) bol) xref-truncation-width)
   1105         (setq pos (+ bol xref-truncation-width))
   1106         (remove-text-properties bol pos '(invisible))
   1107         (put-text-property pos eol 'invisible 'ellipsis))
   1108        ((< (- eol (point)) xref-truncation-width)
   1109         (setq pos (- eol xref-truncation-width))
   1110         (remove-text-properties pos eol '(invisible))
   1111         (put-text-property adjusted-bol pos 'invisible 'ellipsis))
   1112        (t
   1113         (setq pos (- (point) (/ xref-truncation-width 2)))
   1114         (put-text-property adjusted-bol pos 'invisible 'ellipsis)
   1115         (remove-text-properties pos (+ pos xref-truncation-width) '(invisible))
   1116         (put-text-property (+ pos xref-truncation-width) eol 'invisible 'ellipsis))))))
   1117 
   1118 (defun xref--insert-xrefs (xref-alist)
   1119   "Insert XREF-ALIST in the current buffer.
   1120 XREF-ALIST is of the form ((GROUP . (XREF ...)) ...), where
   1121 GROUP is a string for decoration purposes and XREF is an
   1122 `xref-item' object."
   1123   (require 'compile) ; For the compilation faces.
   1124   (cl-loop for (group . xrefs) in xref-alist
   1125            for max-line = (cl-loop for xref in xrefs
   1126                                    maximize (xref-location-line
   1127                                              (xref-item-location xref)))
   1128            for line-format = (and max-line
   1129                                   (format
   1130                                    #("%%%dd:" 0 4 (face xref-line-number) 5 6 (face shadow))
   1131                                    (1+ (floor (log max-line 10)))))
   1132            with item-text-props = (list 'mouse-face 'highlight
   1133                                         'keymap xref--button-map
   1134                                         'help-echo
   1135                                         (concat "mouse-2: display in another window, "
   1136                                                 "RET or mouse-1: follow reference"))
   1137            with prev-group = nil
   1138            with prev-line = nil
   1139            do
   1140            (xref--insert-propertized '(face xref-file-header xref-group t)
   1141                                      group "\n")
   1142            (dolist (xref xrefs)
   1143              (pcase-let (((cl-struct xref-item summary location) xref))
   1144                (let* ((line (xref-location-line location))
   1145                       (prefix
   1146                        (cond
   1147                         ((not line) "  ")
   1148                         ((and (equal line prev-line)
   1149                               (equal prev-group group))
   1150                          "")
   1151                         (t (format line-format line)))))
   1152                  ;; Render multiple matches on the same line, together.
   1153                  (when (and (equal prev-group group)
   1154                             (or (null line)
   1155                                 (not (equal prev-line line))))
   1156                    (insert "\n"))
   1157                  (xref--insert-propertized (nconc (list 'xref-item xref)
   1158                                                   item-text-props)
   1159                                            prefix summary)
   1160                  (setq prev-line line
   1161                        prev-group group))))
   1162            (insert "\n"))
   1163   (add-to-invisibility-spec '(ellipsis . t))
   1164   (save-excursion
   1165     (goto-char (point-min))
   1166     (while (= 0 (forward-line 1))
   1167       (xref--apply-truncation)))
   1168   (run-hooks 'xref-after-update-hook))
   1169 
   1170 (defun xref--group-name-for-display (group project-root)
   1171   "Return GROUP formatted in the preferred style.
   1172 
   1173 The style is determined by the value of `xref-file-name-display'.
   1174 If GROUP looks like a file name, its value is formatted according
   1175 to that style.  Otherwise it is returned unchanged."
   1176   ;; XXX: The way we verify that it's indeed a file name and not some
   1177   ;; other kind of string, e.g. Java package name or TITLE from
   1178   ;; `tags-apropos-additional-actions', is pretty lax.  But we don't
   1179   ;; want to use `file-exists-p' for performance reasons.  If this
   1180   ;; ever turns out to be a problem, some other alternatives are to
   1181   ;; either have every location type which uses file names format the
   1182   ;; values themselves (e.g. by piping through some public function),
   1183   ;; or adding a new accessor to locations, like GROUP-TYPE.
   1184   (cl-ecase xref-file-name-display
   1185     (abs group)
   1186     (nondirectory
   1187      (if (file-name-absolute-p group)
   1188          (file-name-nondirectory group)
   1189        group))
   1190     (project-relative
   1191      (if (and project-root
   1192               (string-prefix-p project-root group))
   1193          (substring group (length project-root))
   1194        group))))
   1195 
   1196 (defun xref--analyze (xrefs)
   1197   "Find common groups in XREFS and format group names.
   1198 Return an alist of the form ((GROUP . (XREF ...)) ...)."
   1199   (let* ((alist
   1200           (xref--alistify xrefs
   1201                           (lambda (x)
   1202                             (xref-location-group (xref-item-location x)))))
   1203          (project (and
   1204                    (eq xref-file-name-display 'project-relative)
   1205                    (project-current)))
   1206          (project-root (and project
   1207                             (expand-file-name (xref--project-root project)))))
   1208     (mapcar
   1209      (lambda (pair)
   1210        (cons (xref--group-name-for-display (car pair) project-root)
   1211              (cdr pair)))
   1212      alist)))
   1213 
   1214 (defun xref--ensure-default-directory (dd buffer)
   1215   ;; We might be in a let-binding which will restore the current value
   1216   ;; to a previous one (bug#53626).  So do this later.
   1217   (run-with-timer
   1218    0 nil
   1219    (lambda () (with-current-buffer buffer (setq default-directory dd)))))
   1220 
   1221 (defun xref--show-xref-buffer (fetcher alist)
   1222   (cl-assert (functionp fetcher))
   1223   (let* ((xrefs
   1224           (or
   1225            (assoc-default 'fetched-xrefs alist)
   1226            (funcall fetcher)))
   1227          (xref-alist (xref--analyze xrefs))
   1228          (dd default-directory)
   1229          buf)
   1230     (with-current-buffer (get-buffer-create xref-buffer-name)
   1231       (xref--ensure-default-directory dd (current-buffer))
   1232       (xref--xref-buffer-mode)
   1233       (xref--show-common-initialize xref-alist fetcher alist)
   1234       (pop-to-buffer (current-buffer))
   1235       (setq buf (current-buffer)))
   1236     (xref--auto-jump-first buf (assoc-default 'auto-jump alist))
   1237     buf))
   1238 
   1239 (defun xref--project-root (project)
   1240   (if (fboundp 'project-root)
   1241       (project-root project)
   1242     (with-no-warnings
   1243       (car (project-roots project)))))
   1244 
   1245 (defun xref--show-common-initialize (xref-alist fetcher alist)
   1246   (setq buffer-undo-list nil)
   1247   (let ((inhibit-read-only t)
   1248         (buffer-undo-list t)
   1249         (inhibit-modification-hooks t))
   1250     (erase-buffer)
   1251     (setq overlay-arrow-position nil)
   1252     (xref--insert-xrefs xref-alist)
   1253     (add-hook 'post-command-hook 'xref--apply-truncation nil t)
   1254     (goto-char (point-min))
   1255     (setq xref--original-window (assoc-default 'window alist)
   1256           xref--original-window-intent (assoc-default 'display-action alist))
   1257     (setq xref--fetcher fetcher)))
   1258 
   1259 (defun xref-revert-buffer ()
   1260   "Refresh the search results in the current buffer."
   1261   (interactive)
   1262   (let ((inhibit-read-only t)
   1263         (buffer-undo-list t)
   1264         (inhibit-modification-hooks t))
   1265     (save-excursion
   1266       (condition-case err
   1267           (let ((alist (xref--analyze (funcall xref--fetcher))))
   1268             (erase-buffer)
   1269             (xref--insert-xrefs alist))
   1270         (user-error
   1271          (erase-buffer)
   1272          (insert
   1273           (propertize
   1274            (error-message-string err)
   1275            'face 'error)))))))
   1276 
   1277 (defun xref--auto-jump-first (buf value)
   1278   (when value
   1279     (select-window (get-buffer-window buf))
   1280     (goto-char (point-min)))
   1281   (cond
   1282    ((eq value t)
   1283     (xref-next-line-no-show)
   1284     (xref-goto-xref))
   1285    ((eq value 'show)
   1286     (xref-next-line))
   1287    ((eq value 'move)
   1288     (forward-line 1))))
   1289 
   1290 (defun xref-show-definitions-buffer (fetcher alist)
   1291   "Show the definitions list in a regular window.
   1292 
   1293 When only one definition found, jump to it right away instead."
   1294   (let ((xrefs (funcall fetcher))
   1295         buf)
   1296     (cond
   1297      ((not (cdr xrefs))
   1298       (xref-pop-to-location (car xrefs)
   1299                             (assoc-default 'display-action alist)))
   1300      (t
   1301       (setq buf
   1302             (xref--show-xref-buffer fetcher
   1303                                     (cons (cons 'fetched-xrefs xrefs)
   1304                                           alist)))
   1305       (xref--auto-jump-first buf (assoc-default 'auto-jump alist))
   1306       buf))))
   1307 
   1308 (define-obsolete-function-alias
   1309   'xref--show-defs-buffer #'xref-show-definitions-buffer "28.1")
   1310 
   1311 (defun xref-show-definitions-buffer-at-bottom (fetcher alist)
   1312   "Show the definitions list in a window at the bottom.
   1313 
   1314 When there is more than one definition, split the selected window
   1315 and show the list in a small window at the bottom.  And use a
   1316 local keymap that binds `RET' to `xref-quit-and-goto-xref'."
   1317   (let* ((xrefs (funcall fetcher))
   1318          (dd default-directory)
   1319          ;; XXX: Make percentage customizable maybe?
   1320          (max-height (/ (window-height) 2))
   1321          (size-fun (lambda (window)
   1322                      (fit-window-to-buffer window max-height)))
   1323          xref-alist
   1324          buf)
   1325     (cond
   1326      ((not (cdr xrefs))
   1327       (xref-pop-to-location (car xrefs)
   1328                             (assoc-default 'display-action alist)))
   1329      (t
   1330       ;; Call it here because it can call (project-current), and that
   1331       ;; might depend on individual buffer, not just directory.
   1332       (setq xref-alist (xref--analyze xrefs))
   1333 
   1334       (with-current-buffer (get-buffer-create xref-buffer-name)
   1335         (xref--ensure-default-directory dd (current-buffer))
   1336         (xref--transient-buffer-mode)
   1337         (xref--show-common-initialize xref-alist fetcher alist)
   1338         (pop-to-buffer (current-buffer)
   1339                        `(display-buffer-in-direction . ((direction . below)
   1340                                                         (window-height . ,size-fun))))
   1341         (setq buf (current-buffer)))
   1342       (xref--auto-jump-first buf (assoc-default 'auto-jump alist))
   1343       buf))))
   1344 
   1345 (define-obsolete-function-alias 'xref--show-defs-buffer-at-bottom
   1346   #'xref-show-definitions-buffer-at-bottom "28.1")
   1347 
   1348 (defun xref--completing-read-group (cand transform)
   1349   "Return group title of candidate CAND or TRANSFORM the candidate."
   1350   (if transform
   1351       (substring cand (1+ (next-single-property-change 0 'xref--group cand)))
   1352     (get-text-property 0 'xref--group cand)))
   1353 
   1354 (defun xref-show-definitions-completing-read (fetcher alist)
   1355   "Let the user choose the target definition with completion.
   1356 
   1357 When there is more than one definition, let the user choose
   1358 between them by typing in the minibuffer with completion."
   1359   (let* ((xrefs (funcall fetcher))
   1360          (xref-alist (xref--analyze xrefs))
   1361          xref-alist-with-line-info
   1362          xref
   1363          (group-prefix-length
   1364           ;; FIXME: Groups are not always file names, but they often
   1365           ;; are.  At least this shouldn't make the other kinds of
   1366           ;; groups look worse.
   1367           (let ((common-prefix (try-completion "" xref-alist)))
   1368             (if (> (length common-prefix) 0)
   1369                 (length (file-name-directory common-prefix))
   1370               0))))
   1371 
   1372     (cl-loop for ((group . xrefs) . more1) on xref-alist
   1373              do
   1374              (cl-loop for (xref . more2) on xrefs do
   1375                       (let* ((summary (xref-item-summary xref))
   1376                              (location (xref-item-location xref))
   1377                              (line (xref-location-line location))
   1378                              (line-fmt
   1379                               (if line
   1380                                   (format #("%d:" 0 2 (face xref-line-number))
   1381                                           line)
   1382                                 ""))
   1383                              (group-prefix
   1384                               (substring group group-prefix-length))
   1385                              (group-fmt
   1386                               (propertize group-prefix
   1387                                           'face 'xref-file-header
   1388                                           'xref--group group-prefix))
   1389                              (candidate
   1390                               (format "%s:%s%s" group-fmt line-fmt summary)))
   1391                         (push (cons candidate xref) xref-alist-with-line-info))))
   1392 
   1393     (setq xref (if (not (cdr xrefs))
   1394                    (car xrefs)
   1395                  (let* ((collection (reverse xref-alist-with-line-info))
   1396                         (ctable
   1397                          (lambda (string pred action)
   1398                            (cond
   1399                             ((eq action 'metadata)
   1400                              `(metadata
   1401                                . ((category . xref-location)
   1402                                   (group-function . ,#'xref--completing-read-group))))
   1403                             (t
   1404                              (complete-with-action action collection string pred)))))
   1405                         (def (caar collection)))
   1406                    (cdr (assoc (completing-read "Choose definition: "
   1407                                                 ctable nil t
   1408                                                 nil nil
   1409                                                 def)
   1410                                collection)))))
   1411 
   1412     (xref-pop-to-location xref (assoc-default 'display-action alist))))
   1413 
   1414 ;; TODO: Can delete this alias before Emacs 28's release.
   1415 (define-obsolete-function-alias
   1416   'xref--show-defs-minibuffer #'xref-show-definitions-completing-read "28.1")
   1417 
   1418 
   1419 (defcustom xref-show-xrefs-function 'xref--show-xref-buffer
   1420   "Function to display a list of search results.
   1421 
   1422 It should accept two arguments: FETCHER and ALIST.
   1423 
   1424 FETCHER is a function of no arguments that returns a list of xref
   1425 values.  It must not depend on the current buffer or selected
   1426 window.
   1427 
   1428 ALIST can include, but is not limited to, the following keys:
   1429 
   1430 WINDOW for the window that was selected before the current
   1431 command was called.
   1432 
   1433 DISPLAY-ACTION indicates where the target location should be
   1434 displayed.  The possible values are nil, `window' meaning the
   1435 other window, or `frame' meaning the other frame."
   1436   :type 'function)
   1437 
   1438 (defcustom xref-show-definitions-function 'xref-show-definitions-buffer
   1439   "Function to handle the definition search results.
   1440 
   1441 Accepts the same arguments as `xref-show-xrefs-function'.
   1442 
   1443 Generally, it is expected to jump to the definition if there's
   1444 only one, and otherwise provide some way to choose among the
   1445 definitions."
   1446   :type '(choice
   1447           (const :tag "Show a regular list of locations"
   1448                  xref-show-definitions-buffer)
   1449           (const :tag "Show a \"transient\" list at the bottom of the window"
   1450                  xref-show-definitions-buffer-at-bottom)
   1451           (const :tag "Choose the definition with completion"
   1452                  xref-show-definitions-completing-read)
   1453           (function :tag "Custom function")))
   1454 
   1455 (defvar xref--read-identifier-history nil)
   1456 
   1457 (defvar xref--read-pattern-history nil)
   1458 
   1459 ;;;###autoload
   1460 (defun xref-show-xrefs (fetcher display-action)
   1461   "Display some Xref values produced by FETCHER using DISPLAY-ACTION.
   1462 The meanings of both arguments are the same as documented in
   1463 `xref-show-xrefs-function'."
   1464   (xref--show-xrefs fetcher display-action))
   1465 
   1466 (defun xref--show-xrefs (fetcher display-action &optional _always-show-list)
   1467   (xref--push-markers)
   1468   (unless (functionp fetcher)
   1469     ;; Old convention.
   1470     (let ((xrefs fetcher))
   1471       (setq fetcher
   1472             (lambda ()
   1473               (if (eq xrefs 'called-already)
   1474                   (user-error "Refresh is not supported")
   1475                 (prog1
   1476                     xrefs
   1477                   (setq xrefs 'called-already)))))))
   1478   (funcall xref-show-xrefs-function fetcher
   1479            `((window . ,(selected-window))
   1480              (display-action . ,display-action)
   1481              (auto-jump . ,xref-auto-jump-to-first-xref))))
   1482 
   1483 (defun xref--show-defs (xrefs display-action)
   1484   (xref--push-markers)
   1485   (funcall xref-show-definitions-function xrefs
   1486            `((window . ,(selected-window))
   1487              (display-action . ,display-action)
   1488              (auto-jump . ,xref-auto-jump-to-first-definition))))
   1489 
   1490 (defun xref--push-markers ()
   1491   (unless (region-active-p) (push-mark nil t))
   1492   (xref-push-marker-stack))
   1493 
   1494 (defun xref--prompt-p (command)
   1495   (or (eq xref-prompt-for-identifier t)
   1496       (if (eq (car xref-prompt-for-identifier) 'not)
   1497           (not (memq command (cdr xref-prompt-for-identifier)))
   1498         (memq command xref-prompt-for-identifier))))
   1499 
   1500 (defun xref--read-identifier (prompt)
   1501   "Return the identifier at point or read it from the minibuffer."
   1502   (let* ((backend (xref-find-backend))
   1503          (def (xref-backend-identifier-at-point backend))
   1504          (completion-ignore-case
   1505           (xref-backend-identifier-completion-ignore-case backend)))
   1506     (cond ((or current-prefix-arg
   1507                (not def)
   1508                (xref--prompt-p this-command))
   1509            (let ((id
   1510                   (completing-read
   1511                    ;; `format-prompt' is new in Emacs 28.1
   1512                    (if (fboundp 'format-prompt)
   1513                        (format-prompt (substring prompt 0 (string-match
   1514                                                            "[ :]+\\'" prompt))
   1515                                       def)
   1516                      (if def
   1517                          (format "%s (default %s): "
   1518                                  (substring prompt 0 (string-match
   1519                                                       "[ :]+\\'" prompt))
   1520                                  def)
   1521                        prompt))
   1522                    (xref-backend-identifier-completion-table backend)
   1523                    nil nil nil
   1524                    'xref--read-identifier-history def)))
   1525              (if (equal id "")
   1526                  (or def (user-error "There is no default identifier"))
   1527                id)))
   1528           (t def))))
   1529 
   1530 
   1531 ;;; Commands
   1532 
   1533 (defun xref--find-xrefs (input kind arg display-action)
   1534   (xref--show-xrefs
   1535    (xref--create-fetcher input kind arg)
   1536    display-action))
   1537 
   1538 (defun xref--find-definitions (id display-action)
   1539   (xref--show-defs
   1540    (xref--create-fetcher id 'definitions id)
   1541    display-action))
   1542 
   1543 (defun xref--create-fetcher (input kind arg)
   1544   "Return an xref list fetcher function.
   1545 
   1546 It revisits the saved position and delegates the finding logic to
   1547 the xref backend method indicated by KIND and passes ARG to it."
   1548   (let* ((orig-buffer (current-buffer))
   1549          (orig-position (point))
   1550          (backend (xref-find-backend))
   1551          (method (intern (format "xref-backend-%s" kind))))
   1552     (lambda ()
   1553       (save-excursion
   1554         ;; Xref methods are generally allowed to depend on the text
   1555         ;; around point, not just on their explicit arguments.
   1556         ;;
   1557         ;; There is only so much we can do, however, to recreate that
   1558         ;; context, given that the user is free to change the buffer
   1559         ;; contents freely in the meantime.
   1560         (when (buffer-live-p orig-buffer)
   1561           (set-buffer orig-buffer)
   1562           (ignore-errors (goto-char orig-position)))
   1563         (let ((xrefs (funcall method backend arg)))
   1564           (unless xrefs
   1565             (xref--not-found-error kind input))
   1566           xrefs)))))
   1567 
   1568 (defun xref--not-found-error (kind input)
   1569   (user-error "No %s found for: %s" (symbol-name kind) input))
   1570 
   1571 ;;;###autoload
   1572 (defun xref-find-definitions (identifier)
   1573   "Find the definition of the identifier at point.
   1574 With prefix argument or when there's no identifier at point,
   1575 prompt for it.
   1576 
   1577 If sufficient information is available to determine a unique
   1578 definition for IDENTIFIER, display it in the selected window.
   1579 Otherwise, display the list of the possible definitions in a
   1580 buffer where the user can select from the list.
   1581 
   1582 Use \\[xref-go-back] to return back to where you invoked this command."
   1583   (interactive (list (xref--read-identifier "Find definitions of: ")))
   1584   (xref--find-definitions identifier nil))
   1585 
   1586 ;;;###autoload
   1587 (defun xref-find-definitions-other-window (identifier)
   1588   "Like `xref-find-definitions' but switch to the other window."
   1589   (interactive (list (xref--read-identifier "Find definitions of: ")))
   1590   (xref--find-definitions identifier 'window))
   1591 
   1592 ;;;###autoload
   1593 (defun xref-find-definitions-other-frame (identifier)
   1594   "Like `xref-find-definitions' but switch to the other frame."
   1595   (interactive (list (xref--read-identifier "Find definitions of: ")))
   1596   (xref--find-definitions identifier 'frame))
   1597 
   1598 ;;;###autoload
   1599 (defun xref-find-references (identifier)
   1600   "Find references to the identifier at point.
   1601 This command might prompt for the identifier as needed, perhaps
   1602 offering the symbol at point as the default.
   1603 With prefix argument, or if `xref-prompt-for-identifier' is t,
   1604 always prompt for the identifier.  If `xref-prompt-for-identifier'
   1605 is nil, prompt only if there's no usable symbol at point."
   1606   (interactive (list (xref--read-identifier "Find references of: ")))
   1607   (xref--find-xrefs identifier 'references identifier nil))
   1608 
   1609 (defun xref-find-references-and-replace (from to)
   1610   "Replace all references to identifier FROM with TO."
   1611   (interactive
   1612    (let* ((query-replace-read-from-default 'find-tag-default)
   1613           (common
   1614            (query-replace-read-args "Query replace identifier" nil)))
   1615      (list (nth 0 common) (nth 1 common))))
   1616   (require 'xref)
   1617   (with-current-buffer
   1618       (let ((xref-show-xrefs-function
   1619              ;; Some future-proofing (bug#44905).
   1620              (custom--standard-value 'xref-show-xrefs-function))
   1621             ;; Disable auto-jumping, it will mess up replacement logic.
   1622             xref-auto-jump-to-first-xref)
   1623         (xref-find-references from))
   1624     (xref-query-replace-in-results ".*" to)))
   1625 
   1626 ;;;###autoload
   1627 (defun xref-find-definitions-at-mouse (event)
   1628   "Find the definition of identifier at or around mouse click.
   1629 This command is intended to be bound to a mouse event."
   1630   (interactive "e")
   1631   (let ((identifier
   1632          (save-excursion
   1633            (mouse-set-point event)
   1634            (xref-backend-identifier-at-point (xref-find-backend)))))
   1635     (if identifier
   1636         (xref-find-definitions identifier)
   1637       (user-error "No identifier here"))))
   1638 
   1639 ;;;###autoload
   1640 (defun xref-find-references-at-mouse (event)
   1641   "Find references to the identifier at or around mouse click.
   1642 This command is intended to be bound to a mouse event."
   1643   (interactive "e")
   1644   (let ((identifier
   1645          (save-excursion
   1646            (mouse-set-point event)
   1647            (xref-backend-identifier-at-point (xref-find-backend)))))
   1648     (if identifier
   1649         (let ((xref-prompt-for-identifier nil))
   1650           (xref-find-references identifier))
   1651       (user-error "No identifier here"))))
   1652 
   1653 (declare-function apropos-parse-pattern "apropos" (pattern &optional do-all))
   1654 
   1655 ;;;###autoload
   1656 (defun xref-find-apropos (pattern)
   1657   "Find all meaningful symbols that match PATTERN.
   1658 The argument has the same meaning as in `apropos'.
   1659 See `tags-apropos-additional-actions' for how to augment the
   1660 output of this command when the backend is etags."
   1661   (interactive (list (read-string
   1662                       "Search for pattern (word list or regexp): "
   1663                       nil 'xref--read-pattern-history
   1664                       (xref-backend-identifier-at-point
   1665                        (xref-find-backend)))))
   1666   (require 'apropos)
   1667   (let* ((newpat
   1668           (if (and (version< emacs-version "28.0.50")
   1669                    (memq (xref-find-backend) '(elisp etags)))
   1670               ;; Handle backends in older Emacs.
   1671               (xref-apropos-regexp pattern)
   1672             ;; Delegate pattern handling to the backend fully.
   1673             ;; The old way didn't work for "external" backends.
   1674             pattern)))
   1675     (xref--find-xrefs pattern 'apropos newpat nil)))
   1676 
   1677 (defun xref-apropos-regexp (pattern)
   1678   "Return an Emacs regexp from PATTERN similar to `apropos'."
   1679   (apropos-parse-pattern
   1680    (if (string-equal (regexp-quote pattern) pattern)
   1681        ;; Split into words
   1682        (or (split-string pattern "[ \t]+" t)
   1683            (user-error "No word list given"))
   1684      pattern)))
   1685 
   1686 
   1687 ;;; Key bindings
   1688 
   1689 ;;;###autoload (define-key esc-map "." #'xref-find-definitions)
   1690 ;;;###autoload (define-key esc-map "," #'xref-go-back)
   1691 ;;;###autoload (define-key esc-map [?\C-,] #'xref-go-forward)
   1692 ;;;###autoload (define-key esc-map "?" #'xref-find-references)
   1693 ;;;###autoload (define-key esc-map [?\C-.] #'xref-find-apropos)
   1694 ;;;###autoload (define-key ctl-x-4-map "." #'xref-find-definitions-other-window)
   1695 ;;;###autoload (define-key ctl-x-5-map "." #'xref-find-definitions-other-frame)
   1696 
   1697 
   1698 ;;; Helper functions
   1699 
   1700 (defvar xref-etags-mode--saved nil)
   1701 
   1702 (define-minor-mode xref-etags-mode
   1703   "Minor mode to make xref use etags again.
   1704 
   1705 Certain major modes install their own mechanisms for listing
   1706 identifiers and navigation.  Turn this on to undo those settings
   1707 and just use etags."
   1708   :lighter ""
   1709   (if xref-etags-mode
   1710       (progn
   1711         (setq xref-etags-mode--saved xref-backend-functions)
   1712         (kill-local-variable 'xref-backend-functions))
   1713     (setq-local xref-backend-functions xref-etags-mode--saved)))
   1714 
   1715 (declare-function semantic-symref-instantiate "semantic/symref")
   1716 (declare-function semantic-symref-perform-search "semantic/symref")
   1717 (declare-function grep-expand-template "grep")
   1718 (defvar ede-minor-mode) ;; ede.el
   1719 
   1720 ;;;###autoload
   1721 (defun xref-references-in-directory (symbol dir)
   1722   "Find all references to SYMBOL in directory DIR.
   1723 Return a list of xref values.
   1724 
   1725 This function uses the Semantic Symbol Reference API, see
   1726 `semantic-symref-tool-alist' for details on which tools are used,
   1727 and when."
   1728   (cl-assert (directory-name-p dir))
   1729   (require 'semantic/symref)
   1730   (defvar semantic-symref-tool)
   1731 
   1732   ;; Some symref backends use `ede-project-root-directory' as the root
   1733   ;; directory for the search, rather than `default-directory'. Since
   1734   ;; the caller has specified `dir', we bind `ede-minor-mode' to nil
   1735   ;; to force the backend to use `default-directory'.
   1736   (let* ((ede-minor-mode nil)
   1737          (default-directory dir)
   1738          ;; FIXME: Remove CScope and Global from the recognized tools?
   1739          ;; The current implementations interpret the symbol search as
   1740          ;; "find all calls to the given function", but not function
   1741          ;; definition. And they return nothing when passed a variable
   1742          ;; name, even a global one.
   1743          (semantic-symref-tool 'detect)
   1744          (case-fold-search nil)
   1745          (inst (semantic-symref-instantiate :searchfor symbol
   1746                                             :searchtype 'symbol
   1747                                             :searchscope 'subdirs
   1748                                             :resulttype 'line-and-text)))
   1749     (xref--convert-hits (semantic-symref-perform-search inst)
   1750                         (format "\\_<%s\\_>" (regexp-quote symbol)))))
   1751 
   1752 (define-obsolete-function-alias
   1753   'xref-collect-references
   1754   #'xref-references-in-directory
   1755   "27.1")
   1756 
   1757 ;;;###autoload
   1758 (defun xref-matches-in-directory (regexp files dir ignores)
   1759   "Find all matches for REGEXP in directory DIR.
   1760 Return a list of xref values.
   1761 Only files matching some of FILES and none of IGNORES are searched.
   1762 FILES is a string with glob patterns separated by spaces.
   1763 IGNORES is a list of glob patterns for files to ignore."
   1764   ;; DIR can also be a regular file for now; let's not advertise that.
   1765   (grep-compute-defaults)
   1766   (defvar grep-find-template)
   1767   (defvar grep-highlight-matches)
   1768   (pcase-let*
   1769       ((grep-find-template (replace-regexp-in-string "<C>" "<C> -E"
   1770                                                      grep-find-template t t))
   1771        (grep-highlight-matches nil)
   1772        ;; TODO: Sanitize the regexp to remove Emacs-specific terms,
   1773        ;; so that Grep can search for the "relaxed" version.  Can we
   1774        ;; do that reliably enough, without creating false negatives?
   1775        (command (xref--rgrep-command (xref--regexp-to-extended regexp)
   1776                                      files
   1777                                      "."
   1778                                      ignores))
   1779        (local-dir (directory-file-name
   1780                    (file-name-unquote
   1781                     (file-local-name (expand-file-name dir)))))
   1782        (buf (get-buffer-create " *xref-grep*"))
   1783        (`(,grep-re ,file-group ,line-group . ,_) (car grep-regexp-alist))
   1784        (status nil)
   1785        (hits nil))
   1786     (with-current-buffer buf
   1787       (erase-buffer)
   1788       (setq default-directory dir)
   1789       (setq status
   1790             (process-file-shell-command command nil t))
   1791       (goto-char (point-min))
   1792       ;; Can't use the exit status: Grep exits with 1 to mean "no
   1793       ;; matches found".  Find exits with 1 if any of the invocations
   1794       ;; exit with non-zero. "No matches" and "Grep program not found"
   1795       ;; are all the same to it.
   1796       (when (and (/= (point-min) (point-max))
   1797                  (not (looking-at grep-re)))
   1798         (user-error "Search failed with status %d: %s" status (buffer-string)))
   1799       (while (re-search-forward grep-re nil t)
   1800         (push (list (string-to-number (match-string line-group))
   1801                     (concat local-dir (substring (match-string file-group) 1))
   1802                     (buffer-substring-no-properties (point) (line-end-position)))
   1803               hits)))
   1804     (xref--convert-hits (nreverse hits) regexp)))
   1805 
   1806 (define-obsolete-function-alias
   1807   'xref-collect-matches
   1808   #'xref-matches-in-directory
   1809   "27.1")
   1810 
   1811 (declare-function tramp-tramp-file-p "tramp")
   1812 (declare-function tramp-file-local-name "tramp")
   1813 
   1814 ;; TODO: Experiment with 'xargs -P4' (or any other number).
   1815 ;; This speeds up either command, even more than rg's '-j4' does.
   1816 ;; Ripgrep gets jumbled output, though, even with --line-buffered.
   1817 ;; But Grep seems to be stable. Even without --line-buffered.
   1818 (defcustom xref-search-program-alist
   1819   '((grep
   1820      .
   1821      ;; '-s' because 'git ls-files' can output broken symlinks.
   1822      "xargs -0 grep <C> --null -snHE -e <R>")
   1823     (ripgrep
   1824      .
   1825      ;; '!*/' is there to filter out dirs (e.g. submodules).
   1826      "xargs -0 rg <C> --null -nH --no-heading --no-messages -g '!*/' -e <R>"
   1827      )
   1828     (ugrep . "xargs -0 ugrep <C> --null -ns -e <R>"))
   1829   "Association list mapping program identifiers to command templates.
   1830 
   1831 Program identifier should be a symbol, named after the search program.
   1832 
   1833 The command template must be a shell command (or usually a
   1834 pipeline) that will search the files based on the list of file
   1835 names that is piped from stdin, separated by null characters.
   1836 The template should have the following fields:
   1837 
   1838   <C> for extra arguments such as -i and --color
   1839   <R> for the regexp itself (in Extended format)"
   1840   :type '(repeat
   1841           (cons (symbol :tag "Program identifier")
   1842                 (string :tag "Command template")))
   1843   :version "28.1"
   1844   :package-version '(xref . "1.0.4"))
   1845 
   1846 (defcustom xref-search-program 'grep
   1847   "The program to use for regexp search inside files.
   1848 
   1849 This must reference a corresponding entry in `xref-search-program-alist'.
   1850 
   1851 This variable is used in `xref-matches-in-files', which is the
   1852 utility function used by commands like `dired-do-find-regexp' and
   1853 `project-find-regexp'."
   1854   :type '(choice
   1855           (const :tag "Use Grep" grep)
   1856           (const :tag "Use ripgrep" ripgrep)
   1857           (const :tag "Use ugrep" ugrep)
   1858           (symbol :tag "User defined"))
   1859   :version "28.1"
   1860   :package-version '(xref . "1.0.4"))
   1861 
   1862 (defmacro xref--with-connection-local-variables (&rest body)
   1863   (declare (debug t))
   1864   (if (>= emacs-major-version 27)
   1865       `(with-connection-local-variables ,@body)
   1866     `(progn ,@body)))
   1867 
   1868 ;;;###autoload
   1869 (defun xref-matches-in-files (regexp files)
   1870   "Find all matches for REGEXP in FILES.
   1871 Return a list of xref values.
   1872 FILES must be a list of absolute file names.
   1873 
   1874 See `xref-search-program' and `xref-search-program-alist' for how
   1875 to control which program to use when looking for matches."
   1876   (cl-assert (consp files))
   1877   (require 'grep)
   1878   (defvar grep-highlight-matches)
   1879   (pcase-let*
   1880       ((output (get-buffer-create " *project grep output*"))
   1881        (`(,grep-re ,file-group ,line-group . ,_) (car grep-regexp-alist))
   1882        (status nil)
   1883        (hits nil)
   1884        ;; Support for remote files.  The assumption is that, if the
   1885        ;; first file is remote, they all are, and on the same host.
   1886        (dir (file-name-directory (car files)))
   1887        (remote-id (file-remote-p dir))
   1888        ;; The 'auto' default would be fine too, but ripgrep can't handle
   1889        ;; the options we pass in that case.
   1890        (grep-highlight-matches nil)
   1891        (command (grep-expand-template (cdr
   1892                                        (or
   1893                                         (assoc
   1894                                          xref-search-program
   1895                                          xref-search-program-alist)
   1896                                         (user-error "Unknown search program `%s'"
   1897                                                     xref-search-program)))
   1898                                       (xref--regexp-to-extended regexp))))
   1899     (when remote-id
   1900       (require 'tramp)
   1901       (setq files (mapcar
   1902                    (if (tramp-tramp-file-p dir)
   1903                        #'tramp-file-local-name
   1904                        #'file-local-name)
   1905                    files)))
   1906     (when (file-name-quoted-p (car files))
   1907       (setq files (mapcar #'file-name-unquote files)))
   1908     (with-current-buffer output
   1909       (erase-buffer)
   1910       (with-temp-buffer
   1911         (insert (mapconcat #'identity files "\0"))
   1912         (setq default-directory dir)
   1913         (setq status
   1914               (xref--with-connection-local-variables
   1915                (xref--process-file-region (point-min)
   1916                                           (point-max)
   1917                                           shell-file-name
   1918                                           output
   1919                                           nil
   1920                                           shell-command-switch
   1921                                           command))))
   1922       (goto-char (point-min))
   1923       (when (and (/= (point-min) (point-max))
   1924                  (not (looking-at grep-re))
   1925                  ;; TODO: Show these matches as well somehow?
   1926                  ;; Matching both Grep's and Ripgrep 13's messages.
   1927                  (not (looking-at ".*[bB]inary file.* matches")))
   1928         (user-error "Search failed with status %d: %s" status
   1929                     (buffer-substring (point-min) (line-end-position))))
   1930       (while (re-search-forward grep-re nil t)
   1931         (push (list (string-to-number (match-string line-group))
   1932                     (match-string file-group)
   1933                     (buffer-substring-no-properties (point) (line-end-position)))
   1934               hits)))
   1935     ;; By default, ripgrep's output order is non-deterministic
   1936     ;; (https://github.com/BurntSushi/ripgrep/issues/152)
   1937     ;; because it does the search in parallel.
   1938     ;; Grep's output also comes out in seemingly arbitrary order,
   1939     ;; though stable one. Let's sort both for better UI.
   1940     (setq hits
   1941           (sort (nreverse hits)
   1942                 (lambda (h1 h2)
   1943                   (string< (cadr h1) (cadr h2)))))
   1944     (xref--convert-hits hits regexp)))
   1945 
   1946 (defun xref--process-file-region ( start end program
   1947                                    &optional buffer display
   1948                                    &rest args)
   1949   ;; FIXME: This branching shouldn't be necessary, but
   1950   ;; call-process-region *is* measurably faster, even for a program
   1951   ;; doing some actual work (for a period of time). Even though
   1952   ;; call-process-region also creates a temp file internally
   1953   ;; (https://lists.gnu.org/archive/html/emacs-devel/2019-01/msg00211.html).
   1954   (if (not (file-remote-p default-directory))
   1955       (apply #'call-process-region
   1956              start end program nil buffer display args)
   1957     (let ((infile (make-temp-file "ppfr")))
   1958       (unwind-protect
   1959           (progn
   1960             (write-region start end infile nil 'silent)
   1961             (apply #'process-file program infile buffer display args))
   1962         (delete-file infile)))))
   1963 
   1964 (defun xref--rgrep-command (regexp files dir ignores)
   1965   (require 'find-dired)      ; for `find-name-arg'
   1966   (defvar grep-find-template)
   1967   (defvar find-name-arg)
   1968   ;; `shell-quote-argument' quotes the tilde as well.
   1969   (cl-assert (not (string-match-p "\\`~" dir)))
   1970   (grep-expand-template
   1971    grep-find-template
   1972    regexp
   1973    (concat (shell-quote-argument "(")
   1974            " " find-name-arg " "
   1975            (mapconcat
   1976             #'shell-quote-argument
   1977             (split-string files)
   1978             (concat " -o " find-name-arg " "))
   1979            " "
   1980            (shell-quote-argument ")"))
   1981    (shell-quote-argument dir)
   1982    (xref--find-ignores-arguments ignores dir)))
   1983 
   1984 (defun xref--find-ignores-arguments (ignores dir)
   1985   "Convert IGNORES and DIR to a list of arguments for `find'.
   1986 IGNORES is a list of glob patterns.  DIR is an absolute
   1987 directory, used as the root of the ignore globs."
   1988   (cl-assert (not (string-match-p "\\`~" dir)))
   1989   (if (not ignores)
   1990       ""
   1991     ;; TODO: All in-tree callers are passing in just "." or "./".
   1992     ;; We can simplify.
   1993     ;; And, if we ever end up deleting xref-matches-in-directory, move
   1994     ;; this function to the project package.
   1995     (setq dir (file-name-as-directory dir))
   1996     (concat
   1997      (shell-quote-argument "(")
   1998      " -path "
   1999      (mapconcat
   2000       (lambda (ignore)
   2001         (when (string-match-p "/\\'" ignore)
   2002           (setq ignore (concat ignore "*")))
   2003         (shell-quote-argument (if (string-match "\\`\\./" ignore)
   2004                                   (replace-match dir t t ignore)
   2005                                 (if (string-prefix-p "*" ignore)
   2006                                     ignore
   2007                                   (concat "*/" ignore)))))
   2008       ignores
   2009       " -o -path ")
   2010      " "
   2011      (shell-quote-argument ")")
   2012      " -prune -o ")))
   2013 
   2014 (defun xref--regexp-to-extended (str)
   2015   (replace-regexp-in-string
   2016    ;; FIXME: Add tests.  Move to subr.el, make a public function.
   2017    ;; Maybe error on Emacs-only constructs.
   2018    "\\(?:\\\\\\\\\\)*\\(?:\\\\[][]\\)?\\(?:\\[.+?\\]\\|\\(\\\\?[(){}|]\\)\\)"
   2019    (lambda (str)
   2020      (cond
   2021       ((not (match-beginning 1))
   2022        str)
   2023       ((eq (length (match-string 1 str)) 2)
   2024        (concat (substring str 0 (match-beginning 1))
   2025                (substring (match-string 1 str) 1 2)))
   2026       (t
   2027        (concat (substring str 0 (match-beginning 1))
   2028                "\\"
   2029                (match-string 1 str)))))
   2030    str t t))
   2031 
   2032 (defun xref--regexp-syntax-dependent-p (str)
   2033   "Return non-nil when STR depends on the buffer's syntax.
   2034 Such as the current syntax table and the applied syntax properties."
   2035   (let ((case-fold-search nil))
   2036     (string-match-p (rx
   2037                      (or string-start (not (in ?\\)))
   2038                      (0+ (= 2 ?\\))
   2039                      ?\\
   2040                      (in ?b ?B ?< ?> ?w ?W ?_ ?s ?S))
   2041                     str)))
   2042 
   2043 (defvar xref--last-file-buffer nil)
   2044 (defvar xref--temp-buffer-file-name nil)
   2045 (defvar xref--hits-remote-id nil)
   2046 
   2047 (defun xref--convert-hits (hits regexp)
   2048   (let (xref--last-file-buffer
   2049         (tmp-buffer (generate-new-buffer " *xref-temp*"))
   2050         (xref--hits-remote-id (file-remote-p default-directory))
   2051         (syntax-needed (xref--regexp-syntax-dependent-p regexp)))
   2052     (unwind-protect
   2053         (mapcan (lambda (hit)
   2054                   (xref--collect-matches hit regexp tmp-buffer syntax-needed))
   2055                 hits)
   2056       (kill-buffer tmp-buffer))))
   2057 
   2058 (defun xref--collect-matches (hit regexp tmp-buffer syntax-needed)
   2059   (pcase-let* ((`(,line ,file ,text) hit)
   2060                (file (and file (concat xref--hits-remote-id file)))
   2061                (buf (xref--find-file-buffer file))
   2062                (inhibit-modification-hooks t))
   2063     (if buf
   2064         (with-current-buffer buf
   2065           (save-excursion
   2066             (save-restriction
   2067               (widen)
   2068               (goto-char (point-min))
   2069               (forward-line (1- line))
   2070               (xref--collect-matches-1 regexp file line
   2071                                        (line-beginning-position)
   2072                                        (line-end-position)
   2073                                        syntax-needed))))
   2074       ;; Using the temporary buffer is both a performance and a buffer
   2075       ;; management optimization.
   2076       (with-current-buffer tmp-buffer
   2077         (erase-buffer)
   2078         (when (and syntax-needed
   2079                    (not (equal file xref--temp-buffer-file-name)))
   2080           (insert-file-contents file nil 0 200)
   2081           ;; Can't (setq-local delay-mode-hooks t) because of
   2082           ;; bug#23272, but the performance penalty seems minimal.
   2083           (let ((buffer-file-name file)
   2084                 (inhibit-message t)
   2085                 message-log-max)
   2086             (ignore-errors
   2087               (set-auto-mode t)))
   2088           (setq-local xref--temp-buffer-file-name file)
   2089           (setq-local inhibit-read-only t)
   2090           (erase-buffer))
   2091         (insert text)
   2092         (goto-char (point-min))
   2093         (xref--collect-matches-1 regexp file line
   2094                                  (point)
   2095                                  (point-max)
   2096                                  syntax-needed)))))
   2097 
   2098 (defun xref--collect-matches-1 (regexp file line line-beg line-end syntax-needed)
   2099   (let (matches
   2100         stop beg end
   2101         last-beg last-end
   2102         summary-end)
   2103     (when syntax-needed
   2104       (syntax-propertize line-end))
   2105     (while (not stop)
   2106       (if (and
   2107            ;; REGEXP might match an empty string.  Or line.
   2108            (not (and last-beg (eql end line-beg)))
   2109            (re-search-forward regexp line-end t))
   2110           (setq beg (match-beginning 0)
   2111                 end (match-end 0)
   2112                 summary-end beg)
   2113         (setq stop t
   2114               summary-end line-end))
   2115       (when last-beg
   2116         (let* ((beg-column (- last-beg line-beg))
   2117                (end-column (- last-end line-beg))
   2118                (summary-start (if matches last-beg line-beg))
   2119                (summary (buffer-substring summary-start
   2120                                           summary-end))
   2121                (loc (xref-make-file-location file line beg-column)))
   2122           (add-face-text-property (- last-beg summary-start)
   2123                                   (- last-end summary-start)
   2124                                   'xref-match t summary)
   2125           (push (xref-make-match summary loc (- end-column beg-column))
   2126                 matches)))
   2127       (setq last-beg beg
   2128             last-end end))
   2129     (nreverse matches)))
   2130 
   2131 (defun xref--find-file-buffer (file)
   2132   (unless (equal (car xref--last-file-buffer) file)
   2133     ;; `find-buffer-visiting' is considerably slower,
   2134     ;; especially on remote files.
   2135     (let ((buf (get-file-buffer file)))
   2136       (when (and buf
   2137                  (or
   2138                   (buffer-modified-p buf)
   2139                   (unless xref--hits-remote-id
   2140                     (not (verify-visited-file-modtime (current-buffer))))))
   2141         ;; We can't use buffers whose contents diverge from disk (bug#54025).
   2142         (setq buf nil))
   2143       (setq xref--last-file-buffer (cons file buf))))
   2144   (cdr xref--last-file-buffer))
   2145 
   2146 (provide 'xref)
   2147 
   2148 ;;; xref.el ends here