consult-xref.el (4721B)
1 ;;; consult-xref.el --- Xref integration for Consult -*- lexical-binding: t -*- 2 3 ;; Copyright (C) 2021, 2022 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 <http://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 31 (defvar consult-xref--history nil) 32 33 (defun consult-xref--candidates (xrefs) 34 "Return candidate list from XREFS." 35 (let ((root (consult--project-root))) 36 (mapcar (lambda (xref) 37 (let* ((loc (xref-item-location xref)) 38 (group (if (fboundp 'xref--group-name-for-display) 39 ;; This function is available in xref 1.3.2 40 (xref--group-name-for-display 41 (xref-location-group loc) root) 42 (xref-location-group loc))) 43 (cand (consult--format-location 44 group 45 (or (xref-location-line loc) 0) 46 (xref-item-summary xref)))) 47 (add-text-properties 48 0 1 `(consult--candidate ,xref consult-xref--group ,group) cand) 49 cand)) 50 xrefs))) 51 52 (defun consult-xref--preview (display) 53 "Xref preview with DISPLAY function." 54 (let ((open (consult--temporary-files)) 55 (preview (consult--jump-preview))) 56 (lambda (action cand) 57 (unless cand 58 (funcall open)) 59 (let ((consult--buffer-display display)) 60 (funcall preview action 61 (when-let (loc (and cand (eq action 'preview) 62 (xref-item-location cand))) 63 ;; Only preview file and buffer markers 64 (cl-typecase loc 65 (xref-buffer-location 66 (xref-location-marker loc)) 67 (xref-file-location 68 (consult--position-marker 69 (funcall open 70 ;; xref-location-group returns the file name 71 (let ((xref-file-name-display 'abs)) 72 (xref-location-group loc))) 73 (xref-location-line loc) 74 (xref-file-location-column loc))) 75 (t (message "No preview for %s" (type-of loc)) nil)))))))) 76 77 (defun consult-xref--group (cand transform) 78 "Return title for CAND or TRANSFORM the candidate." 79 (if transform 80 (substring cand (1+ (length (get-text-property 0 'consult-xref--group cand)))) 81 (get-text-property 0 'consult-xref--group cand))) 82 83 ;;;###autoload 84 (defun consult-xref (fetcher &optional alist) 85 "Show xrefs with preview in the minibuffer. 86 87 This function can be used for `xref-show-xrefs-function'. 88 See `xref-show-xrefs-function' for the description of the 89 FETCHER and ALIST arguments." 90 (let ((candidates (consult--with-increased-gc 91 (consult-xref--candidates (funcall fetcher)))) 92 (display (alist-get 'display-action alist))) 93 (xref-pop-to-location 94 (if (cdr candidates) 95 (apply 96 #'consult--read 97 candidates 98 (append 99 (consult--customize-get #'consult-xref) 100 (list 101 :prompt "Go to xref: " 102 :history 'consult-xref--history 103 :require-match t 104 :sort nil 105 :category 'xref-location 106 :group #'consult-xref--group 107 :state 108 ;; do not preview other frame 109 (when-let (fun (pcase-exhaustive display 110 ('frame nil) 111 ('window #'switch-to-buffer-other-window) 112 ('nil #'switch-to-buffer))) 113 (consult-xref--preview fun)) 114 :lookup #'consult--lookup-candidate))) 115 (get-text-property 0 'consult--candidate (car candidates))) 116 display))) 117 118 (provide 'consult-xref) 119 ;;; consult-xref.el ends here