Make cl-print respect print-quoted (bug#31649)
* lisp/emacs-lisp/cl-print.el (cl-print-object) <cons>: Observe print-quoted when printing quote and its relatives. Add printing of 'function' as #'.
This commit is contained in:
parent
26b52ac40e
commit
c6ef3c8321
2 changed files with 17 additions and 2 deletions
|
@ -61,11 +61,16 @@ call other entry points instead, such as `cl-prin1'."
|
||||||
(princ "..." stream)
|
(princ "..." stream)
|
||||||
(let ((car (pop object))
|
(let ((car (pop object))
|
||||||
(count 1))
|
(count 1))
|
||||||
(if (and (memq car '(\, quote \` \,@ \,.))
|
(if (and print-quoted
|
||||||
|
(memq car '(\, quote function \` \,@ \,.))
|
||||||
(consp object)
|
(consp object)
|
||||||
(null (cdr object)))
|
(null (cdr object)))
|
||||||
(progn
|
(progn
|
||||||
(princ (if (eq car 'quote) '\' car) stream)
|
(princ (cond
|
||||||
|
((eq car 'quote) '\')
|
||||||
|
((eq car 'function) "#'")
|
||||||
|
(t car))
|
||||||
|
stream)
|
||||||
(cl-print-object (car object) stream))
|
(cl-print-object (car object) stream))
|
||||||
(princ "(" stream)
|
(princ "(" stream)
|
||||||
(cl-print-object car stream)
|
(cl-print-object car stream)
|
||||||
|
|
|
@ -72,6 +72,16 @@
|
||||||
(should (equal "#s(cl-print-tests-struct :a (a (b (c ...))) :b nil :c nil :d nil :e nil)"
|
(should (equal "#s(cl-print-tests-struct :a (a (b (c ...))) :b nil :c nil :d nil :e nil)"
|
||||||
(cl-prin1-to-string deep-struct)))))
|
(cl-prin1-to-string deep-struct)))))
|
||||||
|
|
||||||
|
(ert-deftest cl-print-tests-5 ()
|
||||||
|
"CL printing observes `print-quoted'."
|
||||||
|
(let ((quoted-stuff '('a #'b `(,c ,@d))))
|
||||||
|
(let ((print-quoted t))
|
||||||
|
(should (equal "('a #'b `(,c ,@d))"
|
||||||
|
(cl-prin1-to-string quoted-stuff))))
|
||||||
|
(let ((print-quoted nil))
|
||||||
|
(should (equal "((quote a) (function b) (\\` ((\\, c) (\\,@ d))))"
|
||||||
|
(cl-prin1-to-string quoted-stuff))))))
|
||||||
|
|
||||||
(ert-deftest cl-print-circle ()
|
(ert-deftest cl-print-circle ()
|
||||||
(let ((x '(#1=(a . #1#) #1#)))
|
(let ((x '(#1=(a . #1#) #1#)))
|
||||||
(let ((print-circle nil))
|
(let ((print-circle nil))
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue