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