From 01229fe0096e936ea8f4fad0d64967671c4b1892 Mon Sep 17 00:00:00 2001 From: Alan Mackenzie Date: Fri, 29 Sep 2023 16:14:04 +0000 Subject: [PATCH] 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 , 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. --- lisp/emacs-lisp/cl-print.el | 31 +++++++++++++++++++++++++++---- 1 file changed, 27 insertions(+), 4 deletions(-) diff --git a/lisp/emacs-lisp/cl-print.el b/lisp/emacs-lisp/cl-print.el index 71929caabb8..d0bfcab4082 100644 --- 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 -- 2.39.5