From 99b24a7dc7472d04e6de43fb48f45869a272c26c Mon Sep 17 00:00:00 2001 From: Gemini Lasswell Date: Tue, 29 May 2018 11:41:09 -0700 Subject: [PATCH] Make cl-print respect print-quoted * lisp/emacs-lisp/cl-print.el (cl-print-object) : Print quote and its relatives as lists if print-quoted is nil. Add printing of 'function' as #'. * test/lisp/emacs-lisp/cl-print-tests.el (cl-print-tests-5): New test. --- lisp/emacs-lisp/cl-print.el | 9 +++++++-- test/lisp/emacs-lisp/cl-print-tests.el | 10 ++++++++++ 2 files changed, 17 insertions(+), 2 deletions(-) diff --git a/lisp/emacs-lisp/cl-print.el b/lisp/emacs-lisp/cl-print.el index 55e2bf8bd4..1eae8faf23 100644 --- a/lisp/emacs-lisp/cl-print.el +++ b/lisp/emacs-lisp/cl-print.el @@ -61,11 +61,16 @@ cl-print--depth (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 bfce4a16ce..404d323d0c 100644 --- 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)) -- 2.16.2