Commit ca983772 authored by Gemini Lasswell's avatar Gemini Lasswell

Add new commands to Edebug backtraces

Add commands to go to source if available, and to show and hide
Edebug's instrumentation.  Make Edebug pop to backtraces instead of
displaying them, which makes Edebug consistant with the behavior of
ERT and the Lisp Debugger.
* doc/lispref/edebug.texi (Edebug Misc): Document when and how you can
jump to source code from an Edebug backtrace.  Document
'edebug-backtrace-show-instrumentation' and
'edebug-backtrace-hide-instrumentation'.
* lisp/emacs-lisp/backtrace.el (backtrace-frame): Add comments to
describe the fields.
(backtrace-goto-source-functions): New
abnormal hook.
(backtrace-mode-map): Add keybinding and menu item for
backtrace-goto-source.
(backtrace--flags-width): New constant.
(backtrace-update-flags): Use it.
(backtrace-goto-source): New command.
(backtrace--print-flags): Print the :source-available flag.
* lisp/emacs-lisp/edebug.el (edebug-backtrace-frames)
(edebug-instrumented-backtrace-frames): New variables.
(edebug-backtrace, edebug--backtrace-frames): Remove functions.
(edebug-pop-to-backtrace, edebug--backtrace-goto-source)
(edebug--add-source-info): New functions.
(edebug-mode-map, edebug-mode-menus): Replace 'edebug-backtrace' with
'edebug-pop-to-backtrace'.
(edebug--strip-instrumentation): New function.
(edebug--unwrap-and-add-info): Remove.
(edebug-unwrap-frame, edebug-add-source-info): New functions.
(edebug-backtrace-show-instrumentation)
(edebug-backtrace-hide-instrumentation): New commands.
* test/lisp/emacs-lisp/edebug-tests.el (edebug-tests-check-keymap):
Verify keybindings in backtrace-mode-map used by new test.
Update with binding for 'edebug-pop-to-backtrace'.
(edebug-tests-backtrace-goto-source): New test.
* test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el
(edebug-test-code-range): Add a new stop point.
parent 1459ad2c
......@@ -442,8 +442,16 @@ Redisplay the most recently known expression result in the echo area
Display a backtrace, excluding Edebug's own functions for clarity
(@code{edebug-backtrace}).
@xref{Debugging,, Backtraces, elisp}, for the commands which work
in a backtrace buffer.
@xref{Debugging,, Backtraces, elisp}, for a description of backtraces
and the commands which work on them.
If you would like to see Edebug's functions in the backtrace,
use @kbd{M-x edebug-backtrace-show-instrumentation}. To hide them
again use @kbd{M-x edebug-backtrace-hide-instrumentation}.
If a backtrace frame starts with @samp{>} that means that Edebug knows
where the source code for the frame is located. Use @kbd{s} to jump
to the source code for the current frame.
The backtrace buffer is killed automatically when you continue
execution.
......
......@@ -484,11 +484,20 @@ using the new variables 'edebug-behavior-alist',
globally or for individual definitions.
+++
*** Edebug's backtrace buffer now uses 'backtrace-mode'.
Backtrace mode adds fontification, links and commands for changing the
*** Edebug's backtrace buffer now uses 'backtrace-mode'. Backtrace
mode adds fontification, links and commands for changing the
appearance of backtrace frames. See the node "Backtraces" in the Elisp
manual for documentation of the new mode and its commands.
The binding of 'd' in Edebug's keymap is now 'edebug-pop-to-backtrace'
which replaces 'edebug-backtrace'. Consequently Edebug's backtrace
windows now behave like those of the Lisp Debugger and of ERT, in that
when they appear they will be the selected window.
The new 'backtrace-goto-source' command, bound to 's', works in
Edebug's backtraces on backtrace frames whose source code has
been instrumented by Edebug.
** Enhanced xterm support
*** New variable 'xterm-set-window-title' controls whether Emacs sets
......
......@@ -66,7 +66,14 @@ abbreviate the forms it prints."
(cl-defstruct
(backtrace-frame
(:constructor backtrace-make-frame))
evald fun args flags locals buffer pos)
evald ; Non-nil if argument evaluation is complete.
fun ; The function called/to call in this frame.
args ; Either evaluated or unevaluated arguments to the function.
flags ; A plist, possible properties are :debug-on-exit and :source-available.
locals ; An alist containing variable names and values.
buffer ; If non-nil, the buffer in use by eval-buffer or eval-region.
pos ; The position in the buffer.
)
(cl-defun backtrace-get-frames
(&optional base &key (constructor #'backtrace-make-frame))
......@@ -181,6 +188,15 @@ This is commonly used to recompute `backtrace-frames'.")
(defvar-local backtrace-print-function #'cl-prin1
"Function used to print values in the current Backtrace buffer.")
(defvar-local backtrace-goto-source-functions nil
"Abnormal hook used to jump to the source code for the current frame.
Each hook function is called with no argument, and should return
non-nil if it is able to switch to the buffer containing the
source code. Execution of the hook will stop if one of the
functions returns non-nil. When adding a function to this hook,
you should also set the :source-available flag for the backtrace
frames where the source code location is known.")
(defvar backtrace-mode-map
(let ((map (copy-keymap special-mode-map)))
(set-keymap-parent map button-buffer-map)
......@@ -188,6 +204,7 @@ This is commonly used to recompute `backtrace-frames'.")
(define-key map "p" 'backtrace-backward-frame)
(define-key map "v" 'backtrace-toggle-locals)
(define-key map "#" 'backtrace-toggle-print-circle)
(define-key map "s" 'backtrace-goto-source)
(define-key map "\C-m" 'backtrace-help-follow-symbol)
(define-key map "+" 'backtrace-pretty-print)
(define-key map "-" 'backtrace-collapse)
......@@ -212,6 +229,12 @@ This is commonly used to recompute `backtrace-frames'.")
:help "Use line breaks and indentation to make a form more readable"]
["Collapse to Single Line" backtrace-collapse]
"--"
["Go to Source" backtrace-goto-source
:active (and (backtrace-get-index)
(plist-get (backtrace-frame-flags
(nth (backtrace-get-index) backtrace-frames))
:source-available))
:help "Show the source code for the current frame"]
["Help for Symbol" backtrace-help-follow-symbol
:help "Show help for symbol at point"]
["Describe Backtrace Mode" describe-mode
......@@ -219,6 +242,9 @@ This is commonly used to recompute `backtrace-frames'.")
map)
"Local keymap for `backtrace-mode' buffers.")
(defconst backtrace--flags-width 2
"Width in characters of the flags for a backtrace frame.")
;;; Navigation and Text Properties
;; This mode uses the following text properties:
......@@ -580,6 +606,20 @@ content of the sexp."
'(backtrace-section backtrace-index backtrace-view
backtrace-form))))
(defun backtrace-goto-source ()
"If its location is known, jump to the source code for the frame at point."
(interactive)
(let* ((index (or (backtrace-get-index) (user-error "Not in a stack frame")))
(frame (nth index backtrace-frames))
(source-available (plist-get (backtrace-frame-flags frame)
:source-available)))
(unless (and source-available
(catch 'done
(dolist (func backtrace-goto-source-functions)
(when (funcall func)
(throw 'done t)))))
(user-error "Source code location not known"))))
(defun backtrace-help-follow-symbol (&optional pos)
"Follow cross-reference at POS, defaulting to point.
For the cross-reference format, see `help-make-xrefs'."
......@@ -681,8 +721,12 @@ property for use by navigation."
(defun backtrace--print-flags (frame view)
"Print the flags of a backtrace FRAME if enabled in VIEW."
(let ((beg (point))
(flag (plist-get (backtrace-frame-flags frame) :debug-on-exit)))
(insert (if (and (plist-get view :show-flags) flag) "* " " "))
(flag (plist-get (backtrace-frame-flags frame) :debug-on-exit))
(source (plist-get (backtrace-frame-flags frame) :source-available)))
(when (plist-get view :show-flags)
(when source (insert ">"))
(when flag (insert "*")))
(insert (make-string (- backtrace--flags-width (- (point) beg)) ?\s))
(put-text-property beg (point) 'backtrace-section 'func)))
(defun backtrace--print-func-and-args (frame _view)
......@@ -770,7 +814,7 @@ Fall back to `prin1' if there is an error."
(let ((props (backtrace-get-text-properties begin))
(inhibit-read-only t)
(standard-output (current-buffer)))
(delete-char 2)
(delete-char backtrace--flags-width)
(backtrace--print-flags (nth (backtrace-get-index) backtrace-frames)
view)
(add-text-properties begin (point) props))))))
......
......@@ -3692,7 +3692,7 @@ be installed in `emacs-lisp-mode-map'.")
;; misc
(define-key map "?" 'edebug-help)
(define-key map "d" 'edebug-backtrace)
(define-key map "d" 'edebug-pop-to-backtrace)
(define-key map "-" 'negative-argument)
......@@ -3985,6 +3985,13 @@ Otherwise call `debug' normally."
;;; Backtrace buffer
(defvar-local edebug-backtrace-frames nil
"Stack frames of the current Edebug Backtrace buffer without instrumentation.
This should be a list of `edebug---frame' objects.")
(defvar-local edebug-instrumented-backtrace-frames nil
"Stack frames of the current Edebug Backtrace buffer with instrumentation.
This should be a list of `edebug---frame' objects.")
;; Data structure for backtrace frames with information
;; from Edebug instrumentation found in the backtrace.
(cl-defstruct
......@@ -3993,7 +4000,7 @@ Otherwise call `debug' normally."
(:include backtrace-frame))
def-name before-index after-index)
(defun edebug-backtrace ()
(defun edebug-pop-to-backtrace ()
"Display the current backtrace in a `backtrace-mode' window."
(interactive)
(if (or (not edebug-backtrace-buffer)
......@@ -4002,31 +4009,33 @@ Otherwise call `debug' normally."
(generate-new-buffer "*Edebug Backtrace*"))
;; Else, could just display edebug-backtrace-buffer.
)
(with-output-to-temp-buffer (buffer-name edebug-backtrace-buffer)
(setq edebug-backtrace-buffer standard-output)
(with-current-buffer edebug-backtrace-buffer
(unless (derived-mode-p 'backtrace-mode)
(backtrace-mode))
(setq backtrace-frames (edebug--backtrace-frames))
(backtrace-print)
(goto-char (point-min)))))
(defun edebug--backtrace-frames ()
"Return backtrace frames with instrumentation removed.
(pop-to-buffer edebug-backtrace-buffer)
(unless (derived-mode-p 'backtrace-mode)
(backtrace-mode)
(add-hook 'backtrace-goto-source-functions 'edebug--backtrace-goto-source))
(setq edebug-instrumented-backtrace-frames
(backtrace-get-frames 'edebug-debugger
:constructor #'edebug--make-frame)
edebug-backtrace-frames (edebug--strip-instrumentation
edebug-instrumented-backtrace-frames)
backtrace-frames edebug-backtrace-frames)
(backtrace-print)
(goto-char (point-min)))
(defun edebug--strip-instrumentation (frames)
"Return a new list of backtrace frames with instrumentation removed.
Remove frames for Edebug's functions and the lambdas in
`edebug-enter' wrappers."
(let* ((frames (backtrace-get-frames 'edebug-debugger
:constructor #'edebug--make-frame))
skip-next-lambda def-name before-index after-index
results
(index (length frames)))
`edebug-enter' wrappers. Fill in the def-name, before-index
and after-index fields in both FRAMES and the returned list
of deinstrumented frames, for those frames where the source
code location is known."
(let (skip-next-lambda def-name before-index after-index results
(index (length frames)))
(dolist (frame (reverse frames))
(let ((fun (edebug--frame-fun frame))
(let ((new-frame (copy-edebug--frame frame))
(fun (edebug--frame-fun frame))
(args (edebug--frame-args frame)))
(cl-decf index)
(when (edebug--frame-evald frame)
(setq before-index nil
after-index nil))
(pcase fun
('edebug-enter
(setq skip-next-lambda t
......@@ -4037,17 +4046,18 @@ Remove frames for Edebug's functions and the lambdas in
(nth 0 args))
after-index (nth 1 args)))
((pred edebug--symbol-not-prefixed-p)
(edebug--unwrap-and-add-info frame def-name before-index after-index)
(setf (edebug--frame-def-name frame) (and before-index def-name))
(setf (edebug--frame-before-index frame) before-index)
(setf (edebug--frame-after-index frame) after-index)
(push frame results)
(edebug--unwrap-frame new-frame)
(edebug--add-source-info new-frame def-name before-index after-index)
(edebug--add-source-info frame def-name before-index after-index)
(push new-frame results)
(setq before-index nil
after-index nil))
(`(,(or 'lambda 'closure) . ,_)
(unless skip-next-lambda
(edebug--unwrap-and-add-info frame def-name before-index after-index)
(push frame results))
(edebug--unwrap-frame new-frame)
(edebug--add-source-info frame def-name before-index after-index)
(edebug--add-source-info new-frame def-name before-index after-index)
(push new-frame results))
(setq before-index nil
after-index nil
skip-next-lambda nil)))))
......@@ -4058,14 +4068,9 @@ Remove frames for Edebug's functions and the lambdas in
(and (symbolp sym)
(not (string-prefix-p "edebug-" (symbol-name sym)))))
(defun edebug--unwrap-and-add-info (frame def-name before-index after-index)
"Update FRAME with the additional info needed by an edebug--frame.
Save DEF-NAME, BEFORE-INDEX and AFTER-INDEX in FRAME. Also
remove Edebug's instrumentation from the function and any
unevaluated arguments in FRAME."
(setf (edebug--frame-def-name frame) (and before-index def-name))
(setf (edebug--frame-before-index frame) before-index)
(setf (edebug--frame-after-index frame) after-index)
(defun edebug--unwrap-frame (frame)
"Remove Edebug's instrumentation from FRAME.
Strip it from the function and any unevaluated arguments."
(setf (edebug--frame-fun frame) (edebug-unwrap* (edebug--frame-fun frame)))
(unless (edebug--frame-evald frame)
(let (results)
......@@ -4073,6 +4078,41 @@ unevaluated arguments in FRAME."
(push (edebug-unwrap* arg) results))
(setf (edebug--frame-args frame) (nreverse results)))))
(defun edebug--add-source-info (frame def-name before-index after-index)
"Update FRAME with the additional info needed by an edebug--frame.
Save DEF-NAME, BEFORE-INDEX and AFTER-INDEX in FRAME."
(when (and before-index def-name)
(setf (edebug--frame-flags frame)
(plist-put (copy-sequence (edebug--frame-flags frame))
:source-available t)))
(setf (edebug--frame-def-name frame) (and before-index def-name))
(setf (edebug--frame-before-index frame) before-index)
(setf (edebug--frame-after-index frame) after-index))
(defun edebug--backtrace-goto-source ()
(let* ((index (backtrace-get-index))
(frame (nth index backtrace-frames)))
(when (edebug--frame-def-name frame)
(let* ((data (get (edebug--frame-def-name frame) 'edebug))
(marker (nth 0 data))
(offsets (nth 2 data)))
(pop-to-buffer (marker-buffer marker))
(goto-char (+ (marker-position marker)
(aref offsets (edebug--frame-before-index frame))))))))
(defun edebug-backtrace-show-instrumentation ()
"Show Edebug's instrumentation in an Edebug Backtrace buffer."
(interactive)
(unless (eq backtrace-frames edebug-instrumented-backtrace-frames)
(setq backtrace-frames edebug-instrumented-backtrace-frames)
(revert-buffer)))
(defun edebug-backtrace-hide-instrumentation ()
"Show Edebug's instrumentation in an Edebug Backtrace buffer."
(interactive)
(unless (eq backtrace-frames edebug-backtrace-frames)
(setq backtrace-frames edebug-backtrace-frames)
(revert-buffer)))
;;; Trace display
......@@ -4246,7 +4286,7 @@ It is removed when you hit any char."
["Bounce to Current Point" edebug-bounce-point t]
["View Outside Windows" edebug-view-outside t]
["Previous Result" edebug-previous-result t]
["Show Backtrace" edebug-backtrace t]
["Show Backtrace" edebug-pop-to-backtrace t]
["Display Freq Count" edebug-display-freq-count t])
("Eval"
......
......@@ -41,7 +41,7 @@
(defun edebug-test-code-range (num)
!start!(let ((index 0)
(result nil))
(while (< index num)!test!
(while !lt!(< index num)!test!
(push index result)!loop!
(cl-incf index))!end-loop!
(nreverse result)))
......
......@@ -432,9 +432,11 @@ test and possibly others should be updated."
(verify-keybinding "P" 'edebug-view-outside) ;; same as v
(verify-keybinding "W" 'edebug-toggle-save-windows)
(verify-keybinding "?" 'edebug-help)
(verify-keybinding "d" 'edebug-backtrace)
(verify-keybinding "d" 'edebug-pop-to-backtrace)
(verify-keybinding "-" 'negative-argument)
(verify-keybinding "=" 'edebug-temp-display-freq-count)))
(verify-keybinding "=" 'edebug-temp-display-freq-count)
(should (eq (lookup-key backtrace-mode-map "n") 'backtrace-forward-frame))
(should (eq (lookup-key backtrace-mode-map "s") 'backtrace-goto-source))))
(ert-deftest edebug-tests-stop-point-at-start-of-first-instrumented-function ()
"Edebug stops at the beginning of an instrumented function."
......@@ -924,5 +926,17 @@ test and possibly others should be updated."
"g"
(should (equal edebug-tests-@-result "The result of applying + to (1 x) is 11")))))
(ert-deftest edebug-tests-backtrace-goto-source ()
"Edebug can jump to instrumented source from its *Edebug-Backtrace* buffer."
(edebug-tests-with-normal-env
(edebug-tests-setup-@ "range" '(2) t)
(edebug-tests-run-kbd-macro
"@ SPC SPC"
(edebug-tests-should-be-at "range" "lt")
"dns" ; Pop to backtrace, next frame, goto source.
(edebug-tests-should-be-at "range" "start")
"g"
(should (equal edebug-tests-@-result '(0 1))))))
(provide 'edebug-tests)
;;; edebug-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