From e09120d68694272ea5efbe13b16936b4382389d8 Mon Sep 17 00:00:00 2001
From: Gemini Lasswell <gazally@runbox.com>
Date: Tue, 19 Jun 2018 07:27:41 -0700
Subject: Add backtrace-mode and use it in the debugger, ERT and Edebug

* doc/lispref/debugging.texi (Using Debugger): Remove explanation of
backtrace buffer.  Refer to new node.
(Backtraces): New node.
(Debugger Commands): Refer to new node.  Remove 'v'.
* doc/lispref/edebug.texi (Edebug Misc): Refer to new node.
* doc/misc/ert.texi (Running Tests Interactively): Refer to new node.

* lisp/emacs-lisp-backtrace.el: New file.
* test/lisp/emacs-lisp/backtrace-tests.el: New file.

* lisp/emacs-lisp/debug.el: (debugger-buffer-state): New cl-defstruct.
(debugger--restore-buffer-state): New function.
(debug): Use a debugger-buffer-state object to save and restore buffer
state.  Fix bug#15749 by leaving an unused buffer in debugger-mode,
empty, instead of in fundamental-mode, and then when reusing a buffer,
not calling debugger-mode if the buffer is already in debugger-mode.
(debugger-insert-backtrace): Remove.
(debugger-setup-buffer): Use backtrace-mode.
(debugger--insert-header): New function.
(debugger-continue, debugger-return-value): Change check for flags to
use backtrace-frames.
(debugger-frame-number): Determine backtrace frame number from
backtrace-frames.
(debugger--locals-visible-p, debugger--insert-locals)
(debugger--show-locals, debugger--hide-locals)
(debugger-toggle-locals): Remove.
(debugger-mode-map): Make a child of backtrace-mode-map.  Move
navigation commands to backtrace-mode-map.  Bind 'q' to debugger-quit
instead of top-level.  Make Help Follow menu item call
backtrace-help-follow-symbol.
(debugger-mode): Derive from backtrace-mode.
(debug-help-follow): Remove.  Move body of this function to
'backtrace-help-follow-symbol' in backtrace.el.
(debugger-quit): New function.

* lisp/emacs-lisp/edebug.el (edebug-unwrap-results): Remove warning
in docstring about circular results.
(edebug-unwrap): Use pcase.
(edebug-unwrap1): New function to unwrap circular objects.
(edebug-unwrap*): Use it.
(edebug--frame): New cl-defstruct.
(edebug-backtrace): Call the buffer *Edebug Backtrace* and use
backtrace-mode.  Get the frames from edebug--backtrace-frames.
(edebug--backtrace-frames, edebug--unwrap-and-add-info)
(edebug--symbol-not-prefixed-p): New functions.

* lisp/emacs-lisp/lisp-mode.el
(lisp-el-font-lock-keywords-for-backtraces)
(lisp-el-font-lock-keywords-for-backtraces-1)
(lisp-el-font-lock-keywords-for-backtraces-2): New constants.

* lisp/emacs-lisp/ert.el (ert--print-backtrace): Remove.
(ert--run-test-debugger): Use backtrace-get-frames.
(ert-run-tests-batch): Use backtrace-to-string.
(ert-results-pop-to-backtrace-for-test-at-point): Use backtrace-mode.
(ert--insert-backtrace-header): New function.

* tests/lisp/emacs-lisp/ert-tests.el (ert-test--which-file):
Use backtrace-frame slot accessor.
---
 lisp/emacs-lisp/edebug.el | 178 ++++++++++++++++++++++++++++++++++------------
 1 file changed, 131 insertions(+), 47 deletions(-)

(limited to 'lisp/emacs-lisp/edebug.el')

diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el
index f0c0db182ed..b22c8952da0 100644
--- a/lisp/emacs-lisp/edebug.el
+++ b/lisp/emacs-lisp/edebug.el
@@ -52,6 +52,7 @@
 
 ;;; Code:
 
