Improve performance of backtrace printing (bug#36566)

* lisp/emacs-lisp/cl-print.el (cl-print-to-string-with-limit): Reduce
print-level and print-length more quickly when the structure being
printed is very large.

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