From: Alan Mackenzie Date: Sat, 28 Oct 2023 09:14:54 +0000 (+0000) Subject: New cl-print-object method for subrs. X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=refs%2Fheads%2Ffeature%2Fnamed-lambdas;p=emacs.git 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. --- 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.