From 42668225122e61c2d3c28cf395dce5134ea4efc2 Mon Sep 17 00:00:00 2001 From: Wilfred Hughes Date: Thu, 2 Aug 2018 23:07:17 -0700 Subject: Extract source code for advised primitives Resolves #141 --- CHANGELOG.md | 3 +++ helpful.el | 16 +++++++++++++--- test/unit-test.el | 7 +++---- 3 files changed, 19 insertions(+), 7 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 4a49244..f95cf81 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -13,6 +13,9 @@ Helpful now shows keybindings for aliases of the current command too. Fixed an issue where functions defined in .el.gz files were not recognised as being autoloaded. +Fixed an issue where we didn't show the source code for advised +primitives. + # v0.12 Added a 'pretty view' for string values, keymap values, and hooks. diff --git a/helpful.el b/helpful.el index f4be6d9..fb9ad44 100644 --- a/helpful.el +++ b/helpful.el @@ -1381,6 +1381,12 @@ E.g. (x x y z y) -> ((x . 2) (y . 2) (z . 1))" (setcdr item-and-count (1+ (cdr item-and-count))) (push (cons item 1) counts))))) +(defun helpful--without-advice (sym) + "Given advised function SYM, return the function object +without the advice." + (advice--cdr + (advice--symbol-function sym))) + (defun helpful--advised-p (sym) "A list of advice associated with SYM." (and (symbolp sym) @@ -1428,12 +1434,16 @@ POSITION-HEADS takes the form ((123 (defun foo)) (456 (defun bar)))." (defun helpful--primitive-p (sym callable-p) "Return t if SYM is defined in C." - (if callable-p - (subrp (indirect-function sym)) + (cond + ((and callable-p (helpful--advised-p sym)) + (subrp (helpful--without-advice sym))) + (callable-p + (subrp (indirect-function sym))) + (t (let ((filename (find-lisp-object-file-name sym 'defvar))) (or (eq filename 'C-source) (and (stringp filename) - (equal (file-name-extension filename) "c")))))) + (equal (file-name-extension filename) "c"))))))) (defun helpful--sym-value (sym buf) "Return the value of SYM in BUF." diff --git a/test/unit-test.el b/test/unit-test.el index 9732e19..7feb8a0 100644 --- a/test/unit-test.el +++ b/test/unit-test.el @@ -118,10 +118,9 @@ symbol (not a form)." ;; Defined in elisp. (should (not (helpful--primitive-p 'when t)))) -(ert-deftest helpful--primitive-p-fail () - :expected-result :failed - ;; `rename-buffer' is primitive, but it's advised (by uniquify), and - ;; this confuses `helpful--primitive-p'. +(ert-deftest helpful--primitive-p--advised () + "Ensure we handly advised primitive functions correctly." + ;; `rename-buffer' is primitive, but it's advised by uniquify. (should (helpful--primitive-p 'rename-buffer t))) (ert-deftest helpful-callable () -- cgit v1.0