* 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.
This commit is contained in:
Stefan Monnier 2017-03-12 22:09:02 -04:00
parent cf670b49a7
commit 94b59f7dd1

View file

@ -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