helpful

commit c0f6fc0f0bd4289914cb3fdf522db5621fe4d72e
parent bf0e3166a0c8c7568500a70bc089d4feeeace3ab
Author: Wilfred Hughes <me@wilfred.me.uk>
Date:   Sat, 16 Dec 2017 15:49:14 +0000

Enable function tracing from Helpful buffers

Diffstat:
M
CHANGELOG.md
 | 
2
++
M
helpful.el
 | 
36
++++++++++++++++++++++++++++++++++--

2 files changed, 36 insertions(+), 2 deletions(-)
diff --git a/CHANGELOG.md b/CHANGELOG.md
@@ -1,5 +1,7 @@
 # v0.5
 
+Allow function tracing to be enabled/disabled from Helpful buffers.
+
 Ensure docstring references to Info nodes are converted to buttons.
 
 # v0.4
diff --git a/helpful.el b/helpful.el
@@ -227,6 +227,20 @@ or disable if already enabled."
   (helpful--toggle-edebug (button-get button 'symbol))
   (helpful-update))
 
+(define-button-type 'helpful-trace-button
+  'action #'helpful--trace
+  'follow-link t
+  'symbol nil
+  'help-echo "Toggle function tracing")
+
+(defun helpful--trace (button)
+  "Toggle tracing for the current symbol."
+  (let ((sym (button-get button 'symbol)))
+    (if (trace-is-traced sym)
+        (untrace-function sym)
+      (trace-function sym)))
+  (helpful-update))
+
 (define-button-type 'helpful-navigate-button
   'action #'helpful--navigate
   'path nil
@@ -861,6 +875,12 @@ state of the current symbol."
 
     (let ((can-edebug
            (helpful--can-edebug-p helpful--sym helpful--callable-p))
+          (can-trace
+           (and helpful--callable-p
+                ;; Tracing uses advice, and you can't apply advice to
+                ;; primitive functions that are replaced with special
+                ;; opcodes. For example, `narrow-to-region'.
+                (not (plist-get (symbol-plist helpful--sym) 'byte-opcode))))
           (can-disassemble
            (and helpful--callable-p (not primitive-p)))
           (can-forget
@@ -876,8 +896,20 @@ state of the current symbol."
             "Enable edebug")
           nil
           :type 'helpful-edebug-button
-          'symbol helpful--sym)
-         "\n"))
+          'symbol helpful--sym)))
+      (when can-trace
+        (when can-edebug
+          (insert " "))
+        (insert
+         (make-text-button
+          (if (trace-is-traced helpful--sym)
+              "Disable tracing"
+            "Enable tracing")
+          nil
+          :type 'helpful-trace-button
+          'symbol helpful--sym)))
+      (when (or can-edebug can-trace)
+        (insert "\n"))
 
       (when can-disassemble
         (insert