consult-xref.el (4738B)
1 ;;; consult-xref.el --- Xref integration for Consult -*- lexical-binding: t -*- 2 3 ;; Copyright (C) 2021-2024 Free Software Foundation, Inc. 4 5 ;; This file is part of GNU Emacs. 6 7 ;; This program is free software: you can redistribute it and/or modify 8 ;; it under the terms of the GNU General Public License as published by 9 ;; the Free Software Foundation, either version 3 of the License, or 10 ;; (at your option) any later version. 11 12 ;; This program is distributed in the hope that it will be useful, 13 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 ;; GNU General Public License for more details. 16 17 ;; You should have received a copy of the GNU General Public License 18 ;; along with this program. If not, see <https://www.gnu.org/licenses/>. 19 20 ;;; Commentary: 21 22 ;; Provides Xref integration for Consult. This is an extra package, to 23 ;; allow lazy loading of xref.el. The `consult-xref' function is 24 ;; autoloaded. 25 26 ;;; Code: 27 28 (require 'consult) 29 (require 'xref) 30 (eval-when-compile (require 'subr-x)) 31 32 (defvar consult-xref--history nil) 33 34 (defvar consult-xref--fetcher nil 35 "The current xref fetcher. 36 The fetch is stored globally such that it can be accessed by 37 Embark for `embark-export'.") 38 39 (defvar consult-xref--preview 40 '(xref-buffer-location xref-file-location xref-etags-location) 41 "Only the xref types listed here are previewed.") 42 43 (defun consult-xref--candidates () 44 "Return xref candidate list." 45 (let ((root (consult--project-root))) 46 (mapcar (lambda (xref) 47 (let* ((loc (xref-item-location xref)) 48 (group (xref-location-group loc)) 49 (group (if root (string-remove-prefix root group) group)) 50 (cand (consult--format-file-line-match 51 group 52 (or (xref-location-line loc) 0) 53 (xref-item-summary xref)))) 54 (add-text-properties 55 0 1 `(consult-xref ,xref consult--prefix-group ,group) cand) 56 cand)) 57 (funcall consult-xref--fetcher)))) 58 59 (defun consult-xref--preview (display) 60 "Xref preview with DISPLAY function." 61 (let ((open (consult--temporary-files)) 62 (preview (consult--jump-preview))) 63 (lambda (action cand) 64 (unless cand 65 (funcall open)) 66 (let ((consult--buffer-display display)) 67 (funcall preview action 68 (when-let ((loc (and cand (eq action 'preview) 69 (xref-item-location cand))) 70 (type (type-of loc)) 71 ;; Only preview xrefs listed in consult-xref--preview 72 ((memq type consult-xref--preview))) 73 (pcase type 74 ((or 'xref-file-location 'xref-etags-location) 75 (consult--marker-from-line-column 76 (funcall open 77 ;; xref-location-group returns the file name 78 (let ((xref-file-name-display 'abs)) 79 (xref-location-group loc))) 80 (xref-location-line loc) 81 (if (eq type 'xref-file-location) 82 (xref-file-location-column loc) 83 0))) 84 (_ (xref-location-marker loc))))))))) 85 86 ;;;###autoload 87 (defun consult-xref (fetcher &optional alist) 88 "Show xrefs with preview in the minibuffer. 89 90 This function can be used for `xref-show-xrefs-function'. 91 See `xref-show-xrefs-function' for the description of the 92 FETCHER and ALIST arguments." 93 (let* ((consult-xref--fetcher fetcher) 94 (candidates (consult-xref--candidates)) 95 (display (alist-get 'display-action alist)) 96 (this-command #'consult-xref)) 97 (unless candidates 98 (user-error "No xref locations")) 99 (xref-pop-to-location 100 (if (cdr candidates) 101 (consult--read 102 candidates 103 :prompt "Go to xref: " 104 :history 'consult-xref--history 105 :require-match t 106 :sort nil 107 :category 'consult-xref 108 :group #'consult--prefix-group 109 :state 110 ;; do not preview other frame 111 (when-let (fun (pcase-exhaustive display 112 ('frame nil) 113 ('window #'switch-to-buffer-other-window) 114 ('nil #'switch-to-buffer))) 115 (consult-xref--preview fun)) 116 :lookup (apply-partially #'consult--lookup-prop 'consult-xref)) 117 (get-text-property 0 'consult-xref (car candidates))) 118 display))) 119 120 (provide 'consult-xref) 121 ;;; consult-xref.el ends here