diff options
| author | Gemini Lasswell <gazally@runbox.com> | 2019-07-30 11:56:51 -0700 |
|---|---|---|
| committer | Gemini Lasswell <gazally@runbox.com> | 2019-09-13 13:43:07 -0700 |
| commit | 5c40c21a47062782bc983f41e8eeb97180dca693 (patch) | |
| tree | ebb026a2c26868297c8e4ca6896e491ddf78c085 /lisp/emacs-lisp/cl-print.el | |
| parent | 2093395dbf8563af38f206950d95f0bc20183b9c (diff) | |
| download | emacs-5c40c21a47062782bc983f41e8eeb97180dca693.tar.gz emacs-5c40c21a47062782bc983f41e8eeb97180dca693.tar.bz2 emacs-5c40c21a47062782bc983f41e8eeb97180dca693.zip | |
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.
Diffstat (limited to 'lisp/emacs-lisp/cl-print.el')
| -rw-r--r-- | lisp/emacs-lisp/cl-print.el | 21 |
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 |