commit 0b165188463cee994c99f4f1eff7bfc7cd902fb6
parent 7d0d0951f9706d022305d75e6890da66d313d71a
Author: Wilfred Hughes <me@wilfred.me.uk>
Date: Fri, 6 Jul 2018 13:42:11 +0100
Allow viewing callees from a function too
Diffstat:
| M | CHANGELOG.md | | | 3 | +++ |
| M | helpful.el | | | 146 | +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
| M | test/unit-test.el | | | 88 | +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
3 files changed, 237 insertions(+), 0 deletions(-)
diff --git a/CHANGELOG.md b/CHANGELOG.md
@@ -10,6 +10,9 @@ with a link to the relevant command.
* For hooks, which are lists of functions and symbols, convert symbols
to links.
+Added a 'view callees' button which shows functions called inside the
+bodies of source code, with links to view them inside helpful.
+
# v0.11
Further work on syntax highlighting performance for large code
diff --git a/helpful.el b/helpful.el
@@ -554,6 +554,46 @@ or disable if already enabled."
((macrop sym)
(elisp-refs-macro sym)))))
+(define-button-type 'helpful-callees-button
+ 'action #'helpful--show-callees
+ 'symbol nil
+ 'source nil
+ 'follow-link t
+ 'help-echo "Find the functions called by this function/macro")
+
+(defun helpful--show-callees (button)
+ "Find all the references to the symbol that this BUTTON represents."
+ (let* ((buf (get-buffer-create "*helpful callees*"))
+ (sym (button-get button 'symbol))
+ (raw-source (button-get button 'source))
+ (source
+ (if (stringp raw-source)
+ (read raw-source)
+ raw-source))
+ (syms (helpful--callees source)))
+ (setq syms
+ (--sort
+ (string< (symbol-name it) (symbol-name other))
+ syms))
+
+ (pop-to-buffer buf)
+ (let ((inhibit-read-only t))
+ (erase-buffer)
+ (insert
+ ;; TODO: Macros used, special forms used, global vars used.
+ (format "Functions called by %s:\n\n"
+ (symbol-name sym)))
+ (dolist (sym syms)
+ (insert " "
+ (helpful--button
+ (symbol-name sym)
+ 'helpful-describe-exactly-button
+ 'symbol sym
+ 'callable-p t)
+ "\n"))
+ (goto-char (point-min))
+ (special-mode))))
+
(define-button-type 'helpful-manual-button
'action #'helpful--manual
'symbol nil
@@ -1549,6 +1589,103 @@ OBJ may be a symbol or a compiled function object."
(if (symbolp sym) sym "This lambda")
description kind defined))))
+(defun helpful--callees (form)
+ "Given source code FORM, return a list of all the functions called."
+ (let* ((expanded-form (macroexpand-all form))
+ ;; Find all the functions called after macro expansion.
+ (all-fns (helpful--callees-1 expanded-form))
+ ;; Only consider the functions that were in the original code
+ ;; before macro expansion.
+ (form-syms (-filter #'symbolp (-flatten form)))
+ (form-fns (--filter (memq it form-syms) all-fns)))
+ (-distinct form-fns)))
+
+(defun helpful--callees-1 (form)
+ "Return a list of all the functions called in FORM.
+Assumes FORM has been macro expanded. The returned list
+may contain duplicates."
+ (cond
+ ((not (consp form))
+ nil)
+ ;; See `(elisp)Special Forms'. For these special forms, we recurse
+ ;; just like functions but ignore the car.
+ ((memq (car form) '(and catch defconst defvar if interactive
+ or prog1 prog2 progn save-current-buffer
+ save-restriction setq setq-default
+ track-mouse unwind-protect while))
+ (-flatten
+ (-map #'helpful--callees-1 (cdr form))))
+
+ ((eq (car form) 'cond)
+ (let* ((clauses (cdr form))
+ (clause-fns
+ ;; Each clause is a list of forms.
+ (--map
+ (-map #'helpful--callees-1 it) clauses)))
+ (-flatten clause-fns)))
+
+ ((eq (car form) 'condition-case)
+ (let* ((protected-form (nth 2 form))
+ (protected-form-fns (helpful--callees-1 protected-form))
+ (handlers (-drop 3 form))
+ (handler-bodies (-map #'cdr handlers))
+ (handler-fns
+ (--map
+ (-map #'helpful--callees-1 it) handler-bodies)))
+ (append
+ protected-form-fns
+ (-flatten handler-fns))))
+
+ ;; Calling a function with `funcall' or `apply', for example
+ ;; (funcall 'foo 1 2).
+ ((and
+ (memq (car form) '(funcall apply))
+ (eq (car-safe (nth 1 form)) 'quote))
+ (cons
+ (cadr (nth 1 form))
+ (-flatten
+ (-map #'helpful--callees-1 (cdr form)))))
+
+ ((eq (car form) 'function)
+ (let ((arg (nth 1 form)))
+ (if (symbolp arg)
+ ;; #'foo, which is the same as (function foo), is a function
+ ;; reference.
+ (list arg)
+ ;; Handle (function (lambda ...)).
+ (helpful--callees-1 arg))))
+
+ ((eq (car form) 'lambda)
+ ;; Only consider the body, not the param list.
+ (-flatten (-map #'helpful--callees-1 (-drop 2 form))))
+
+ ((eq (car form) 'closure)
+ ;; Same as lambda, but has an additional argument of the
+ ;; closed-over variables.
+ (-flatten (-map #'helpful--callees-1 (-drop 3 form))))
+
+ ((memq (car form) '(let let*))
+ ;; Extract function calls used to set the let-bound variables.
+ (let* ((var-vals (-second-item form))
+ (var-val-callees
+ (--map
+ (if (consp it)
+ (-map #'helpful--callees-1 it)
+ nil)
+ var-vals)))
+ (append
+ (-flatten var-val-callees)
+ ;; Function calls in the let body.
+ (-map #'helpful--callees-1 (-drop 2 form)))))
+
+ ((eq (car form) 'quote)
+ nil)
+ (t
+ (cons
+ (car form)
+ (-flatten
+ (-map #'helpful--callees-1 (cdr form)))))))
+
(defun helpful-update ()
"Update the current *Helpful* buffer to the latest
state of the current symbol."
@@ -1670,6 +1807,15 @@ state of the current symbol."
"\n\n"
(helpful--make-references-button helpful--sym helpful--callable-p))
+ (when (and helpful--callable-p source (not primitive-p))
+ (insert
+ " "
+ (helpful--button
+ "Find callees"
+ 'helpful-callees-button
+ 'symbol helpful--sym
+ 'source source)))
+
(when (helpful--advised-p helpful--sym)
(helpful--insert-section-break)
(insert
diff --git a/test/unit-test.el b/test/unit-test.el
@@ -604,3 +604,91 @@ find the source code."
;; For our purposes, we don't consider nil or t to be bound.
(should (not (helpful--bound-p 'nil)))
(should (not (helpful--bound-p 't))))
+
+(ert-deftest helpful--callees ()
+ (should
+ (equal
+ (helpful--callees '(quote (foo)))
+ nil))
+ ;; Simple function calls.
+ (should
+ (equal
+ (helpful--callees '(foo (bar 1) 2))
+ '(foo bar))))
+
+(ert-deftest helpful--callees-let ()
+ (should
+ (equal
+ (helpful--callees
+ '(progn
+ (let ((x (foo))
+ (y t))
+ (bar x y))
+ (let (y)
+ (baz))
+ (let* ((z (quux))))))
+ '(foo bar baz quux))))
+
+(ert-deftest helpful--callees--lambda ()
+ (should
+ (equal
+ (helpful--callees '(lambda (x) (foo x)))
+ '(foo))))
+
+(ert-deftest helpful--callees--closure ()
+ (should
+ (equal
+ (helpful--callees '(closure (t) (x) (foo x)))
+ '(foo))))
+
+(ert-deftest helpful--callees--function ()
+ (should
+ (equal
+ (helpful--callees '(function (lambda (x) (foo x))))
+ '(foo)))
+ (should
+ (equal
+ (helpful--callees '(function foo))
+ '(foo))))
+
+(ert-deftest helpful--callees--cond ()
+ (should
+ (equal
+ (helpful--callees
+ '(cond
+ (x)
+ ((foo))
+ ((bar)
+ (baz))
+ (t
+ (quux))
+ ))
+ '(foo bar baz quux))))
+
+(ert-deftest helpful--callees--condition-case ()
+ (should
+ (equal
+ (helpful--callees
+ '(condition-case e
+ (foo)
+ (error (bar))
+ ((arith-error file-error) (baz))))
+ '(foo bar baz))))
+
+(ert-deftest helpful--callees--funcall ()
+ (let ((result (helpful--callees
+ '(progn
+ (funcall 'foo 1)
+ (apply 'bar 2)
+ (apply (baz) 3)
+ (apply unknown-var 3)))))
+ (should (memq 'foo result))
+ (should (memq 'bar result))
+ (should (memq 'baz result))
+ (should (not (memq 'unknown-var result))))
+ (let ((result (helpful--callees
+ '(progn
+ (funcall #'foo 1)
+ (apply #'bar 2)))))
+ (should (memq 'foo result))
+ (should (memq 'bar result))))
