From: Gemini Lasswell Date: Tue, 17 Jul 2018 18:47:43 +0000 (-0700) Subject: Add new commands to Edebug backtraces X-Git-Tag: emacs-27.0.90~4655^2~4 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=ca98377280005344fb07c816997b9bc2a737056a;p=emacs.git 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. --- diff --git a/doc/lispref/edebug.texi b/doc/lispref/edebug.texi index 0e0a2e8a643..59c9a68c54b 100644 --- a/doc/lispref/edebug.texi +++ b/doc/lispref/edebug.texi @@ -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. diff --git a/etc/NEWS b/etc/NEWS index 486e0d4384a..53b77656278 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -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 diff --git a/lisp/emacs-lisp/backtrace.el b/lisp/emacs-lisp/backtrace.el index b6ca2890764..5169c305035 100644 --- a/lisp/emacs-lisp/backtrace.el +++ b/lisp/emacs-lisp/backtrace.el @@ -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)))))) diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index 3bf9cb9a488..fc295485fd4 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -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" diff --git a/test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el b/test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el index f3fc78d4e12..97dead057a9 100644 --- a/test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el +++ b/test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el @@ -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))) diff --git a/test/lisp/emacs-lisp/edebug-tests.el b/test/lisp/emacs-lisp/edebug-tests.el index 7d780edf285..7880aaf95bc 100644 --- a/test/lisp/emacs-lisp/edebug-tests.el +++ b/test/lisp/emacs-lisp/edebug-tests.el @@ -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