elisp-refs.el (35316B)
1 ;;; elisp-refs.el --- find callers of elisp functions or macros -*- lexical-binding: t; -*- 2 3 ;; Copyright (C) 2016-2020 Wilfred Hughes <me@wilfred.me.uk> 4 5 ;; Author: Wilfred Hughes <me@wilfred.me.uk> 6 ;; Version: 1.5 7 ;; Package-Version: 1.5 8 ;; Package-Commit: afc82c235feb228dbc860587e607599f5e67aa20 9 ;; Keywords: lisp 10 ;; Package-Requires: ((dash "2.12.0") (s "1.11.0")) 11 12 ;; This program is free software; you can redistribute it and/or modify 13 ;; it under the terms of the GNU General Public License as published by 14 ;; the Free Software Foundation, either version 3 of the License, or 15 ;; (at your option) any later version. 16 17 ;; This program is distributed in the hope that it will be useful, 18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 20 ;; GNU General Public License for more details. 21 22 ;; You should have received a copy of the GNU General Public License 23 ;; along with this program. If not, see <http://www.gnu.org/licenses/>. 24 25 ;;; Commentary: 26 27 ;; elisp-refs.el is an Emacs package for finding references to 28 ;; functions, macros or variables. Unlike a dumb text search, 29 ;; elisp-refs.el actually parses the code, so it's never confused by 30 ;; comments or `foo-bar' matching `foo'. 31 ;; 32 ;; See https://github.com/Wilfred/refs.el/blob/master/README.md for 33 ;; more information. 34 35 ;;; Code: 36 37 (require 'dash) 38 (require 's) 39 (require 'format) 40 (eval-when-compile (require 'cl-lib)) 41 42 ;;; Internal 43 44 (defvar elisp-refs-verbose t) 45 46 (defun elisp-refs--format-int (integer) 47 "Format INTEGER as a string, with , separating thousands." 48 (let ((number (abs integer)) 49 (parts nil)) 50 (while (> number 999) 51 (push (format "%03d" (mod number 1000)) 52 parts) 53 (setq number (/ number 1000))) 54 (push (format "%d" number) parts) 55 (concat 56 (if (< integer 0) "-" "") 57 (s-join "," parts)))) 58 59 (defsubst elisp-refs--start-pos (end-pos) 60 "Find the start position of form ending at END-POS 61 in the current buffer." 62 (let ((parse-sexp-ignore-comments t)) 63 (scan-sexps end-pos -1))) 64 65 (defun elisp-refs--sexp-positions (buffer start-pos end-pos) 66 "Return a list of start and end positions of all the sexps 67 between START-POS and END-POS (inclusive) in BUFFER. 68 69 Positions exclude quote characters, so given 'foo or `foo, we 70 report the position of the symbol foo. 71 72 Not recursive, so we don't consider subelements of nested sexps." 73 (let ((positions nil)) 74 (with-current-buffer buffer 75 (condition-case _err 76 (catch 'done 77 (while t 78 (let* ((sexp-end-pos (let ((parse-sexp-ignore-comments t)) 79 (scan-sexps start-pos 1)))) 80 ;; If we've reached a sexp beyond the range requested, 81 ;; or if there are no sexps left, we're done. 82 (when (or (null sexp-end-pos) (> sexp-end-pos end-pos)) 83 (throw 'done nil)) 84 ;; Otherwise, this sexp is in the range requested. 85 (push (list (elisp-refs--start-pos sexp-end-pos) sexp-end-pos) 86 positions) 87 (setq start-pos sexp-end-pos)))) 88 ;; Terminate when we see "Containing expression ends prematurely" 89 (scan-error nil))) 90 (nreverse positions))) 91 92 (defun elisp-refs--read-buffer-form (symbols-with-pos) 93 "Read a form from the current buffer, starting at point. 94 Returns a list: 95 \(form form-start-pos form-end-pos symbol-positions read-start-pos) 96 97 In Emacs 28 and earlier, SYMBOL-POSITIONS is a list of 0-indexed 98 symbol positions relative to READ-START-POS, according to 99 `read-symbol-positions-list'. 100 101 In Emacs 29+, SYMBOL-POSITIONS is nil. If SYMBOLS-WITH-POS is 102 non-nil, forms are read with `read-positioning-symbols'." 103 (let* ((read-with-symbol-positions t) 104 (read-start-pos (point)) 105 (form (if (and symbols-with-pos (fboundp 'read-positioning-symbols)) 106 (read-positioning-symbols (current-buffer)) 107 (read (current-buffer)))) 108 (symbols (if (boundp 'read-symbol-positions-list) 109 read-symbol-positions-list 110 nil)) 111 (end-pos (point)) 112 (start-pos (elisp-refs--start-pos end-pos))) 113 (list form start-pos end-pos symbols read-start-pos))) 114 115 (defvar elisp-refs--path nil 116 "A buffer-local variable used by `elisp-refs--contents-buffer'. 117 Internal implementation detail.") 118 119 (defun elisp-refs--read-all-buffer-forms (buffer symbols-with-pos) 120 "Read all the forms in BUFFER, along with their positions." 121 (with-current-buffer buffer 122 (goto-char (point-min)) 123 (let ((forms nil)) 124 (condition-case err 125 (while t 126 (push (elisp-refs--read-buffer-form symbols-with-pos) forms)) 127 (error 128 (if (or (equal (car err) 'end-of-file) 129 ;; TODO: this shouldn't occur in valid elisp files, 130 ;; but it's happening in helm-utils.el. 131 (equal (car err) 'scan-error)) 132 ;; Reached end of file, we're done. 133 (nreverse forms) 134 ;; Some unexpected error, propagate. 135 (error "Unexpected error whilst reading %s position %s: %s" 136 (abbreviate-file-name elisp-refs--path) (point) err))))))) 137 138 (defun elisp-refs--proper-list-p (val) 139 "Is VAL a proper list?" 140 (if (fboundp 'proper-list-p) 141 ;; `proper-list-p' was added in Emacs 27.1. 142 ;; http://git.savannah.gnu.org/cgit/emacs.git/commit/?id=2fde6275b69fd113e78243790bf112bbdd2fe2bf 143 (with-no-warnings (proper-list-p val)) 144 ;; Earlier Emacs versions only had format-proper-list-p. 145 (with-no-warnings (format-proper-list-p val)))) 146 147 (defun elisp-refs--walk (buffer form start-pos end-pos symbol match-p &optional path) 148 "Walk FORM, a nested list, and return a list of sublists (with 149 their positions) where MATCH-P returns t. FORM is traversed 150 depth-first (pre-order traversal, left-to-right). 151 152 MATCH-P is called with three arguments: 153 \(SYMBOL CURRENT-FORM PATH). 154 155 PATH is the first element of all the enclosing forms of 156 CURRENT-FORM, innermost first, along with the index of the 157 current form. 158 159 For example if we are looking at h in (e f (g h)), PATH takes the 160 value ((g . 1) (e . 2)). 161 162 START-POS and END-POS should be the position of FORM within BUFFER." 163 (cond 164 ((funcall match-p symbol form path) 165 ;; If this form matches, just return it, along with the position. 166 (list (list form start-pos end-pos))) 167 ;; Otherwise, recurse on the subforms. 168 ((consp form) 169 (let ((matches nil) 170 ;; Find the positions of the subforms. 171 (subforms-positions 172 (if (eq (car-safe form) '\`) 173 ;; Kludge: `elisp-refs--sexp-positions' excludes the ` when 174 ;; calculating positions. So, to find the inner 175 ;; positions when walking from `(...) to (...), we 176 ;; don't need to increment the start position. 177 (cons nil (elisp-refs--sexp-positions buffer start-pos end-pos)) 178 ;; Calculate the positions after the opening paren. 179 (elisp-refs--sexp-positions buffer (1+ start-pos) end-pos)))) 180 ;; For each subform, recurse if it's a list, or a matching symbol. 181 (--each (-zip form subforms-positions) 182 (-let [(subform subform-start subform-end) it] 183 (when (or 184 (and (consp subform) (elisp-refs--proper-list-p subform)) 185 (and (symbolp subform) (eq subform symbol))) 186 (-when-let (subform-matches 187 (elisp-refs--walk 188 buffer subform 189 subform-start subform-end 190 symbol match-p 191 (cons (cons (car-safe form) it-index) path))) 192 (push subform-matches matches))))) 193 194 ;; Concat the results from all the subforms. 195 (apply #'append (nreverse matches)))))) 196 197 ;; TODO: condition-case (condition-case ... (error ...)) is not a call 198 ;; TODO: (cl-destructuring-bind (foo &rest bar) ...) is not a call 199 ;; TODO: letf, cl-letf, -let, -let* 200 (defun elisp-refs--function-p (symbol form path) 201 "Return t if FORM looks like a function call to SYMBOL." 202 (cond 203 ((not (consp form)) 204 nil) 205 ;; Ignore (defun _ (SYMBOL ...) ...) 206 ((or (equal (car path) '(defsubst . 2)) 207 (equal (car path) '(defun . 2)) 208 (equal (car path) '(defmacro . 2)) 209 (equal (car path) '(cl-defun . 2))) 210 nil) 211 ;; Ignore (lambda (SYMBOL ...) ...) 212 ((equal (car path) '(lambda . 1)) 213 nil) 214 ;; Ignore (let (SYMBOL ...) ...) 215 ;; and (let* (SYMBOL ...) ...) 216 ((or 217 (equal (car path) '(let . 1)) 218 (equal (car path) '(let* . 1))) 219 nil) 220 ;; Ignore (let ((SYMBOL ...)) ...) 221 ((or 222 (equal (cl-second path) '(let . 1)) 223 (equal (cl-second path) '(let* . 1))) 224 nil) 225 ;; Ignore (declare-function NAME (ARGS...)) 226 ((equal (car path) '(declare-function . 3)) 227 nil) 228 ;; (SYMBOL ...) 229 ((eq (car form) symbol) 230 t) 231 ;; (foo ... #'SYMBOL ...) 232 ((--any-p (equal it (list 'function symbol)) form) 233 t) 234 ;; (funcall 'SYMBOL ...) 235 ((and (eq (car form) 'funcall) 236 (equal `',symbol (cl-second form))) 237 t) 238 ;; (apply 'SYMBOL ...) 239 ((and (eq (car form) 'apply) 240 (equal `',symbol (cl-second form))) 241 t))) 242 243 (defun elisp-refs--macro-p (symbol form path) 244 "Return t if FORM looks like a macro call to SYMBOL." 245 (cond 246 ((not (consp form)) 247 nil) 248 ;; Ignore (defun _ (SYMBOL ...) ...) 249 ((or (equal (car path) '(defsubst . 2)) 250 (equal (car path) '(defun . 2)) 251 (equal (car path) '(defmacro . 2))) 252 nil) 253 ;; Ignore (lambda (SYMBOL ...) ...) 254 ((equal (car path) '(lambda . 1)) 255 nil) 256 ;; Ignore (let (SYMBOL ...) ...) 257 ;; and (let* (SYMBOL ...) ...) 258 ((or 259 (equal (car path) '(let . 1)) 260 (equal (car path) '(let* . 1))) 261 nil) 262 ;; Ignore (let ((SYMBOL ...)) ...) 263 ((or 264 (equal (cl-second path) '(let . 1)) 265 (equal (cl-second path) '(let* . 1))) 266 nil) 267 ;; (SYMBOL ...) 268 ((eq (car form) symbol) 269 t))) 270 271 ;; Looking for a special form is exactly the same as looking for a 272 ;; macro. 273 (defalias 'elisp-refs--special-p 'elisp-refs--macro-p) 274 275 (defun elisp-refs--variable-p (symbol form path) 276 "Return t if this looks like a variable reference to SYMBOL. 277 We consider parameters to be variables too." 278 (cond 279 ((consp form) 280 nil) 281 ;; Ignore (defun _ (SYMBOL ...) ...) 282 ((or (equal (car path) '(defsubst . 1)) 283 (equal (car path) '(defun . 1)) 284 (equal (car path) '(defmacro . 1)) 285 (equal (car path) '(cl-defun . 1))) 286 nil) 287 ;; (let (SYMBOL ...) ...) is a variable, not a function call. 288 ((or 289 (equal (cl-second path) '(let . 1)) 290 (equal (cl-second path) '(let* . 1))) 291 t) 292 ;; (lambda (SYMBOL ...) ...) is a variable 293 ((equal (cl-second path) '(lambda . 1)) 294 t) 295 ;; (let ((SYMBOL ...)) ...) is also a variable. 296 ((or 297 (equal (cl-third path) '(let . 1)) 298 (equal (cl-third path) '(let* . 1))) 299 t) 300 ;; Ignore (SYMBOL ...) otherwise, we assume it's a function/macro 301 ;; call. 302 ((equal (car path) (cons symbol 0)) 303 nil) 304 ((eq form symbol) 305 t))) 306 307 ;; TODO: benchmark building a list with `push' rather than using 308 ;; mapcat. 309 (defun elisp-refs--read-and-find (buffer symbol match-p) 310 "Read all the forms in BUFFER, and return a list of all forms that 311 contain SYMBOL where MATCH-P returns t. 312 313 For every matching form found, we return the form itself along 314 with its start and end position." 315 (-non-nil 316 (--mapcat 317 (-let [(form start-pos end-pos symbol-positions _read-start-pos) it] 318 ;; Optimisation: if we have a list of positions for the current 319 ;; form (Emacs 28 and earlier), and it doesn't contain the 320 ;; symbol we're looking for, don't bother walking the form. 321 (when (or (null symbol-positions) (assq symbol symbol-positions)) 322 (elisp-refs--walk buffer form start-pos end-pos symbol match-p))) 323 (elisp-refs--read-all-buffer-forms buffer nil)))) 324 325 (defun elisp-refs--walk-positioned-symbols (forms symbol) 326 "Given a nested list of FORMS, return a list of all positions of SYMBOL. 327 Assumes `symbol-with-pos-pos' is defined (Emacs 29+)." 328 (cond 329 ((symbol-with-pos-p forms) 330 (let ((symbols-with-pos-enabled t)) 331 (if (eq forms symbol) 332 (list (list symbol 333 (symbol-with-pos-pos forms) 334 (+ (symbol-with-pos-pos forms) (length (symbol-name symbol)))))))) 335 ((elisp-refs--proper-list-p forms) 336 ;; Proper list, use `--mapcat` to reduce how much we recurse. 337 (--mapcat (elisp-refs--walk-positioned-symbols it symbol) forms)) 338 ((consp forms) 339 ;; Improper list, we have to recurse on head and tail. 340 (append (elisp-refs--walk-positioned-symbols (car forms) symbol) 341 (elisp-refs--walk-positioned-symbols (cdr forms) symbol))) 342 ((vectorp forms) 343 (--mapcat (elisp-refs--walk-positioned-symbols it symbol) forms)))) 344 345 (defun elisp-refs--read-and-find-symbol (buffer symbol) 346 "Read all the forms in BUFFER, and return a list of all 347 positions of SYMBOL." 348 (let* ((symbols-with-pos (fboundp 'symbol-with-pos-pos)) 349 (forms (elisp-refs--read-all-buffer-forms buffer symbols-with-pos))) 350 351 (if symbols-with-pos 352 (elisp-refs--walk-positioned-symbols forms symbol) 353 (-non-nil 354 (--mapcat 355 (-let [(_ _ _ symbol-positions read-start-pos) it] 356 (--map 357 (-let [(sym . offset) it] 358 (when (eq sym symbol) 359 (-let* ((start-pos (+ read-start-pos offset)) 360 (end-pos (+ start-pos (length (symbol-name sym))))) 361 (list sym start-pos end-pos)))) 362 symbol-positions)) 363 forms))))) 364 365 (defun elisp-refs--filter-obarray (pred) 366 "Return a list of all the items in `obarray' where PRED returns t." 367 (let (symbols) 368 (mapatoms (lambda (symbol) 369 (when (and (funcall pred symbol) 370 (not (equal (symbol-name symbol) ""))) 371 (push symbol symbols)))) 372 symbols)) 373 374 (defun elisp-refs--loaded-paths () 375 "Return a list of all files that have been loaded in Emacs. 376 Where the file was a .elc, return the path to the .el file instead." 377 (let ((elc-paths (-non-nil (mapcar #'-first-item load-history)))) 378 (-non-nil 379 (--map 380 (let ((el-name (format "%s.el" (file-name-sans-extension it))) 381 (el-gz-name (format "%s.el.gz" (file-name-sans-extension it)))) 382 (cond ((file-exists-p el-name) el-name) 383 ((file-exists-p el-gz-name) el-gz-name) 384 ;; Ignore files where we can't find a .el file. 385 (t nil))) 386 elc-paths)))) 387 388 (defun elisp-refs--contents-buffer (path) 389 "Read PATH into a disposable buffer, and return it. 390 Works around the fact that Emacs won't allow multiple buffers 391 visiting the same file." 392 (let ((fresh-buffer (generate-new-buffer (format " *refs-%s*" path))) 393 ;; Be defensive against users overriding encoding 394 ;; configurations (Helpful bugs #75 and #147). 395 (coding-system-for-read nil) 396 (file-name-handler-alist 397 '(("\\(?:\\.dz\\|\\.txz\\|\\.xz\\|\\.lzma\\|\\.lz\\|\\.g?z\\|\\.\\(?:tgz\\|svgz\\|sifz\\)\\|\\.tbz2?\\|\\.bz2\\|\\.Z\\)\\(?:~\\|\\.~[-[:alnum:]:#@^._]+\\(?:~[[:digit:]]+\\)?~\\)?\\'" . 398 jka-compr-handler) 399 ("\\`/:" . file-name-non-special)))) 400 (with-current-buffer fresh-buffer 401 (setq-local elisp-refs--path path) 402 (insert-file-contents path) 403 ;; We don't enable emacs-lisp-mode because it slows down this 404 ;; function significantly. We just need the syntax table for 405 ;; scan-sexps to do the right thing with comments. 406 (set-syntax-table emacs-lisp-mode-syntax-table)) 407 fresh-buffer)) 408 409 (defvar elisp-refs--highlighting-buffer 410 nil 411 "A temporary buffer used for highlighting. 412 Since `elisp-refs--syntax-highlight' is a hot function, we 413 don't want to create lots of temporary buffers.") 414 415 (defun elisp-refs--syntax-highlight (str) 416 "Apply font-lock properties to a string STR of Emacs lisp code." 417 ;; Ensure we have a highlighting buffer to work with. 418 (unless (and elisp-refs--highlighting-buffer 419 (buffer-live-p elisp-refs--highlighting-buffer)) 420 (setq elisp-refs--highlighting-buffer 421 (generate-new-buffer " *refs-highlighting*")) 422 (with-current-buffer elisp-refs--highlighting-buffer 423 (delay-mode-hooks (emacs-lisp-mode)))) 424 425 (with-current-buffer elisp-refs--highlighting-buffer 426 (erase-buffer) 427 (insert str) 428 (if (fboundp 'font-lock-ensure) 429 (font-lock-ensure) 430 (with-no-warnings 431 (font-lock-fontify-buffer))) 432 (buffer-string))) 433 434 (defun elisp-refs--replace-tabs (string) 435 "Replace tabs in STRING with spaces." 436 ;; This is important for unindenting, as we may unindent by less 437 ;; than one whole tab. 438 (s-replace "\t" (s-repeat tab-width " ") string)) 439 440 (defun elisp-refs--lines (string) 441 "Return a list of all the lines in STRING. 442 'a\nb' -> ('a\n' 'b')" 443 (let ((lines nil)) 444 (while (> (length string) 0) 445 (let ((index (s-index-of "\n" string))) 446 (if index 447 (progn 448 (push (substring string 0 (1+ index)) lines) 449 (setq string (substring string (1+ index)))) 450 (push string lines) 451 (setq string "")))) 452 (nreverse lines))) 453 454 (defun elisp-refs--map-lines (string fn) 455 "Execute FN for each line in string, and join the result together." 456 (let ((result nil)) 457 (dolist (line (elisp-refs--lines string)) 458 (push (funcall fn line) result)) 459 (apply #'concat (nreverse result)))) 460 461 (defun elisp-refs--unindent-rigidly (string) 462 "Given an indented STRING, unindent rigidly until 463 at least one line has no indent. 464 465 STRING should have a 'elisp-refs-start-pos property. The returned 466 string will have this property updated to reflect the unindent." 467 (let* ((lines (s-lines string)) 468 ;; Get the leading whitespace for each line. 469 (indents (--map (car (s-match (rx bos (+ whitespace)) it)) 470 lines)) 471 (min-indent (-min (--map (length it) indents)))) 472 (propertize 473 (elisp-refs--map-lines 474 string 475 (lambda (line) (substring line min-indent))) 476 'elisp-refs-unindented min-indent))) 477 478 (defun elisp-refs--containing-lines (buffer start-pos end-pos) 479 "Return a string, all the lines in BUFFER that are between 480 START-POS and END-POS (inclusive). 481 482 For the characters that are between START-POS and END-POS, 483 propertize them." 484 (let (expanded-start-pos expanded-end-pos) 485 (with-current-buffer buffer 486 ;; Expand START-POS and END-POS to line boundaries. 487 (goto-char start-pos) 488 (beginning-of-line) 489 (setq expanded-start-pos (point)) 490 (goto-char end-pos) 491 (end-of-line) 492 (setq expanded-end-pos (point)) 493 494 ;; Extract the rest of the line before and after the section we're interested in. 495 (let* ((before-match (buffer-substring expanded-start-pos start-pos)) 496 (after-match (buffer-substring end-pos expanded-end-pos)) 497 ;; Concat the extra text with the actual match, ensuring we 498 ;; highlight the match as code, but highlight the rest as as 499 ;; comments. 500 (text (concat 501 (propertize before-match 502 'face 'font-lock-comment-face) 503 (elisp-refs--syntax-highlight (buffer-substring start-pos end-pos)) 504 (propertize after-match 505 'face 'font-lock-comment-face)))) 506 (-> text 507 (elisp-refs--replace-tabs) 508 (elisp-refs--unindent-rigidly) 509 (propertize 'elisp-refs-start-pos expanded-start-pos 510 'elisp-refs-path elisp-refs--path)))))) 511 512 (defun elisp-refs--find-file (button) 513 "Open the file referenced by BUTTON." 514 (find-file (button-get button 'path)) 515 (goto-char (point-min))) 516 517 (define-button-type 'elisp-refs-path-button 518 'action 'elisp-refs--find-file 519 'follow-link t 520 'help-echo "Open file") 521 522 (defun elisp-refs--path-button (path) 523 "Return a button that navigates to PATH." 524 (with-temp-buffer 525 (insert-text-button 526 (abbreviate-file-name path) 527 :type 'elisp-refs-path-button 528 'path path) 529 (buffer-string))) 530 531 (defun elisp-refs--describe (button) 532 "Show *Help* for the symbol referenced by BUTTON." 533 (let ((symbol (button-get button 'symbol)) 534 (kind (button-get button 'kind))) 535 (cond ((eq kind 'symbol) 536 (describe-symbol symbol)) 537 ((eq kind 'variable) 538 (describe-variable symbol)) 539 (t 540 ;; Emacs uses `describe-function' for functions, macros and 541 ;; special forms. 542 (describe-function symbol))))) 543 544 (define-button-type 'elisp-refs-describe-button 545 'action 'elisp-refs--describe 546 'follow-link t 547 'help-echo "Describe") 548 549 (defun elisp-refs--describe-button (symbol kind) 550 "Return a button that shows *Help* for SYMBOL. 551 KIND should be 'function, 'macro, 'variable, 'special or 'symbol." 552 (with-temp-buffer 553 (insert (symbol-name kind) " ") 554 (insert-text-button 555 (symbol-name symbol) 556 :type 'elisp-refs-describe-button 557 'symbol symbol 558 'kind kind) 559 (buffer-string))) 560 561 (defun elisp-refs--pluralize (number thing) 562 "Human-friendly description of NUMBER occurrences of THING." 563 (format "%s %s%s" 564 (elisp-refs--format-int number) 565 thing 566 (if (equal number 1) "" "s"))) 567 568 (defun elisp-refs--format-count (symbol ref-count file-count 569 searched-file-count prefix) 570 (let* ((file-str (if (zerop file-count) 571 "" 572 (format " in %s" (elisp-refs--pluralize file-count "file")))) 573 (found-str (format "Found %s to %s%s." 574 (elisp-refs--pluralize ref-count "reference") 575 symbol 576 file-str)) 577 (searched-str (if prefix 578 (format "Searched %s in %s." 579 (elisp-refs--pluralize searched-file-count "loaded file") 580 (elisp-refs--path-button (file-name-as-directory prefix))) 581 (format "Searched all %s loaded in Emacs." 582 (elisp-refs--pluralize searched-file-count "file"))))) 583 (s-word-wrap 70 (format "%s %s" found-str searched-str)))) 584 585 ;; TODO: if we have multiple matches on one line, we repeatedly show 586 ;; that line. That's slightly confusing. 587 (defun elisp-refs--show-results (symbol description results 588 searched-file-count prefix) 589 "Given a RESULTS list where each element takes the form \(forms . buffer\), 590 render a friendly results buffer." 591 (let ((buf (get-buffer-create (format "*refs: %s*" symbol)))) 592 (switch-to-buffer buf) 593 (let ((inhibit-read-only t)) 594 (erase-buffer) 595 (save-excursion 596 ;; Insert the header. 597 (insert 598 (elisp-refs--format-count 599 description 600 (-sum (--map (length (car it)) results)) 601 (length results) 602 searched-file-count 603 prefix) 604 "\n\n") 605 ;; Insert the results. 606 (--each results 607 (-let* (((forms . buf) it) 608 (path (with-current-buffer buf elisp-refs--path))) 609 (insert 610 (propertize "File: " 'face 'bold) 611 (elisp-refs--path-button path) "\n") 612 (--each forms 613 (-let [(_ start-pos end-pos) it] 614 (insert (elisp-refs--containing-lines buf start-pos end-pos) 615 "\n"))) 616 (insert "\n"))) 617 ;; Prepare the buffer for the user. 618 (elisp-refs-mode))) 619 ;; Cleanup buffers created when highlighting results. 620 (when elisp-refs--highlighting-buffer 621 (kill-buffer elisp-refs--highlighting-buffer)))) 622 623 (defun elisp-refs--loaded-bufs () 624 "Return a list of open buffers, one for each path in `load-path'." 625 (mapcar #'elisp-refs--contents-buffer (elisp-refs--loaded-paths))) 626 627 (defun elisp-refs--search-1 (bufs match-fn) 628 "Call MATCH-FN on each buffer in BUFS, reporting progress 629 and accumulating results. 630 631 BUFS should be disposable: we make no effort to preserve their 632 state during searching. 633 634 MATCH-FN should return a list where each element takes the form: 635 \(form start-pos end-pos)." 636 (let* (;; Our benchmark suggests we spend a lot of time in GC, and 637 ;; performance improves if we GC less frequently. 638 (gc-cons-percentage 0.8) 639 (total-bufs (length bufs))) 640 (let ((searched 0) 641 (forms-and-bufs nil)) 642 (dolist (buf bufs) 643 (let* ((matching-forms (funcall match-fn buf))) 644 ;; If there were any matches in this buffer, push the 645 ;; matches along with the buffer into our results 646 ;; list. 647 (when matching-forms 648 (push (cons matching-forms buf) forms-and-bufs)) 649 ;; Give feedback to the user on our progress, because 650 ;; searching takes several seconds. 651 (when (and (zerop (mod searched 10)) 652 elisp-refs-verbose) 653 (message "Searched %s/%s files" searched total-bufs)) 654 (cl-incf searched))) 655 (when elisp-refs-verbose 656 (message "Searched %s/%s files" total-bufs total-bufs)) 657 forms-and-bufs))) 658 659 (defun elisp-refs--search (symbol description match-fn &optional path-prefix) 660 "Find references to SYMBOL in all loaded files; call MATCH-FN on each buffer. 661 When PATH-PREFIX, limit to loaded files whose path starts with that prefix. 662 663 Display the results in a hyperlinked buffer. 664 665 MATCH-FN should return a list where each element takes the form: 666 \(form start-pos end-pos)." 667 (let* ((loaded-paths (elisp-refs--loaded-paths)) 668 (matching-paths (if path-prefix 669 (--filter (s-starts-with? path-prefix it) loaded-paths) 670 loaded-paths)) 671 (loaded-src-bufs (mapcar #'elisp-refs--contents-buffer matching-paths))) 672 ;; Use unwind-protect to ensure we always cleanup temporary 673 ;; buffers, even if the user hits C-g. 674 (unwind-protect 675 (progn 676 (let ((forms-and-bufs 677 (elisp-refs--search-1 loaded-src-bufs match-fn))) 678 (elisp-refs--show-results symbol description forms-and-bufs 679 (length loaded-src-bufs) path-prefix))) 680 ;; Clean up temporary buffers. 681 (--each loaded-src-bufs (kill-buffer it))))) 682 683 (defun elisp-refs--completing-read-symbol (prompt &optional filter) 684 "Read an interned symbol from the minibuffer, 685 defaulting to the symbol at point. PROMPT is the string to prompt 686 with. 687 688 If FILTER is given, only offer symbols where (FILTER sym) returns 689 t." 690 (let ((filter (or filter (lambda (_) t)))) 691 (read 692 (completing-read prompt 693 (elisp-refs--filter-obarray filter) 694 nil nil nil nil 695 (-if-let (sym (thing-at-point 'symbol)) 696 (when (funcall filter (read sym)) 697 sym)))))) 698 699 ;;; Commands 700 701 ;;;###autoload 702 (defun elisp-refs-function (symbol &optional path-prefix) 703 "Display all the references to function SYMBOL, in all loaded 704 elisp files. 705 706 If called with a prefix, prompt for a directory to limit the search. 707 708 This searches for functions, not macros. For that, see 709 `elisp-refs-macro'." 710 (interactive 711 (list (elisp-refs--completing-read-symbol "Function: " #'functionp) 712 (when current-prefix-arg 713 (read-directory-name "Limit search to loaded files in: ")))) 714 (when (not (functionp symbol)) 715 (if (macrop symbol) 716 (user-error "%s is a macro. Did you mean elisp-refs-macro?" 717 symbol) 718 (user-error "%s is not a function. Did you mean elisp-refs-symbol?" 719 symbol))) 720 (elisp-refs--search symbol 721 (elisp-refs--describe-button symbol 'function) 722 (lambda (buf) 723 (elisp-refs--read-and-find buf symbol #'elisp-refs--function-p)) 724 path-prefix)) 725 726 ;;;###autoload 727 (defun elisp-refs-macro (symbol &optional path-prefix) 728 "Display all the references to macro SYMBOL, in all loaded 729 elisp files. 730 731 If called with a prefix, prompt for a directory to limit the search. 732 733 This searches for macros, not functions. For that, see 734 `elisp-refs-function'." 735 (interactive 736 (list (elisp-refs--completing-read-symbol "Macro: " #'macrop) 737 (when current-prefix-arg 738 (read-directory-name "Limit search to loaded files in: ")))) 739 (when (not (macrop symbol)) 740 (if (functionp symbol) 741 (user-error "%s is a function. Did you mean elisp-refs-function?" 742 symbol) 743 (user-error "%s is not a function. Did you mean elisp-refs-symbol?" 744 symbol))) 745 (elisp-refs--search symbol 746 (elisp-refs--describe-button symbol 'macro) 747 (lambda (buf) 748 (elisp-refs--read-and-find buf symbol #'elisp-refs--macro-p)) 749 path-prefix)) 750 751 ;;;###autoload 752 (defun elisp-refs-special (symbol &optional path-prefix) 753 "Display all the references to special form SYMBOL, in all loaded 754 elisp files. 755 756 If called with a prefix, prompt for a directory to limit the search." 757 (interactive 758 (list (elisp-refs--completing-read-symbol "Special form: " #'special-form-p) 759 (when current-prefix-arg 760 (read-directory-name "Limit search to loaded files in: ")))) 761 (elisp-refs--search symbol 762 (elisp-refs--describe-button symbol 'special-form) 763 (lambda (buf) 764 (elisp-refs--read-and-find buf symbol #'elisp-refs--special-p)) 765 path-prefix)) 766 767 ;;;###autoload 768 (defun elisp-refs-variable (symbol &optional path-prefix) 769 "Display all the references to variable SYMBOL, in all loaded 770 elisp files. 771 772 If called with a prefix, prompt for a directory to limit the search." 773 (interactive 774 ;; This is awkward. We don't want to just offer defvar variables, 775 ;; because then we can't search for code which uses `let' to bind 776 ;; symbols. There doesn't seem to be a good way to only offer 777 ;; variables that have been bound at some point. 778 (list (elisp-refs--completing-read-symbol "Variable: " ) 779 (when current-prefix-arg 780 (read-directory-name "Limit search to loaded files in: ")))) 781 (elisp-refs--search symbol 782 (elisp-refs--describe-button symbol 'variable) 783 (lambda (buf) 784 (elisp-refs--read-and-find buf symbol #'elisp-refs--variable-p)) 785 path-prefix)) 786 787 ;;;###autoload 788 (defun elisp-refs-symbol (symbol &optional path-prefix) 789 "Display all the references to SYMBOL in all loaded elisp files. 790 791 If called with a prefix, prompt for a directory to limit the 792 search." 793 (interactive 794 (list (elisp-refs--completing-read-symbol "Symbol: " ) 795 (when current-prefix-arg 796 (read-directory-name "Limit search to loaded files in: ")))) 797 (elisp-refs--search symbol 798 (elisp-refs--describe-button symbol 'symbol) 799 (lambda (buf) 800 (elisp-refs--read-and-find-symbol buf symbol)) 801 path-prefix)) 802 803 ;;; Mode 804 805 (defvar elisp-refs-mode-map 806 (let ((map (make-sparse-keymap))) 807 ;; TODO: it would be nice for TAB to navigate to file buttons too, 808 ;; like *Help* does. 809 (set-keymap-parent map special-mode-map) 810 (define-key map (kbd "<tab>") #'elisp-refs-next-match) 811 (define-key map (kbd "<backtab>") #'elisp-refs-prev-match) 812 (define-key map (kbd "n") #'elisp-refs-next-match) 813 (define-key map (kbd "p") #'elisp-refs-prev-match) 814 (define-key map (kbd "q") #'kill-this-buffer) 815 (define-key map (kbd "RET") #'elisp-refs-visit-match) 816 map) 817 "Keymap for `elisp-refs-mode'.") 818 819 (define-derived-mode elisp-refs-mode special-mode "Refs" 820 "Major mode for refs results buffers.") 821 822 (defun elisp--refs-visit-match (open-fn) 823 "Go to the search result at point. 824 Open file with function OPEN_FN. `find-file` or `find-file-other-window`" 825 (interactive) 826 (let* ((path (get-text-property (point) 'elisp-refs-path)) 827 (pos (get-text-property (point) 'elisp-refs-start-pos)) 828 (unindent (get-text-property (point) 'elisp-refs-unindented)) 829 (column-offset (current-column)) 830 (line-offset -1)) 831 (when (null path) 832 (user-error "No match here")) 833 834 ;; If point is not on the first line of the match, work out how 835 ;; far away the first line is. 836 (save-excursion 837 (while (equal pos (get-text-property (point) 'elisp-refs-start-pos)) 838 (forward-line -1) 839 (cl-incf line-offset))) 840 841 (funcall open-fn path) 842 (goto-char pos) 843 ;; Move point so we're on the same char in the buffer that we were 844 ;; on in the results buffer. 845 (forward-line line-offset) 846 (beginning-of-line) 847 (let ((target-offset (+ column-offset unindent)) 848 (i 0)) 849 (while (< i target-offset) 850 (if (looking-at "\t") 851 (cl-incf i tab-width) 852 (cl-incf i)) 853 (forward-char 1))))) 854 855 (defun elisp-refs-visit-match () 856 "Goto the search result at point." 857 (interactive) 858 (elisp--refs-visit-match #'find-file)) 859 860 (defun elisp-refs-visit-match-other-window () 861 "Goto the search result at point, opening in another window." 862 (interactive) 863 (elisp--refs-visit-match #'find-file-other-window)) 864 865 866 (defun elisp-refs--move-to-match (direction) 867 "Move point one match forwards. 868 If DIRECTION is -1, moves backwards instead." 869 (let* ((start-pos (point)) 870 (match-pos (get-text-property start-pos 'elisp-refs-start-pos)) 871 current-match-pos) 872 (condition-case _err 873 (progn 874 ;; Move forward/backwards until we're on the next/previous match. 875 (catch 'done 876 (while t 877 (setq current-match-pos 878 (get-text-property (point) 'elisp-refs-start-pos)) 879 (when (and current-match-pos 880 (not (equal match-pos current-match-pos))) 881 (throw 'done nil)) 882 (forward-char direction))) 883 ;; Move to the beginning of that match. 884 (while (equal (get-text-property (point) 'elisp-refs-start-pos) 885 (get-text-property (1- (point)) 'elisp-refs-start-pos)) 886 (forward-char -1)) 887 ;; Move forward until we're on the first char of match within that 888 ;; line. 889 (while (or 890 (looking-at " ") 891 (eq (get-text-property (point) 'face) 892 'font-lock-comment-face)) 893 (forward-char 1))) 894 ;; If we're at the last result, don't move point. 895 (end-of-buffer 896 (progn 897 (goto-char start-pos) 898 (signal 'end-of-buffer nil)))))) 899 900 (defun elisp-refs-prev-match () 901 "Move to the previous search result in the Refs buffer." 902 (interactive) 903 (elisp-refs--move-to-match -1)) 904 905 (defun elisp-refs-next-match () 906 "Move to the next search result in the Refs buffer." 907 (interactive) 908 (elisp-refs--move-to-match 1)) 909 910 (provide 'elisp-refs) 911 ;;; elisp-refs.el ends here