consult-symbol.el (6329B)
1 ;;; consult-symbol.el --- Consult commands for browsing obarray symbols -*- lexical-binding: t -*- 2 3 ;;; Commentary: 4 5 ;; This package provide `consult-symbol' which completes over the 6 ;; symbols in `obarray' and previews their source definitions. 7 ;; 8 ;; Usage: 9 ;; 10 ;; M-x consult-symbol RET 11 12 13 ;;; Code: 14 15 (require 'consult) 16 (require 'find-func) 17 (require 'help-fns) 18 (require 'xref) 19 20 (defvar consult-symbol--history nil) 21 22 (defconst consult-symbol--narrow 23 '((?f . "Function") 24 (?v . "Variable") 25 (?a . "Face")) 26 "Narrowing configuration for `consult-symbol'.") 27 28 (defcustom consult-symbol-follow-symlinks t 29 "What to do if visiting a symbolic link to a source file under version control." 30 :type '(choice (const :tag "Ask for confirmation" ask) 31 (const :tag "Visit link and warn" nil) 32 (const :tag "Follow link" t)) 33 :safe #'null) 34 35 (defun consult-symbol--type (sym) 36 "Return the narrowing type character of SYM." 37 (cond 38 ((fboundp sym) ?f) 39 ((boundp sym) ?v) 40 ((facep sym) ?a))) 41 42 (defun consult-symbol--candidates () 43 "Return symbol name candidates from `obarray'." 44 (let (cands) 45 (mapatoms 46 (lambda (sym) 47 (when-let* ((type (consult-symbol--type sym))) 48 (push (propertize (symbol-name sym) 49 'consult--symbol sym 50 'consult--type type) 51 cands)))) 52 cands)) 53 54 (defun consult-symbol--file (sym type) 55 "Return the source file name of SYM's definition of TYPE. 56 TYPE is either a function definition, `defvar' or `defface', as accepted 57 by `find-lisp-object-file-name'. Definitions in the C sources are 58 translated to a \"src/*.c\" file name." 59 (when-let* ((file (find-lisp-object-file-name sym type))) 60 (if (eq file 'C-source) 61 (help-C-file-name sym (if (eq type 'defvar) 'var 'subr)) 62 file))) 63 64 (defun consult-symbol--definition (sym) 65 "Return (TYPE . FILE) for the source definition of SYM, or nil. 66 TYPE is nil for a function definition, `defvar' for a variable 67 definition or `defface' for a face definition, as accepted by 68 `find-function-search-for-symbol'." 69 (or 70 (and (fboundp sym) 71 (when-let* ((file (consult-symbol--file sym (symbol-function sym)))) 72 (cons nil file))) 73 (and (boundp sym) 74 (when-let* ((file (consult-symbol--file sym 'defvar))) 75 (cons 'defvar file))) 76 (and (facep sym) 77 (when-let* ((file (consult-symbol--file sym 'defface))) 78 (cons 'defface file))))) 79 80 (defun consult-symbol--find (sym open) 81 "Return a marker to the source definition of SYM, or nil. 82 OPEN is a temporary file opener as returned by 83 `consult--temporary-files'. Nested calls to `find-file-noselect', e.g., 84 from the OPEN function itself, are passed through to the original 85 function, in order to avoid infinite recursion." 86 (pcase-let ((`(,type . ,file) (consult-symbol--definition sym))) 87 (when file 88 (condition-case nil 89 (let ((orig (symbol-function #'find-file-noselect)) 90 (nested nil)) 91 (pcase-let ((`(,buf . ,pos) 92 (cl-letf (((symbol-function #'find-file-noselect) 93 (lambda (name &rest args) 94 (if nested 95 (apply orig name args) 96 (setq nested t) 97 (unwind-protect 98 (funcall open name) 99 (setq nested nil)))))) 100 (find-function-search-for-symbol sym type file)))) 101 (when (buffer-live-p buf) 102 (with-current-buffer buf 103 (save-excursion 104 (save-restriction 105 (widen) 106 (goto-char (or pos (point-min))) 107 (point-marker))))))) 108 (error nil))))) 109 110 (defun consult-symbol--preview () 111 "Symbol preview function, usable as :state argument of `consult--read'. 112 Files are opened temporarily via `consult--temporary-files' and the 113 definition is previewed via `consult--jump-preview'. Symbols whose 114 source cannot be located are not previewed." 115 (let ((open (consult--temporary-files)) 116 (preview (consult--jump-preview))) 117 (lambda (action sym) 118 (unless sym 119 (funcall open)) 120 (funcall preview action 121 (and sym 122 (eq action 'preview) 123 (consult-symbol--find sym open)))))) 124 125 (defun consult-symbol--jump (sym) 126 "Jump to the source definition of SYM." 127 (pcase-let ((`(,type . ,file) (consult-symbol--definition sym))) 128 (if (not file) 129 (message "Unknown source location of `%s'" sym) 130 (xref-push-marker-stack) 131 (let ((vc-follow-symlinks consult-symbol-follow-symlinks)) 132 (pcase-let ((`(,buf . ,pos) 133 (find-function-search-for-symbol sym type file))) 134 (switch-to-buffer buf) 135 (consult--jump 136 (save-excursion 137 (save-restriction 138 (widen) 139 (goto-char (or pos (point-min))) 140 (point-marker))))) 141 (run-hooks 'find-function-after-hook))))) 142 143 ;;;###autoload 144 (defun consult-symbol () 145 "Browse `obarray' symbols with preview of their source definition. 146 147 The command completes over all interned symbols which are defined as 148 function, variable or face. While browsing, the definition of the 149 current candidate is previewed; the source file is only opened 150 temporarily. After selection, jump to the definition, pushing the 151 previous position to the xref marker stack. Symbols can be narrowed by 152 type, see `consult-symbol--narrow'." 153 (interactive) 154 (let ((sym (symbol-at-point))) 155 (consult--read 156 (consult-symbol--candidates) 157 :prompt "Symbol: " 158 :category 'symbol 159 :require-match t 160 :history 'consult-symbol--history 161 :default (and sym (consult-symbol--type sym) (symbol-name sym)) 162 :lookup (apply-partially #'consult--lookup-prop 'consult--symbol) 163 :state (consult--state-with-return 164 (consult-symbol--preview) 165 #'consult-symbol--jump) 166 :group (consult--type-group consult-symbol--narrow) 167 :narrow (consult--type-narrow consult-symbol--narrow)))) 168 169 (provide 'consult-symbol) 170 ;;; consult-symbol.el ends here