diff options
Diffstat (limited to 'lisp/progmodes/xref.el')
| -rw-r--r-- | lisp/progmodes/xref.el | 732 |
1 files changed, 443 insertions, 289 deletions
diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el index e2cd904a6cd..26188bbddab 100644 --- a/lisp/progmodes/xref.el +++ b/lisp/progmodes/xref.el @@ -1,7 +1,7 @@ ;;; xref.el --- Cross-referencing commands -*-lexical-binding:t-*- ;; Copyright (C) 2014-2021 Free Software Foundation, Inc. -;; Version: 1.1.0 +;; Version: 1.3.2 ;; Package-Requires: ((emacs "26.1")) ;; This is a GNU ELPA :core package. Avoid functionality that is not @@ -46,9 +46,9 @@ ;; ;; One would usually call `make-xref' and `xref-make-file-location', ;; `xref-make-buffer-location' or `xref-make-bogus-location' to create -;; them. More generally, a location must be an instance of an EIEIO -;; class inheriting from `xref-location' and implementing -;; `xref-location-group' and `xref-location-marker'. +;; them. More generally, a location must be an instance of a type for +;; which methods `xref-location-group' and `xref-location-marker' are +;; implemented. ;; ;; There's a special kind of xrefs we call "match xrefs", which ;; correspond to search results. For these values, @@ -62,31 +62,48 @@ ;; distinct, because the user can't see the properties when making the ;; choice. ;; +;; Older versions of Xref used EIEIO for implementation of the +;; built-in types, and included a class called `xref-location' which +;; was supposed to be inherited from. Neither is true anymore. +;; ;; See the etags and elisp-mode implementations for full examples. ;;; Code: (require 'cl-lib) -(require 'eieio) (require 'ring) (require 'project) -(defgroup xref nil "Cross-referencing commands" +(eval-and-compile + (when (version< emacs-version "28.0.60") + ;; etags.el in Emacs 26 and 27 uses EIEIO, and its location type + ;; inherits from `xref-location'. + (require 'eieio) + + ;; Suppressing byte-compilation warnings (in Emacs 28+) about + ;; `defclass' not being defined, which happens because the + ;; `require' statement above is not evaluated either. + ;; FIXME: Use `with-suppressed-warnings' when we stop supporting Emacs 26. + (with-no-warnings + (defclass xref-location () () + :documentation "(Obsolete) location represents a position in a file or buffer.")))) + +(defgroup xref nil "Cross-referencing commands." :version "25.1" :group 'tools) ;;; Locations -(defclass xref-location () () - :documentation "A location represents a position in a file or buffer.") - (cl-defgeneric xref-location-marker (location) "Return the marker for LOCATION.") (cl-defgeneric xref-location-group (location) "Return a string used to group a set of locations. -This is typically the filename.") +This is typically a file name, but can also be a package name, or +some other label. + +When it is a file name, it should be the \"expanded\" version.") (cl-defgeneric xref-location-line (_location) "Return the line number corresponding to the location." @@ -96,7 +113,7 @@ This is typically the filename.") "Return the length of the match." nil) -;;;; Commonly needed location classes are defined here: +;;;; Commonly needed location types are defined here: (defcustom xref-file-name-display 'project-relative "Style of file name display in *xref* buffers. @@ -118,19 +135,20 @@ in its full absolute form." ;; FIXME: might be useful to have an optional "hint" i.e. a string to ;; search for in case the line number is slightly out of date. -(defclass xref-file-location (xref-location) - ((file :type string :initarg :file) - (line :type fixnum :initarg :line :reader xref-location-line) - (column :type fixnum :initarg :column :reader xref-file-location-column)) - :documentation "A file location is a file/line/column triple. -Line numbers start from 1 and columns from 0.") +(cl-defstruct (xref-file-location + (:constructor xref-make-file-location (file line column))) + "A file location is a file/line/column triple. +Line numbers start from 1 and columns from 0." + file line column) + +(cl-defmethod xref-location-group ((l xref-file-location)) + (xref-file-location-file l)) -(defun xref-make-file-location (file line column) - "Create and return a new `xref-file-location'." - (make-instance 'xref-file-location :file file :line line :column column)) +(cl-defmethod xref-location-line ((l xref-file-location)) + (xref-file-location-line l)) (cl-defmethod xref-location-marker ((l xref-file-location)) - (with-slots (file line column) l + (pcase-let (((cl-struct xref-file-location file line column) l)) (with-current-buffer (or (get-file-buffer file) (let ((find-file-suppress-same-file-warnings t)) @@ -148,103 +166,58 @@ Line numbers start from 1 and columns from 0.") (forward-char column)) (point-marker)))))) -(defvar xref--project-root-memo nil - "Cons mapping `default-directory' value to the search root.") - -(cl-defmethod xref-location-group ((l xref-file-location)) - (cl-ecase xref-file-name-display - (abs - (oref l file)) - (nondirectory - (file-name-nondirectory (oref l file))) - (project-relative - (unless (and xref--project-root-memo - (equal (car xref--project-root-memo) - default-directory)) - (setq xref--project-root-memo - (cons default-directory - (let ((root - (let ((pr (project-current))) - (and pr (xref--project-root pr))))) - (and root (expand-file-name root)))))) - (let ((file (oref l file)) - (search-root (cdr xref--project-root-memo))) - (if (and search-root - (string-prefix-p search-root file)) - (substring file (length search-root)) - file))))) - -(defclass xref-buffer-location (xref-location) - ((buffer :type buffer :initarg :buffer) - (position :type fixnum :initarg :position))) - -(defun xref-make-buffer-location (buffer position) - "Create and return a new `xref-buffer-location'." - (make-instance 'xref-buffer-location :buffer buffer :position position)) +(cl-defstruct (xref-buffer-location + (:constructor xref-make-buffer-location (buffer position))) + buffer position) (cl-defmethod xref-location-marker ((l xref-buffer-location)) - (with-slots (buffer position) l + (pcase-let (((cl-struct xref-buffer-location buffer position) l)) (let ((m (make-marker))) (move-marker m position buffer)))) (cl-defmethod xref-location-group ((l xref-buffer-location)) - (with-slots (buffer) l + (pcase-let (((cl-struct xref-buffer-location buffer) l)) (or (buffer-file-name buffer) (format "(buffer %s)" (buffer-name buffer))))) -(defclass xref-bogus-location (xref-location) - ((message :type string :initarg :message - :reader xref-bogus-location-message)) - :documentation "Bogus locations are sometimes useful to -indicate errors, e.g. when we know that a function exists but the -actual location is not known.") - -(defun xref-make-bogus-location (message) - "Create and return a new `xref-bogus-location'." - (make-instance 'xref-bogus-location :message message)) +(cl-defstruct (xref-bogus-location + (:constructor xref-make-bogus-location (message))) + "Bogus locations are sometimes useful to indicate errors, +e.g. when we know that a function exists but the actual location +is not known." + message) (cl-defmethod xref-location-marker ((l xref-bogus-location)) - (user-error "%s" (oref l message))) + (user-error "%s" (xref-bogus-location-message l))) (cl-defmethod xref-location-group ((_ xref-bogus-location)) "(No location)") ;;; Cross-reference -(defclass xref-item () - ((summary :type string :initarg :summary - :reader xref-item-summary - :documentation "One line which will be displayed for -this item in the output buffer.") - (location :initarg :location - :reader xref-item-location - :documentation "An object describing how to navigate -to the reference's target.")) - :comment "An xref item describes a reference to a location -somewhere.") - -(defun xref-make (summary location) - "Create and return a new `xref-item'. -SUMMARY is a short string to describe the xref. -LOCATION is an `xref-location'." - (make-instance 'xref-item :summary summary :location location)) - -(defclass xref-match-item () - ((summary :type string :initarg :summary - :reader xref-item-summary) - (location :initarg :location - :type xref-file-location - :reader xref-item-location) - (length :initarg :length :reader xref-match-length)) - :comment "A match xref item describes a search result.") - -(defun xref-make-match (summary location length) - "Create and return a new `xref-match-item'. -SUMMARY is a short string to describe the xref. -LOCATION is an `xref-location'. -LENGTH is the match length, in characters." - (make-instance 'xref-match-item :summary summary - :location location :length length)) +(defmacro xref--defstruct (name &rest fields) + (declare (indent 1)) + `(cl-defstruct ,(if (>= emacs-major-version 27) + name + (remq (assq :noinline name) name)) + ,@fields)) + +(xref--defstruct (xref-item + (:constructor xref-make (summary location)) + (:noinline t)) + "An xref item describes a reference to a location somewhere." + summary location) + +(xref--defstruct (xref-match-item + (:include xref-item) + (:constructor xref-make-match (summary location length)) + (:noinline t)) + "A match xref item describes a search result." + length) + +(cl-defgeneric xref-match-length ((item xref-match-item)) + "Return the length of the match." + (xref-match-item-length item)) ;;; API @@ -270,7 +243,7 @@ generic functions.") The result must be a list of xref objects. If IDENTIFIER contains sufficient information to determine a unique definition, -return only that definition. If there are multiple possible +return only that definition. If there are multiple possible definitions, return all of them. If no definitions can be found, return nil. @@ -290,7 +263,11 @@ find a search tool; by default, this uses \"find | grep\" in the current project's main and external roots." (mapcan (lambda (dir) - (xref-references-in-directory identifier dir)) + (message "Searching %s..." dir) + (redisplay) + (prog1 + (xref-references-in-directory identifier dir) + (message "Searching %s... done" dir))) (let ((pr (project-current t))) (cons (xref--project-root pr) @@ -326,20 +303,19 @@ recognize and then delegate the work to an external process." ;;; misc utilities -(defun xref--alistify (list key test) +(defun xref--alistify (list key) "Partition the elements of LIST into an alist. -KEY extracts the key from an element and TEST is used to compare -keys." - (let ((alist '())) +KEY extracts the key from an element." + (let ((table (make-hash-table :test #'equal))) (dolist (e list) (let* ((k (funcall key e)) - (probe (cl-assoc k alist :test test))) + (probe (gethash k table))) (if probe - (setcdr probe (cons e (cdr probe))) - (push (cons k (list e)) alist)))) + (puthash k (cons e probe) table) + (puthash k (list e) table)))) ;; Put them back in order. - (cl-loop for (key . value) in (reverse alist) - collect (cons key (reverse value))))) + (cl-loop for key being hash-keys of table using (hash-values value) + collect (cons key (nreverse value))))) (defun xref--insert-propertized (props &rest strings) "Insert STRINGS with text properties PROPS." @@ -365,15 +341,9 @@ backward." (t (goto-char start) nil)))) -;;; Marker stack (M-. pushes, M-, pops) - -(defcustom xref-marker-ring-length 16 - "Length of the xref marker ring. -If this variable is not set through Customize, you must call -`xref-set-marker-ring-length' for changes to take effect." - :type 'integer - :initialize #'custom-initialize-default - :set #'xref-set-marker-ring-length) +;; Dummy variable retained for compatibility. +(defvar xref-marker-ring-length 16) +(make-obsolete-variable 'xref-marker-ring-length nil "29.1") (defcustom xref-prompt-for-identifier '(not xref-find-definitions xref-find-definitions-other-window @@ -412,29 +382,81 @@ elements is negated: these commands will NOT prompt." :version "28.1" :package-version '(xref . "1.0.4")) -(defvar xref--marker-ring (make-ring xref-marker-ring-length) - "Ring of markers to implement the marker stack.") +(defcustom xref-auto-jump-to-first-definition nil + "If t, `xref-find-definitions' always jumps to the first result. +`show' means to show the first result's location, but keep the +focus on the Xref buffer's window. +`move' means to only move point to the first result. +This variable also affects the variants of `xref-find-definitions', +such as `xref-find-definitions-other-window'." + :type '(choice (const :tag "Jump" t) + (const :tag "Show" show) + (const :tag "Move point only" move) + (const :tag "No auto-jump" nil)) + :version "28.1" + :package-version '(xref . "1.2.0")) + +(defcustom xref-auto-jump-to-first-xref nil + "If t, `xref-find-references' always jumps to the first result. +`show' means to show the first result's location, but keep the +focus on the Xref buffer's window. +`move' means to only move point to the first result. +This variable also affects commands similar to `xref-find-references', +such as `xref-find-references-at-mouse', `xref-find-apropos', +and `project-find-regexp'. + +Please be careful when changing the value if you are using Emacs 27 +or earlier: it can break `dired-do-find-regexp-and-replace'." + :type '(choice (const :tag "Jump" t) + (const :tag "Show" show) + (const :tag "Move point only" move) + (const :tag "No auto-jump" nil)) + :version "28.1" + :package-version '(xref . "1.2.0")) + +(defvar xref--history (cons nil nil) + "(BACKWARD-STACK . FORWARD-STACK) of markers to visited Xref locations.") -(defun xref-set-marker-ring-length (var val) - "Set `xref-marker-ring-length'. -VAR is the symbol `xref-marker-ring-length' and VAL is the new -value." - (set-default var val) - (if (ring-p xref--marker-ring) - (ring-resize xref--marker-ring val))) +(make-obsolete-variable 'xref-marker-ring nil "29.1") + +(defun xref-set-marker-ring-length (_var _val) + (declare (obsolete nil "29.1")) + nil) (defun xref-push-marker-stack (&optional m) - "Add point M (defaults to `point-marker') to the marker stack." - (ring-insert xref--marker-ring (or m (point-marker)))) + "Add point M (defaults to `point-marker') to the marker stack. +The future stack is erased." + (push (or m (point-marker)) (car xref--history)) + (dolist (mk (cdr xref--history)) + (set-marker mk nil nil)) + (setcdr xref--history nil)) + +;;;###autoload +(define-obsolete-function-alias 'xref-pop-marker-stack #'xref-go-back "29.1") + +;;;###autoload +(defun xref-go-back () + "Go back to the previous position in xref history. +To undo, use \\[xref-go-forward]." + (interactive) + (if (null (car xref--history)) + (user-error "At start of xref history") + (let ((marker (pop (car xref--history)))) + (push (point-marker) (cdr xref--history)) + (switch-to-buffer (or (marker-buffer marker) + (user-error "The marked buffer has been deleted"))) + (goto-char (marker-position marker)) + (set-marker marker nil nil) + (run-hooks 'xref-after-return-hook)))) ;;;###autoload -(defun xref-pop-marker-stack () - "Pop back to where \\[xref-find-definitions] was last invoked." +(defun xref-go-forward () + "Got to the point where a previous \\[xref-go-back] was invoked." (interactive) - (let ((ring xref--marker-ring)) - (when (ring-empty-p ring) - (user-error "Marker stack is empty")) - (let ((marker (ring-remove ring 0))) + (if (null (cdr xref--history)) + (user-error "At end of xref history") + (let ((marker (pop (cdr xref--history)))) + (push (point-marker) (car xref--history)) (switch-to-buffer (or (marker-buffer marker) (user-error "The marked buffer has been deleted"))) (goto-char (marker-position marker)) @@ -457,17 +479,23 @@ value." ;; etags.el needs this (defun xref-clear-marker-stack () - "Discard all markers from the marker stack." - (let ((ring xref--marker-ring)) - (while (not (ring-empty-p ring)) - (let ((marker (ring-remove ring))) - (set-marker marker nil nil))))) + "Discard all markers from the xref history." + (dolist (l (list (car xref--history) (cdr xref--history))) + (dolist (m l) + (set-marker m nil nil))) + (setq xref--history (cons nil nil)) + nil) ;;;###autoload (defun xref-marker-stack-empty-p () - "Return t if the marker stack is empty; nil otherwise." - (ring-empty-p xref--marker-ring)) + "Whether the xref back-history is empty." + (null (car xref--history))) +;; FIXME: rename this to `xref-back-history-empty-p'. +;;;###autoload +(defun xref-forward-history-empty-p () + "Whether the xref forward-history is empty." + (null (cdr xref--history))) (defun xref--goto-char (pos) @@ -478,7 +506,7 @@ value." (goto-char pos)) (defun xref--goto-location (location) - "Set buffer and point according to xref-location LOCATION." + "Set buffer and point according to `xref-location' LOCATION." (let ((marker (xref-location-marker location))) (set-buffer (marker-buffer marker)) (xref--goto-char marker))) @@ -486,9 +514,9 @@ value." (defun xref-pop-to-location (item &optional action) "Go to the location of ITEM and display the buffer. ACTION controls how the buffer is displayed: - nil -- switch-to-buffer - `window' -- pop-to-buffer (other window) - `frame' -- pop-to-buffer (other frame) + nil -- `switch-to-buffer' + `window' -- `pop-to-buffer' (other window) + `frame' -- `pop-to-buffer' (other frame) If SELECT is non-nil, select the target window." (let* ((marker (save-excursion (xref-location-marker (xref-item-location item)))) @@ -596,12 +624,19 @@ SELECT is `quit', also quit the *xref* window." (xref--show-pos-in-buf marker buf)))))) (user-error (message (error-message-string err))))) +(defun xref--set-arrow () + "Set the overlay arrow at the line at point." + (setq overlay-arrow-position + (set-marker (or overlay-arrow-position (make-marker)) + (line-beginning-position)))) + (defun xref-show-location-at-point () "Display the source of xref at point in the appropriate window, if any." (interactive) (let* ((xref (xref--item-at-point)) (xref--current-item xref)) (when xref + (xref--set-arrow) (xref--show-location (xref-item-location xref))))) (defun xref-next-line-no-show () @@ -657,8 +692,9 @@ quit the *xref* buffer." (interactive "P") (let* ((buffer (current-buffer)) (xref (or (xref--item-at-point) - (user-error "No reference at point"))) + (user-error "Choose a reference to visit"))) (xref--current-item xref)) + (xref--set-arrow) (xref--show-location (xref-item-location xref) (if quit 'quit t)) (if (fboundp 'next-error-found) (next-error-found buffer (current-buffer)) @@ -674,7 +710,7 @@ quit the *xref* buffer." "Quit *xref* buffer, then pop the xref marker stack." (interactive) (quit-window) - (xref-pop-marker-stack)) + (xref-go-back)) (defun xref-query-replace-in-results (from to) "Perform interactive replacement of FROM with TO in all displayed xrefs. @@ -739,7 +775,7 @@ references displayed in the current *xref* buffer." (defun xref--outdated-p (item) "Check that the match location at current position is up-to-date. -ITEMS is an xref item which " +ITEMS is an xref item which " ; FIXME: Expand documentation. ;; FIXME: The check should most likely be a generic function instead ;; of the assumption that all matches' summaries relate to the ;; buffer text in a particular way. @@ -877,18 +913,21 @@ beginning of the line." ;; it gets reset to that window's point from time to time). (let ((win (get-buffer-window (current-buffer)))) (and win (set-window-point win (point)))) - (xref--show-location (xref-item-location xref) t)) + (xref--set-arrow) + (let ((xref--current-item xref)) + (xref--show-location (xref-item-location xref) t))) (t (error "No %s xref" (if backward "previous" "next")))))) (defvar xref--button-map (let ((map (make-sparse-keymap))) (define-key map [mouse-1] #'xref-goto-xref) - (define-key map [mouse-2] #'xref--mouse-2) + (define-key map [mouse-2] #'xref-select-and-show-xref) map)) -(defun xref--mouse-2 (event) - "Move point to the button and show the xref definition." +(defun xref-select-and-show-xref (event) + "Move point to the button and show the xref definition. +The window showing the xref buffer will be selected." (interactive "e") (mouse-set-point event) (forward-line 0) @@ -896,6 +935,9 @@ beginning of the line." (xref--search-property 'xref-item)) (xref-show-location-at-point)) +(define-obsolete-function-alias + 'xref--mouse-2 #'xref-select-and-show-xref "28.1") + (defcustom xref-truncation-width 400 "The column to visually \"truncate\" each Xref buffer line to." :type '(choice @@ -935,49 +977,48 @@ beginning of the line." (put-text-property (+ pos xref-truncation-width) eol 'invisible 'ellipsis)))))) (defun xref--insert-xrefs (xref-alist) - "Insert XREF-ALIST in the current-buffer. + "Insert XREF-ALIST in the current buffer. XREF-ALIST is of the form ((GROUP . (XREF ...)) ...), where GROUP is a string for decoration purposes and XREF is an `xref-item' object." (require 'compile) ; For the compilation faces. - (cl-loop for ((group . xrefs) . more1) on xref-alist - for max-line-width = - (cl-loop for xref in xrefs - maximize (let ((line (xref-location-line - (oref xref location)))) - (length (and line (format "%d" line))))) - for line-format = (and max-line-width - (format "%%%dd: " max-line-width)) + (cl-loop for (group . xrefs) in xref-alist + for max-line = (cl-loop for xref in xrefs + maximize (xref-location-line + (xref-item-location xref))) + for line-format = (and max-line + (format "%%%dd: " (1+ (floor (log max-line 10))))) + with item-text-props = (list 'mouse-face 'highlight + 'keymap xref--button-map + 'help-echo + (concat "mouse-2: display in another window, " + "RET or mouse-1: follow reference")) with prev-group = nil with prev-line = nil do (xref--insert-propertized '(face xref-file-header xref-group t) group "\n") - (cl-loop for (xref . more2) on xrefs do - (with-slots (summary location) xref - (let* ((line (xref-location-line location)) - (prefix - (cond - ((not line) " ") - ((and (equal line prev-line) - (equal prev-group group)) - "") - (t (propertize (format line-format line) - 'face 'xref-line-number))))) - ;; Render multiple matches on the same line, together. - (when (and (equal prev-group group) - (not (equal prev-line line))) - (insert "\n")) - (xref--insert-propertized - (list 'xref-item xref - 'mouse-face 'highlight - 'keymap xref--button-map - 'help-echo - (concat "mouse-2: display in another window, " - "RET or mouse-1: follow reference")) - prefix summary) - (setq prev-line line - prev-group group)))) + (dolist (xref xrefs) + (pcase-let (((cl-struct xref-item summary location) xref)) + (let* ((line (xref-location-line location)) + (prefix + (cond + ((not line) " ") + ((and (equal line prev-line) + (equal prev-group group)) + "") + (t (propertize (format line-format line) + 'face 'xref-line-number))))) + ;; Render multiple matches on the same line, together. + (when (and (equal prev-group group) + (or (null line) + (not (equal prev-line line)))) + (insert "\n")) + (xref--insert-propertized (nconc (list 'xref-item xref) + item-text-props) + prefix summary) + (setq prev-line line + prev-group group)))) (insert "\n")) (add-to-invisibility-spec '(ellipsis . t)) (save-excursion @@ -986,13 +1027,49 @@ GROUP is a string for decoration purposes and XREF is an (xref--apply-truncation))) (run-hooks 'xref-after-update-hook)) +(defun xref--group-name-for-display (group project-root) + "Return GROUP formatted in the prefered style. + +The style is determined by the value of `xref-file-name-display'. +If GROUP looks like a file name, its value is formatted according +to that style. Otherwise it is returned unchanged." + ;; XXX: The way we verify that it's indeed a file name and not some + ;; other kind of string, e.g. Java package name or TITLE from + ;; `tags-apropos-additional-actions', is pretty lax. But we don't + ;; want to use `file-exists-p' for performance reasons. If this + ;; ever turns out to be a problem, some other alternatives are to + ;; either have every location type which uses file names format the + ;; values themselves (e.g. by piping through some public function), + ;; or adding a new accessor to locations, like GROUP-TYPE. + (cl-ecase xref-file-name-display + (abs group) + (nondirectory + (if (string-match-p "\\`~?/" group) + (file-name-nondirectory group) + group)) + (project-relative + (if (and project-root + (string-prefix-p project-root group)) + (substring group (length project-root)) + group)))) + (defun xref--analyze (xrefs) - "Find common filenames in XREFS. -Return an alist of the form ((FILENAME . (XREF ...)) ...)." - (xref--alistify xrefs - (lambda (x) - (xref-location-group (xref-item-location x))) - #'equal)) + "Find common groups in XREFS and format group names. +Return an alist of the form ((GROUP . (XREF ...)) ...)." + (let* ((alist + (xref--alistify xrefs + (lambda (x) + (xref-location-group (xref-item-location x))))) + (project (and + (eq xref-file-name-display 'project-relative) + (project-current))) + (project-root (and project + (expand-file-name (xref--project-root project))))) + (mapcar + (lambda (pair) + (cons (xref--group-name-for-display (car pair) project-root) + (cdr pair))) + alist))) (defun xref--show-xref-buffer (fetcher alist) (cl-assert (functionp fetcher)) @@ -1001,13 +1078,16 @@ Return an alist of the form ((FILENAME . (XREF ...)) ...)." (assoc-default 'fetched-xrefs alist) (funcall fetcher))) (xref-alist (xref--analyze xrefs)) - (dd default-directory)) + (dd default-directory) + buf) (with-current-buffer (get-buffer-create xref-buffer-name) (setq default-directory dd) (xref--xref-buffer-mode) (xref--show-common-initialize xref-alist fetcher alist) (pop-to-buffer (current-buffer)) - (current-buffer)))) + (setq buf (current-buffer))) + (xref--auto-jump-first buf (assoc-default 'auto-jump alist)) + buf)) (defun xref--project-root (project) (if (fboundp 'project-root) @@ -1018,8 +1098,10 @@ Return an alist of the form ((FILENAME . (XREF ...)) ...)." (defun xref--show-common-initialize (xref-alist fetcher alist) (setq buffer-undo-list nil) (let ((inhibit-read-only t) - (buffer-undo-list t)) + (buffer-undo-list t) + (inhibit-modification-hooks t)) (erase-buffer) + (setq overlay-arrow-position nil) (xref--insert-xrefs xref-alist) (add-hook 'post-command-hook 'xref--apply-truncation nil t) (goto-char (point-min)) @@ -1031,7 +1113,8 @@ Return an alist of the form ((FILENAME . (XREF ...)) ...)." "Refresh the search results in the current buffer." (interactive) (let ((inhibit-read-only t) - (buffer-undo-list t)) + (buffer-undo-list t) + (inhibit-modification-hooks t)) (save-excursion (condition-case err (let ((alist (xref--analyze (funcall xref--fetcher)))) @@ -1044,19 +1127,36 @@ Return an alist of the form ((FILENAME . (XREF ...)) ...)." (error-message-string err) 'face 'error))))))) +(defun xref--auto-jump-first (buf value) + (when value + (select-window (get-buffer-window buf)) + (goto-char (point-min))) + (cond + ((eq value t) + (xref-next-line-no-show) + (xref-goto-xref)) + ((eq value 'show) + (xref-next-line)) + ((eq value 'move) + (forward-line 1)))) + (defun xref-show-definitions-buffer (fetcher alist) "Show the definitions list in a regular window. When only one definition found, jump to it right away instead." - (let ((xrefs (funcall fetcher))) + (let ((xrefs (funcall fetcher)) + buf) (cond ((not (cdr xrefs)) (xref-pop-to-location (car xrefs) (assoc-default 'display-action alist))) (t - (xref--show-xref-buffer fetcher - (cons (cons 'fetched-xrefs xrefs) - alist)))))) + (setq buf + (xref--show-xref-buffer fetcher + (cons (cons 'fetched-xrefs xrefs) + alist))) + (xref--auto-jump-first buf (assoc-default 'auto-jump alist)) + buf)))) (define-obsolete-function-alias 'xref--show-defs-buffer #'xref-show-definitions-buffer "28.1") @@ -1072,7 +1172,8 @@ local keymap that binds `RET' to `xref-quit-and-goto-xref'." ;; XXX: Make percentage customizable maybe? (max-height (/ (window-height) 2)) (size-fun (lambda (window) - (fit-window-to-buffer window max-height)))) + (fit-window-to-buffer window max-height))) + buf) (cond ((not (cdr xrefs)) (xref-pop-to-location (car xrefs) @@ -1085,7 +1186,9 @@ local keymap that binds `RET' to `xref-quit-and-goto-xref'." (pop-to-buffer (current-buffer) `(display-buffer-in-direction . ((direction . below) (window-height . ,size-fun)))) - (current-buffer)))))) + (setq buf (current-buffer))) + (xref--auto-jump-first buf (assoc-default 'auto-jump alist)) + buf)))) (define-obsolete-function-alias 'xref--show-defs-buffer-at-bottom #'xref-show-definitions-buffer-at-bottom "28.1") @@ -1117,22 +1220,23 @@ between them by typing in the minibuffer with completion." (cl-loop for ((group . xrefs) . more1) on xref-alist do (cl-loop for (xref . more2) on xrefs do - (with-slots (summary location) xref - (let* ((line (xref-location-line location)) - (line-fmt - (if line - (format #("%d:" 0 2 (face xref-line-number)) - line) - "")) - (group-prefix - (substring group group-prefix-length)) - (group-fmt - (propertize group-prefix - 'face 'xref-file-header - 'xref--group group-prefix)) - (candidate - (format "%s:%s%s" group-fmt line-fmt summary))) - (push (cons candidate xref) xref-alist-with-line-info))))) + (let* ((summary (xref-item-summary xref)) + (location (xref-item-location xref)) + (line (xref-location-line location)) + (line-fmt + (if line + (format #("%d:" 0 2 (face xref-line-number)) + line) + "")) + (group-prefix + (substring group group-prefix-length)) + (group-fmt + (propertize group-prefix + 'face 'xref-file-header + 'xref--group group-prefix)) + (candidate + (format "%s:%s%s" group-fmt line-fmt summary))) + (push (cons candidate xref) xref-alist-with-line-info)))) (setq xref (if (not (cdr xrefs)) (car xrefs) @@ -1214,13 +1318,15 @@ definitions." (setq xrefs 'called-already))))))) (funcall xref-show-xrefs-function fetcher `((window . ,(selected-window)) - (display-action . ,display-action)))) + (display-action . ,display-action) + (auto-jump . ,xref-auto-jump-to-first-xref)))) (defun xref--show-defs (xrefs display-action) (xref--push-markers) (funcall xref-show-definitions-function xrefs `((window . ,(selected-window)) - (display-action . ,display-action)))) + (display-action . ,display-action) + (auto-jump . ,xref-auto-jump-to-first-definition)))) (defun xref--push-markers () (unless (region-active-p) (push-mark nil t)) @@ -1243,12 +1349,17 @@ definitions." (xref--prompt-p this-command)) (let ((id (completing-read - (if def - (format "%s (default %s): " - (substring prompt 0 (string-match - "[ :]+\\'" prompt)) - def) - prompt) + ;; `format-prompt' is new in Emacs 28.1 + (if (fboundp 'format-prompt) + (format-prompt (substring prompt 0 (string-match + "[ :]+\\'" prompt)) + def) + (if def + (format "%s (default %s): " + (substring prompt 0 (string-match + "[ :]+\\'" prompt)) + def) + prompt)) (xref-backend-identifier-completion-table backend) nil nil nil 'xref--read-identifier-history def))) @@ -1307,7 +1418,9 @@ prompt for it. If sufficient information is available to determine a unique definition for IDENTIFIER, display it in the selected window. Otherwise, display the list of the possible definitions in a -buffer where the user can select from the list." +buffer where the user can select from the list. + +Use \\[xref-go-back] to return back to where you invoked this command." (interactive (list (xref--read-identifier "Find definitions of: "))) (xref--find-definitions identifier nil)) @@ -1347,15 +1460,33 @@ This command is intended to be bound to a mouse event." (xref-find-definitions identifier) (user-error "No identifier here")))) +;;;###autoload +(defun xref-find-references-at-mouse (event) + "Find references to the identifier at or around mouse click. +This command is intended to be bound to a mouse event." + (interactive "e") + (let ((identifier + (save-excursion + (mouse-set-point event) + (xref-backend-identifier-at-point (xref-find-backend))))) + (if identifier + (let ((xref-prompt-for-identifier nil)) + (xref-find-references identifier)) + (user-error "No identifier here")))) + (declare-function apropos-parse-pattern "apropos" (pattern)) ;;;###autoload (defun xref-find-apropos (pattern) "Find all meaningful symbols that match PATTERN. -The argument has the same meaning as in `apropos'." +The argument has the same meaning as in `apropos'. +See `tags-apropos-additional-actions' for how to augment the +output of this command when the backend is etags." (interactive (list (read-string "Search for pattern (word list or regexp): " - nil 'xref--read-pattern-history))) + nil 'xref--read-pattern-history + (xref-backend-identifier-at-point + (xref-find-backend))))) (require 'apropos) (let* ((newpat (if (and (version< emacs-version "28.0.50") @@ -1380,7 +1511,8 @@ The argument has the same meaning as in `apropos'." ;;; Key bindings ;;;###autoload (define-key esc-map "." #'xref-find-definitions) -;;;###autoload (define-key esc-map "," #'xref-pop-marker-stack) +;;;###autoload (define-key esc-map "," #'xref-go-back) +;;;###autoload (define-key esc-map [?\C-,] #'xref-go-forward) ;;;###autoload (define-key esc-map "?" #'xref-find-references) ;;;###autoload (define-key esc-map [?\C-.] #'xref-find-apropos) ;;;###autoload (define-key ctl-x-4-map "." #'xref-find-definitions-other-window) @@ -1466,18 +1598,18 @@ IGNORES is a list of glob patterns for files to ignore." ;; do that reliably enough, without creating false negatives? (command (xref--rgrep-command (xref--regexp-to-extended regexp) files - (directory-file-name - (file-name-unquote - (file-local-name (expand-file-name dir)))) + "." ignores)) - (def default-directory) + (local-dir (directory-file-name + (file-name-unquote + (file-local-name (expand-file-name dir))))) (buf (get-buffer-create " *xref-grep*")) (`(,grep-re ,file-group ,line-group . ,_) (car grep-regexp-alist)) (status nil) (hits nil)) (with-current-buffer buf (erase-buffer) - (setq default-directory def) + (setq default-directory dir) (setq status (process-file-shell-command command nil t)) (goto-char (point-min)) @@ -1490,7 +1622,7 @@ IGNORES is a list of glob patterns for files to ignore." (user-error "Search failed with status %d: %s" status (buffer-string))) (while (re-search-forward grep-re nil t) (push (list (string-to-number (match-string line-group)) - (match-string file-group) + (concat local-dir (substring (match-string file-group) 1)) (buffer-substring-no-properties (point) (line-end-position))) hits))) (xref--convert-hits (nreverse hits) regexp))) @@ -1511,16 +1643,11 @@ IGNORES is a list of glob patterns for files to ignore." '((grep . ;; '-s' because 'git ls-files' can output broken symlinks. - "xargs -0 grep <C> -snHE -e <R>") + "xargs -0 grep <C> --null -snHE -e <R>") (ripgrep . - ;; Note: by default, ripgrep's output order is non-deterministic - ;; (https://github.com/BurntSushi/ripgrep/issues/152) - ;; because it does the search in parallel. You can use the template - ;; without the '| sort ...' part if GNU sort is not available on - ;; your system and/or stable ordering is not important to you. - ;; Note#2: '!*/' is there to filter out dirs (e.g. submodules). - "xargs -0 rg <C> -nH --no-messages -g '!*/' -e <R> | sort -t: -k1,1 -k2n,2" + ;; '!*/' is there to filter out dirs (e.g. submodules). + "xargs -0 rg <C> --null -nH --no-messages -g '!*/' -e <R>" )) "Associative list mapping program identifiers to command templates. @@ -1542,8 +1669,12 @@ The template should have the following fields: (defcustom xref-search-program 'grep "The program to use for regexp search inside files. -This must reference a corresponding entry in `xref-search-program-alist'." - :type `(choice +This must reference a corresponding entry in `xref-search-program-alist'. + +This variable is used in `xref-matches-in-files', which is the +utility function used by commands like `dired-do-find-regexp' and +`project-find-regexp'." + :type '(choice (const :tag "Use Grep" grep) (const :tag "Use ripgrep" ripgrep) (symbol :tag "User defined")) @@ -1554,7 +1685,10 @@ This must reference a corresponding entry in `xref-search-program-alist'." (defun xref-matches-in-files (regexp files) "Find all matches for REGEXP in FILES. Return a list of xref values. -FILES must be a list of absolute file names." +FILES must be a list of absolute file names. + +See `xref-search-program' and `xref-search-program-alist' for how +to control which program to use when looking for matches." (cl-assert (consp files)) (require 'grep) (defvar grep-highlight-matches) @@ -1612,7 +1746,16 @@ FILES must be a list of absolute file names." (match-string file-group) (buffer-substring-no-properties (point) (line-end-position))) hits))) - (xref--convert-hits (nreverse hits) regexp))) + ;; By default, ripgrep's output order is non-deterministic + ;; (https://github.com/BurntSushi/ripgrep/issues/152) + ;; because it does the search in parallel. + ;; Grep's output also comes out in seemingly arbitrary order, + ;; though stable one. Let's sort both for better UI. + (setq hits + (sort (nreverse hits) + (lambda (h1 h2) + (string< (cadr h1) (cadr h2))))) + (xref--convert-hits hits regexp))) (defun xref--process-file-region ( start end program &optional buffer display @@ -1659,6 +1802,11 @@ directory, used as the root of the ignore globs." (cl-assert (not (string-match-p "\\`~" dir))) (if (not ignores) "" + ;; TODO: All in-tree callers are passing in just "." or "./". + ;; We can simplify. + ;; And, if we ever end up deleting xref-matches-in-directory, move + ;; this function to the project package. + (setq dir (file-name-as-directory dir)) (concat (shell-quote-argument "(") " -path " @@ -1711,27 +1859,31 @@ Such as the current syntax table and the applied syntax properties." (defun xref--convert-hits (hits regexp) (let (xref--last-file-buffer - (tmp-buffer (generate-new-buffer " *xref-temp*"))) + (tmp-buffer (generate-new-buffer " *xref-temp*")) + (remote-id (file-remote-p default-directory)) + (syntax-needed (xref--regexp-syntax-dependent-p regexp))) (unwind-protect - (mapcan (lambda (hit) (xref--collect-matches hit regexp tmp-buffer)) + (mapcan (lambda (hit) + (xref--collect-matches hit regexp tmp-buffer remote-id syntax-needed)) hits) (kill-buffer tmp-buffer)))) -(defun xref--collect-matches (hit regexp tmp-buffer) +(defun xref--collect-matches (hit regexp tmp-buffer remote-id syntax-needed) (pcase-let* ((`(,line ,file ,text) hit) - (remote-id (file-remote-p default-directory)) (file (and file (concat remote-id file))) (buf (xref--find-file-buffer file)) - (syntax-needed (xref--regexp-syntax-dependent-p regexp))) + (inhibit-modification-hooks t)) (if buf (with-current-buffer buf (save-excursion - (goto-char (point-min)) - (forward-line (1- line)) - (xref--collect-matches-1 regexp file line - (line-beginning-position) - (line-end-position) - syntax-needed))) + (save-restriction + (widen) + (goto-char (point-min)) + (forward-line (1- line)) + (xref--collect-matches-1 regexp file line + (line-beginning-position) + (line-end-position) + syntax-needed)))) ;; Using the temporary buffer is both a performance and a buffer ;; management optimization. (with-current-buffer tmp-buffer @@ -1757,34 +1909,36 @@ Such as the current syntax table and the applied syntax properties." syntax-needed))))) (defun xref--collect-matches-1 (regexp file line line-beg line-end syntax-needed) - (let (match-pairs matches) + (let (matches + stop beg end + last-beg last-end + summary-end) (when syntax-needed (syntax-propertize line-end)) - (while (and - ;; REGEXP might match an empty string. Or line. - (or (null match-pairs) - (> (point) line-beg)) - (re-search-forward regexp line-end t)) - (push (cons (match-beginning 0) - (match-end 0)) - match-pairs)) - (setq match-pairs (nreverse match-pairs)) - (while match-pairs - (let* ((beg-end (pop match-pairs)) - (beg-column (- (car beg-end) line-beg)) - (end-column (- (cdr beg-end) line-beg)) - (loc (xref-make-file-location file line beg-column)) - (summary (buffer-substring (if matches (car beg-end) line-beg) - (if match-pairs - (caar match-pairs) - line-end)))) - (when matches - (cl-decf beg-column (- (car beg-end) line-beg)) - (cl-decf end-column (- (car beg-end) line-beg))) - (add-face-text-property beg-column end-column 'xref-match - t summary) - (push (xref-make-match summary loc (- end-column beg-column)) - matches))) + (while (not stop) + (if (and + ;; REGEXP might match an empty string. Or line. + (not (and last-beg (eql end line-beg))) + (re-search-forward regexp line-end t)) + (setq beg (match-beginning 0) + end (match-end 0) + summary-end beg) + (setq stop t + summary-end line-end)) + (when last-beg + (let* ((beg-column (- last-beg line-beg)) + (end-column (- last-end line-beg)) + (summary-start (if matches last-beg line-beg)) + (summary (buffer-substring summary-start + summary-end)) + (loc (xref-make-file-location file line beg-column))) + (add-face-text-property (- last-beg summary-start) + (- last-end summary-start) + 'xref-match t summary) + (push (xref-make-match summary loc (- end-column beg-column)) + matches))) + (setq last-beg beg + last-end end)) (nreverse matches))) (defun xref--find-file-buffer (file) |