;;; debug.el --- debuggers and related commands for Emacs -*- lexical-binding: t -*-
-;; Copyright (C) 1985-1986, 1994, 2001-2013 Free Software Foundation,
+;; Copyright (C) 1985-1986, 1994, 2001-2016 Free Software Foundation,
;; Inc.
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: lisp, tools, maint
;; This file is part of GNU Emacs.
The value affects the behavior of operations on any window
previously showing the debugger buffer.
-`nil' means that if its window is not deleted when exiting the
+nil means that if its window is not deleted when exiting the
debugger, invoking `switch-to-prev-buffer' will usually show
the debugger buffer again.
This is to optimize `debugger-make-xrefs'.")
(defvar debugger-outer-match-data)
-(defvar debugger-outer-load-read-function)
-(defvar debugger-outer-overriding-local-map)
-(defvar debugger-outer-overriding-terminal-local-map)
-(defvar debugger-outer-track-mouse)
-(defvar debugger-outer-last-command)
-(defvar debugger-outer-this-command)
-(defvar debugger-outer-unread-command-events)
-(defvar debugger-outer-unread-post-input-method-events)
-(defvar debugger-outer-last-input-event)
-(defvar debugger-outer-last-command-event)
-(defvar debugger-outer-last-nonmenu-event)
-(defvar debugger-outer-last-event-frame)
-(defvar debugger-outer-standard-input)
-(defvar debugger-outer-standard-output)
-(defvar debugger-outer-inhibit-redisplay)
-(defvar debugger-outer-cursor-in-echo-area)
(defvar debugger-will-be-back nil
"Non-nil if we expect to get back in the debugger soon.")
(defvar inhibit-debug-on-entry nil
- "Non-nil means that debug-on-entry is disabled.")
+ "Non-nil means that `debug-on-entry' is disabled.")
(defvar debugger-jumping-flag nil
- "Non-nil means that debug-on-entry is disabled.
+ "Non-nil means that `debug-on-entry' is disabled.
This variable is used by `debugger-jump', `debugger-step-through',
and `debugger-reenable' to temporarily disable debug-on-entry.")
;; Save the outer values of these vars for the `e' command
;; before we replace the values.
(debugger-outer-match-data (match-data))
- (debugger-outer-load-read-function load-read-function)
- (debugger-outer-overriding-local-map overriding-local-map)
- (debugger-outer-overriding-terminal-local-map
- overriding-terminal-local-map)
- (debugger-outer-track-mouse track-mouse)
- (debugger-outer-last-command last-command)
- (debugger-outer-this-command this-command)
- (debugger-outer-unread-command-events unread-command-events)
- (debugger-outer-unread-post-input-method-events
- unread-post-input-method-events)
- (debugger-outer-last-input-event last-input-event)
- (debugger-outer-last-command-event last-command-event)
- (debugger-outer-last-nonmenu-event last-nonmenu-event)
- (debugger-outer-last-event-frame last-event-frame)
- (debugger-outer-standard-input standard-input)
- (debugger-outer-standard-output standard-output)
- (debugger-outer-inhibit-redisplay inhibit-redisplay)
- (debugger-outer-cursor-in-echo-area cursor-in-echo-area)
(debugger-with-timeout-suspend (with-timeout-suspend)))
;; Set this instead of binding it, so that `q'
;; will not restore it.
;; Don't let these magic variables affect the debugger itself.
(let ((last-command nil) this-command track-mouse
(inhibit-trace t)
- (inhibit-debug-on-entry t)
unread-command-events
unread-post-input-method-events
last-input-event last-command-event last-nonmenu-event
debugger-buffer
`((display-buffer-reuse-window
display-buffer-in-previous-window)
- . (,(when debugger-previous-window
- `(previous-window . ,debugger-previous-window)))))
+ . (,(when (and (window-live-p debugger-previous-window)
+ (frame-visible-p
+ (window-frame debugger-previous-window)))
+ `(previous-window . ,debugger-previous-window)))))
(setq debugger-window (selected-window))
(if (eq debugger-previous-window debugger-window)
(when debugger-jumping-flag
(window-resize
debugger-window
(- debugger-previous-window-height
- (window-total-size debugger-window)))
+ (window-total-height debugger-window)))
(error nil)))
(setq debugger-previous-window debugger-window))
(debugger-mode)
(eq (window-buffer debugger-window) debugger-buffer))
;; Record height of debugger window.
(setq debugger-previous-window-height
- (window-total-size debugger-window)))
+ (window-total-height debugger-window)))
(if debugger-will-be-back
;; Restore previous window configuration (Bug#12623).
(set-window-configuration window-configuration)
(funcall (nth 0 debugger-previous-state))))))
(with-timeout-unsuspend debugger-with-timeout-suspend)
(set-match-data debugger-outer-match-data)))
- ;; Put into effect the modified values of these variables
- ;; in case the user set them with the `e' command.
- (setq load-read-function debugger-outer-load-read-function)
- (setq overriding-local-map debugger-outer-overriding-local-map)
- (setq overriding-terminal-local-map
- debugger-outer-overriding-terminal-local-map)
- (setq track-mouse debugger-outer-track-mouse)
- (setq last-command debugger-outer-last-command)
- (setq this-command debugger-outer-this-command)
- (setq unread-command-events debugger-outer-unread-command-events)
- (setq unread-post-input-method-events
- debugger-outer-unread-post-input-method-events)
- (setq last-input-event debugger-outer-last-input-event)
- (setq last-command-event debugger-outer-last-command-event)
- (setq last-nonmenu-event debugger-outer-last-nonmenu-event)
- (setq last-event-frame debugger-outer-last-event-frame)
- (setq standard-input debugger-outer-standard-input)
- (setq standard-output debugger-outer-standard-output)
- (setq inhibit-redisplay debugger-outer-inhibit-redisplay)
- (setq cursor-in-echo-area debugger-outer-cursor-in-echo-area)
(setq debug-on-next-call debugger-step-after-exit)
debugger-value)))
\f
(insert "Debugger entered")
;; lambda is for debug-on-call when a function call is next.
;; debug is for debug-on-entry function called.
- (pcase (car args)
- ((or `lambda `debug)
- (insert "--entering a function:\n"))
- ;; Exiting a function.
- (`exit
- (insert "--returning value: ")
- (setq debugger-value (nth 1 args))
- (prin1 debugger-value (current-buffer))
- (insert ?\n)
- (delete-char 1)
- (insert ? )
- (beginning-of-line))
- ;; Debugger entered for an error.
- (`error
- (insert "--Lisp error: ")
- (prin1 (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"))
- ;; User calls debug directly.
- (_
- (insert ": ")
- (prin1 (if (eq (car args) 'nil)
- (cdr args) args)
- (current-buffer))
- (insert ?\n)))
+ (let ((pos (point)))
+ (pcase (car args)
+ ((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))
+ (prin1 debugger-value (current-buffer))
+ (insert ?\n)
+ (delete-char 1)
+ (insert ? )
+ (beginning-of-line))
+ ;; Debugger entered for an error.
+ (`error
+ (insert "--Lisp error: ")
+ (setq pos (point))
+ (prin1 (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))
+ (prin1 (if (eq (car args) 'nil)
+ (cdr args) args)
+ (current-buffer))
+ (insert ?\n)))
+ ;; Place point on "stack frame 0" (bug#15101).
+ (goto-char pos))
;; After any frame that uses eval-buffer,
;; insert a line that states the buffer position it's reading at.
(save-excursion
(setq debugger-jumping-flag nil)
(remove-hook 'post-command-hook 'debugger-reenable))
-(defun debugger-frame-number ()
+(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))
- (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)))
+ (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-line 1)
(while (progn
(forward-char 2)
- (if (= (following-char) ?\()
- (forward-sexp 1)
- (forward-sexp 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 " *;;;")
"Request entry to debugger when this frame exits.
Applies to the frame whose line point is on in the backtrace."
(interactive)
- (save-excursion
- (beginning-of-line)
- (if (looking-at " *;;;\\|[a-z]")
- (error "This line is not a function call")))
- (beginning-of-line)
(backtrace-debug (debugger-frame-number) t)
+ (beginning-of-line)
(if (= (following-char) ? )
(let ((inhibit-read-only t))
(delete-char 1)
"Do not enter debugger when this frame exits.
Applies to the frame whose line point is on in the backtrace."
(interactive)
- (save-excursion
- (beginning-of-line)
- (if (looking-at " *;;;\\|[a-z]")
- (error "This line is not a function call")))
- (beginning-of-line)
(backtrace-debug (debugger-frame-number) nil)
+ (beginning-of-line)
(if (= (following-char) ?*)
(let ((inhibit-read-only t))
(delete-char 1)
(defmacro debugger-env-macro (&rest body)
"Run BODY in original environment."
(declare (indent 0))
- `(save-excursion
- (if (null (buffer-name debugger-old-buffer))
- ;; old buffer deleted
- (setq debugger-old-buffer (current-buffer)))
- (set-buffer debugger-old-buffer)
- (let ((load-read-function debugger-outer-load-read-function)
- (overriding-terminal-local-map
- debugger-outer-overriding-terminal-local-map)
- (overriding-local-map debugger-outer-overriding-local-map)
- (track-mouse debugger-outer-track-mouse)
- (last-command debugger-outer-last-command)
- (this-command debugger-outer-this-command)
- (unread-command-events debugger-outer-unread-command-events)
- (unread-post-input-method-events
- debugger-outer-unread-post-input-method-events)
- (last-input-event debugger-outer-last-input-event)
- (last-command-event debugger-outer-last-command-event)
- (last-nonmenu-event debugger-outer-last-nonmenu-event)
- (last-event-frame debugger-outer-last-event-frame)
- (standard-input debugger-outer-standard-input)
- (standard-output debugger-outer-standard-output)
- (inhibit-redisplay debugger-outer-inhibit-redisplay)
- (cursor-in-echo-area debugger-outer-cursor-in-echo-area))
- (set-match-data debugger-outer-match-data)
- (prog1
- (progn ,@body)
- (setq debugger-outer-match-data (match-data))
- (setq debugger-outer-load-read-function load-read-function)
- (setq debugger-outer-overriding-terminal-local-map
- overriding-terminal-local-map)
- (setq debugger-outer-overriding-local-map overriding-local-map)
- (setq debugger-outer-track-mouse track-mouse)
- (setq debugger-outer-last-command last-command)
- (setq debugger-outer-this-command this-command)
- (setq debugger-outer-unread-command-events unread-command-events)
- (setq debugger-outer-unread-post-input-method-events
- unread-post-input-method-events)
- (setq debugger-outer-last-input-event last-input-event)
- (setq debugger-outer-last-command-event last-command-event)
- (setq debugger-outer-last-nonmenu-event last-nonmenu-event)
- (setq debugger-outer-last-event-frame last-event-frame)
- (setq debugger-outer-standard-input standard-input)
- (setq debugger-outer-standard-output standard-output)
- (setq debugger-outer-inhibit-redisplay inhibit-redisplay)
- (setq debugger-outer-cursor-in-echo-area cursor-in-echo-area)
- ))))
-
-(defun debugger-eval-expression (exp)
- "Eval an expression, in an environment like that outside the debugger."
+ `(progn
+ (set-match-data debugger-outer-match-data)
+ (prog1
+ (progn ,@body)
+ (setq debugger-outer-match-data (match-data)))))
+
+(defun debugger--backtrace-base ()
+ "Return the function name that marks the top of the backtrace.
+See `backtrace-frame'."
+ (cond ((eq 'debug--implement-debug-on-entry
+ (cadr (backtrace-frame 1 'debug)))
+ 'debug--implement-debug-on-entry)
+ (t 'debug)))
+
+(defun debugger-eval-expression (exp &optional nframe)
+ "Eval an expression, in an environment like that outside the debugger.
+The environment used is the one when entering the activation frame at point."
(interactive
- (list (read-from-minibuffer "Eval: "
- nil read-expression-map t
- 'read-expression-history)))
- (debugger-env-macro (eval-expression exp)))
+ (list (read--expression "Eval in stack frame: ")))
+ (let ((nframe (or nframe
+ (condition-case nil (1+ (debugger-frame-number 'skip-base))
+ (error 0)))) ;; If on first line.
+ (base (debugger--backtrace-base)))
+ (debugger-env-macro
+ (let ((val (backtrace-eval exp nframe base)))
+ (prog1
+ (prin1 val t)
+ (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 " = ")
+ (prin1 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))))
+
\f
(defvar debugger-mode-map
(let ((map (make-keymap))
(define-key map "h" 'describe-mode)
(define-key map "q" 'top-level)
(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)
(put 'debugger-mode 'mode-class 'special)
-(defun debugger-mode ()
+(define-derived-mode debugger-mode fundamental-mode "Debugger"
"Mode for backtrace buffers, selected in debugger.
\\<debugger-mode-map>
A line starts with `*' if exiting that frame will call the debugger.
Complete list of commands:
\\{debugger-mode-map}"
- (kill-all-local-variables)
- (setq major-mode 'debugger-mode)
- (setq mode-name "Debugger")
(setq truncate-lines t)
(set-syntax-table emacs-lisp-mode-syntax-table)
- (use-local-map debugger-mode-map)
- (run-mode-hooks 'debugger-mode-hook))
+ (use-local-map debugger-mode-map))
\f
(defcustom debugger-record-buffer "*Debugger-record*"
"Buffer name for expression values, for \\[debugger-record-expression]."
(defun debugger-record-expression (exp)
"Display a variable's value and record it in `*Backtrace-record*' buffer."
(interactive
- (list (read-from-minibuffer
- "Record Eval: "
- nil
- read-expression-map t
- 'read-expression-history)))
+ (list (read--expression "Record Eval: ")))
(let* ((buffer (get-buffer-create debugger-record-buffer))
(standard-output buffer))
(princ (format "Debugger Eval (%s): " exp))
(buffer-substring (line-beginning-position 0)
(line-end-position 0)))))
-(declare-function help-xref-interned "help-mode" (symbol))
-
(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")
- (require 'help-mode)
;; 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.
(progn (skip-syntax-forward "w_")
(point)))))))
(when (or (boundp sym) (fboundp sym) (facep sym))
- (help-xref-interned sym)))))
+ (describe-symbol sym)))))
\f
;; When you change this, you may also need to change the number of
;; frames that the debugger skips.
functions to break on entry."
(if (or inhibit-debug-on-entry debugger-jumping-flag)
nil
- (funcall debugger 'debug)))
+ (let ((inhibit-debug-on-entry t))
+ (funcall debugger 'debug))))
;;;###autoload
(defun debug-on-entry (function)
(not (special-form-p symbol))))
t nil nil (symbol-name fn)))
(list (if (equal val "") fn (intern val)))))
- (advice-add function :before #'debug--implement-debug-on-entry)
+ (advice-add function :before #'debug--implement-debug-on-entry
+ '((depth . -100)))
function)
(defun debug--function-list ()
(progn
(advice-remove function #'debug--implement-debug-on-entry)
function)
- (message "Cancelling debug-on-entry for all functions")
+ (message "Canceling debug-on-entry for all functions")
(mapcar #'cancel-debug-on-entry (debug--function-list))))
(defun debugger-list-functions ()