[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master aa45ea8a331: In cl-prin1, enable raw printing for a byte-compiled
From: |
Alan Mackenzie |
Subject: |
master aa45ea8a331: In cl-prin1, enable raw printing for a byte-compiled function |
Date: |
Wed, 11 Oct 2023 09:29:40 -0400 (EDT) |
branch: master
commit aa45ea8a33132f3a95b1e2c085776919febd5458
Author: Alan Mackenzie <acm@muc.de>
Commit: Alan Mackenzie <acm@muc.de>
In cl-prin1, enable raw printing for a byte-compiled function
* lisp/emacs-lisp/cl-print.el (cl-print-compiled): document the
new option `raw'.
(cl-print-object/compiled-function): when cl-print-compiled is
`raw', just print the function using `prin1'. Apply a button
to this output which, when activated disassembles the function.
* etc/NEWS (cl-print): Add an entry for this new feature.
---
etc/NEWS | 4 +++
lisp/emacs-lisp/cl-print.el | 83 ++++++++++++++++++++++++++-------------------
2 files changed, 52 insertions(+), 35 deletions(-)
diff --git a/etc/NEWS b/etc/NEWS
index 220568429fd..6637a5c87e2 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -162,6 +162,10 @@ should now work anywhere the data is generated by
'cl-print'.
*** Modes can control the expansion via 'cl-print-expand-ellipsis-function'.
+*** There is a new setting 'raw' for 'cl-print-compiled' which causes
+byte-compiled functions to be printed in full by 'prin1'. A button on
+this output can be activated to disassemble the function.
+
** Modeline elements can now be right-aligned.
Anything following the symbol 'mode-line-format-right-align' in
'mode-line-format' will be right-aligned. Exactly where it is
diff --git a/lisp/emacs-lisp/cl-print.el b/lisp/emacs-lisp/cl-print.el
index b6d1f13bb2f..56e35078d39 100644
--- a/lisp/emacs-lisp/cl-print.el
+++ b/lisp/emacs-lisp/cl-print.el
@@ -165,6 +165,7 @@ Print the contents hidden by the ellipsis to STREAM."
(defvar cl-print-compiled nil
"Control how to print byte-compiled functions.
Acceptable values include:
+- `raw' to print out the full contents of the function using `prin1'.
- `static' to print the vector of constants.
- `disassemble' to print the disassembly of the code.
- nil to skip printing any details about the code.")
@@ -187,42 +188,54 @@ into a button whose action shows the function's
disassembly.")
(if args
(prin1 args stream)
(princ "()" stream)))
- (pcase (help-split-fundoc (documentation object 'raw) object)
- ;; Drop args which `help-function-arglist' already printed.
- (`(,_usage . ,(and doc (guard (stringp 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 " " stream)
- (let ((button-start (and cl-print-compiled-button
- (bufferp stream)
- (with-current-buffer stream (point)))))
- (princ (format "#<bytecode %#x>" (sxhash object)) stream)
- (when (eq cl-print-compiled 'static)
+ (if (eq cl-print-compiled 'raw)
+ (let ((button-start
+ (and cl-print-compiled-button
+ (bufferp stream)
+ (with-current-buffer stream (1+ (point))))))
+ (princ " " stream)
+ (prin1 object stream)
+ (when button-start
+ (with-current-buffer stream
+ (make-text-button button-start (point)
+ :type 'help-byte-code
+ 'byte-code-function object))))
+ (pcase (help-split-fundoc (documentation object 'raw) object)
+ ;; Drop args which `help-function-arglist' already printed.
+ (`(,_usage . ,(and doc (guard (stringp doc))))
+ (princ " " stream)
+ (prin1 doc stream)))
+ (let ((inter (interactive-form object)))
+ (when inter
(princ " " stream)
- (cl-print-object (aref object 2) stream))
- (when button-start
- (with-current-buffer stream
- (make-text-button button-start (point)
- :type 'help-byte-code
- 'byte-code-function object)))))
- (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 " " stream)
+ (let ((button-start (and cl-print-compiled-button
+ (bufferp stream)
+ (with-current-buffer stream (point)))))
+ (princ (format "#<bytecode %#x>" (sxhash object)) stream)
+ (when (eq cl-print-compiled 'static)
+ (princ " " stream)
+ (cl-print-object (aref object 2) stream))
+ (when button-start
+ (with-current-buffer stream
+ (make-text-button button-start (point)
+ :type 'help-byte-code
+ 'byte-code-function object)))))
+ (princ ")" stream)))
;; This belongs in oclosure.el, of course, but some load-ordering issues make
it
;; complicated.
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- master aa45ea8a331: In cl-prin1, enable raw printing for a byte-compiled function,
Alan Mackenzie <=