[Emacs-diffs] master ca98377 14/19: Add new commands to Edebug backtraces

[Gemini Lasswell]

branch: master
commit ca98377280005344fb07c816997b9bc2a737056a
Author: Gemini Lasswell <address@hidden>
Commit: Gemini Lasswell <address@hidden>

    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.
---
 doc/lispref/edebug.texi                            |  12 ++-
 etc/NEWS                                           |  13 ++-
 lisp/emacs-lisp/backtrace.el                       |  52 ++++++++-
 lisp/emacs-lisp/edebug.el                          | 118 ++++++++++++++-------
 .../edebug-resources/edebug-test-code.el           |   2 +-
 test/lisp/emacs-lisp/edebug-tests.el               |  18 +++-
 6 files changed, 165 insertions(+), 50 deletions(-)

diff --git a/doc/lispref/edebug.texi b/doc/lispref/edebug.texi
index 0e0a2e8..59c9a68 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}).
 
address@hidden,, Backtraces, elisp}, for the commands which work
-in a backtrace buffer.
address@hidden,, 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 486e0d4..53b7765 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 b6ca289..5169c30 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 3bf9cb9..fc29548 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 f3fc78d..97dead0 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 7d780ed..7880aaf 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 address@hidden "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 address@hidden '(0 1))))))
+
 (provide 'edebug-tests)
 ;;; edebug-tests.el ends here