mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-06 06:20:55 -08:00
Code Issues Projects Releases Wiki Activity

Add backtrace-mode and use it in the debugger, ERT and Edebug

Browse source 
* 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.
This commit is contained in:
Gemini Lasswell 2018-06-19 07:27:41 -07:00
parent 8a7620955b
commit e09120d686
11 changed files with 1260 additions and 350 deletions
Download patch file Download diff file Expand all files Collapse all files

390
lisp/emacs-lisp/debug.el
View file

@ -28,6 +28,7 @@
;;; Code:
(require 'cl-lib)
(require 'backtrace)
(require 'button)
(defgroup debugger nil
@ -133,6 +134,25 @@ where CAUSE can be:
- exit: called because of exit of a flagged function.
- error: called because of `debug-on-error'.")
(cl-defstruct (debugger--buffer-state
(:constructor debugger--save-buffer-state
(&aux (mode major-mode)
(header backtrace-insert-header-function)
(frames backtrace-frames)
(content (buffer-string))
(pos (point)))))
mode header frames content pos)
(defun debugger--restore-buffer-state (state)
(unless (derived-mode-p (debugger--buffer-state-mode state))
(funcall (debugger--buffer-state-mode state)))
(setq backtrace-insert-header-function (debugger--buffer-state-header state)
backtrace-frames (debugger--buffer-state-frames state))
(let ((inhibit-read-only t))
(erase-buffer)
(insert (debugger--buffer-state-content state)))
(goto-char (debugger--buffer-state-pos state)))
;;;###autoload
(setq debugger 'debug)
;;;###autoload
@ -174,7 +194,7 @@ first will be printed into the backtrace buffer."
(debugger-previous-state
(if (get-buffer "*Backtrace*")
(with-current-buffer (get-buffer "*Backtrace*")
(list major-mode (buffer-string)))))
(debugger--save-buffer-state))))
(debugger-args args)
(debugger-buffer (get-buffer-create "*Backtrace*"))
(debugger-old-buffer (current-buffer))
@ -236,7 +256,8 @@ first will be printed into the backtrace buffer."
(window-total-height debugger-window)))
(error nil)))
(setq debugger-previous-window debugger-window))
(debugger-mode)
(unless (derived-mode-p 'debugger-mode)
(debugger-mode))
(debugger-setup-buffer debugger-args)
(when noninteractive
;; If the backtrace is long, save the beginning
@ -280,15 +301,14 @@ first will be printed into the backtrace buffer."
(setq debugger-previous-window nil))
;; Restore previous state of debugger-buffer in case we were
;; in a recursive invocation of the debugger, otherwise just
;; erase the buffer and put it into fundamental mode.
;; erase the buffer.
(when (buffer-live-p debugger-buffer)
(with-current-buffer debugger-buffer
(let ((inhibit-read-only t))
(erase-buffer)
(if (null debugger-previous-state)
(fundamental-mode)
(insert (nth 1 debugger-previous-state))
(funcall (nth 0 debugger-previous-state))))))
(if debugger-previous-state
(debugger--restore-buffer-state debugger-previous-state)
(setq backtrace-insert-header-function nil)
(setq backtrace-frames nil)
(backtrace-print))))
(with-timeout-unsuspend debugger-with-timeout-suspend)
(set-match-data debugger-outer-match-data)))
(setq debug-on-next-call debugger-step-after-exit)
@ -301,112 +321,80 @@ first will be printed into the backtrace buffer."
(message "Error in debug printer: %S" err)
(prin1 obj stream))))
(defun debugger-insert-backtrace (frames do-xrefs)
"Format and insert the backtrace FRAMES at point.
Make functions into cross-reference buttons if DO-XREFS is non-nil."
(let ((standard-output (current-buffer))
(eval-buffers eval-buffer-list))
(require 'help-mode) ; Define `help-function-def' button type.
(pcase-dolist (`(,evald ,fun ,args ,flags) frames)
(insert (if (plist-get flags :debug-on-exit)
"* " " "))
(let ((fun-file (and do-xrefs (symbol-file fun 'defun)))
(fun-pt (point)))
(cond
((and evald (not debugger-stack-frame-as-list))
(debugger--print fun)
(if args (debugger--print args) (princ "()")))
(t
(debugger--print (cons fun args))
(cl-incf fun-pt)))
(when fun-file
(make-text-button fun-pt (+ fun-pt (length (symbol-name fun)))
:type 'help-function-def
'help-args (list fun fun-file))))
;; After any frame that uses eval-buffer, insert a line that
;; states the buffer position it's reading at.
(when (and eval-buffers (memq fun '(eval-buffer eval-region)))
(insert (format " ; Reading at buffer position %d"
;; This will get the wrong result if there are
;; two nested eval-region calls for the same
;; buffer. That's not a very useful case.
(with-current-buffer (pop eval-buffers)
(point)))))
(insert "\n"))))
(defun debugger-setup-buffer (args)
"Initialize the `*Backtrace*' buffer for entry to the debugger.
That buffer should be current already."
(setq buffer-read-only nil)
(erase-buffer)
(set-buffer-multibyte t) ;Why was it nil ? -stef
(setq buffer-undo-list t)
That buffer should be current already and in debugger-mode."
(setq backtrace-frames (nthcdr
;; Remove debug--implement-debug-on-entry and the
;; advice's `apply' frame.
(if (eq (car args) 'debug) 3 1)
(backtrace-get-frames 'debug)))
(when (eq (car-safe args) 'exit)
(setq debugger-value (nth 1 args))
(setf (cl-getf (backtrace-frame-flags (car backtrace-frames))
:debug-on-exit)
nil))
(setq backtrace-view '(:do-xrefs t :show-flags t)
backtrace-insert-header-function (lambda ()
(debugger--insert-header args))
backtrace-print-function debugger-print-function)
(backtrace-print)
;; Place point on "stack frame 0" (bug#15101).
(goto-char (point-min))
(search-forward ":" (line-end-position) t)
(when (and (< (point) (line-end-position))
(= (char-after) ?\s))
(forward-char)))
(defun debugger--insert-header (args)
"Insert the header for the debugger's Backtrace buffer.
Include the reason for debugger entry from ARGS."
(insert "Debugger entered")
(let ((frames (nthcdr
;; Remove debug--implement-debug-on-entry and the
;; advice's `apply' frame.
(if (eq (car args) 'debug) 3 1)
(backtrace-frames 'debug)))
(print-escape-newlines t)
(print-escape-control-characters t)
;; If you increase print-level, add more depth in call_debugger.
(print-level 8)
(print-length 50)
(pos (point)))
(pcase (car args)
;; lambda is for debug-on-call when a function call is next.
;; debug is for debug-on-entry function called.
((or `lambda `debug)
(insert "--entering a function:\n")
(setq pos (1- (point))))
;; Exiting a function.
(`exit
(insert "--returning value: ")
(setq pos (point))
(setq debugger-value (nth 1 args))
(debugger--print debugger-value (current-buffer))
(setf (cl-getf (nth 3 (car frames)) :debug-on-exit) nil)
(insert ?\n))
;; Watchpoint triggered.
((and `watchpoint (let `(,symbol ,newval . ,details) (cdr args)))
(insert
"--"
(pcase details
(`(makunbound nil) (format "making %s void" symbol))
(`(makunbound ,buffer) (format "killing local value of %s in buffer %s"
symbol buffer))
(`(defvaralias ,_) (format "aliasing %s to %s" symbol newval))
(`(let ,_) (format "let-binding %s to %S" symbol newval))
(`(unlet ,_) (format "ending let-binding of %s" symbol))
(`(set nil) (format "setting %s to %S" symbol newval))
(`(set ,buffer) (format "setting %s in buffer %s to %S"
symbol buffer newval))
(_ (error "unrecognized watchpoint triggered %S" (cdr args))))
": ")
(setq pos (point))
(insert ?\n))
;; Debugger entered for an error.
(`error
(insert "--Lisp error: ")
(setq pos (point))
(debugger--print (nth 1 args) (current-buffer))
(insert ?\n))
;; debug-on-call, when the next thing is an eval.
(`t
(insert "--beginning evaluation of function call form:\n")
(setq pos (1- (point))))
;; User calls debug directly.
(_
(insert ": ")
(setq pos (point))
(debugger--print
(if (eq (car args) 'nil)
(cdr args) args)
(current-buffer))
(insert ?\n)))
(debugger-insert-backtrace frames t)
;; Place point on "stack frame 0" (bug#15101).
(goto-char pos)))
(pcase (car args)
;; lambda is for debug-on-call when a function call is next.
;; debug is for debug-on-entry function called.
((or `lambda `debug)
(insert "--entering a function:\n"))
;; Exiting a function.
(`exit
(insert "--returning value: ")
(insert (backtrace-print-to-string debugger-value))
(insert ?\n))
;; Watchpoint triggered.
((and `watchpoint (let `(,symbol ,newval . ,details) (cdr args)))
(insert
"--"
(pcase details
(`(makunbound nil) (format "making %s void" symbol))
(`(makunbound ,buffer) (format "killing local value of %s in buffer %s"
symbol buffer))
(`(defvaralias ,_) (format "aliasing %s to %s" symbol newval))
(`(let ,_) (format "let-binding %s to %s" symbol
(backtrace-print-to-string newval)))
(`(unlet ,_) (format "ending let-binding of %s" symbol))
(`(set nil) (format "setting %s to %s" symbol
(backtrace-print-to-string newval)))
(`(set ,buffer) (format "setting %s in buffer %s to %s"
symbol buffer
(backtrace-print-to-string newval)))
(_ (error "unrecognized watchpoint triggered %S" (cdr args))))
": ")
(insert ?\n))
;; Debugger entered for an error.
(`error
(insert "--Lisp error: ")
(insert (backtrace-print-to-string (nth 1 args)))
(insert ?\n))
;; debug-on-call, when the next thing is an eval.
(`t
(insert "--beginning evaluation of function call form:\n"))
;; User calls debug directly.
(_
(insert ": ")
(insert (backtrace-print-to-string (if (eq (car args) 'nil)
(cdr args) args)))
(insert ?\n))))
(defun debugger-step-through ()
@ -426,12 +414,12 @@ Enter another debugger on next entry to eval, apply or funcall."
(unless debugger-may-continue
(error "Cannot continue"))
(message "Continuing.")
(save-excursion
;; Check to see if we've flagged some frame for debug-on-exit, in which
;; case we'll probably come back to the debugger soon.
(goto-char (point-min))
(if (re-search-forward "^\\* " nil t)
(setq debugger-will-be-back t)))
;; Check to see if we've flagged some frame for debug-on-exit, in which
;; case we'll probably come back to the debugger soon.
(dolist (frame backtrace-frames)
(when (plist-get (backtrace-frame-flags frame) :debug-on-exit)
(setq debugger-will-be-back t)))
(exit-recursive-edit))
(defun debugger-return-value (val)
@ -446,12 +434,11 @@ will be used, such as in a debug on exit from a frame."
(setq debugger-value val)
(princ "Returning " t)
(debugger--print debugger-value)
(save-excursion
;; Check to see if we've flagged some frame for debug-on-exit, in which
;; case we'll probably come back to the debugger soon.
(goto-char (point-min))
(if (re-search-forward "^\\* " nil t)
(setq debugger-will-be-back t)))
(dolist (frame backtrace-frames)
(when (plist-get (backtrace-frame-flags frame) :debug-on-exit)
(setq debugger-will-be-back t)))
(exit-recursive-edit))
(defun debugger-jump ()
@ -473,63 +460,40 @@ removes itself from that hook."
(defun debugger-frame-number (&optional skip-base)
"Return number of frames in backtrace before the one point points at."
(save-excursion
(beginning-of-line)
(if (looking-at " *;;;\\|[a-z]")
(error "This line is not a function call"))
(let ((opoint (point))
(count 0))
(unless skip-base
(let ((index (backtrace-get-index))
(count 0))
(unless index
(error "This line is not a function call"))
(unless skip-base
(while (not (eq (cadr (backtrace-frame count)) 'debug))
(setq count (1+ count)))
;; Skip debug--implement-debug-on-entry frame.
(when (eq 'debug--implement-debug-on-entry
(cadr (backtrace-frame (1+ count))))
(setq count (+ 2 count))))
(goto-char (point-min))
(when (looking-at "Debugger entered--\\(Lisp error\\|returning value\\):")
(goto-char (match-end 0))
(forward-sexp 1))
(forward-line 1)
(while (progn
(forward-char 2)
(cond ((debugger--locals-visible-p)
(goto-char (next-single-char-property-change
(point) 'locals-visible)))
((= (following-char) ?\()
(forward-sexp 1))
(t
(forward-sexp 2)))
(forward-line 1)
(<= (point) opoint))
(if (looking-at " *;;;")
(forward-line 1))
(setq count (1+ count)))
count)))
(+ count index)))
(defun debugger-frame ()
"Request entry to debugger when this frame exits.
Applies to the frame whose line point is on in the backtrace."
(interactive)
(backtrace-debug (debugger-frame-number) t)
(beginning-of-line)
(if (= (following-char) ? )
(let ((inhibit-read-only t))
(delete-char 1)
(insert ?*)))
(beginning-of-line))
(setf
(cl-getf (backtrace-frame-flags (nth (backtrace-get-index) backtrace-frames))
:debug-on-exit)
t)
(backtrace-update-flags))
(defun debugger-frame-clear ()
"Do not enter debugger when this frame exits.
Applies to the frame whose line point is on in the backtrace."
(interactive)
(backtrace-debug (debugger-frame-number) nil)
(beginning-of-line)
(if (= (following-char) ?*)
(let ((inhibit-read-only t))
(delete-char 1)
(insert ? )))
(beginning-of-line))
(setf
(cl-getf (backtrace-frame-flags (nth (backtrace-get-index) backtrace-frames))
:debug-on-exit)
nil)
(backtrace-update-flags))
(defmacro debugger-env-macro (&rest body)
"Run BODY in original environment."
@ -564,69 +528,11 @@ The environment used is the one when entering the activation frame at point."
(let ((str (eval-expression-print-format val)))
(if str (princ str t))))))))
(defun debugger--locals-visible-p ()
"Are the local variables of the current stack frame visible?"
(save-excursion
(move-to-column 2)
(get-text-property (point) 'locals-visible)))
(defun debugger--insert-locals (locals)
"Insert the local variables LOCALS at point."
(cond ((null locals)
(insert "\n [no locals]"))
(t
(let ((print-escape-newlines t))
(dolist (s+v locals)
(let ((symbol (car s+v))
(value (cdr s+v)))
(insert "\n ")
(prin1 symbol (current-buffer))
(insert " = ")
(debugger--print value (current-buffer))))))))
(defun debugger--show-locals ()
"For the frame at point, insert locals and add text properties."
(let* ((nframe (1+ (debugger-frame-number 'skip-base)))
(base (debugger--backtrace-base))
(locals (backtrace--locals nframe base))
(inhibit-read-only t))
(save-excursion
(let ((start (progn
(move-to-column 2)
(point))))
(end-of-line)
(debugger--insert-locals locals)
(add-text-properties start (point) '(locals-visible t))))))
(defun debugger--hide-locals ()
"Delete local variables and remove the text property."
(let* ((col (current-column))
(end (progn
(move-to-column 2)
(next-single-char-property-change (point) 'locals-visible)))
(start (previous-single-char-property-change end 'locals-visible))
(inhibit-read-only t))
(remove-text-properties start end '(locals-visible))
(goto-char start)
(end-of-line)
(delete-region (point) end)
(move-to-column col)))
(defun debugger-toggle-locals ()
"Show or hide local variables of the current stack frame."
(interactive)
(cond ((debugger--locals-visible-p)
(debugger--hide-locals))
(t
(debugger--show-locals))))
(defvar debugger-mode-map
(let ((map (make-keymap))
(menu-map (make-sparse-keymap)))
(set-keymap-parent map button-buffer-map)
(suppress-keymap map)
(define-key map "-" 'negative-argument)
(set-keymap-parent map backtrace-mode-map)
(define-key map "b" 'debugger-frame)
(define-key map "c" 'debugger-continue)
(define-key map "j" 'debugger-jump)
@ -634,24 +540,20 @@ The environment used is the one when entering the activation frame at point."
(define-key map "u" 'debugger-frame-clear)
(define-key map "d" 'debugger-step-through)
(define-key map "l" 'debugger-list-functions)
(define-key map "h" 'describe-mode)
(define-key map "q" 'top-level)
(define-key map "q" 'debugger-quit)
(define-key map "e" 'debugger-eval-expression)
(define-key map "v" 'debugger-toggle-locals) ; "v" is for "variables".
(define-key map " " 'next-line)
(define-key map "R" 'debugger-record-expression)
(define-key map "\C-m" 'debug-help-follow)
(define-key map [mouse-2] 'push-button)
(define-key map [menu-bar debugger] (cons "Debugger" menu-map))
(define-key menu-map [deb-top]
'(menu-item "Quit" top-level
'(menu-item "Quit" debugger-quit
:help "Quit debugging and return to top level"))
(define-key menu-map [deb-s0] '("--"))
(define-key menu-map [deb-descr]
'(menu-item "Describe Debugger Mode" describe-mode
:help "Display documentation for debugger-mode"))
(define-key menu-map [deb-hfol]
'(menu-item "Help Follow" debug-help-follow
'(menu-item "Help Follow" backtrace-help-follow-symbol
:help "Follow cross-reference"))
(define-key menu-map [deb-nxt]
'(menu-item "Next Line" next-line
@ -689,8 +591,8 @@ The environment used is the one when entering the activation frame at point."
(put 'debugger-mode 'mode-class 'special)
(define-derived-mode debugger-mode fundamental-mode "Debugger"
"Mode for backtrace buffers, selected in debugger.
(define-derived-mode debugger-mode backtrace-mode "Debugger"
"Mode for debugging Emacs Lisp using a backtrace.
\\<debugger-mode-map>
A line starts with `*' if exiting that frame will call the debugger.
Type \\[debugger-frame] or \\[debugger-frame-clear] to set or remove the `*'.
@ -704,8 +606,6 @@ which functions will enter the debugger when called.
Complete list of commands:
\\{debugger-mode-map}"
(setq truncate-lines t)
(set-syntax-table emacs-lisp-mode-syntax-table)
(add-hook 'kill-buffer-hook
(lambda () (if (> (recursion-depth) 0) (top-level)))
nil t)
@ -732,27 +632,6 @@ Complete list of commands:
(buffer-substring (line-beginning-position 0)
(line-end-position 0)))))
(defun debug-help-follow (&optional pos)
"Follow cross-reference at POS, defaulting to point.
For the cross-reference format, see `help-make-xrefs'."
(interactive "d")
;; Ideally we'd just do (call-interactively 'help-follow) except that this
;; assumes we're already in a *Help* buffer and reuses it, so it ends up
;; incorrectly "reusing" the *Backtrace* buffer to show the help info.
(unless pos
(setq pos (point)))
(unless (push-button pos)
;; check if the symbol under point is a function or variable
(let ((sym
(intern
(save-excursion
(goto-char pos) (skip-syntax-backward "w_")
(buffer-substring (point)
(progn (skip-syntax-forward "w_")
(point)))))))
(when (or (boundp sym) (fboundp sym) (facep sym))
(describe-symbol sym)))))
;; When you change this, you may also need to change the number of
;; frames that the debugger skips.
@ -853,6 +732,13 @@ To specify a nil argument interactively, exit with an empty minibuffer."
;;(princ "be set to debug on entry, even if it is in the list.")
)))))
(defun debugger-quit ()
"Quit debugging and return to the top level."
(interactive)
(if (= (recursion-depth) 0)
(quit-window)
(top-level)))
(defun debug--implement-debug-watch (symbol newval op where)
"Conditionally call the debugger.
This function is called when SYMBOL's value is modified."