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 #'.

diff --git a/lisp/emacs-lisp/cl-print.el b/lisp/emacs-lisp/cl-print.el
index 780b9fb3fe959f84c6341ce9383d33207ea63860..66561ce26445c5c8214bf5f9c3f71bb14d892d14 100644 (file)
--- a/lisp/emacs-lisp/cl-print.el
+++ b/lisp/emacs-lisp/cl-print.el
@@ -61,11 +61,16 @@ call other entry points instead, such as `cl-prin1'."
       (princ "..." stream)
     (let ((car (pop object))
           (count 1))
-      (if (and (memq car '(\, quote \` \,@ \,.))
+      (if (and print-quoted
+               (memq car '(\, quote function \` \,@ \,.))
                (consp object)
                (null (cdr object)))
           (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))
         (princ "(" stream)
         (cl-print-object car stream)

diff --git a/test/lisp/emacs-lisp/cl-print-tests.el b/test/lisp/emacs-lisp/cl-print-tests.el
index bfce4a16cecf191573305375377542310819e0a1..404d323d0c12926f685671fe281f624cd39eb789 100644 (file)
--- a/test/lisp/emacs-lisp/cl-print-tests.el
+++ b/test/lisp/emacs-lisp/cl-print-tests.el
@@ -72,6 +72,16 @@
     (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)))))
 
+(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 ()
   (let ((x '(#1=(a . #1#) #1#)))
     (let ((print-circle nil))