procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

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

Browse source 
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.
This commit is contained in:
Alan Mackenzie 2023-09-29 16:14:04 +00:00
parent 6e4432673c
commit 01229fe009
1 changed files with 27 additions and 4 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

31
lisp/emacs-lisp/cl-print.el
View file

@ -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