diff options
Diffstat (limited to 'lisp/progmodes/xref.el')
| -rw-r--r-- | lisp/progmodes/xref.el | 357 |
1 files changed, 267 insertions, 90 deletions
diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el index e59bfdd36d2..57d803894c8 100644 --- a/lisp/progmodes/xref.el +++ b/lisp/progmodes/xref.el @@ -71,9 +71,6 @@ (require 'ring) (require 'project) -(eval-when-compile - (require 'semantic/symref)) ;; for hit-lines slot - (defgroup xref nil "Cross-referencing commands" :version "25.1" :group 'tools) @@ -101,6 +98,16 @@ This is typically the filename.") ;;;; Commonly needed location classes are defined here: +(defcustom xref-file-name-display 'abs + "Style of file name display in *xref* buffers. +If the value is the symbol `abs', the default, show the file names +in their full absolute form. +If `nondirectory', show only the nondirectory (a.k.a. \"base name\") +part of the file name." + :type '(choice (const :tag "absolute file name" abs) + (const :tag "nondirectory file name" nondirectory)) + :version "27.1") + ;; 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) @@ -129,7 +136,9 @@ Line numbers start from 1 and columns from 0.") (point-marker)))))) (cl-defmethod xref-location-group ((l xref-file-location)) - (oref l file)) + (cl-ecase xref-file-name-display + (abs (oref l file)) + (nondirectory (file-name-nondirectory (oref l file))))) (defclass xref-buffer-location (xref-location) ((buffer :type buffer :initarg :buffer) @@ -317,8 +326,12 @@ backward." ;;; Marker stack (M-. pushes, M-, pops) (defcustom xref-marker-ring-length 16 - "Length of the xref marker ring." - :type 'integer) + "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) (defcustom xref-prompt-for-identifier '(not xref-find-definitions xref-find-definitions-other-window @@ -354,6 +367,14 @@ elements is negated: these commands will NOT prompt." (defvar xref--marker-ring (make-ring xref-marker-ring-length) "Ring of markers to implement the marker stack.") +(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))) + (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)))) @@ -414,7 +435,7 @@ elements is negated: these commands will NOT prompt." (set-buffer (marker-buffer marker)) (xref--goto-char marker))) -(defun xref--pop-to-location (item &optional action) +(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 @@ -439,6 +460,18 @@ If SELECT is non-nil, select the target window." (defconst xref-buffer-name "*xref*" "The name of the buffer to show xrefs.") +(defface xref-file-header '((t :inherit compilation-info)) + "Face used to highlight file header in the xref buffer." + :version "27.1") + +(defface xref-line-number '((t :inherit compilation-line-number)) + "Face for displaying line numbers in the xref buffer." + :version "27.1") + +(defface xref-match '((t :inherit highlight)) + "Face used to highlight matches in the xref buffer." + :version "27.1") + (defmacro xref--with-dedicated-window (&rest body) `(let* ((xref-w (get-buffer-window xref-buffer-name)) (xref-w-dedicated (window-dedicated-p xref-w))) @@ -456,6 +489,9 @@ If SELECT is non-nil, select the target window." (defvar-local xref--original-window nil "The original window this xref buffer was created from.") +(defvar-local xref--fetcher nil + "The original function to call to fetch the list of xrefs.") + (defun xref--show-pos-in-buf (pos buf) "Goto and display position POS of buffer BUF in a window. Honor `xref--original-window-intent', run `xref-after-jump-hook' @@ -465,27 +501,18 @@ and finally return the window." (or (eq xref--original-window-intent 'frame) pop-up-frames)) (action - (cond ((memq - xref--original-window-intent - '(window frame)) + (cond ((eq xref--original-window-intent 'frame) t) + ((eq xref--original-window-intent 'window) + `((xref--display-buffer-in-other-window) + (window . ,xref--original-window))) ((and (window-live-p xref--original-window) (or (not (window-dedicated-p xref--original-window)) (eq (window-buffer xref--original-window) buf))) - `(,(lambda (buf _alist) - (set-window-buffer xref--original-window buf) - xref--original-window)))))) - (with-selected-window - (with-selected-window - ;; Just before `display-buffer', place ourselves in the - ;; original window to suggest preserving it. Of course, if - ;; user has deleted the original window, all bets are off, - ;; just use the selected one. - (or (and (window-live-p xref--original-window) - xref--original-window) - (selected-window)) - (display-buffer buf action)) + `((xref--display-buffer-in-window) + (window . ,xref--original-window)))))) + (with-selected-window (display-buffer buf action) (xref--goto-char pos) (run-hooks 'xref-after-jump-hook) (let ((buf (current-buffer))) @@ -493,6 +520,19 @@ and finally return the window." (setq-local other-window-scroll-buffer buf))) (selected-window)))) +(defun xref--display-buffer-in-other-window (buffer alist) + (let ((window (assoc-default 'window alist))) + (cl-assert window) + (xref--with-dedicated-window + (with-selected-window window + (display-buffer buffer t))))) + +(defun xref--display-buffer-in-window (buffer alist) + (let ((window (assoc-default 'window alist))) + (cl-assert window) + (with-selected-window window + (display-buffer buffer '(display-buffer-same-window))))) + (defun xref--show-location (location &optional select) "Help `xref-show-xref' and `xref-goto-xref' do their job. Go to LOCATION and if SELECT is non-nil select its window. If @@ -503,8 +543,9 @@ SELECT is `quit', also quit the *xref* window." (xref-buffer (current-buffer))) (cond (select (if (eq select 'quit) (quit-window nil nil)) - (with-current-buffer xref-buffer - (select-window (xref--show-pos-in-buf marker buf)))) + (select-window + (with-current-buffer xref-buffer + (xref--show-pos-in-buf marker buf)))) (t (save-selected-window (xref--with-dedicated-window @@ -541,9 +582,12 @@ SELECT is `quit', also quit the *xref* window." Non-interactively, non-nil QUIT means to first quit the *xref* buffer." (interactive) - (let ((xref (or (xref--item-at-point) - (user-error "No reference at point")))) - (xref--show-location (xref-item-location xref) (if quit 'quit t)))) + (let* ((buffer (current-buffer)) + (xref (or (xref--item-at-point) + (user-error "No reference at point"))) + (xref--current-item xref)) + (xref--show-location (xref-item-location xref) (if quit 'quit t)) + (next-error-found buffer (current-buffer)))) (defun xref-quit-and-goto-xref () "Quit *xref* buffer, then jump to xref on current line." @@ -677,6 +721,7 @@ references displayed in the current *xref* buffer." ;; suggested by Johan Claesson "to further reduce finger movement": (define-key map (kbd ".") #'xref-next-line) (define-key map (kbd ",") #'xref-prev-line) + (define-key map (kbd "g") #'xref-revert-buffer) map)) (define-derived-mode xref--xref-buffer-mode special-mode "XREF" @@ -685,14 +730,26 @@ references displayed in the current *xref* buffer." (setq next-error-function #'xref--next-error-function) (setq next-error-last-buffer (current-buffer))) +(defvar xref--transient-buffer-mode-map + (let ((map (make-sparse-keymap))) + (define-key map (kbd "RET") #'xref-quit-and-goto-xref) + (set-keymap-parent map xref--xref-buffer-mode-map) + map)) + +(define-derived-mode xref--transient-buffer-mode + xref--xref-buffer-mode + "XREF Transient") + (defun xref--next-error-function (n reset?) (when reset? (goto-char (point-min))) (let ((backward (< n 0)) (n (abs n)) (xref nil)) - (dotimes (_ n) - (setq xref (xref--search-property 'xref-item backward))) + (if (= n 0) + (setq xref (get-text-property (point) 'xref-item)) + (dotimes (_ n) + (setq xref (xref--search-property 'xref-item backward)))) (cond (xref ;; Save the current position (when the buffer is visible, ;; it gets reset to that window's point from time to time). @@ -704,7 +761,6 @@ references displayed in the current *xref* buffer." (defvar xref--button-map (let ((map (make-sparse-keymap))) - (define-key map [(control ?m)] #'xref-goto-xref) (define-key map [mouse-1] #'xref-goto-xref) (define-key map [mouse-2] #'xref--mouse-2) map)) @@ -714,7 +770,8 @@ references displayed in the current *xref* buffer." (interactive "e") (mouse-set-point event) (forward-line 0) - (xref--search-property 'xref-item) + (or (get-text-property (point) 'xref-item) + (xref--search-property 'xref-item)) (xref-show-location-at-point)) (defun xref--insert-xrefs (xref-alist) @@ -732,18 +789,17 @@ GROUP is a string for decoration purposes and XREF is an for line-format = (and max-line-width (format "%%%dd: " max-line-width)) do - (xref--insert-propertized '(face compilation-info) group "\n") + (xref--insert-propertized '(face xref-file-header) group "\n") (cl-loop for (xref . more2) on xrefs do (with-slots (summary location) xref (let* ((line (xref-location-line location)) (prefix (if line (propertize (format line-format line) - 'face 'compilation-line-number) + 'face 'xref-line-number) " "))) (xref--insert-propertized (list 'xref-item xref - ;; 'face 'font-lock-keyword-face 'mouse-face 'highlight 'keymap xref--button-map 'help-echo @@ -760,47 +816,121 @@ Return an alist of the form ((FILENAME . (XREF ...)) ...)." (xref-location-group (xref-item-location x))) #'equal)) -(defun xref--show-xref-buffer (xrefs alist) - (let ((xref-alist (xref--analyze xrefs))) +(defun xref--show-xref-buffer (fetcher alist) + (cl-assert (functionp fetcher)) + (let* ((xrefs + (or + (assoc-default 'fetched-xrefs alist) + (funcall fetcher))) + (xref-alist (xref--analyze xrefs))) (with-current-buffer (get-buffer-create xref-buffer-name) - (setq buffer-undo-list nil) - (let ((inhibit-read-only t) - (buffer-undo-list t)) - (erase-buffer) - (xref--insert-xrefs xref-alist) - (xref--xref-buffer-mode) - (pop-to-buffer (current-buffer)) - (goto-char (point-min)) - (setq xref--original-window (assoc-default 'window alist) - xref--original-window-intent (assoc-default 'display-action alist)) - (current-buffer))))) + (xref--xref-buffer-mode) + (xref--show-common-initialize xref-alist fetcher alist) + (pop-to-buffer (current-buffer)) + (current-buffer)))) + +(defun xref--show-common-initialize (xref-alist fetcher alist) + (setq buffer-undo-list nil) + (let ((inhibit-read-only t) + (buffer-undo-list t)) + (erase-buffer) + (xref--insert-xrefs xref-alist) + (goto-char (point-min)) + (setq xref--original-window (assoc-default 'window alist) + xref--original-window-intent (assoc-default 'display-action alist)) + (setq xref--fetcher fetcher))) + +(defun xref-revert-buffer () + "Refresh the search results in the current buffer." + (interactive) + (let ((inhibit-read-only t) + (buffer-undo-list t)) + (save-excursion + (erase-buffer) + (condition-case err + (xref--insert-xrefs + (xref--analyze (funcall xref--fetcher))) + (user-error + (insert + (propertize + (error-message-string err) + 'face 'error)))) + (goto-char (point-min))))) + +(defun xref--show-defs-buffer (fetcher alist) + (let ((xrefs (funcall fetcher))) + (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)))))) + +(defun xref--show-defs-buffer-at-bottom (fetcher alist) + "Show definitions list in a window at the bottom. +When there is more than one definition, split the selected window +and show the list in a small window at the bottom. And use a +local keymap that binds `RET' to `xref-quit-and-goto-xref'." + (let ((xrefs (funcall fetcher))) + (cond + ((not (cdr xrefs)) + (xref-pop-to-location (car xrefs) + (assoc-default 'display-action alist))) + (t + (with-current-buffer (get-buffer-create xref-buffer-name) + (xref--transient-buffer-mode) + (xref--show-common-initialize (xref--analyze xrefs) fetcher alist) + (pop-to-buffer (current-buffer) + '(display-buffer-in-direction . ((direction . below)))) + (current-buffer)))))) -;; This part of the UI seems fairly uncontroversial: it reads the -;; identifier and deals with the single definition case. -;; (FIXME: do we really want this case to be handled like that in -;; "find references" and "find regexp searches"?) -;; -;; The controversial multiple definitions case is handed off to -;; xref-show-xrefs-function. +(defcustom xref-show-xrefs-function 'xref--show-xref-buffer + "Function to display a list of search results. + +It should accept two arguments: FETCHER and ALIST. + +FETCHER is a function of no arguments that returns a list of xref +values. It must not depend on the current buffer or selected +window. + +ALIST can include, but limited to, the following keys: + +WINDOW for the window that was selected before the current +command was called. -(defvar xref-show-xrefs-function 'xref--show-xref-buffer - "Function to display a list of xrefs.") +DISPLAY-ACTION indicates where the target location should be +displayed. The possible values are nil, `window' meaning the +other window, or `frame' meaning the other frame." + :type 'function) + +(defcustom xref-show-definitions-function 'xref--show-defs-buffer + "Function to display a list of definitions. + +Accepts the same arguments as `xref-show-xrefs-function'." + :type 'function) (defvar xref--read-identifier-history nil) (defvar xref--read-pattern-history nil) -(defun xref--show-xrefs (xrefs display-action &optional always-show-list) - (cond - ((and (not (cdr xrefs)) (not always-show-list)) - (xref-push-marker-stack) - (xref--pop-to-location (car xrefs) display-action)) - (t - (xref-push-marker-stack) - (funcall xref-show-xrefs-function xrefs - `((window . ,(selected-window)) - (display-action . ,display-action)))))) +(defun xref--show-xrefs (fetcher display-action) + (xref--push-markers) + (funcall xref-show-xrefs-function fetcher + `((window . ,(selected-window)) + (display-action . ,display-action)))) + +(defun xref--show-defs (xrefs display-action) + (xref--push-markers) + (funcall xref-show-definitions-function xrefs + `((window . ,(selected-window)) + (display-action . ,display-action)))) + +(defun xref--push-markers () + (unless (region-active-p) (push-mark nil t)) + (xref-push-marker-stack)) (defun xref--prompt-p (command) (or (eq xref-prompt-for-identifier t) @@ -811,34 +941,66 @@ Return an alist of the form ((FILENAME . (XREF ...)) ...)." (defun xref--read-identifier (prompt) "Return the identifier at point or read it from the minibuffer." (let* ((backend (xref-find-backend)) - (id (xref-backend-identifier-at-point backend))) + (def (xref-backend-identifier-at-point backend))) (cond ((or current-prefix-arg - (not id) + (not def) (xref--prompt-p this-command)) - (completing-read (if id - (format "%s (default %s): " - (substring prompt 0 (string-match - "[ :]+\\'" prompt)) - id) - prompt) - (xref-backend-identifier-completion-table backend) - nil nil nil - 'xref--read-identifier-history id)) - (t id)))) + (let ((id + (completing-read + (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))) + (if (equal id "") + (or def (user-error "There is no defailt identifier")) + id))) + (t def)))) ;;; Commands (defun xref--find-xrefs (input kind arg display-action) - (let ((xrefs (funcall (intern (format "xref-backend-%s" kind)) - (xref-find-backend) - arg))) - (unless xrefs - (user-error "No %s found for: %s" (symbol-name kind) input)) - (xref--show-xrefs xrefs display-action))) + (xref--show-xrefs + (xref--create-fetcher input kind arg) + display-action)) (defun xref--find-definitions (id display-action) - (xref--find-xrefs id 'definitions id display-action)) + (xref--show-defs + (xref--create-fetcher id 'definitions id) + display-action)) + +(defun xref--create-fetcher (input kind arg) + "Return an xref list fetcher function. + +It revisits the saved position and delegates the finding logic to +the xref backend method indicated by KIND and passes ARG to it." + (let* ((orig-buffer (current-buffer)) + (orig-position (point)) + (backend (xref-find-backend)) + (method (intern (format "xref-backend-%s" kind)))) + (lambda () + (save-excursion + ;; Xref methods are generally allowed to depend on the text + ;; around point, not just on their explicit arguments. + ;; + ;; There is only so much we can do, however, to recreate that + ;; context, given that the user is free to change the buffer + ;; contents freely in the meantime. + (when (buffer-live-p orig-buffer) + (set-buffer orig-buffer) + (ignore-errors (goto-char orig-position))) + (let ((xrefs (funcall method backend arg))) + (unless xrefs + (xref--not-found-error kind input)) + xrefs))))) + +(defun xref--not-found-error (kind input) + (user-error "No %s found for: %s" (symbol-name kind) input)) ;;;###autoload (defun xref-find-definitions (identifier) @@ -876,6 +1038,19 @@ is nil, prompt only if there's no usable symbol at point." (interactive (list (xref--read-identifier "Find references of: "))) (xref--find-xrefs identifier 'references identifier nil)) +;;;###autoload +(defun xref-find-definitions-at-mouse (event) + "Find the definition of 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 + (xref-find-definitions identifier) + (user-error "No identifier here")))) + (declare-function apropos-parse-pattern "apropos" (pattern)) ;;;###autoload @@ -976,7 +1151,7 @@ IGNORES is a list of glob patterns." ;; do that reliably enough, without creating false negatives? (command (xref--rgrep-command (xref--regexp-to-extended regexp) files - (expand-file-name dir) + (file-local-name (expand-file-name dir)) ignores)) (def default-directory) (buf (get-buffer-create " *xref-grep*")) @@ -987,7 +1162,7 @@ IGNORES is a list of glob patterns." (erase-buffer) (setq default-directory def) (setq status - (call-process-shell-command command nil t)) + (process-file-shell-command command nil t)) (goto-char (point-min)) ;; Can't use the exit status: Grep exits with 1 to mean "no ;; matches found". Find exits with 1 if any of the invocations @@ -1028,7 +1203,8 @@ IGNORES is a list of glob patterns." IGNORES is a list of glob patterns. DIR is an absolute directory, used as the root of the ignore globs." (cl-assert (not (string-match-p "\\`~" dir))) - (when ignores + (if (not ignores) + "" (concat (shell-quote-argument "(") " -path " @@ -1089,6 +1265,7 @@ Such as the current syntax table and the applied syntax properties." (defun xref--collect-matches (hit regexp tmp-buffer) (pcase-let* ((`(,line ,file ,text) hit) + (file (and file (concat (file-remote-p default-directory) file))) (buf (xref--find-buffer-visiting file)) (syntax-needed (xref--regexp-syntax-dependent-p regexp))) (if buf @@ -1139,7 +1316,7 @@ Such as the current syntax table and the applied syntax properties." (end-column (- (match-end 0) line-beg)) (loc (xref-make-file-location file line beg-column)) (summary (buffer-substring line-beg line-end))) - (add-face-text-property beg-column end-column 'highlight + (add-face-text-property beg-column end-column 'xref-match t summary) (push (xref-make-match summary loc (- end-column beg-column)) matches))) |