helpful

commit 42668225122e61c2d3c28cf395dce5134ea4efc2
parent 691064ef0c35d343478891dc71366c058d9156a6
Author: Wilfred Hughes <me@wilfred.me.uk>
Date:   Thu,  2 Aug 2018 23:07:17 -0700

Extract source code for advised primitives

Resolves #141

Diffstat:
M
CHANGELOG.md
 | 
3
+++
M
helpful.el
 | 
16
+++++++++++++---
M
test/unit-test.el
 | 
7
+++----

3 files changed, 19 insertions(+), 7 deletions(-)
diff --git 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
@@ -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
@@ -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 ()