914 lines
35 KiB
EmacsLisp
914 lines
35 KiB
EmacsLisp
;;; elisp-refs.el --- find callers of elisp functions or macros -*- lexical-binding: t; -*-
|
|
|
|
;; Copyright (C) 2016-2020 Wilfred Hughes <me@wilfred.me.uk>
|
|
|
|
;; Author: Wilfred Hughes <me@wilfred.me.uk>
|
|
;; Version: 1.6
|
|
;; Keywords: lisp
|
|
;; Package-Requires: ((dash "2.12.0") (s "1.11.0"))
|
|
|
|
;; This program is free software; you can redistribute it and/or modify
|
|
;; it under the terms of the GNU General Public License as published by
|
|
;; the Free Software Foundation, either version 3 of the License, or
|
|
;; (at your option) any later version.
|
|
|
|
;; This program is distributed in the hope that it will be useful,
|
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
;; GNU General Public License for more details.
|
|
|
|
;; You should have received a copy of the GNU General Public License
|
|
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
|
|
|
;;; Commentary:
|
|
|
|
;; elisp-refs.el is an Emacs package for finding references to
|
|
;; functions, macros or variables. Unlike a dumb text search,
|
|
;; elisp-refs.el actually parses the code, so it's never confused by
|
|
;; comments or `foo-bar' matching `foo'.
|
|
;;
|
|
;; See https://github.com/Wilfred/refs.el/blob/master/README.md for
|
|
;; more information.
|
|
|
|
;;; Code:
|
|
|
|
(require 'dash)
|
|
(require 's)
|
|
(require 'format)
|
|
(eval-when-compile (require 'cl-lib))
|
|
|
|
(defvar symbols-with-pos-enabled)
|
|
(declare-function symbol-with-pos-p nil (object))
|
|
(declare-function symbol-with-pos-pos nil (ls))
|
|
|
|
;;; Internal
|
|
|
|
(defvar elisp-refs-verbose t)
|
|
|
|
(defun elisp-refs--format-int (integer)
|
|
"Format INTEGER as a string, with , separating thousands."
|
|
(let ((number (abs integer))
|
|
(parts nil))
|
|
(while (> number 999)
|
|
(push (format "%03d" (mod number 1000))
|
|
parts)
|
|
(setq number (/ number 1000)))
|
|
(push (format "%d" number) parts)
|
|
(concat
|
|
(if (< integer 0) "-" "")
|
|
(s-join "," parts))))
|
|
|
|
(defsubst elisp-refs--start-pos (end-pos)
|
|
"Find the start position of form ending at END-POS
|
|
in the current buffer."
|
|
(let ((parse-sexp-ignore-comments t))
|
|
(scan-sexps end-pos -1)))
|
|
|
|
(defun elisp-refs--sexp-positions (buffer start-pos end-pos)
|
|
"Return a list of start and end positions of all the sexps
|
|
between START-POS and END-POS (inclusive) in BUFFER.
|
|
|
|
Positions exclude quote characters, so given 'foo or `foo, we
|
|
report the position of the symbol foo.
|
|
|
|
Not recursive, so we don't consider subelements of nested sexps."
|
|
(let ((positions nil))
|
|
(with-current-buffer buffer
|
|
(condition-case _err
|
|
(catch 'done
|
|
(while t
|
|
(let* ((sexp-end-pos (let ((parse-sexp-ignore-comments t))
|
|
(scan-sexps start-pos 1))))
|
|
;; If we've reached a sexp beyond the range requested,
|
|
;; or if there are no sexps left, we're done.
|
|
(when (or (null sexp-end-pos) (> sexp-end-pos end-pos))
|
|
(throw 'done nil))
|
|
;; Otherwise, this sexp is in the range requested.
|
|
(push (list (elisp-refs--start-pos sexp-end-pos) sexp-end-pos)
|
|
positions)
|
|
(setq start-pos sexp-end-pos))))
|
|
;; Terminate when we see "Containing expression ends prematurely"
|
|
(scan-error nil)))
|
|
(nreverse positions)))
|
|
|
|
(defun elisp-refs--read-buffer-form (symbols-with-pos)
|
|
"Read a form from the current buffer, starting at point.
|
|
Returns a list:
|
|
\(form form-start-pos form-end-pos symbol-positions read-start-pos)
|
|
|
|
In Emacs 28 and earlier, SYMBOL-POSITIONS is a list of 0-indexed
|
|
symbol positions relative to READ-START-POS, according to
|
|
`read-symbol-positions-list'.
|
|
|
|
In Emacs 29+, SYMBOL-POSITIONS is nil. If SYMBOLS-WITH-POS is
|
|
non-nil, forms are read with `read-positioning-symbols'."
|
|
(let* ((read-with-symbol-positions t)
|
|
(read-start-pos (point))
|
|
(form (if (and symbols-with-pos (fboundp 'read-positioning-symbols))
|
|
(read-positioning-symbols (current-buffer))
|
|
(read (current-buffer))))
|
|
(symbols (if (boundp 'read-symbol-positions-list)
|
|
read-symbol-positions-list
|
|
nil))
|
|
(end-pos (point))
|
|
(start-pos (elisp-refs--start-pos end-pos)))
|
|
(list form start-pos end-pos symbols read-start-pos)))
|
|
|
|
(defvar elisp-refs--path nil
|
|
"A buffer-local variable used by `elisp-refs--contents-buffer'.
|
|
Internal implementation detail.")
|
|
|
|
(defun elisp-refs--read-all-buffer-forms (buffer symbols-with-pos)
|
|
"Read all the forms in BUFFER, along with their positions."
|
|
(with-current-buffer buffer
|
|
(goto-char (point-min))
|
|
(let ((forms nil))
|
|
(condition-case err
|
|
(while t
|
|
(push (elisp-refs--read-buffer-form symbols-with-pos) forms))
|
|
(error
|
|
(if (or (equal (car err) 'end-of-file)
|
|
;; TODO: this shouldn't occur in valid elisp files,
|
|
;; but it's happening in helm-utils.el.
|
|
(equal (car err) 'scan-error))
|
|
;; Reached end of file, we're done.
|
|
(nreverse forms)
|
|
;; Some unexpected error, propagate.
|
|
(error "Unexpected error whilst reading %s position %s: %s"
|
|
(abbreviate-file-name elisp-refs--path) (point) err)))))))
|
|
|
|
(defun elisp-refs--proper-list-p (val)
|
|
"Is VAL a proper list?"
|
|
(if (fboundp 'proper-list-p)
|
|
;; `proper-list-p' was added in Emacs 27.1.
|
|
;; http://git.savannah.gnu.org/cgit/emacs.git/commit/?id=2fde6275b69fd113e78243790bf112bbdd2fe2bf
|
|
(with-no-warnings (proper-list-p val))
|
|
;; Earlier Emacs versions only had format-proper-list-p.
|
|
(with-no-warnings (format-proper-list-p val))))
|
|
|
|
(defun elisp-refs--walk (buffer form start-pos end-pos symbol match-p &optional path)
|
|
"Walk FORM, a nested list, and return a list of sublists (with
|
|
their positions) where MATCH-P returns t. FORM is traversed
|
|
depth-first (pre-order traversal, left-to-right).
|
|
|
|
MATCH-P is called with three arguments:
|
|
\(SYMBOL CURRENT-FORM PATH).
|
|
|
|
PATH is the first element of all the enclosing forms of
|
|
CURRENT-FORM, innermost first, along with the index of the
|
|
current form.
|
|
|
|
For example if we are looking at h in (e f (g h)), PATH takes the
|
|
value ((g . 1) (e . 2)).
|
|
|
|
START-POS and END-POS should be the position of FORM within BUFFER."
|
|
(cond
|
|
((funcall match-p symbol form path)
|
|
;; If this form matches, just return it, along with the position.
|
|
(list (list form start-pos end-pos)))
|
|
;; Otherwise, recurse on the subforms.
|
|
((consp form)
|
|
(let ((matches nil)
|
|
;; Find the positions of the subforms.
|
|
(subforms-positions
|
|
(if (eq (car-safe form) '\`)
|
|
;; Kludge: `elisp-refs--sexp-positions' excludes the ` when
|
|
;; calculating positions. So, to find the inner
|
|
;; positions when walking from `(...) to (...), we
|
|
;; don't need to increment the start position.
|
|
(cons nil (elisp-refs--sexp-positions buffer start-pos end-pos))
|
|
;; Calculate the positions after the opening paren.
|
|
(elisp-refs--sexp-positions buffer (1+ start-pos) end-pos))))
|
|
;; For each subform, recurse if it's a list, or a matching symbol.
|
|
(--each (-zip-pair form subforms-positions)
|
|
(-let [(subform subform-start subform-end) it]
|
|
(when (or
|
|
(and (consp subform) (elisp-refs--proper-list-p subform))
|
|
(and (symbolp subform) (eq subform symbol)))
|
|
(-when-let (subform-matches
|
|
(elisp-refs--walk
|
|
buffer subform
|
|
subform-start subform-end
|
|
symbol match-p
|
|
(cons (cons (car-safe form) it-index) path)))
|
|
(push subform-matches matches)))))
|
|
|
|
;; Concat the results from all the subforms.
|
|
(apply #'append (nreverse matches))))))
|
|
|
|
;; TODO: condition-case (condition-case ... (error ...)) is not a call
|
|
;; TODO: (cl-destructuring-bind (foo &rest bar) ...) is not a call
|
|
;; TODO: letf, cl-letf, -let, -let*
|
|
(defun elisp-refs--function-p (symbol form path)
|
|
"Return t if FORM looks like a function call to SYMBOL."
|
|
(cond
|
|
((not (consp form))
|
|
nil)
|
|
;; Ignore (defun _ (SYMBOL ...) ...)
|
|
((or (equal (car path) '(defsubst . 2))
|
|
(equal (car path) '(defun . 2))
|
|
(equal (car path) '(defmacro . 2))
|
|
(equal (car path) '(cl-defun . 2)))
|
|
nil)
|
|
;; Ignore (lambda (SYMBOL ...) ...)
|
|
((equal (car path) '(lambda . 1))
|
|
nil)
|
|
;; Ignore (let (SYMBOL ...) ...)
|
|
;; and (let* (SYMBOL ...) ...)
|
|
((or
|
|
(equal (car path) '(let . 1))
|
|
(equal (car path) '(let* . 1)))
|
|
nil)
|
|
;; Ignore (let ((SYMBOL ...)) ...)
|
|
((or
|
|
(equal (cl-second path) '(let . 1))
|
|
(equal (cl-second path) '(let* . 1)))
|
|
nil)
|
|
;; Ignore (declare-function NAME (ARGS...))
|
|
((equal (car path) '(declare-function . 3))
|
|
nil)
|
|
;; (SYMBOL ...)
|
|
((eq (car form) symbol)
|
|
t)
|
|
;; (foo ... #'SYMBOL ...)
|
|
((--any-p (equal it (list 'function symbol)) form)
|
|
t)
|
|
;; (funcall 'SYMBOL ...)
|
|
((and (eq (car form) 'funcall)
|
|
(equal `',symbol (cl-second form)))
|
|
t)
|
|
;; (apply 'SYMBOL ...)
|
|
((and (eq (car form) 'apply)
|
|
(equal `',symbol (cl-second form)))
|
|
t)))
|
|
|
|
(defun elisp-refs--macro-p (symbol form path)
|
|
"Return t if FORM looks like a macro call to SYMBOL."
|
|
(cond
|
|
((not (consp form))
|
|
nil)
|
|
;; Ignore (defun _ (SYMBOL ...) ...)
|
|
((or (equal (car path) '(defsubst . 2))
|
|
(equal (car path) '(defun . 2))
|
|
(equal (car path) '(defmacro . 2)))
|
|
nil)
|
|
;; Ignore (lambda (SYMBOL ...) ...)
|
|
((equal (car path) '(lambda . 1))
|
|
nil)
|
|
;; Ignore (let (SYMBOL ...) ...)
|
|
;; and (let* (SYMBOL ...) ...)
|
|
((or
|
|
(equal (car path) '(let . 1))
|
|
(equal (car path) '(let* . 1)))
|
|
nil)
|
|
;; Ignore (let ((SYMBOL ...)) ...)
|
|
((or
|
|
(equal (cl-second path) '(let . 1))
|
|
(equal (cl-second path) '(let* . 1)))
|
|
nil)
|
|
;; (SYMBOL ...)
|
|
((eq (car form) symbol)
|
|
t)))
|
|
|
|
;; Looking for a special form is exactly the same as looking for a
|
|
;; macro.
|
|
(defalias 'elisp-refs--special-p 'elisp-refs--macro-p)
|
|
|
|
(defun elisp-refs--variable-p (symbol form path)
|
|
"Return t if this looks like a variable reference to SYMBOL.
|
|
We consider parameters to be variables too."
|
|
(cond
|
|
((consp form)
|
|
nil)
|
|
;; Ignore (defun _ (SYMBOL ...) ...)
|
|
((or (equal (car path) '(defsubst . 1))
|
|
(equal (car path) '(defun . 1))
|
|
(equal (car path) '(defmacro . 1))
|
|
(equal (car path) '(cl-defun . 1)))
|
|
nil)
|
|
;; (let (SYMBOL ...) ...) is a variable, not a function call.
|
|
((or
|
|
(equal (cl-second path) '(let . 1))
|
|
(equal (cl-second path) '(let* . 1)))
|
|
t)
|
|
;; (lambda (SYMBOL ...) ...) is a variable
|
|
((equal (cl-second path) '(lambda . 1))
|
|
t)
|
|
;; (let ((SYMBOL ...)) ...) is also a variable.
|
|
((or
|
|
(equal (cl-third path) '(let . 1))
|
|
(equal (cl-third path) '(let* . 1)))
|
|
t)
|
|
;; Ignore (SYMBOL ...) otherwise, we assume it's a function/macro
|
|
;; call.
|
|
((equal (car path) (cons symbol 0))
|
|
nil)
|
|
((eq form symbol)
|
|
t)))
|
|
|
|
;; TODO: benchmark building a list with `push' rather than using
|
|
;; mapcat.
|
|
(defun elisp-refs--read-and-find (buffer symbol match-p)
|
|
"Read all the forms in BUFFER, and return a list of all forms that
|
|
contain SYMBOL where MATCH-P returns t.
|
|
|
|
For every matching form found, we return the form itself along
|
|
with its start and end position."
|
|
(-non-nil
|
|
(--mapcat
|
|
(-let [(form start-pos end-pos symbol-positions _read-start-pos) it]
|
|
;; Optimisation: if we have a list of positions for the current
|
|
;; form (Emacs 28 and earlier), and it doesn't contain the
|
|
;; symbol we're looking for, don't bother walking the form.
|
|
(when (or (null symbol-positions) (assq symbol symbol-positions))
|
|
(elisp-refs--walk buffer form start-pos end-pos symbol match-p)))
|
|
(elisp-refs--read-all-buffer-forms buffer nil))))
|
|
|
|
(defun elisp-refs--walk-positioned-symbols (forms symbol)
|
|
"Given a nested list of FORMS, return a list of all positions of SYMBOL.
|
|
Assumes `symbol-with-pos-pos' is defined (Emacs 29+)."
|
|
(cond
|
|
((symbol-with-pos-p forms)
|
|
(let ((symbols-with-pos-enabled t))
|
|
(if (eq forms symbol)
|
|
(list (list symbol
|
|
(symbol-with-pos-pos forms)
|
|
(+ (symbol-with-pos-pos forms) (length (symbol-name symbol))))))))
|
|
((elisp-refs--proper-list-p forms)
|
|
;; Proper list, use `--mapcat` to reduce how much we recurse.
|
|
(--mapcat (elisp-refs--walk-positioned-symbols it symbol) forms))
|
|
((consp forms)
|
|
;; Improper list, we have to recurse on head and tail.
|
|
(append (elisp-refs--walk-positioned-symbols (car forms) symbol)
|
|
(elisp-refs--walk-positioned-symbols (cdr forms) symbol)))
|
|
((vectorp forms)
|
|
(--mapcat (elisp-refs--walk-positioned-symbols it symbol) forms))))
|
|
|
|
(defun elisp-refs--read-and-find-symbol (buffer symbol)
|
|
"Read all the forms in BUFFER, and return a list of all
|
|
positions of SYMBOL."
|
|
(let* ((symbols-with-pos (fboundp 'symbol-with-pos-pos))
|
|
(forms (elisp-refs--read-all-buffer-forms buffer symbols-with-pos)))
|
|
|
|
(if symbols-with-pos
|
|
(elisp-refs--walk-positioned-symbols forms symbol)
|
|
(-non-nil
|
|
(--mapcat
|
|
(-let [(_ _ _ symbol-positions read-start-pos) it]
|
|
(--map
|
|
(-let [(sym . offset) it]
|
|
(when (eq sym symbol)
|
|
(-let* ((start-pos (+ read-start-pos offset))
|
|
(end-pos (+ start-pos (length (symbol-name sym)))))
|
|
(list sym start-pos end-pos))))
|
|
symbol-positions))
|
|
forms)))))
|
|
|
|
(defun elisp-refs--filter-obarray (pred)
|
|
"Return a list of all the items in `obarray' where PRED returns t."
|
|
(let (symbols)
|
|
(mapatoms (lambda (symbol)
|
|
(when (and (funcall pred symbol)
|
|
(not (equal (symbol-name symbol) "")))
|
|
(push symbol symbols))))
|
|
symbols))
|
|
|
|
(defun elisp-refs--loaded-paths ()
|
|
"Return a list of all files that have been loaded in Emacs.
|
|
Where the file was a .elc, return the path to the .el file instead."
|
|
(let ((elc-paths (-non-nil (mapcar #'-first-item load-history))))
|
|
(-non-nil
|
|
(--map
|
|
(let ((el-name (format "%s.el" (file-name-sans-extension it)))
|
|
(el-gz-name (format "%s.el.gz" (file-name-sans-extension it))))
|
|
(cond ((file-exists-p el-name) el-name)
|
|
((file-exists-p el-gz-name) el-gz-name)
|
|
;; Ignore files where we can't find a .el file.
|
|
(t nil)))
|
|
elc-paths))))
|
|
|
|
(defun elisp-refs--contents-buffer (path)
|
|
"Read PATH into a disposable buffer, and return it.
|
|
Works around the fact that Emacs won't allow multiple buffers
|
|
visiting the same file."
|
|
(let ((fresh-buffer (generate-new-buffer (format " *refs-%s*" path)))
|
|
;; Be defensive against users overriding encoding
|
|
;; configurations (Helpful bugs #75 and #147).
|
|
(coding-system-for-read nil)
|
|
(file-name-handler-alist
|
|
'(("\\(?:\\.dz\\|\\.txz\\|\\.xz\\|\\.lzma\\|\\.lz\\|\\.g?z\\|\\.\\(?:tgz\\|svgz\\|sifz\\)\\|\\.tbz2?\\|\\.bz2\\|\\.Z\\)\\(?:~\\|\\.~[-[:alnum:]:#@^._]+\\(?:~[[:digit:]]+\\)?~\\)?\\'" .
|
|
jka-compr-handler)
|
|
("\\(?:^/\\)\\(\\(?:\\(?:\\(-\\|[[:alnum:]]\\{2,\\}\\)\\(?::\\)\\(?:\\([^/:|[:blank:]]+\\)\\(?:@\\)\\)?\\(\\(?:[%._[:alnum:]-]+\\|\\(?:\\[\\)\\(?:\\(?:[[:alnum:]]*:\\)+[.[:alnum:]]*\\)?\\(?:]\\)\\)\\(?:\\(?:#\\)\\(?:[[:digit:]]+\\)\\)?\\)?\\)\\(?:|\\)\\)+\\)?\\(?:\\(-\\|[[:alnum:]]\\{2,\\}\\)\\(?::\\)\\(?:\\([^/:|[:blank:]]+\\)\\(?:@\\)\\)?\\(\\(?:[%._[:alnum:]-]+\\|\\(?:\\[\\)\\(?:\\(?:[[:alnum:]]*:\\)+[.[:alnum:]]*\\)?\\(?:]\\)\\)\\(?:\\(?:#\\)\\(?:[[:digit:]]+\\)\\)?\\)?\\)\\(?::\\)\\([^\n
|
|
]*\\'\\)" . tramp-file-name-handler)
|
|
("\\`/:" . file-name-non-special))))
|
|
(with-current-buffer fresh-buffer
|
|
(setq-local elisp-refs--path path)
|
|
(insert-file-contents path)
|
|
;; We don't enable emacs-lisp-mode because it slows down this
|
|
;; function significantly. We just need the syntax table for
|
|
;; scan-sexps to do the right thing with comments.
|
|
(set-syntax-table emacs-lisp-mode-syntax-table))
|
|
fresh-buffer))
|
|
|
|
(defvar elisp-refs--highlighting-buffer
|
|
nil
|
|
"A temporary buffer used for highlighting.
|
|
Since `elisp-refs--syntax-highlight' is a hot function, we
|
|
don't want to create lots of temporary buffers.")
|
|
|
|
(defun elisp-refs--syntax-highlight (str)
|
|
"Apply font-lock properties to a string STR of Emacs lisp code."
|
|
;; Ensure we have a highlighting buffer to work with.
|
|
(unless (and elisp-refs--highlighting-buffer
|
|
(buffer-live-p elisp-refs--highlighting-buffer))
|
|
(setq elisp-refs--highlighting-buffer
|
|
(generate-new-buffer " *refs-highlighting*"))
|
|
(with-current-buffer elisp-refs--highlighting-buffer
|
|
(delay-mode-hooks (emacs-lisp-mode))))
|
|
|
|
(with-current-buffer elisp-refs--highlighting-buffer
|
|
(erase-buffer)
|
|
(insert str)
|
|
(if (fboundp 'font-lock-ensure)
|
|
(font-lock-ensure)
|
|
(with-no-warnings
|
|
(font-lock-fontify-buffer)))
|
|
(buffer-string)))
|
|
|
|
(defun elisp-refs--replace-tabs (string)
|
|
"Replace tabs in STRING with spaces."
|
|
;; This is important for unindenting, as we may unindent by less
|
|
;; than one whole tab.
|
|
(s-replace "\t" (s-repeat tab-width " ") string))
|
|
|
|
(defun elisp-refs--lines (string)
|
|
"Return a list of all the lines in STRING.
|
|
'a\nb' -> ('a\n' 'b')"
|
|
(let ((lines nil))
|
|
(while (> (length string) 0)
|
|
(let ((index (s-index-of "\n" string)))
|
|
(if index
|
|
(progn
|
|
(push (substring string 0 (1+ index)) lines)
|
|
(setq string (substring string (1+ index))))
|
|
(push string lines)
|
|
(setq string ""))))
|
|
(nreverse lines)))
|
|
|
|
(defun elisp-refs--map-lines (string fn)
|
|
"Execute FN for each line in string, and join the result together."
|
|
(let ((result nil))
|
|
(dolist (line (elisp-refs--lines string))
|
|
(push (funcall fn line) result))
|
|
(apply #'concat (nreverse result))))
|
|
|
|
(defun elisp-refs--unindent-rigidly (string)
|
|
"Given an indented STRING, unindent rigidly until
|
|
at least one line has no indent.
|
|
|
|
STRING should have a 'elisp-refs-start-pos property. The returned
|
|
string will have this property updated to reflect the unindent."
|
|
(let* ((lines (s-lines string))
|
|
;; Get the leading whitespace for each line.
|
|
(indents (--map (car (s-match (rx bos (+ whitespace)) it))
|
|
lines))
|
|
(min-indent (-min (--map (length it) indents))))
|
|
(propertize
|
|
(elisp-refs--map-lines
|
|
string
|
|
(lambda (line) (substring line min-indent)))
|
|
'elisp-refs-unindented min-indent)))
|
|
|
|
(defun elisp-refs--containing-lines (buffer start-pos end-pos)
|
|
"Return a string, all the lines in BUFFER that are between
|
|
START-POS and END-POS (inclusive).
|
|
|
|
For the characters that are between START-POS and END-POS,
|
|
propertize them."
|
|
(let (expanded-start-pos expanded-end-pos)
|
|
(with-current-buffer buffer
|
|
;; Expand START-POS and END-POS to line boundaries.
|
|
(goto-char start-pos)
|
|
(beginning-of-line)
|
|
(setq expanded-start-pos (point))
|
|
(goto-char end-pos)
|
|
(end-of-line)
|
|
(setq expanded-end-pos (point))
|
|
|
|
;; Extract the rest of the line before and after the section we're interested in.
|
|
(let* ((before-match (buffer-substring expanded-start-pos start-pos))
|
|
(after-match (buffer-substring end-pos expanded-end-pos))
|
|
;; Concat the extra text with the actual match, ensuring we
|
|
;; highlight the match as code, but highlight the rest as as
|
|
;; comments.
|
|
(text (concat
|
|
(propertize before-match
|
|
'face 'font-lock-comment-face)
|
|
(elisp-refs--syntax-highlight (buffer-substring start-pos end-pos))
|
|
(propertize after-match
|
|
'face 'font-lock-comment-face))))
|
|
(-> text
|
|
(elisp-refs--replace-tabs)
|
|
(elisp-refs--unindent-rigidly)
|
|
(propertize 'elisp-refs-start-pos expanded-start-pos
|
|
'elisp-refs-path elisp-refs--path))))))
|
|
|
|
(defun elisp-refs--find-file (button)
|
|
"Open the file referenced by BUTTON."
|
|
(find-file (button-get button 'path))
|
|
(goto-char (point-min)))
|
|
|
|
(define-button-type 'elisp-refs-path-button
|
|
'action 'elisp-refs--find-file
|
|
'follow-link t
|
|
'help-echo "Open file")
|
|
|
|
(defun elisp-refs--path-button (path)
|
|
"Return a button that navigates to PATH."
|
|
(with-temp-buffer
|
|
(insert-text-button
|
|
(abbreviate-file-name path)
|
|
:type 'elisp-refs-path-button
|
|
'path path)
|
|
(buffer-string)))
|
|
|
|
(defun elisp-refs--describe (button)
|
|
"Show *Help* for the symbol referenced by BUTTON."
|
|
(let ((symbol (button-get button 'symbol))
|
|
(kind (button-get button 'kind)))
|
|
(cond ((eq kind 'symbol)
|
|
(describe-symbol symbol))
|
|
((eq kind 'variable)
|
|
(describe-variable symbol))
|
|
(t
|
|
;; Emacs uses `describe-function' for functions, macros and
|
|
;; special forms.
|
|
(describe-function symbol)))))
|
|
|
|
(define-button-type 'elisp-refs-describe-button
|
|
'action 'elisp-refs--describe
|
|
'follow-link t
|
|
'help-echo "Describe")
|
|
|
|
(defun elisp-refs--describe-button (symbol kind)
|
|
"Return a button that shows *Help* for SYMBOL.
|
|
KIND should be 'function, 'macro, 'variable, 'special or 'symbol."
|
|
(with-temp-buffer
|
|
(insert (symbol-name kind) " ")
|
|
(insert-text-button
|
|
(symbol-name symbol)
|
|
:type 'elisp-refs-describe-button
|
|
'symbol symbol
|
|
'kind kind)
|
|
(buffer-string)))
|
|
|
|
(defun elisp-refs--pluralize (number thing)
|
|
"Human-friendly description of NUMBER occurrences of THING."
|
|
(format "%s %s%s"
|
|
(elisp-refs--format-int number)
|
|
thing
|
|
(if (equal number 1) "" "s")))
|
|
|
|
(defun elisp-refs--format-count (symbol ref-count file-count
|
|
searched-file-count prefix)
|
|
(let* ((file-str (if (zerop file-count)
|
|
""
|
|
(format " in %s" (elisp-refs--pluralize file-count "file"))))
|
|
(found-str (format "Found %s to %s%s."
|
|
(elisp-refs--pluralize ref-count "reference")
|
|
symbol
|
|
file-str))
|
|
(searched-str (if prefix
|
|
(format "Searched %s in %s."
|
|
(elisp-refs--pluralize searched-file-count "loaded file")
|
|
(elisp-refs--path-button (file-name-as-directory prefix)))
|
|
(format "Searched all %s loaded in Emacs."
|
|
(elisp-refs--pluralize searched-file-count "file")))))
|
|
(s-word-wrap 70 (format "%s %s" found-str searched-str))))
|
|
|
|
;; TODO: if we have multiple matches on one line, we repeatedly show
|
|
;; that line. That's slightly confusing.
|
|
(defun elisp-refs--show-results (symbol description results
|
|
searched-file-count prefix)
|
|
"Given a RESULTS list where each element takes the form \(forms . buffer\),
|
|
render a friendly results buffer."
|
|
(let ((buf (get-buffer-create (format "*refs: %s*" symbol))))
|
|
(switch-to-buffer buf)
|
|
(let ((inhibit-read-only t))
|
|
(erase-buffer)
|
|
(save-excursion
|
|
;; Insert the header.
|
|
(insert
|
|
(elisp-refs--format-count
|
|
description
|
|
(-sum (--map (length (car it)) results))
|
|
(length results)
|
|
searched-file-count
|
|
prefix)
|
|
"\n\n")
|
|
;; Insert the results.
|
|
(--each results
|
|
(-let* (((forms . buf) it)
|
|
(path (with-current-buffer buf elisp-refs--path)))
|
|
(insert
|
|
(propertize "File: " 'face 'bold)
|
|
(elisp-refs--path-button path) "\n")
|
|
(--each forms
|
|
(-let [(_ start-pos end-pos) it]
|
|
(insert (elisp-refs--containing-lines buf start-pos end-pos)
|
|
"\n")))
|
|
(insert "\n")))
|
|
;; Prepare the buffer for the user.
|
|
(elisp-refs-mode)))
|
|
;; Cleanup buffers created when highlighting results.
|
|
(when elisp-refs--highlighting-buffer
|
|
(kill-buffer elisp-refs--highlighting-buffer))))
|
|
|
|
(defun elisp-refs--loaded-bufs ()
|
|
"Return a list of open buffers, one for each path in `load-path'."
|
|
(mapcar #'elisp-refs--contents-buffer (elisp-refs--loaded-paths)))
|
|
|
|
(defun elisp-refs--search-1 (bufs match-fn)
|
|
"Call MATCH-FN on each buffer in BUFS, reporting progress
|
|
and accumulating results.
|
|
|
|
BUFS should be disposable: we make no effort to preserve their
|
|
state during searching.
|
|
|
|
MATCH-FN should return a list where each element takes the form:
|
|
\(form start-pos end-pos)."
|
|
(let* (;; Our benchmark suggests we spend a lot of time in GC, and
|
|
;; performance improves if we GC less frequently.
|
|
(gc-cons-percentage 0.8)
|
|
(total-bufs (length bufs)))
|
|
(let ((searched 0)
|
|
(forms-and-bufs nil))
|
|
(dolist (buf bufs)
|
|
(let* ((matching-forms (funcall match-fn buf)))
|
|
;; If there were any matches in this buffer, push the
|
|
;; matches along with the buffer into our results
|
|
;; list.
|
|
(when matching-forms
|
|
(push (cons matching-forms buf) forms-and-bufs))
|
|
;; Give feedback to the user on our progress, because
|
|
;; searching takes several seconds.
|
|
(when (and (zerop (mod searched 10))
|
|
elisp-refs-verbose)
|
|
(message "Searched %s/%s files" searched total-bufs))
|
|
(cl-incf searched)))
|
|
(when elisp-refs-verbose
|
|
(message "Searched %s/%s files" total-bufs total-bufs))
|
|
forms-and-bufs)))
|
|
|
|
(defun elisp-refs--search (symbol description match-fn &optional path-prefix)
|
|
"Find references to SYMBOL in all loaded files; call MATCH-FN on each buffer.
|
|
When PATH-PREFIX, limit to loaded files whose path starts with that prefix.
|
|
|
|
Display the results in a hyperlinked buffer.
|
|
|
|
MATCH-FN should return a list where each element takes the form:
|
|
\(form start-pos end-pos)."
|
|
(let* ((loaded-paths (elisp-refs--loaded-paths))
|
|
(matching-paths (if path-prefix
|
|
(--filter (s-starts-with? path-prefix it) loaded-paths)
|
|
loaded-paths))
|
|
(loaded-src-bufs (mapcar #'elisp-refs--contents-buffer matching-paths)))
|
|
;; Use unwind-protect to ensure we always cleanup temporary
|
|
;; buffers, even if the user hits C-g.
|
|
(unwind-protect
|
|
(progn
|
|
(let ((forms-and-bufs
|
|
(elisp-refs--search-1 loaded-src-bufs match-fn)))
|
|
(elisp-refs--show-results symbol description forms-and-bufs
|
|
(length loaded-src-bufs) path-prefix)))
|
|
;; Clean up temporary buffers.
|
|
(--each loaded-src-bufs (kill-buffer it)))))
|
|
|
|
(defun elisp-refs--completing-read-symbol (prompt &optional filter)
|
|
"Read an interned symbol from the minibuffer,
|
|
defaulting to the symbol at point. PROMPT is the string to prompt
|
|
with.
|
|
|
|
If FILTER is given, only offer symbols where (FILTER sym) returns
|
|
t."
|
|
(let ((filter (or filter (lambda (_) t))))
|
|
(read
|
|
(completing-read prompt
|
|
(elisp-refs--filter-obarray filter)
|
|
nil nil nil nil
|
|
(-if-let (sym (thing-at-point 'symbol))
|
|
(when (funcall filter (read sym))
|
|
sym))))))
|
|
|
|
;;; Commands
|
|
|
|
;;;###autoload
|
|
(defun elisp-refs-function (symbol &optional path-prefix)
|
|
"Display all the references to function SYMBOL, in all loaded
|
|
elisp files.
|
|
|
|
If called with a prefix, prompt for a directory to limit the search.
|
|
|
|
This searches for functions, not macros. For that, see
|
|
`elisp-refs-macro'."
|
|
(interactive
|
|
(list (elisp-refs--completing-read-symbol "Function: " #'functionp)
|
|
(when current-prefix-arg
|
|
(read-directory-name "Limit search to loaded files in: "))))
|
|
(when (not (functionp symbol))
|
|
(if (macrop symbol)
|
|
(user-error "%s is a macro. Did you mean elisp-refs-macro?"
|
|
symbol)
|
|
(user-error "%s is not a function. Did you mean elisp-refs-symbol?"
|
|
symbol)))
|
|
(elisp-refs--search symbol
|
|
(elisp-refs--describe-button symbol 'function)
|
|
(lambda (buf)
|
|
(elisp-refs--read-and-find buf symbol #'elisp-refs--function-p))
|
|
path-prefix))
|
|
|
|
;;;###autoload
|
|
(defun elisp-refs-macro (symbol &optional path-prefix)
|
|
"Display all the references to macro SYMBOL, in all loaded
|
|
elisp files.
|
|
|
|
If called with a prefix, prompt for a directory to limit the search.
|
|
|
|
This searches for macros, not functions. For that, see
|
|
`elisp-refs-function'."
|
|
(interactive
|
|
(list (elisp-refs--completing-read-symbol "Macro: " #'macrop)
|
|
(when current-prefix-arg
|
|
(read-directory-name "Limit search to loaded files in: "))))
|
|
(when (not (macrop symbol))
|
|
(if (functionp symbol)
|
|
(user-error "%s is a function. Did you mean elisp-refs-function?"
|
|
symbol)
|
|
(user-error "%s is not a function. Did you mean elisp-refs-symbol?"
|
|
symbol)))
|
|
(elisp-refs--search symbol
|
|
(elisp-refs--describe-button symbol 'macro)
|
|
(lambda (buf)
|
|
(elisp-refs--read-and-find buf symbol #'elisp-refs--macro-p))
|
|
path-prefix))
|
|
|
|
;;;###autoload
|
|
(defun elisp-refs-special (symbol &optional path-prefix)
|
|
"Display all the references to special form SYMBOL, in all loaded
|
|
elisp files.
|
|
|
|
If called with a prefix, prompt for a directory to limit the search."
|
|
(interactive
|
|
(list (elisp-refs--completing-read-symbol "Special form: " #'special-form-p)
|
|
(when current-prefix-arg
|
|
(read-directory-name "Limit search to loaded files in: "))))
|
|
(elisp-refs--search symbol
|
|
(elisp-refs--describe-button symbol 'special-form)
|
|
(lambda (buf)
|
|
(elisp-refs--read-and-find buf symbol #'elisp-refs--special-p))
|
|
path-prefix))
|
|
|
|
;;;###autoload
|
|
(defun elisp-refs-variable (symbol &optional path-prefix)
|
|
"Display all the references to variable SYMBOL, in all loaded
|
|
elisp files.
|
|
|
|
If called with a prefix, prompt for a directory to limit the search."
|
|
(interactive
|
|
;; This is awkward. We don't want to just offer defvar variables,
|
|
;; because then we can't search for code which uses `let' to bind
|
|
;; symbols. There doesn't seem to be a good way to only offer
|
|
;; variables that have been bound at some point.
|
|
(list (elisp-refs--completing-read-symbol "Variable: " )
|
|
(when current-prefix-arg
|
|
(read-directory-name "Limit search to loaded files in: "))))
|
|
(elisp-refs--search symbol
|
|
(elisp-refs--describe-button symbol 'variable)
|
|
(lambda (buf)
|
|
(elisp-refs--read-and-find buf symbol #'elisp-refs--variable-p))
|
|
path-prefix))
|
|
|
|
;;;###autoload
|
|
(defun elisp-refs-symbol (symbol &optional path-prefix)
|
|
"Display all the references to SYMBOL in all loaded elisp files.
|
|
|
|
If called with a prefix, prompt for a directory to limit the
|
|
search."
|
|
(interactive
|
|
(list (elisp-refs--completing-read-symbol "Symbol: " )
|
|
(when current-prefix-arg
|
|
(read-directory-name "Limit search to loaded files in: "))))
|
|
(elisp-refs--search symbol
|
|
(elisp-refs--describe-button symbol 'symbol)
|
|
(lambda (buf)
|
|
(elisp-refs--read-and-find-symbol buf symbol))
|
|
path-prefix))
|
|
|
|
;;; Mode
|
|
|
|
(defvar elisp-refs-mode-map
|
|
(let ((map (make-sparse-keymap)))
|
|
;; TODO: it would be nice for TAB to navigate to file buttons too,
|
|
;; like *Help* does.
|
|
(set-keymap-parent map special-mode-map)
|
|
(define-key map (kbd "<tab>") #'elisp-refs-next-match)
|
|
(define-key map (kbd "<backtab>") #'elisp-refs-prev-match)
|
|
(define-key map (kbd "n") #'elisp-refs-next-match)
|
|
(define-key map (kbd "p") #'elisp-refs-prev-match)
|
|
(define-key map (kbd "RET") #'elisp-refs-visit-match)
|
|
map)
|
|
"Keymap for `elisp-refs-mode'.")
|
|
|
|
(define-derived-mode elisp-refs-mode special-mode "Refs"
|
|
"Major mode for refs results buffers.")
|
|
|
|
(defun elisp--refs-visit-match (open-fn)
|
|
"Go to the search result at point.
|
|
Open file with function OPEN_FN. `find-file` or `find-file-other-window`"
|
|
(interactive)
|
|
(let* ((path (get-text-property (point) 'elisp-refs-path))
|
|
(pos (get-text-property (point) 'elisp-refs-start-pos))
|
|
(unindent (get-text-property (point) 'elisp-refs-unindented))
|
|
(column-offset (current-column))
|
|
(line-offset -1))
|
|
(when (null path)
|
|
(user-error "No match here"))
|
|
|
|
;; If point is not on the first line of the match, work out how
|
|
;; far away the first line is.
|
|
(save-excursion
|
|
(while (equal pos (get-text-property (point) 'elisp-refs-start-pos))
|
|
(forward-line -1)
|
|
(cl-incf line-offset)))
|
|
|
|
(funcall open-fn path)
|
|
(goto-char pos)
|
|
;; Move point so we're on the same char in the buffer that we were
|
|
;; on in the results buffer.
|
|
(forward-line line-offset)
|
|
(beginning-of-line)
|
|
(let ((target-offset (+ column-offset unindent))
|
|
(i 0))
|
|
(while (< i target-offset)
|
|
(if (looking-at "\t")
|
|
(cl-incf i tab-width)
|
|
(cl-incf i))
|
|
(forward-char 1)))))
|
|
|
|
(defun elisp-refs-visit-match ()
|
|
"Goto the search result at point."
|
|
(interactive)
|
|
(elisp--refs-visit-match #'find-file))
|
|
|
|
(defun elisp-refs-visit-match-other-window ()
|
|
"Goto the search result at point, opening in another window."
|
|
(interactive)
|
|
(elisp--refs-visit-match #'find-file-other-window))
|
|
|
|
|
|
(defun elisp-refs--move-to-match (direction)
|
|
"Move point one match forwards.
|
|
If DIRECTION is -1, moves backwards instead."
|
|
(let* ((start-pos (point))
|
|
(match-pos (get-text-property start-pos 'elisp-refs-start-pos))
|
|
current-match-pos)
|
|
(condition-case _err
|
|
(progn
|
|
;; Move forward/backwards until we're on the next/previous match.
|
|
(catch 'done
|
|
(while t
|
|
(setq current-match-pos
|
|
(get-text-property (point) 'elisp-refs-start-pos))
|
|
(when (and current-match-pos
|
|
(not (equal match-pos current-match-pos)))
|
|
(throw 'done nil))
|
|
(forward-char direction)))
|
|
;; Move to the beginning of that match.
|
|
(while (equal (get-text-property (point) 'elisp-refs-start-pos)
|
|
(get-text-property (1- (point)) 'elisp-refs-start-pos))
|
|
(forward-char -1))
|
|
;; Move forward until we're on the first char of match within that
|
|
;; line.
|
|
(while (or
|
|
(looking-at " ")
|
|
(eq (get-text-property (point) 'face)
|
|
'font-lock-comment-face))
|
|
(forward-char 1)))
|
|
;; If we're at the last result, don't move point.
|
|
(end-of-buffer
|
|
(progn
|
|
(goto-char start-pos)
|
|
(signal 'end-of-buffer nil))))))
|
|
|
|
(defun elisp-refs-prev-match ()
|
|
"Move to the previous search result in the Refs buffer."
|
|
(interactive)
|
|
(elisp-refs--move-to-match -1))
|
|
|
|
(defun elisp-refs-next-match ()
|
|
"Move to the next search result in the Refs buffer."
|
|
(interactive)
|
|
(elisp-refs--move-to-match 1))
|
|
|
|
(provide 'elisp-refs)
|
|
;;; elisp-refs.el ends here
|