From 94b59f7dd1e8611495ff0f4596dc6dec20e268af Mon Sep 17 00:00:00 2001
From: Stefan Monnier <monnier@iro.umontreal.ca>
Date: Sun, 12 Mar 2017 22:09:02 -0400
Subject: [PATCH] * lisp/emacs-lisp/cl-print.el (cl-print-compiled): New
 variable

(cl-print-object) <compiled-function>: Print the docstring and
interactive form.  Obey cl-print-compiled.
---
 lisp/emacs-lisp/cl-print.el | 38 +++++++++++++++++++++++++++++++++++--
 1 file changed, 36 insertions(+), 2 deletions(-)

diff --git a/lisp/emacs-lisp/cl-print.el b/lisp/emacs-lisp/cl-print.el
index b4a7be805a3..8a8d4a4c1af 100644
--- a/lisp/emacs-lisp/cl-print.el
+++ b/lisp/emacs-lisp/cl-print.el
@@ -74,11 +74,45 @@ call other entry points instead, such as `cl-prin1'."
     (cl-print-object (aref object i) stream))
   (princ "]" stream))
 
+(defvar cl-print-compiled nil
+  "Control how to print byte-compiled functions.  Can be:
+- `static' to print the vector of constants.
+- `disassemble' to print the disassembly of the code.
+- nil to skip printing any details about the code.")
+
 (cl-defmethod cl-print-object ((object compiled-function) stream)
   ;; We use "#f(...)" rather than "#<...>" so that pp.el gives better results.
   (princ "#f(compiled-function " stream)
-  (prin1 (help-function-arglist object 'preserve-names) stream)
-  (princ " #<bytecode>)" stream))
+  (let ((args (help-function-arglist object 'preserve-names)))
+    (if args
+        (prin1 args stream)
+      (princ "()" stream)))
+  (let ((doc (documentation object 'raw)))
+    (when doc
+      (princ " " stream)
+      (prin1 doc stream)))
+  (let ((inter (interactive-form object)))
+    (when inter
+      (princ " " stream)
+      (cl-print-object
+       (if (eq 'byte-code (car-safe (cadr inter)))
+           `(interactive ,(make-byte-code nil (nth 1 (cadr inter))
+                                          (nth 2 (cadr inter))
+                                          (nth 3 (cadr inter))))
+         inter)
+       stream)))
+  (if (eq cl-print-compiled 'disassemble)
+      (princ
+       (with-temp-buffer
+         (insert "\n")
+         (disassemble-1 object 0)
+         (buffer-string))
+       stream)
+    (princ " #<bytecode>" stream)
+    (when (eq cl-print-compiled 'static)
+      (princ " " stream)
+      (cl-print-object (aref object 2) stream)))
+  (princ ")" stream))
 
 ;; This belongs in nadvice.el, of course, but some load-ordering issues make it
 ;; complicated: cl-generic uses macros from cl-macs and cl-macs uses advice-add
-- 
2.39.5