summaryrefslogtreecommitdiff
path: root/lisp/emacs-lisp/cl-print.el
diff options
context:
space:
mode:
authorTassilo Horn <tsdh@gnu.org>2019-09-22 11:02:39 +0200
committerTassilo Horn <tsdh@gnu.org>2019-09-22 11:02:39 +0200
commitaf0642a4cb220f33a43d1380be085bc0b7134bb8 (patch)
treee3b1b57bc42e712c77bd55fc4fc722cf93fe6c66 /lisp/emacs-lisp/cl-print.el
parent8992bc7d1b7e7babbf2899b5c45e84b486f504e6 (diff)
parent37a4233a366797360c2f4f475591a3406586bcfb (diff)
downloademacs-scratch/tsdh-vc-list-files.tar.gz
Merge remote-tracking branch 'origin/master' into scratch/tsdh-vc-list-filesscratch/tsdh-vc-list-files
Diffstat (limited to 'lisp/emacs-lisp/cl-print.el')
-rw-r--r--lisp/emacs-lisp/cl-print.el21
1 files changed, 11 insertions, 10 deletions
diff --git a/lisp/emacs-lisp/cl-print.el b/lisp/emacs-lisp/cl-print.el
index 5fe3dd1b912..530770128e6 100644
--- a/lisp/emacs-lisp/cl-print.el
+++ b/lisp/emacs-lisp/cl-print.el
@@ -548,21 +548,22 @@ limit."
;; call_debugger (bug#31919).
(let* ((print-length (when limit (min limit 50)))
(print-level (when limit (min 8 (truncate (log limit)))))
- (delta (when limit
- (max 1 (truncate (/ print-length print-level))))))
+ (delta-length (when limit
+ (max 1 (truncate (/ print-length print-level))))))
(with-temp-buffer
(catch 'done
(while t
(erase-buffer)
(funcall print-function value (current-buffer))
- ;; Stop when either print-level is too low or the value is
- ;; successfully printed in the space allowed.
- (when (or (not limit)
- (< (- (point-max) (point-min)) limit)
- (= print-level 2))
- (throw 'done (buffer-string)))
- (cl-decf print-level)
- (cl-decf print-length delta))))))
+ (let ((result (- (point-max) (point-min))))
+ ;; Stop when either print-level is too low or the value is
+ ;; successfully printed in the space allowed.
+ (when (or (not limit) (< result limit) (<= print-level 2))
+ (throw 'done (buffer-string)))
+ (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)))))))))
(provide 'cl-print)
;;; cl-print.el ends here