+(require 'backtrace)
 (require 'macroexp)
 (require 'cl-lib)
 (eval-when-compile (require 'pcase))
@@ -206,8 +207,7 @@ Use this with caution since it is not debugged."
   "Non-nil if Edebug should unwrap results of expressions.
 That is, Edebug will try to remove its own instrumentation from the result.
 This is useful when debugging macros where the results of expressions
-are instrumented expressions.  But don't do this when results might be
-circular or an infinite loop will result."
+are instrumented expressions."
   :type 'boolean
   :group 'edebug)
 
@@ -1265,25 +1265,59 @@ purpose by adding an entry to this alist, and setting
 (defun edebug-unwrap (sexp)
   "Return the unwrapped SEXP or return it as is if it is not wrapped.
 The SEXP might be the result of wrapping a body, which is a list of
-expressions; a `progn' form will be returned enclosing these forms."
-  (if (consp sexp)
-      (cond
-       ((eq 'edebug-after (car sexp))
-	(nth 3 sexp))
-       ((eq 'edebug-enter (car sexp))
-        (macroexp-progn (nthcdr 2 (nth 1 (nth 3 sexp)))))
-       (t sexp);; otherwise it is not wrapped, so just return it.
-       )
-    sexp))
+expressions; a `progn' form will be returned enclosing these forms.
+Does not unwrap inside vectors, records, structures, or hash tables."
+  (pcase sexp
+    (`(edebug-after ,_before-form ,_after-index ,form)
+     form)
+    (`(lambda ,args (edebug-enter ',_sym ,_arglist
+				   (function (lambda nil . ,body))))
+     `(lambda ,args ,@body))
+    (`(closure ,env ,args (edebug-enter ',_sym ,_arglist
+					 (function (lambda nil . ,body))))
+     `(closure ,env ,args ,@body))
+    (`(edebug-enter ',_sym ,_args (function (lambda nil . ,body)))
+     (macroexp-progn body))
+    (_ sexp)))
 
 (defun edebug-unwrap* (sexp)
   "Return the SEXP recursively unwrapped."
+  (let ((ht (make-hash-table :test 'eq)))
+    (edebug--unwrap1 sexp ht)))
+
+(defun edebug--unwrap1 (sexp hash-table)
+  "Unwrap SEXP using HASH-TABLE of things already unwrapped.
+HASH-TABLE contains the results of unwrapping cons cells within
+SEXP, which are reused to avoid infinite loops when SEXP is or
+contains a circular object."
   (let ((new-sexp (edebug-unwrap sexp)))
     (while (not (eq sexp new-sexp))
       (setq sexp new-sexp
 	    new-sexp (edebug-unwrap sexp)))
     (if (consp new-sexp)
-	(mapcar #'edebug-unwrap* new-sexp)
+	(let ((result (gethash new-sexp hash-table nil)))
+	  (unless result
+	    (let ((remainder new-sexp)
+		  current)
+	      (setq result (cons nil nil)
+		    current result)
+	      (while
+		  (progn
+		    (puthash remainder current hash-table)
+		    (setf (car current)
+			  (edebug--unwrap1 (car remainder) hash-table))
+		    (setq remainder (cdr remainder))
+		    (cond
+		     ((atom remainder)
+		      (setf (cdr current)
+			    (edebug--unwrap1 remainder hash-table))
+		      nil)
+		     ((gethash remainder hash-table nil)
+		      (setf (cdr current) (gethash remainder hash-table nil))
+		      nil)
+		     (t (setq current
+			      (setf (cdr current) (cons nil nil)))))))))
+	  result)
       new-sexp)))
 
 
@@ -3916,8 +3950,10 @@ Global commands prefixed by `global-edebug-prefix':
 ;; (setq debugger 'debug)  ; use the standard debugger
 
 ;; Note that debug and its utilities must be byte-compiled to work,
-;; since they depend on the backtrace looking a certain way.  But
-;; edebug is not dependent on this, yet.
+;; since they depend on the backtrace looking a certain way.  Edebug
+;; will work if not byte-compiled, but it will not be able correctly
+;; remove its instrumentation from backtraces unless it is
+;; byte-compiled.
 
 (defun edebug (&optional arg-mode &rest args)
   "Replacement for `debug'.
@@ -3947,48 +3983,96 @@ Otherwise call `debug' normally."
     (apply #'debug arg-mode args)
     ))
 
+;;; Backtrace buffer
+
+;; Data structure for backtrace frames with information
+;; from Edebug instrumentation found in the backtrace.
+(cl-defstruct
+    (edebug--frame
+     (:constructor edebug--make-frame)
+     (:include backtrace-frame))
+  def-name before-index after-index)
 
 (defun edebug-backtrace ()
-  "Display a non-working backtrace.  Better than nothing..."
+  "Display the current backtrace in a `backtrace-mode' window."
   (interactive)
   (if (or (not edebug-backtrace-buffer)
 	  (null (buffer-name edebug-backtrace-buffer)))
       (setq edebug-backtrace-buffer
-	    (generate-new-buffer "*Backtrace*"))
+	    (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)
-    (let ((print-escape-newlines t)
-	  (print-length 50)	; FIXME cf edebug-safe-prin1-to-string
-	  last-ok-point)
-      (backtrace)
-
-      ;; Clean up the backtrace.
-      ;; Not quite right for current edebug scheme.
-      (set-buffer edebug-backtrace-buffer)
-      (setq truncate-lines t)
-      (goto-char (point-min))
-      (setq last-ok-point (point))
-      (if t (progn
-
-      ;; Delete interspersed edebug internals.
-      (while (re-search-forward "^  (?edebug" nil t)
-	(beginning-of-line)
-	(cond
-	 ((looking-at "^  (edebug-after")
-	  ;; Previous lines may contain code, so just delete this line.
-	  (setq last-ok-point (point))
-	  (forward-line 1)
-	  (delete-region last-ok-point (point)))
-
-	 ((looking-at (if debugger-stack-frame-as-list
-                          "^  (edebug"
-                        "^  edebug"))
-	  (forward-line 1)
-	  (delete-region last-ok-point (point))
-	  )))
-      )))))
+    (with-current-buffer edebug-backtrace-buffer
+      (unless (derived-mode-p 'backtrace-mode)
+        (backtrace-mode))
+      (setq backtrace-frames (edebug--backtrace-frames)
+            backtrace-view '(:do-xrefs t))
+      (backtrace-print)
+      (goto-char (point-min)))))
+
+(defun edebug--backtrace-frames ()
+  "Return 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)))
+    (dolist (frame (reverse frames))
+      (let ((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
+                 def-name (nth 0 args)))
+          ('edebug-after
+           (setq before-index (if (consp (nth 0 args))
+                                  (nth 1 (nth 0 args))
+                                (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)
+           (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))
+	   (setq before-index nil
+                 after-index nil
+                 skip-next-lambda nil)))))
+    results))
+
+(defun edebug--symbol-not-prefixed-p (sym)
+  "Return non-nil if SYM is a symbol not prefixed by \"edebug-\"."
+  (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)
+  (setf (edebug--frame-fun frame) (edebug-unwrap* (edebug--frame-fun frame)))
+  (unless (edebug--frame-evald frame)
+    (let (results)
+      (dolist (arg (edebug--frame-args frame))
+        (push (edebug-unwrap* arg) results))
+      (setf (edebug--frame-args frame) (nreverse results)))))
 
 
 ;;; Trace display
-- 
cgit v1.2.3


From 5b50fa5a9d4f7c032a845bc0152c11b70ee1bf53 Mon Sep 17 00:00:00 2001
From: Gemini Lasswell <gazally@runbox.com>
Date: Sun, 24 Jun 2018 07:17:47 -0700
Subject: Always make buttons from function names in backtraces

* lisp/emacs-lisp/backtrace.el (backtrace-view)
(backtrace--print-func-and-args, backtrace-mode): Always
make buttons.  Remove all uses of ':do-xrefs'.
* lisp/emacs-lisp/debug.el (debugger-setup-buffer): Modify
backtrace-view instead of setting it.
* lisp/emacs-lisp/edebug.el (edebug-backtrace):
* lisp/emacs-lisp/ert.el
(ert-results-pop-to-backtrace-for-test-at-point):
Remove initialization of backtrace-view.
---
 lisp/emacs-lisp/backtrace.el | 13 +++++++------
 lisp/emacs-lisp/debug.el     |  2 +-
 lisp/emacs-lisp/edebug.el    |  3 +--
 lisp/emacs-lisp/ert.el       |  3 +--
 4 files changed, 10 insertions(+), 11 deletions(-)

(limited to 'lisp/emacs-lisp/edebug.el')

diff --git a/lisp/emacs-lisp/backtrace.el b/lisp/emacs-lisp/backtrace.el
index d16edb6a6cf..bcff14705c7 100644
--- a/lisp/emacs-lisp/backtrace.el
+++ b/lisp/emacs-lisp/backtrace.el
@@ -146,7 +146,7 @@ This should be a list of `backtrace-frame' objects.")
 
 (defvar-local backtrace-view nil
   "A plist describing how to render backtrace frames.
-Possible entries are :show-flags, :do-xrefs and :print-circle.")
+Possible entries are :show-flags and :print-circle.")
 
 (defvar-local backtrace-insert-header-function nil
   "Function for inserting a header for the current Backtrace buffer.
@@ -591,14 +591,14 @@ property for use by navigation."
     (insert (if (and (plist-get view :show-flags) flag) "* " "  "))
     (put-text-property beg (point) 'backtrace-section 'func)))
 
-(defun backtrace--print-func-and-args (frame view)
+(defun backtrace--print-func-and-args (frame _view)
   "Print the function, arguments and buffer position of a backtrace FRAME.
 Format it according to VIEW."
   (let* ((beg (point))
          (evald (backtrace-frame-evald frame))
          (fun   (backtrace-frame-fun frame))
          (args  (backtrace-frame-args frame))
-         (fun-file (and (plist-get view :do-xrefs) (symbol-file fun 'defun)))
+         (fun-file (symbol-file fun 'defun))
          (fun-pt (point)))
     (cond
      ((and evald (not debugger-stack-frame-as-list))
@@ -707,15 +707,16 @@ creates a backtrace-mode buffer, should usually do the following:
  - Maybe set `backtrace-insert-header-function' to a function to create
    header text for the buffer.
  - Set `backtrace-frames' (see below).
- - Set `backtrace-view' if desired (see below).
+ - Maybe modify `backtrace-view' (see below).
  - Maybe set `backtrace-print-function'.
 
 A command which creates or switches to a Backtrace mode buffer,
 such as `ert-results-pop-to-backtrace-for-test-at-point', should
 initialize `backtrace-frames' to a list of `backtrace-frame'
 objects (`backtrace-get-frames' is provided for that purpose, if
-desired), and `backtrace-view' to a plist describing how it wants
-the backtrace to appear.  Finally, it should call `backtrace-print'.
+desired), and may optionally modify `backtrace-view', which is a
+plist describing the appearance of the backtrace.  Finally, it
+should call `backtrace-print'.
 
 `backtrace-print' calls `backtrace-insert-header-function'
 followed by `backtrace-print-frame', once for each stack frame."
diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el
index 707e0cfa186..48ca32ddd83 100644
--- a/lisp/emacs-lisp/debug.el
+++ b/lisp/emacs-lisp/debug.el
@@ -335,7 +335,7 @@ That buffer should be current already and in debugger-mode."
                    :debug-on-exit)
           nil))
 
-  (setq backtrace-view '(:do-xrefs t :show-flags t)
+  (setq backtrace-view (plist-put backtrace-view :show-flags t)
         backtrace-insert-header-function (lambda ()
                                            (debugger--insert-header args))
         backtrace-print-function debugger-print-function)
diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el
index b22c8952da0..3bf9cb9a488 100644
--- a/lisp/emacs-lisp/edebug.el
+++ b/lisp/emacs-lisp/edebug.el
@@ -4007,8 +4007,7 @@ Otherwise call `debug' normally."
     (with-current-buffer edebug-backtrace-buffer
       (unless (derived-mode-p 'backtrace-mode)
         (backtrace-mode))
-      (setq backtrace-frames (edebug--backtrace-frames)
-            backtrace-view '(:do-xrefs t))
+      (setq backtrace-frames (edebug--backtrace-frames))
       (backtrace-print)
       (goto-char (point-min)))))
 
diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el
index 7178493ebe5..eb9695d0c12 100644
--- a/lisp/emacs-lisp/ert.el
+++ b/lisp/emacs-lisp/ert.el
@@ -2449,8 +2449,7 @@ To be used in the ERT results buffer."
            (backtrace-mode))
          (setq backtrace-insert-header-function
                (lambda () (ert--insert-backtrace-header (ert-test-name test)))
-               backtrace-frames (ert-test-result-with-condition-backtrace result)
-               backtrace-view '(:do-xrefs t))
+               backtrace-frames (ert-test-result-with-condition-backtrace result))
          (backtrace-print)
          (goto-char (point-min)))))))
 
-- 
cgit v1.2.3


From ca98377280005344fb07c816997b9bc2a737056a Mon Sep 17 00:00:00 2001
From: Gemini Lasswell <gazally@runbox.com>
Date: Tue, 17 Jul 2018 11:47:43 -0700
Subject: 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(-)

(limited to 'lisp/emacs-lisp/edebug.el')

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
-- 
cgit v1.2.3


From 58be6cb6bbb2cc7b1c35c0fc30b6f4f9b111eb77 Mon Sep 17 00:00:00 2001
From: Gemini Lasswell <gazally@runbox.com>
Date: Fri, 27 Jul 2018 12:37:10 -0700
Subject: Fix typo in edebug-backtrace-hide-instrumentation's docstring.

* lisp/emacs-lisp/edebug.el (edebug-backtrace-hide-instrumentation):
Fix docstring copypasta.
---
 lisp/emacs-lisp/edebug.el | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

(limited to 'lisp/emacs-lisp/edebug.el')

diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el
index fc295485fd4..fa418c68281 100644
--- a/lisp/emacs-lisp/edebug.el
+++ b/lisp/emacs-lisp/edebug.el
@@ -4108,7 +4108,7 @@ Save DEF-NAME, BEFORE-INDEX and AFTER-INDEX in FRAME."
     (revert-buffer)))
 
 (defun edebug-backtrace-hide-instrumentation ()
-  "Show Edebug's instrumentation in an Edebug Backtrace buffer."
+  "Hide Edebug's instrumentation in an Edebug Backtrace buffer."
   (interactive)
   (unless (eq backtrace-frames edebug-backtrace-frames)
     (setq backtrace-frames edebug-backtrace-frames)
-- 
cgit v1.2.3