Commit a3ba34ae authored by Gemini Lasswell's avatar Gemini Lasswell

Add new command to expand all "..."s in a backtrace frame

* doc/lispref/debugging.texi (Backtraces): Document new keybinding.
* lisp/emacs-lisp/backtrace.el (backtrace-line-length): Add the
option of unlimited line length.
(backtrace--match-ellipsis-in-string): Add a comment to explain
why this function is necessary.
(backtrace-mode-map): Add keybinding for 'backtrace-expand-ellipses'.
(backtrace-expand-ellipsis): Use 'cl-print-to-string-with-limit'.
(backtrace-expand-ellipses): New command.
(backtrace-print-to-string): Use 'cl-print-to-string-with-limit'.
Tag the printed forms with a gensym instead of the values of
print-length and print-level.
(backtrace--print): Add 'stream' argument.
* test/lisp/emacs-lisp/backtrace-tests.el
(backtrace-tests--expand-ellipsis): Make the test less dependent
on the implementation.
(backtrace-tests--expand-ellipses): New test.

Move the fitting of a printed representation into a limited number of
characters using appropriate values of print-level and print-length
from 'backtrace-print-to-string' to cl-print.el for future use by
other parts of Emacs.
* lisp/emacs-lisp/cl-print.el (cl-print-to-string-with-limit): New
function.
* test/lisp/emacs-lisp/cl-print-tests.el
(cl-print-tests-print-to-string-with-limit): New test.
parent 2ede75c4
......@@ -457,6 +457,9 @@ Collapse the top-level Lisp form at point back to a single line.
@item #
Toggle @code{print-circle} for the frame at point.
@item .
Expand all the forms abbreviated with ``...'' in the frame at point.
@end table
@node Debugger Commands
......
......@@ -55,7 +55,8 @@ order to debug the code that does fontification."
"Target length for lines in Backtrace buffers.
Backtrace mode will attempt to abbreviate printing of backtrace
frames to make them shorter than this, but success is not
guaranteed."
guaranteed. If set to nil or zero, Backtrace mode will not
abbreviate the forms it prints."
:type 'integer
:group 'backtrace
:version "27.1")
......@@ -146,6 +147,9 @@ fontifies.")
(defun backtrace--match-ellipsis-in-string (bound)
;; Fontify ellipses within strings as buttons.
;; This is necessary because ellipses are text property buttons
;; instead of overlay buttons, which is done because there could
;; be a large number of them.
(when (re-search-forward "\\(\\.\\.\\.\\)\"" bound t)
(and (get-text-property (- (point) 2) 'cl-print-ellipsis)
(get-text-property (- (point) 3) 'cl-print-ellipsis)
......@@ -187,6 +191,7 @@ This is commonly used to recompute `backtrace-frames'.")
(define-key map "\C-m" 'backtrace-help-follow-symbol)
(define-key map "+" 'backtrace-pretty-print)
(define-key map "-" 'backtrace-collapse)
(define-key map "." 'backtrace-expand-ellipses)
(define-key map [follow-link] 'mouse-face)
(define-key map [mouse-2] 'mouse-select-window)
map)
......@@ -207,9 +212,7 @@ This is commonly used to recompute `backtrace-frames'.")
;; backtrace-form: A value applied to each printed representation of a
;; top-level s-expression, which needs to be different for sexps
;; printed adjacent to each other, so the limits can be quickly
;; found for pretty-printing. The value chosen is a list contining
;; the values of print-level and print-length used to print the
;; sexp, and those values are used when expanding ellipses.
;; found for pretty-printing.
(defsubst backtrace-get-index (&optional pos)
"Return the index of the backtrace frame at POS.
......@@ -423,9 +426,6 @@ Reprint the frame with the new view plist."
(defun backtrace-expand-ellipsis (button)
"Expand display of the elided form at BUTTON."
;; TODO a command to expand all ... in form at point
;; with argument, don't bind print-level, length??
;; Enable undo so there's a way to go back?
(interactive)
(goto-char (button-start button))
(unless (get-text-property (point) 'cl-print-ellipsis)
......@@ -437,25 +437,44 @@ Reprint the frame with the new view plist."
(begin (previous-single-property-change end 'cl-print-ellipsis))
(value (get-text-property begin 'cl-print-ellipsis))
(props (backtrace-get-text-properties begin))
(tag (backtrace-get-form begin))
(length (nth 0 tag)) ; TODO should this work with a target char count
(level (nth 1 tag)) ; like backtrace-print-to-string?
(inhibit-read-only t))
(backtrace--with-output-variables (backtrace-get-view)
(let ((print-level level)
(print-length length))
(delete-region begin end)
(cl-print-expand-ellipsis value (current-buffer))
(setq end (point))
(goto-char begin)
(while (< (point) end)
(let ((next (next-single-property-change (point) 'cl-print-ellipsis
nil end)))
(when (get-text-property (point) 'cl-print-ellipsis)
(make-text-button (point) next :type 'backtrace-ellipsis))
(goto-char next)))
(goto-char begin)
(add-text-properties begin end props)))))
(delete-region begin end)
(insert (cl-print-to-string-with-limit #'cl-print-expand-ellipsis value
backtrace-line-length))
(setq end (point))
(goto-char begin)
(while (< (point) end)
(let ((next (next-single-property-change (point) 'cl-print-ellipsis
nil end)))
(when (get-text-property (point) 'cl-print-ellipsis)
(make-text-button (point) next :type 'backtrace-ellipsis))
(goto-char next)))
(goto-char begin)
(add-text-properties begin end props))))
(defun backtrace-expand-ellipses (&optional no-limit)
"Expand display of all \"...\"s in the backtrace frame at point.
\\<backtrace-mode-map>
Each ellipsis will be limited to `backtrace-line-length'
characters in its expansion. With optional prefix argument
NO-LIMIT, do not limit the number of characters. Note that with
or without the argument, using this command can result in very
long lines and very poor display performance. If this happens
and is a problem, use `\\[revert-buffer]' to return to the
initial state of the Backtrace buffer."
(interactive "P")
(save-excursion
(let ((start (backtrace-get-frame-start))
(end (backtrace-get-frame-end))
(backtrace-line-length (unless no-limit backtrace-line-length)))
(goto-char end)
(while (> (point) start)
(let ((next (previous-single-property-change (point) 'cl-print-ellipsis
nil start)))
(when (get-text-property (point) 'cl-print-ellipsis)
(push-button (point)))
(goto-char next))))))
(defun backtrace-pretty-print ()
"Pretty-print the top level s-expression at point."
......@@ -605,8 +624,7 @@ line and recenter window line accordingly."
"Return a printed representation of OBJ formatted for backtraces.
Attempt to get the length of the returned string under LIMIT
charcters with appropriate settings of `print-level' and
`print-length.' Attach the settings used with the text property
`backtrace-form'. LIMIT defaults to `backtrace-line-length'."
`print-length.' LIMIT defaults to `backtrace-line-length'."
(backtrace--with-output-variables backtrace-view
(backtrace--print-to-string obj limit)))
......@@ -614,36 +632,20 @@ charcters with appropriate settings of `print-level' and
;; This is for use by callers who wrap the call with
;; backtrace--with-output-variables.
(setq limit (or limit backtrace-line-length))
(let* ((length 50) ; (/ backtrace-line-length 100) ??
(level (truncate (log limit)))
(delta (truncate (/ length level))))
(with-temp-buffer
(catch 'done
(while t
(erase-buffer)
(let ((standard-output (current-buffer))
(print-length length)
(print-level level))
(backtrace--print sexp))
;; Stop when either the level is too low or the sexp is
;; successfully printed in the space allowed.
(when (or (< (- (point-max) (point-min)) limit) (= level 2))
(throw 'done nil))
(cl-decf level)
(cl-decf length delta)))
(put-text-property (point-min) (point)
'backtrace-form (list length level))
;; Make buttons from all the "..."s.
;; TODO should this be under control of :do-ellipses in the view
;; plist?
(goto-char (point-min))
(while (< (point) (point-max))
(let ((end (next-single-property-change (point) 'cl-print-ellipsis
nil (point-max))))
(when (get-text-property (point) 'cl-print-ellipsis)
(make-text-button (point) end :type 'backtrace-ellipsis))
(goto-char end)))
(buffer-string))))
(with-temp-buffer
(insert (cl-print-to-string-with-limit #'backtrace--print sexp limit))
;; Add a unique backtrace-form property.
(put-text-property (point-min) (point) 'backtrace-form (gensym))
;; Make buttons from all the "..."s. Since there might be many of
;; them, use text property buttons.
(goto-char (point-min))
(while (< (point) (point-max))
(let ((end (next-single-property-change (point) 'cl-print-ellipsis
nil (point-max))))
(when (get-text-property (point) 'cl-print-ellipsis)
(make-text-button (point) end :type 'backtrace-ellipsis))
(goto-char end)))
(buffer-string)))
(defun backtrace-print-frame (frame view)
"Insert a backtrace FRAME at point formatted according to VIEW.
......@@ -727,14 +729,14 @@ Print them only if :show-locals is non-nil in the VIEW plist."
(insert "\n")))
(put-text-property beg (point) 'backtrace-section 'locals))))
(defun backtrace--print (obj)
"Attempt to print OBJ using `backtrace-print-function'.
(defun backtrace--print (obj &optional stream)
"Attempt to print OBJ to STREAM using `backtrace-print-function'.
Fall back to `prin1' if there is an error."
(condition-case err
(funcall backtrace-print-function obj)
(funcall backtrace-print-function obj stream)
(error
(message "Error in backtrace printer: %S" err)
(prin1 obj))))
(prin1 obj stream))))
(defun backtrace-update-flags ()
"Update the display of the flags in the backtrace frame at point."
......@@ -805,8 +807,6 @@ followed by `backtrace-print-frame', once for each stack frame."
backtrace-font-lock-keywords-1
backtrace-font-lock-keywords-2)
nil nil nil nil
;; TODO This one doesn't look necessary:
;; (font-lock-mark-block-function . mark-defun)
(font-lock-syntactic-face-function
. lisp-font-lock-syntactic-face-function))))
(setq truncate-lines t)
......
......@@ -524,5 +524,45 @@ node `(elisp)Output Variables'."
(cl-prin1 object (current-buffer))
(buffer-string)))
;;;###autoload
(defun cl-print-to-string-with-limit (print-function value limit)
"Return a string containing a printed representation of VALUE.
Attempt to get the length of the returned string under LIMIT
characters with appropriate settings of `print-level' and
`print-length.' Use PRINT-FUNCTION to print, which should take
the arguments VALUE and STREAM and which should respect
`print-length' and `print-level'. LIMIT may be nil or zero in
which case PRINT-FUNCTION will be called with `print-level' and
`print-length' bound to nil.
Use this function with `cl-prin1' to print an object,
abbreviating it with ellipses to fit within a size limit. Use
this function with `cl-prin1-expand-ellipsis' to expand an
ellipsis, abbreviating the expansion to stay within a size
limit."
(setq limit (and (natnump limit)
(not (zerop limit))
limit))
;; Since this is used by the debugger when stack space may be
;; limited, if you increase print-level here, add more depth in
;; 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))))))
(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))))))
(provide 'cl-print)
;;; cl-print.el ends here
......@@ -349,32 +349,74 @@ digit and replace with #[0-9]."
(buffer-string)))
(ert-deftest backtrace-tests--expand-ellipsis ()
"Backtrace buffers ellipsify large forms and can expand the ellipses."
"Backtrace buffers ellipsify large forms as buttons which expand the ellipses."
;; make a backtrace with an ellipsis
;; expand the ellipsis
(ert-with-test-buffer (:name "variables")
(let* ((print-level nil)
(print-length nil)
(arg (let ((long (make-list 100 'a))
(deep '(0 (1 (2 (3 (4 (5 (6 (7 (8 (9))))))))))))
(setf (nth 1 long) deep)
long))
(backtrace-line-length 300)
(arg (make-list 40 (make-string 10 ?a)))
(results (backtrace-tests--result arg)))
(backtrace-tests--make-backtrace arg)
(backtrace-print)
;; There should be two ellipses. Find and expand them.
;; There should be an ellipsis. Find and expand it.
(goto-char (point-min))
(search-forward "...")
(backward-char)
(push-button)
(search-forward "...")
(backward-char)
(push-button)
(should (string= (backtrace-tests--get-substring (point-min) (point-max))
results)))))
(ert-deftest backtrace-tests--expand-ellipses ()
"Backtrace buffers ellipsify large forms and can expand the ellipses."
(ert-with-test-buffer (:name "variables")
(let* ((print-level nil)
(print-length nil)
(backtrace-line-length 300)
(arg (let ((outer (make-list 40 (make-string 10 ?a)))
(nested (make-list 40 (make-string 10 ?b))))
(setf (nth 39 nested) (make-list 40 (make-string 10 ?c)))
(setf (nth 39 outer) nested)
outer))
(results (backtrace-tests--result-with-locals arg)))
;; Make a backtrace with local variables visible.
(backtrace-tests--make-backtrace arg)
(backtrace-print)
(backtrace-toggle-locals '(4))
;; There should be two ellipses.
(goto-char (point-min))
(should (search-forward "..."))
(should (search-forward "..."))
(should-error (search-forward "..."))
;; Expanding the last frame without argument should expand both
;; ellipses, but the expansions will contain one ellipsis each.
(let ((buffer-len (- (point-max) (point-min))))
(goto-char (point-max))
(backtrace-backward-frame)
(backtrace-expand-ellipses)
(should (> (- (point-max) (point-min)) buffer-len))
(goto-char (point-min))
(should (search-forward "..."))
(should (search-forward "..."))
(should-error (search-forward "...")))
;; Expanding with argument should remove all ellipses.
(goto-char (point-max))
(backtrace-backward-frame)
(backtrace-expand-ellipses '(4))
(goto-char (point-min))
(should-error (search-forward "..."))
(should (string= (backtrace-tests--get-substring (point-min) (point-max))
results)))))
(ert-deftest backtrace-tests--to-string ()
"Backtraces can be produced as strings."
(let ((frames (ert-with-test-buffer (:name nil)
......
......@@ -233,5 +233,41 @@
(let ((print-circle t))
(should (equal "(0 . #1=(0 . #1#))" (cl-prin1-to-string x))))))
(ert-deftest cl-print-tests-print-to-string-with-limit ()
(let* ((thing10 (make-list 10 'a))
(thing100 (make-list 100 'a))
(thing10x10 (make-list 10 thing10))
(nested-thing (let ((val 'a))
(dotimes (_i 20)
(setq val (list val)))
val))
;; Make a consistent environment for this test.
(print-circle nil)
(print-level nil)
(print-length nil))
;; Print something that fits in the space given.
(should (string= (cl-prin1-to-string thing10)
(cl-print-to-string-with-limit #'cl-prin1 thing10 100)))
;; Print something which needs to be abbreviated and which can be.
(should (< (length (cl-print-to-string-with-limit #'cl-prin1 thing100 100))
100
(length (cl-prin1-to-string thing100))))
;; Print something resistant to easy abbreviation.
(should (string= (cl-prin1-to-string thing10x10)
(cl-print-to-string-with-limit #'cl-prin1 thing10x10 100)))
;; Print something which should be abbreviated even if the limit is large.
(should (< (length (cl-print-to-string-with-limit #'cl-prin1 nested-thing 1000))
(length (cl-prin1-to-string nested-thing))))
;; Print with no limits.
(dolist (thing (list thing10 thing100 thing10x10 nested-thing))
(let ((rep (cl-prin1-to-string thing)))
(should (string= rep (cl-print-to-string-with-limit #'cl-prin1 thing 0)))
(should (string= rep (cl-print-to-string-with-limit #'cl-prin1 thing nil)))))))
;;; cl-print-tests.el ends here.
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment