branch: externals/assess commit 46834f94233707f5ff40b59a1191a3dd09059e12 Author: Phillip Lord <phillip.l...@russet.org.uk> Commit: Phillip Lord <phillip.l...@russet.org.uk>
Add ability to capture calls to hooks --- assess-call.el | 29 +++++++++++++++++++++++++++++ test/assess-call-test.el | 27 +++++++++++++++++++++++++++ 2 files changed, 56 insertions(+) diff --git a/assess-call.el b/assess-call.el index 6cd0b3997a..df5bfaa438 100644 --- a/assess-call.el +++ b/assess-call.el @@ -90,6 +90,35 @@ parameters of the calls, and the cdr being the return value." (advice-remove sym-fn capture-lambda) (funcall capture-lambda :return))) +(defun assess-call--hook-capture-lambda () + "Returns a function which captures all of its args. + +The returned function takes any number of ARGS. In the special +case that the first arg is `:return` then it returns all previous +args." + (let ((capture-store nil)) + (lambda (&rest args) + (if (eq (car-safe args) :return) + capture-store + (setq capture-store + (cons + args + capture-store)))))) + +(defun assess-call-capture-hook (hook-var fn &optional append local) + "Trace all calls to HOOK-VAR when FN is called with no args. +APPEND and LOCAL are passed to `add-hook` and documented there." + (let ((capture-lambda + (assess-call--hook-capture-lambda))) + (add-hook hook-var + capture-lambda + append local) + (funcall fn) + (remove-hook hook-var + capture-lambda + local) + (funcall capture-lambda :return))) + (provide 'assess-call) ;;; assess-call.el ends here ;; #+end_src diff --git a/test/assess-call-test.el b/test/assess-call-test.el index 9d0876b3fb..8c243e78e5 100644 --- a/test/assess-call-test.el +++ b/test/assess-call-test.el @@ -65,4 +65,31 @@ (assess-call-capture-multiply 1 2) (assess-call-capture-multiply 3 4)))))) +(defvar assess-call-test-hook nil) + +(ert-deftest assess-call-test-hook-test () + (should + (equal + '(nil) + (assess-call-capture-hook + 'assess-call-test-hook + (lambda () + (run-hooks 'assess-call-test-hook))))) + (should + (equal + '(nil nil) + (assess-call-capture-hook + 'assess-call-test-hook + (lambda () + (run-hooks 'assess-call-test-hook) + (run-hooks 'assess-call-test-hook))))) + (should + (equal + '((bob)) + (assess-call-capture-hook + 'assess-call-test-hook + (lambda () + (run-hook-with-args 'assess-call-test-hook + 'bob)))))) + (provide 'assess-call-test)