;;; debug.el --- debuggers and related commands for Emacs
-;; Copyright (C) 1985-1986, 1994, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1985-1986, 1994, 2001-2012 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: lisp, tools, maint
:group 'debugger
:version "21.1")
+(defcustom debugger-bury-or-kill 'bury
+ "How to proceed with the debugger buffer when exiting `debug'.
+The value used here 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
+ debugger, invoking `switch-to-prev-buffer' will usually show
+ the debugger buffer again.
+
+`append' means that if the window is not deleted, the debugger
+ buffer moves to the end of the window's previous buffers so
+ it's less likely that a future invocation of
+ `switch-to-prev-buffer' will switch to it. Also, it moves the
+ buffer to the end of the frame's buffer list.
+
+`bury' means that if the window is not deleted, its buffer is
+ removed from the window's list of previous buffers. Also, it
+ moves the buffer to the end of the frame's buffer list. This
+ value provides the most reliable remedy to not have
+ `switch-to-prev-buffer' switch to the debugger buffer again
+ without killing the buffer.
+
+`kill' means to kill the debugger buffer.
+
+The value used here is passed to `quit-restore-window'."
+ :type '(choice
+ (const :tag "Keep alive" nil)
+ (const :tag "Append" append)
+ (const :tag "Bury" bury)
+ (const :tag "Kill" kill))
+ :group 'debugger
+ :version "24.2")
+
(defvar debug-function-list nil
"List of functions currently set for debug on entry.")
(defvar debugger-old-buffer nil
"This is the buffer that was current when the debugger was entered.")
+(defvar debugger-previous-window nil
+ "This is the window last showing the debugger buffer.")
+
+(defvar debugger-previous-window-height nil
+ "The last recorded height of `debugger-previous-window'.")
+
(defvar debugger-previous-backtrace nil
"The contents of the previous backtrace (including text properties).
This is to optimize `debugger-make-xrefs'.")
(defvar debugger-outer-track-mouse)
(defvar debugger-outer-last-command)
(defvar debugger-outer-this-command)
-;; unread-command-char is obsolete,
-;; but we still save and restore it
-;; in case some user program still tries to set it.
-(defvar debugger-outer-unread-command-char)
(defvar debugger-outer-unread-command-events)
(defvar debugger-outer-unread-post-input-method-events)
(defvar debugger-outer-last-input-event)
(defvar inhibit-trace) ;Not yet implemented.
+(defvar debugger-args nil
+ "Arguments with which the debugger was called.
+It is a list expected to take the form (CAUSE . REST)
+where CAUSE can be:
+- debug: called for entry to a flagged function.
+- t: called because of debug-on-next-call.
+- lambda: same thing but via `funcall'.
+- exit: called because of exit of a flagged function.
+- error: called because of `debug-on-error'.")
+
;;;###autoload
(setq debugger 'debug)
;;;###autoload
(unless noninteractive
(message "Entering debugger..."))
(let (debugger-value
- (debug-on-error nil)
- (debug-on-quit nil)
(debugger-previous-state
(if (get-buffer "*Backtrace*")
(with-current-buffer (get-buffer "*Backtrace*")
(list major-mode (buffer-string)))))
(debugger-buffer (get-buffer-create "*Backtrace*"))
(debugger-old-buffer (current-buffer))
+ (debugger-window nil)
(debugger-step-after-exit nil)
(debugger-will-be-back nil)
;; Don't keep reading from an executing kbd macro!
(debugger-outer-track-mouse track-mouse)
(debugger-outer-last-command last-command)
(debugger-outer-this-command this-command)
- (debugger-outer-unread-command-char
- (with-no-warnings unread-command-char))
(debugger-outer-unread-command-events unread-command-events)
(debugger-outer-unread-post-input-method-events
unread-post-input-method-events)
(cursor-in-echo-area nil))
(unwind-protect
(save-excursion
- (save-window-excursion
- (with-no-warnings
- (setq unread-command-char -1))
- (when (eq (car debugger-args) 'debug)
- ;; Skip the frames for backtrace-debug, byte-code,
- ;; and implement-debug-on-entry.
- (backtrace-debug 4 t)
- ;; Place an extra debug-on-exit for macro's.
- (when (eq 'lambda (car-safe (cadr (backtrace-frame 4))))
- (backtrace-debug 5 t)))
- (pop-to-buffer debugger-buffer)
- (debugger-mode)
- (debugger-setup-buffer debugger-args)
- (when noninteractive
- ;; If the backtrace is long, save the beginning
- ;; and the end, but discard the middle.
- (when (> (count-lines (point-min) (point-max))
- debugger-batch-max-lines)
- (goto-char (point-min))
- (forward-line (/ 2 debugger-batch-max-lines))
- (let ((middlestart (point)))
- (goto-char (point-max))
- (forward-line (- (/ 2 debugger-batch-max-lines)
- debugger-batch-max-lines))
- (delete-region middlestart (point)))
- (insert "...\n"))
+ (when (eq (car debugger-args) 'debug)
+ ;; Skip the frames for backtrace-debug, byte-code,
+ ;; and implement-debug-on-entry.
+ (backtrace-debug 4 t)
+ ;; Place an extra debug-on-exit for macro's.
+ (when (eq 'lambda (car-safe (cadr (backtrace-frame 4))))
+ (backtrace-debug 5 t)))
+ (pop-to-buffer
+ debugger-buffer
+ `((display-buffer-reuse-window
+ display-buffer-in-previous-window)
+ . (,(when debugger-previous-window
+ `(previous-window . ,debugger-previous-window)))))
+ (setq debugger-window (selected-window))
+ (if (eq debugger-previous-window debugger-window)
+ (when debugger-jumping-flag
+ ;; Try to restore previous height of debugger
+ ;; window.
+ (condition-case nil
+ (window-resize
+ debugger-window
+ (- debugger-previous-window-height
+ (window-total-size debugger-window)))
+ (error nil)))
+ (setq debugger-previous-window debugger-window))
+ (debugger-mode)
+ (debugger-setup-buffer debugger-args)
+ (when noninteractive
+ ;; If the backtrace is long, save the beginning
+ ;; and the end, but discard the middle.
+ (when (> (count-lines (point-min) (point-max))
+ debugger-batch-max-lines)
(goto-char (point-min))
- (message "%s" (buffer-string))
- (kill-emacs -1))
+ (forward-line (/ 2 debugger-batch-max-lines))
+ (let ((middlestart (point)))
+ (goto-char (point-max))
+ (forward-line (- (/ 2 debugger-batch-max-lines)
+ debugger-batch-max-lines))
+ (delete-region middlestart (point)))
+ (insert "...\n"))
+ (goto-char (point-min))
+ (message "%s" (buffer-string))
+ (kill-emacs -1))
+ (message "")
+ (let ((standard-output nil)
+ (buffer-read-only t))
(message "")
- (let ((standard-output nil)
- (buffer-read-only t))
- (message "")
- ;; Make sure we unbind buffer-read-only in the right buffer.
- (save-excursion
- (recursive-edit)))))
- ;; Kill or at least neuter the backtrace buffer, so that users
- ;; don't try to execute debugger commands in an invalid context.
- (if (get-buffer-window debugger-buffer 0)
- ;; Still visible despite the save-window-excursion? Maybe it
- ;; it's in a pop-up frame. It would be annoying to delete and
- ;; recreate it every time the debugger stops, so instead we'll
- ;; erase it (and maybe hide it) but keep it alive.
- (with-current-buffer debugger-buffer
- (with-selected-window (get-buffer-window debugger-buffer 0)
- (when (and (window-dedicated-p (selected-window))
- (not debugger-will-be-back))
- ;; If the window is not dedicated, burying the buffer
- ;; will mean that the frame created for it is left
- ;; around showing some random buffer, and next time we
- ;; pop to the debugger buffer we'll create yet
- ;; another frame.
- ;; If debugger-will-be-back is non-nil, the frame
- ;; would need to be de-iconified anyway immediately
- ;; after when we re-enter the debugger, so iconifying it
- ;; here would cause flashing.
- ;; Drew Adams is not happy with this: he wants to frame
- ;; to be left at the top-level, still working on how
- ;; best to do that.
- (bury-buffer))))
- (unless debugger-previous-state
- (kill-buffer debugger-buffer)))
- ;; Restore the previous state of the debugger-buffer, in case we were
- ;; in a recursive invocation of the debugger.
- (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))))))
+ ;; Make sure we unbind buffer-read-only in the right buffer.
+ (save-excursion
+ (recursive-edit))))
+ (when (and (not debugger-will-be-back)
+ (window-live-p debugger-window)
+ (eq (window-buffer debugger-window) debugger-buffer))
+ ;; Record height of debugger window.
+ (setq debugger-previous-window-height
+ (window-total-size debugger-window))
+ ;; Unshow debugger-buffer.
+ (quit-restore-window debugger-window debugger-bury-or-kill)
+ ;; Restore current buffer (Bug#12502).
+ (set-buffer debugger-old-buffer))
+ ;; 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.
+ (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))))))
(with-timeout-unsuspend debugger-with-timeout-suspend)
(set-match-data debugger-outer-match-data)))
;; Put into effect the modified values of these variables
(setq track-mouse debugger-outer-track-mouse)
(setq last-command debugger-outer-last-command)
(setq this-command debugger-outer-this-command)
- (with-no-warnings
- (setq unread-command-char debugger-outer-unread-command-char))
(setq unread-command-events debugger-outer-unread-command-events)
(setq unread-post-input-method-events
debugger-outer-unread-post-input-method-events)
(insert "Debugger entered")
;; lambda is for debug-on-call when a function call is next.
;; debug is for debug-on-entry function called.
- (cond ((memq (car debugger-args) '(lambda debug))
- (insert "--entering a function:\n"))
- ;; Exiting a function.
- ((eq (car debugger-args) 'exit)
- (insert "--returning value: ")
- (setq debugger-value (nth 1 debugger-args))
- (prin1 debugger-value (current-buffer))
- (insert ?\n)
- (delete-char 1)
- (insert ? )
- (beginning-of-line))
- ;; Debugger entered for an error.
- ((eq (car debugger-args) 'error)
- (insert "--Lisp error: ")
- (prin1 (nth 1 debugger-args) (current-buffer))
- (insert ?\n))
- ;; debug-on-call, when the next thing is an eval.
- ((eq (car debugger-args) t)
- (insert "--beginning evaluation of function call form:\n"))
- ;; User calls debug directly.
- (t
- (insert ": ")
- (prin1 (if (eq (car debugger-args) 'nil)
- (cdr debugger-args) debugger-args)
- (current-buffer))
- (insert ?\n)))
+ (pcase (car debugger-args)
+ ((or `lambda `debug)
+ (insert "--entering a function:\n"))
+ ;; Exiting a function.
+ (`exit
+ (insert "--returning value: ")
+ (setq debugger-value (nth 1 debugger-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 debugger-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 debugger-args) 'nil)
+ (cdr debugger-args) debugger-args)
+ (current-buffer))
+ (insert ?\n)))
;; After any frame that uses eval-buffer,
;; insert a line that states the buffer position it's reading at.
(save-excursion
"Attach cross-references to function names in the `*Backtrace*' buffer."
(interactive "b")
(with-current-buffer (or buffer (current-buffer))
- (setq buffer (current-buffer))
- (let ((inhibit-read-only t)
- (old-end (point-min)) (new-end (point-min)))
- ;; If we saved an old backtrace, find the common part
- ;; between the new and the old.
- ;; Compare line by line, starting from the end,
- ;; because that's the part that is likely to be unchanged.
- (if debugger-previous-backtrace
- (let (old-start new-start (all-match t))
- (goto-char (point-max))
- (with-temp-buffer
- (insert debugger-previous-backtrace)
- (while (and all-match (not (bobp)))
- (setq old-end (point))
- (forward-line -1)
- (setq old-start (point))
- (with-current-buffer buffer
- (setq new-end (point))
+ (save-excursion
+ (setq buffer (current-buffer))
+ (let ((inhibit-read-only t)
+ (old-end (point-min)) (new-end (point-min)))
+ ;; If we saved an old backtrace, find the common part
+ ;; between the new and the old.
+ ;; Compare line by line, starting from the end,
+ ;; because that's the part that is likely to be unchanged.
+ (if debugger-previous-backtrace
+ (let (old-start new-start (all-match t))
+ (goto-char (point-max))
+ (with-temp-buffer
+ (insert debugger-previous-backtrace)
+ (while (and all-match (not (bobp)))
+ (setq old-end (point))
(forward-line -1)
- (setq new-start (point)))
- (if (not (zerop
- (let ((case-fold-search nil))
- (compare-buffer-substrings
- (current-buffer) old-start old-end
- buffer new-start new-end))))
- (setq all-match nil))))
- ;; Now new-end is the position of the start of the
- ;; unchanged part in the current buffer, and old-end is
- ;; the position of that same text in the saved old
- ;; backtrace. But we must subtract (point-min) since strings are
- ;; indexed in origin 0.
-
- ;; Replace the unchanged part of the backtrace
- ;; with the text from debugger-previous-backtrace,
- ;; since that already has the proper xrefs.
- ;; With this optimization, we only need to scan
- ;; the changed part of the backtrace.
- (delete-region new-end (point-max))
- (goto-char (point-max))
- (insert (substring debugger-previous-backtrace
- (- old-end (point-min))))
- ;; Make the unchanged part of the backtrace inaccessible
- ;; so it won't be scanned.
- (narrow-to-region (point-min) new-end)))
-
- ;; Scan the new part of the backtrace, inserting xrefs.
- (goto-char (point-min))
- (while (progn
- (goto-char (+ (point) 2))
- (skip-syntax-forward "^w_")
- (not (eobp)))
- (let* ((beg (point))
- (end (progn (skip-syntax-forward "w_") (point)))
- (sym (intern-soft (buffer-substring-no-properties
- beg end)))
- (file (and sym (symbol-file sym 'defun))))
- (when file
- (goto-char beg)
- ;; help-xref-button needs to operate on something matched
- ;; by a regexp, so set that up for it.
- (re-search-forward "\\(\\sw\\|\\s_\\)+")
- (help-xref-button 0 'help-function-def sym file)))
- (forward-line 1))
- (widen))
- (setq debugger-previous-backtrace (buffer-string))))
+ (setq old-start (point))
+ (with-current-buffer buffer
+ (setq new-end (point))
+ (forward-line -1)
+ (setq new-start (point)))
+ (if (not (zerop
+ (let ((case-fold-search nil))
+ (compare-buffer-substrings
+ (current-buffer) old-start old-end
+ buffer new-start new-end))))
+ (setq all-match nil))))
+ ;; Now new-end is the position of the start of the
+ ;; unchanged part in the current buffer, and old-end is
+ ;; the position of that same text in the saved old
+ ;; backtrace. But we must subtract (point-min) since strings are
+ ;; indexed in origin 0.
+
+ ;; Replace the unchanged part of the backtrace
+ ;; with the text from debugger-previous-backtrace,
+ ;; since that already has the proper xrefs.
+ ;; With this optimization, we only need to scan
+ ;; the changed part of the backtrace.
+ (delete-region new-end (point-max))
+ (goto-char (point-max))
+ (insert (substring debugger-previous-backtrace
+ (- old-end (point-min))))
+ ;; Make the unchanged part of the backtrace inaccessible
+ ;; so it won't be scanned.
+ (narrow-to-region (point-min) new-end)))
+
+ ;; Scan the new part of the backtrace, inserting xrefs.
+ (goto-char (point-min))
+ (while (progn
+ (goto-char (+ (point) 2))
+ (skip-syntax-forward "^w_")
+ (not (eobp)))
+ (let* ((beg (point))
+ (end (progn (skip-syntax-forward "w_") (point)))
+ (sym (intern-soft (buffer-substring-no-properties
+ beg end)))
+ (file (and sym (symbol-file sym 'defun))))
+ (when file
+ (goto-char beg)
+ ;; help-xref-button needs to operate on something matched
+ ;; by a regexp, so set that up for it.
+ (re-search-forward "\\(\\sw\\|\\s_\\)+")
+ (help-xref-button 0 'help-function-def sym file)))
+ (forward-line 1))
+ (widen))
+ (setq debugger-previous-backtrace (buffer-string)))))
\f
(defun debugger-step-through ()
"Proceed, stepping through subexpressions of this expression.
This is only useful when the value returned from the debugger
will be used, such as in a debug on exit from a frame."
(interactive "XReturn value (evaluated): ")
+ (when (memq (car debugger-args) '(t lambda error debug))
+ (error "Cannot return a value %s"
+ (if (eq (car debugger-args) 'error)
+ "from an error" "at function entrance")))
(setq debugger-value val)
(princ "Returning " t)
(prin1 debugger-value)
(cursor-in-echo-area debugger-outer-cursor-in-echo-area))
(set-match-data debugger-outer-match-data)
(prog1
- (let ((save-ucc (with-no-warnings unread-command-char)))
- (unwind-protect
- (progn
- (with-no-warnings
- (setq unread-command-char debugger-outer-unread-command-char))
- (prog1 (progn ,@body)
- (with-no-warnings
- (setq debugger-outer-unread-command-char unread-command-char))))
- (with-no-warnings
- (setq unread-command-char save-ucc))))
+ (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
,(interactive-form (symbol-function function))
(apply ',(symbol-function function)
debug-on-entry-args)))
- (when (eq (car-safe (symbol-function function)) 'autoload)
+ (when (autoloadp (symbol-function function))
;; The function is autoloaded. Load its real definition.
- (load (cadr (symbol-function function)) nil noninteractive nil t))
+ (autoload-do-load (symbol-function function) function))
(when (or (not (consp (symbol-function function)))
(and (eq (car (symbol-function function)) 'macro)
(not (consp (cdr (symbol-function function))))))
,defn
,@(remq '&rest (remq '&optional args))))))
(if (> (length defn) 5)
+ ;; The mere presence of field 5 is sufficient to make
+ ;; it interactive.
(push `(interactive ,(aref defn 5)) body))
- (if (aref defn 4)
+ (if (and (> (length defn) 4) (aref defn 4))
;; Use `documentation' here, to get the actual string,
;; in case the compiled function has a reference
;; to the .elc file.
HCoop / bpt / emacs.git / blobdiff