From 695638203352a6943943acea559a572940e39be4 Mon Sep 17 00:00:00 2001 From: Alan Mackenzie Date: Wed, 27 Sep 2023 09:54:33 +0000 Subject: [PATCH] Revert "Don't use ellipses while cl-printing strings." This reverts commit 761f8901fffdb155cbcc7f3b5a2329161c2c1826. --- lisp/emacs-lisp/cl-print.el | 18 ++++++++++++++---- test/lisp/emacs-lisp/cl-print-tests.el | 17 ++++++++++++++++- 2 files changed, 30 insertions(+), 5 deletions(-) diff --git a/lisp/emacs-lisp/cl-print.el b/lisp/emacs-lisp/cl-print.el index 627b6cc3089..71929caabb8 100644 --- a/lisp/emacs-lisp/cl-print.el +++ b/lisp/emacs-lisp/cl-print.el @@ -264,17 +264,27 @@ into a button whose action shows the function's disassembly.") (cl-defmethod cl-print-object ((object string) stream) (unless stream (setq stream standard-output)) (let* ((has-properties (or (text-properties-at 0 object) - (next-property-change 0 object)))) + (next-property-change 0 object))) + (len (length object)) + (limit (if (natnump print-length) (min print-length len) len))) (if (and has-properties cl-print--depth (natnump print-level) (> cl-print--depth print-level)) (cl-print-insert-ellipsis object nil stream) - ;; Print the string. + ;; Print all or part of the string (when has-properties (princ "#(" stream)) - (prin1 (if has-properties (substring-no-properties object) object) - stream) + (if (= limit len) + (prin1 (if has-properties (substring-no-properties object) object) + stream) + (let ((part (concat (substring-no-properties object 0 limit) "..."))) + (prin1 part stream) + (when (bufferp stream) + (with-current-buffer stream + (cl-print-propertize-ellipsis object limit + (- (point) 4) + (- (point) 1) stream))))) ;; Print the property list. (when has-properties (cl-print--string-props object 0 stream) diff --git a/test/lisp/emacs-lisp/cl-print-tests.el b/test/lisp/emacs-lisp/cl-print-tests.el index e44a8e5ccc4..3073a42e39d 100644 --- a/test/lisp/emacs-lisp/cl-print-tests.el +++ b/test/lisp/emacs-lisp/cl-print-tests.el @@ -58,6 +58,21 @@ (cl-print-tests-check-ellipsis-expansion [a [b [c [d [e]]]]] "[a [b [c ...]]]" "[d [e]]"))) +(ert-deftest cl-print-tests-ellipsis-string () + "Ellipsis expansion works in strings." + (let ((print-length 4) + (print-level 3)) + (cl-print-tests-check-ellipsis-expansion + "abcdefg" "\"abcd...\"" "efg") + (cl-print-tests-check-ellipsis-expansion + "abcdefghijk" "\"abcd...\"" "efgh...") + (cl-print-tests-check-ellipsis-expansion + '(1 (2 (3 #("abcde" 0 5 (test t))))) + "(1 (2 (3 ...)))" "#(\"abcd...\" 0 5 (test t))") + (cl-print-tests-check-ellipsis-expansion + #("abcd" 0 1 (bold t) 1 2 (invisible t) 3 4 (italic t)) + "#(\"abcd\" 0 1 (bold t) ...)" "1 2 (invisible t) ..."))) + (ert-deftest cl-print-tests-ellipsis-struct () "Ellipsis expansion works in structures." (let ((print-length 4) @@ -129,7 +144,7 @@ ;; Print something which needs to be abbreviated and which can be. (should (< (length (cl-print-to-string-with-limit #'cl-prin1 thing100 100)) - 150 ;; 100. The LIMIT argument is advisory rather than absolute. + 100 (length (cl-prin1-to-string thing100)))) ;; Print something resistant to easy abbreviation. -- 2.39.5