diff options
Diffstat (limited to 'lisp/progmodes/xref.el')
| -rw-r--r-- | lisp/progmodes/xref.el | 238 |
1 files changed, 166 insertions, 72 deletions
diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el index 18fdd963fb1..d3780d571fc 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.0.4 +;; Version: 1.1.0 ;; Package-Requires: ((emacs "26.1")) ;; This is a GNU ELPA :core package. Avoid functionality that is not @@ -24,11 +24,6 @@ ;;; Commentary: -;; NOTE: The xref API is still experimental and can change in major, -;; backward-incompatible ways. Everyone is encouraged to try it, and -;; report to us any problems or use cases we hadn't anticipated, by -;; sending an email to emacs-devel, or `M-x report-emacs-bug'. -;; ;; This file provides a somewhat generic infrastructure for cross ;; referencing commands, in particular "find-definition". ;; @@ -97,17 +92,13 @@ This is typically the filename.") "Return the line number corresponding to the location." nil) -(cl-defgeneric xref-location-column (_location) - "Return the exact column corresponding to the location." - nil) - (cl-defgeneric xref-match-length (_item) "Return the length of the match." nil) ;;;; Commonly needed location classes are defined here: -(defcustom xref-file-name-display 'abs +(defcustom xref-file-name-display 'project-relative "Style of file name display in *xref* buffers. If the value is the symbol `abs', the default, show the file names @@ -130,7 +121,7 @@ in its full absolute form." (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-location-column)) + (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.") @@ -415,6 +406,12 @@ elements is negated: these commands will NOT prompt." "Functions called after returning to a pre-jump location." :type 'hook) +(defcustom xref-after-update-hook nil + "Functions called after the xref buffer is updated." + :type 'hook + :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.") @@ -519,7 +516,7 @@ If SELECT is non-nil, select the target window." "Face for displaying line numbers in the xref buffer." :version "27.1") -(defface xref-match '((t :inherit highlight)) +(defface xref-match '((t :inherit match)) "Face used to highlight matches in the xref buffer." :version "27.1") @@ -607,16 +604,26 @@ SELECT is `quit', also quit the *xref* window." (when xref (xref--show-location (xref-item-location xref))))) +(defun xref-next-line-no-show () + "Move to the next xref but don't display its source." + (interactive) + (xref--search-property 'xref-item)) + (defun xref-next-line () "Move to the next xref and display its source in the appropriate window." (interactive) - (xref--search-property 'xref-item) + (xref-next-line-no-show) (xref-show-location-at-point)) +(defun xref-prev-line-no-show () + "Move to the previous xref but don't display its source." + (interactive) + (xref--search-property 'xref-item t)) + (defun xref-prev-line () "Move to the previous xref and display its source in the appropriate window." (interactive) - (xref--search-property 'xref-item t) + (xref-prev-line-no-show) (xref-show-location-at-point)) (defun xref-next-group () @@ -645,12 +652,12 @@ SELECT is `quit', also quit the *xref* window." (defun xref-goto-xref (&optional quit) "Jump to the xref on the current line and select its window. -Non-interactively, non-nil QUIT, or interactively, with prefix argument -means to first quit the *xref* buffer." +If QUIT is non-nil (interactively, with prefix argument), also +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--show-location (xref-item-location xref) (if quit 'quit t)) (if (fboundp 'next-error-found) @@ -713,10 +720,7 @@ references displayed in the current *xref* buffer." (push pair all-pairs) ;; Perform sanity check first. (xref--goto-location loc) - (if (xref--outdated-p item - (buffer-substring-no-properties - (line-beginning-position) - (line-end-position))) + (if (xref--outdated-p item) (message "Search result out of date, skipping") (cond ((null file-buf) @@ -733,18 +737,38 @@ references displayed in the current *xref* buffer." (move-marker (car pair) nil) (move-marker (cdr pair) nil))))))) -(defun xref--outdated-p (item line-text) - ;; FIXME: The check should probably be a generic function instead of - ;; the assumption that all matches contain the full line as summary. - (let ((summary (xref-item-summary item)) - (strip (lambda (s) (if (string-match "\r\\'" s) - (substring-no-properties s 0 -1) - s)))) +(defun xref--outdated-p (item) + "Check that the match location at current position is up-to-date. +ITEMS is an xref item which " + ;; 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. + (let* ((summary (xref-item-summary item)) + ;; Sometimes buffer contents include ^M, and sometimes Grep + ;; output includes it, and they don't always match. + (strip (lambda (s) (if (string-match "\r\\'" s) + (substring-no-properties s 0 -1) + s))) + (stripped-summary (funcall strip summary)) + (lendpos (line-end-position)) + (check (lambda () + (let ((comparison-end + (+ (point) (length stripped-summary)))) + (and (>= lendpos comparison-end) + (equal stripped-summary + (buffer-substring-no-properties + (point) comparison-end))))))) (not - ;; Sometimes buffer contents include ^M, and sometimes Grep - ;; output includes it, and they don't always match. - (equal (funcall strip line-text) - (funcall strip summary))))) + (or + ;; Either summary contains match text and after + ;; (2nd+ match on the line)... + (funcall check) + ;; ...or it starts at bol, includes the match and after. + (and (< (point) (+ (line-beginning-position) + (length stripped-summary))) + (save-excursion + (forward-line 0) + (funcall check))))))) ;; FIXME: Write a nicer UI. (defun xref--query-replace-1 (from to iter) @@ -872,6 +896,44 @@ beginning of the line." (xref--search-property 'xref-item)) (xref-show-location-at-point)) +(defcustom xref-truncation-width 400 + "The column to visually \"truncate\" each Xref buffer line to." + :type '(choice + (integer :tag "Number of columns") + (const :tag "Disable truncation" nil))) + +(defun xref--apply-truncation () + (let ((bol (line-beginning-position)) + (eol (line-end-position)) + (inhibit-read-only t) + pos adjusted-bol) + (when (and xref-truncation-width + (> (- eol bol) xref-truncation-width) + ;; Either truncation not applied yet, or it hides the current + ;; position: need to refresh. + (or (and (null (get-text-property (1- eol) 'invisible)) + (null (get-text-property bol 'invisible))) + (get-text-property (point) 'invisible))) + (setq adjusted-bol + (cond + ((eq (get-text-property bol 'face) 'xref-line-number) + (next-single-char-property-change bol 'face)) + (t bol))) + (cond + ((< (- (point) bol) xref-truncation-width) + (setq pos (+ bol xref-truncation-width)) + (remove-text-properties bol pos '(invisible)) + (put-text-property pos eol 'invisible 'ellipsis)) + ((< (- eol (point)) xref-truncation-width) + (setq pos (- eol xref-truncation-width)) + (remove-text-properties pos eol '(invisible)) + (put-text-property adjusted-bol pos 'invisible 'ellipsis)) + (t + (setq pos (- (point) (/ xref-truncation-width 2))) + (put-text-property adjusted-bol pos 'invisible 'ellipsis) + (remove-text-properties pos (+ pos xref-truncation-width) '(invisible)) + (put-text-property (+ pos xref-truncation-width) eol 'invisible 'ellipsis)))))) + (defun xref--insert-xrefs (xref-alist) "Insert XREF-ALIST in the current-buffer. XREF-ALIST is of the form ((GROUP . (XREF ...)) ...), where @@ -886,30 +948,27 @@ GROUP is a string for decoration purposes and XREF is an (length (and line (format "%d" line))))) for line-format = (and max-line-width (format "%%%dd: " max-line-width)) - with prev-line-key = nil + 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)) - (new-summary summary) - (line-key (list (xref-location-group location) line)) (prefix - (if line - (propertize (format line-format line) - 'face 'xref-line-number) - " "))) + (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 line (equal prev-line-key line-key)) - (when-let ((column (xref-location-column location))) - (delete-region - (save-excursion - (forward-line -1) - (move-to-column (+ (length prefix) column)) - (point)) - (point)) - (setq new-summary (substring summary column) prefix ""))) + (when (and (equal prev-group group) + (or (null line) + (not (equal prev-line line)))) + (insert "\n")) (xref--insert-propertized (list 'xref-item xref 'mouse-face 'highlight @@ -917,9 +976,16 @@ GROUP is a string for decoration purposes and XREF is an 'help-echo (concat "mouse-2: display in another window, " "RET or mouse-1: follow reference")) - prefix new-summary) - (setq prev-line-key line-key))) - (insert "\n")))) + prefix summary) + (setq prev-line line + prev-group group)))) + (insert "\n")) + (add-to-invisibility-spec '(ellipsis . t)) + (save-excursion + (goto-char (point-min)) + (while (= 0 (forward-line 1)) + (xref--apply-truncation))) + (run-hooks 'xref-after-update-hook)) (defun xref--analyze (xrefs) "Find common filenames in XREFS. @@ -956,6 +1022,7 @@ Return an alist of the form ((FILENAME . (XREF ...)) ...)." (buffer-undo-list t)) (erase-buffer) (xref--insert-xrefs xref-alist) + (add-hook 'post-command-hook 'xref--apply-truncation nil t) (goto-char (point-min)) (setq xref--original-window (assoc-default 'window alist) xref--original-window-intent (assoc-default 'display-action alist)) @@ -1024,6 +1091,12 @@ local keymap that binds `RET' to `xref-quit-and-goto-xref'." (define-obsolete-function-alias 'xref--show-defs-buffer-at-bottom #'xref-show-definitions-buffer-at-bottom "28.1") +(defun xref--completing-read-group (cand transform) + "Return group title of candidate CAND or TRANSFORM the candidate." + (if transform + (substring cand (1+ (next-single-property-change 0 'xref--group cand))) + (get-text-property 0 'xref--group cand))) + (defun xref-show-definitions-completing-read (fetcher alist) "Let the user choose the target definition with completion. @@ -1052,10 +1125,12 @@ between them by typing in the minibuffer with completion." (format #("%d:" 0 2 (face xref-line-number)) line) "")) + (group-prefix + (substring group group-prefix-length)) (group-fmt - (propertize - (substring group group-prefix-length) - 'face 'xref-file-header)) + (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))))) @@ -1067,7 +1142,9 @@ between them by typing in the minibuffer with completion." (lambda (string pred action) (cond ((eq action 'metadata) - '(metadata . ((category . xref-location)))) + `(metadata + . ((category . xref-location) + (group-function . ,#'xref--completing-read-group)))) (t (complete-with-action action collection string pred))))) (def (caar collection))) @@ -1279,7 +1356,9 @@ This command is intended to be bound to a mouse event." The argument has the same meaning as in `apropos'." (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") @@ -1390,8 +1469,9 @@ 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 - (file-name-as-directory - (file-local-name (expand-file-name dir))) + (directory-file-name + (file-name-unquote + (file-local-name (expand-file-name dir)))) ignores)) (def default-directory) (buf (get-buffer-create " *xref-grep*")) @@ -1508,6 +1588,8 @@ FILES must be a list of absolute file names." #'tramp-file-local-name #'file-local-name) files))) + (when (file-name-quoted-p (car files)) + (setq files (mapcar #'file-name-unquote files))) (with-current-buffer output (erase-buffer) (with-temp-buffer @@ -1647,12 +1729,14 @@ Such as the current syntax table and the applied syntax properties." (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 @@ -1678,20 +1762,30 @@ 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 (matches) + (let (match-pairs matches) (when syntax-needed (syntax-propertize line-end)) - ;; FIXME: This results in several lines with the same - ;; summary. Solve with composite pattern? (while (and ;; REGEXP might match an empty string. Or line. - (or (null matches) + (or (null match-pairs) (> (point) line-beg)) (re-search-forward regexp line-end t)) - (let* ((beg-column (- (match-beginning 0) line-beg)) - (end-column (- (match-end 0) line-beg)) + (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 line-beg line-end))) + (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)) |