Commit 2093395d authored by Gemini Lasswell's avatar Gemini Lasswell

Improve print output options commands in backtrace-mode (bug#36566)

* lisp/emacs-lisp/backtrace.el (backtrace-view): Mention
:print-gensym in docstring.
(backtrace-mode-map): Add keyboard binding for
backtrace-toggle-print-gensym.  Add menu entries for
backtrace-toggle-print-circle and backtrace-toggle-print-gensym.
(backtrace--with-output-variables): Bind print-gensym with value
of :print-gensym found in view plist.
(backtrace-toggle-print-circle): Remove description of
implementation details from docstring.
(backtrace-toggle-print-gensym): New command.
(backtrace--toggle-feature): Add echo area message describing result
of command.

* test/lisp/emacs-lisp/backtrace-tests.el
(backtrace-tests--print-circle): New test.

* doc/lispref/debugging.texi (Backtraces): Document keyboard
binding for backtrace-toggle-print-gensym.
parent 224534ab
...@@ -457,6 +457,9 @@ Collapse the top-level Lisp form at point back to a single line. ...@@ -457,6 +457,9 @@ Collapse the top-level Lisp form at point back to a single line.
@item # @item #
Toggle @code{print-circle} for the frame at point. Toggle @code{print-circle} for the frame at point.
@item :
Toggle @code{print-gensym} for the frame at point.
@item . @item .
Expand all the forms abbreviated with ``...'' in the frame at point. Expand all the forms abbreviated with ``...'' in the frame at point.
......
...@@ -175,7 +175,8 @@ This should be a list of `backtrace-frame' objects.") ...@@ -175,7 +175,8 @@ This should be a list of `backtrace-frame' objects.")
(defvar-local backtrace-view nil (defvar-local backtrace-view nil
"A plist describing how to render backtrace frames. "A plist describing how to render backtrace frames.
Possible entries are :show-flags, :show-locals and :print-circle.") Possible entries are :show-flags, :show-locals, :print-circle
and :print-gensym.")
(defvar-local backtrace-insert-header-function nil (defvar-local backtrace-insert-header-function nil
"Function for inserting a header for the current Backtrace buffer. "Function for inserting a header for the current Backtrace buffer.
...@@ -205,6 +206,7 @@ frames where the source code location is known.") ...@@ -205,6 +206,7 @@ frames where the source code location is known.")
(define-key map "p" 'backtrace-backward-frame) (define-key map "p" 'backtrace-backward-frame)
(define-key map "v" 'backtrace-toggle-locals) (define-key map "v" 'backtrace-toggle-locals)
(define-key map "#" 'backtrace-toggle-print-circle) (define-key map "#" 'backtrace-toggle-print-circle)
(define-key map ":" 'backtrace-toggle-print-gensym)
(define-key map "s" 'backtrace-goto-source) (define-key map "s" 'backtrace-goto-source)
(define-key map "\C-m" 'backtrace-help-follow-symbol) (define-key map "\C-m" 'backtrace-help-follow-symbol)
(define-key map "+" 'backtrace-multi-line) (define-key map "+" 'backtrace-multi-line)
...@@ -224,6 +226,18 @@ frames where the source code location is known.") ...@@ -224,6 +226,18 @@ frames where the source code location is known.")
:active (backtrace-get-index) :active (backtrace-get-index)
:selected (plist-get (backtrace-get-view) :show-locals) :selected (plist-get (backtrace-get-view) :show-locals)
:help "Show or hide the local variables for the frame at point"] :help "Show or hide the local variables for the frame at point"]
["Show Circular Structures" backtrace-toggle-print-circle
:style toggle
:active (backtrace-get-index)
:selected (plist-get (backtrace-get-view) :print-circle)
:help
"Condense or expand shared or circular structures in the frame at point"]
["Show Uninterned Symbols" backtrace-toggle-print-gensym
:style toggle
:active (backtrace-get-index)
:selected (plist-get (backtrace-get-view) :print-gensym)
:help
"Toggle unique printing of uninterned symbols in the frame at point"]
["Expand \"...\"s" backtrace-expand-ellipses ["Expand \"...\"s" backtrace-expand-ellipses
:help "Expand all the abbreviated forms in the current frame"] :help "Expand all the abbreviated forms in the current frame"]
["Show on Multiple Lines" backtrace-multi-line ["Show on Multiple Lines" backtrace-multi-line
...@@ -339,6 +353,7 @@ It runs `backtrace-revert-hook', then calls `backtrace-print'." ...@@ -339,6 +353,7 @@ It runs `backtrace-revert-hook', then calls `backtrace-print'."
`(let ((print-escape-control-characters t) `(let ((print-escape-control-characters t)
(print-escape-newlines t) (print-escape-newlines t)
(print-circle (plist-get ,view :print-circle)) (print-circle (plist-get ,view :print-circle))
(print-gensym (plist-get ,view :print-gensym))
(standard-output (current-buffer))) (standard-output (current-buffer)))
,@body)) ,@body))
...@@ -420,12 +435,18 @@ Set it to VALUE unless the button is a `backtrace-ellipsis' button." ...@@ -420,12 +435,18 @@ Set it to VALUE unless the button is a `backtrace-ellipsis' button."
(defun backtrace-toggle-print-circle (&optional all) (defun backtrace-toggle-print-circle (&optional all)
"Toggle `print-circle' for the backtrace frame at point. "Toggle `print-circle' for the backtrace frame at point.
With prefix argument ALL, toggle the value of :print-circle in With prefix argument ALL, toggle the default value bound to
`backtrace-view', which affects all of the backtrace frames in `print-circle' for all the frames in the buffer."
the buffer."
(interactive "P") (interactive "P")
(backtrace--toggle-feature :print-circle all)) (backtrace--toggle-feature :print-circle all))
(defun backtrace-toggle-print-gensym (&optional all)
"Toggle `print-gensym' for the backtrace frame at point.
With prefix argument ALL, toggle the default value bound to
`print-gensym' for all the frames in the buffer."
(interactive "P")
(backtrace--toggle-feature :print-gensym all))
(defun backtrace--toggle-feature (feature all) (defun backtrace--toggle-feature (feature all)
"Toggle FEATURE for the current backtrace frame or for the buffer. "Toggle FEATURE for the current backtrace frame or for the buffer.
FEATURE should be one of the options in `backtrace-view'. If ALL FEATURE should be one of the options in `backtrace-view'. If ALL
...@@ -450,12 +471,15 @@ position point at the start of the frame it was in before." ...@@ -450,12 +471,15 @@ position point at the start of the frame it was in before."
(goto-char (point-min)) (goto-char (point-min))
(while (and (not (eql index (backtrace-get-index))) (while (and (not (eql index (backtrace-get-index)))
(< (point) (point-max))) (< (point) (point-max)))
(goto-char (backtrace-get-frame-end))))) (goto-char (backtrace-get-frame-end))))
(let ((index (backtrace-get-index))) (message "%s is now %s for all frames"
(unless index (substring (symbol-name feature) 1) value))
(user-error "Not in a stack frame")) (unless (backtrace-get-index)
(backtrace--set-feature feature (user-error "Not in a stack frame"))
(not (plist-get (backtrace-get-view) feature)))))) (let ((value (not (plist-get (backtrace-get-view) feature))))
(backtrace--set-feature feature value)
(message "%s is now %s for this frame"
(substring (symbol-name feature) 1) value))))
(defun backtrace--set-feature (feature value) (defun backtrace--set-feature (feature value)
"Set FEATURE in the view plist of the frame at point to VALUE. "Set FEATURE in the view plist of the frame at point to VALUE.
......
...@@ -335,6 +335,55 @@ line contains the strings \"lambda\" and \"number\"." ...@@ -335,6 +335,55 @@ line contains the strings \"lambda\" and \"number\"."
(should (string-match-p results (should (string-match-p results
(backtrace-tests--get-substring (point-min) (point-max))))))) (backtrace-tests--get-substring (point-min) (point-max)))))))
(ert-deftest backtrace-tests--print-gensym ()
"Backtrace buffers can toggle `print-gensym' syntax."
(ert-with-test-buffer (:name "print-gensym")
(let* ((print-gensym nil)
(arg (list (gensym "first") (gensym) (gensym "last")))
(results (backtrace-tests--make-regexp
(backtrace-tests--result arg)))
(results-gensym (regexp-quote (let ((print-gensym t))
(backtrace-tests--result arg))))
(last-frame (backtrace-tests--make-regexp
(format (nth (1- backtrace-tests--line-count)
(backtrace-tests--backtrace-lines))
arg)))
(last-frame-gensym (regexp-quote
(let ((print-gensym t))
(format (nth (1- backtrace-tests--line-count)
(backtrace-tests--backtrace-lines))
arg)))))
(backtrace-tests--make-backtrace arg)
(backtrace-print)
(should (string-match-p results
(backtrace-tests--get-substring (point-min) (point-max))))
;; Go to the last frame.
(goto-char (point-max))
(forward-line -1)
;; Turn on print-gensym for that frame.
(backtrace-toggle-print-gensym)
(should (string-match-p last-frame-gensym
(backtrace-tests--get-substring (point) (point-max))))
;; Turn off print-gensym for the frame.
(backtrace-toggle-print-gensym)
(should (string-match-p last-frame
(backtrace-tests--get-substring (point) (point-max))))
(should (string-match-p results
(backtrace-tests--get-substring (point-min) (point-max))))
;; Turn print-gensym on for the buffer.
(backtrace-toggle-print-gensym '(4))
(should (string-match-p last-frame-gensym
(backtrace-tests--get-substring (point) (point-max))))
(should (string-match-p results-gensym
(backtrace-tests--get-substring (point-min) (point-max))))
;; Turn print-gensym off.
(backtrace-toggle-print-gensym '(4))
(should (string-match-p last-frame
(backtrace-tests--get-substring
(point) (+ (point) (length last-frame)))))
(should (string-match-p results
(backtrace-tests--get-substring (point-min) (point-max)))))))
(defun backtrace-tests--make-regexp (str) (defun backtrace-tests--make-regexp (str)
"Make regexp from STR for `backtrace-tests--print-circle'. "Make regexp from STR for `backtrace-tests--print-circle'.
Used for results of printing circular objects without Used for results of printing circular objects without
......
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