Stop truncating strings too much in cl-print-string-with-limit

This fixes bug#65680, by introducing a new variable limiting
the length of a printed string, rather than abusing
print-length for that purpose.

* lisp/emacs-lisp/cl-print.el (cl-print-string-length): New
variable.
(cl-print-object <string>, cl-print--string-props): Use
cl-print-string-length rather than print-length here.
(cl-print-string-with-limit): bind cl-print-string-length based
on argument `limit'.  Decrement it by a quarter at each trial
iteration of printing.

diff --git a/lisp/emacs-lisp/cl-print.el b/lisp/emacs-lisp/cl-print.el
index 71929caabb82b90f47d5aeea34e8e77e6ababa6f..d0bfcab4082bff0b0939e095f140a7beaf69bcd6 100644 (file)
--- a/lisp/emacs-lisp/cl-print.el
+++ b/lisp/emacs-lisp/cl-print.el
@@ -261,12 +261,26 @@ into a button whose action shows the function's disassembly.")
 (cl-defmethod cl-print-object-contents ((object cl-structure-object) start stream)
   (cl-print--struct-contents object start stream)) ;FIXME: η-redex!
 
+(defvar cl-print-string-length nil
+  "Maximum length of string to print before abbreviating.
+A value of nil means no limit.
+
+When Emacs abbreviates a string, it prints the first
+`cl-print-string-length' characters of the string, followed by
+\"...\".  You can type RET, or click on this ellipsis to expand
+the string.
+
+This variable has effect only in the `cl-prin*' functions, not in
+primitives such as `prin1'.")
+
 (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)))
          (len (length object))
-         (limit (if (natnump print-length) (min print-length len) len)))
+         (limit (if (natnump cl-print-string-length)
+                    (min cl-print-string-length len)
+                  len)))
     (if (and has-properties
              cl-print--depth
              (natnump print-level)
@@ -325,8 +339,9 @@ into a button whose action shows the function's disassembly.")
   (let* ((len (length object)))
     (if (atom start)
         ;; Print part of the string.
-        (let* ((limit (if (natnump print-length)
-                          (min (+ start print-length) len) len))
+        (let* ((limit (if (natnump cl-print-string-length)
+                          (min (+ start cl-print-string-length) len)
+                        len))
                (substr (substring-no-properties object start limit))
                (printed (prin1-to-string substr))
                (trimmed (substring printed 1 -1)))
@@ -557,6 +572,11 @@ abbreviating it with ellipses to fit within a size limit."
                         ((null limit) nil)
                         ((eq limit t) print-level)
                         (t (min 8 (truncate (log limit))))))
+         (cl-print-string-length
+          (cond
+           ((or (null limit) (zerop limit)) nil)
+           ((eq limit t) cl-print-string-length)
+           (t (max 0 (- limit 3)))))
          (delta-length (when (natnump limit)
                          (max 1 (truncate (/ print-length print-level))))))
     (with-temp-buffer
@@ -572,7 +592,10 @@ abbreviating it with ellipses to fit within a size limit."
             (let* ((ratio (/ result limit))
                    (delta-level (max 1 (min (- print-level 2) ratio))))
               (cl-decf print-level delta-level)
-              (cl-decf print-length (* delta-length delta-level)))))))))
+              (cl-decf print-length (* delta-length delta-level))
+              (when cl-print-string-length
+                (cl-decf cl-print-string-length
+                         (ceiling cl-print-string-length 4.0))))))))))
 
 (provide 'cl-print)
 ;;; cl-print.el ends here