emacs-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

feature/named-lambdas c0d898596ed: New cl-print-object method for subrs.


From: Alan Mackenzie
Subject: feature/named-lambdas c0d898596ed: New cl-print-object method for subrs.
Date: Sat, 28 Oct 2023 05:17:28 -0400 (EDT)

branch: feature/named-lambdas
commit c0d898596edb1b3dd159a81fbbedb2c4e310ea5b
Author: Alan Mackenzie <acm@muc.de>
Commit: Alan Mackenzie <acm@muc.de>

    New cl-print-object method for subrs.
    
    This method also prints the defining symbol, when present.
    
    * lisp/emacs-lisp/cl-print.el (cl-print-object/subr): New
    method.
---
 lisp/emacs-lisp/cl-print.el | 22 +++++++++++++++-------
 1 file changed, 15 insertions(+), 7 deletions(-)

diff --git a/lisp/emacs-lisp/cl-print.el b/lisp/emacs-lisp/cl-print.el
index 5b7a5b3b92f..19305782ecc 100644
--- a/lisp/emacs-lisp/cl-print.el
+++ b/lisp/emacs-lisp/cl-print.el
@@ -193,11 +193,10 @@ into a button whose action shows the function's 
disassembly.")
 (cl-defmethod cl-print-object ((object compiled-function) stream)
   (unless stream (setq stream standard-output))
   (let ((defsym
-         (cond
-          ((subrp object)
-           (subr-native-defining-symbol object))
-          ((> (length object) 5)
-           (aref object 5)))))
+         ;; 2023-10-26: Currently `compiled-function' appears not to
+         ;; include subrs.
+         (and (> (length object) 5)
+           (aref object 5))))
     (when (and defsym (not (eq defsym t)) (symbolp defsym))
       (princ "{" stream)
       (;; cl-
@@ -255,8 +254,17 @@ into a button whose action shows the function's 
disassembly.")
           (with-current-buffer stream
             (make-text-button button-start (point)
                               :type 'help-byte-code
-                              'byte-code-function object)))))
-    (princ ")" stream)))
+                              'byte-code-function object))))))
+  (princ ")" stream))
+
+(cl-defmethod cl-print-object ((object subr) stream)
+  (unless stream (setq stream standard-output))
+  (let ((defsym (subr-native-defining-symbol object)))
+    (when (and defsym (not (eq defsym t)) (symbolp defsym))
+      (princ "{" stream)
+      (prin1 defsym stream)
+      (princ "} " stream)))
+  (prin1 object stream))
 
 ;; This belongs in oclosure.el, of course, but some load-ordering issues make 
it
 ;; complicated.



reply via email to

[Prev in Thread] Current Thread [Next in Thread]