1;;; debug.el --- debuggers and related commands for Emacs -*- lexical-binding: t -*- 2 3;; Copyright (C) 1985-1986, 1994, 2001-2021 Free Software Foundation, 4;; Inc. 5 6;; Maintainer: emacs-devel@gnu.org 7;; Keywords: lisp, tools, maint 8 9;; This file is part of GNU Emacs. 10 11;; GNU Emacs is free software: you can redistribute it and/or modify 12;; it under the terms of the GNU General Public License as published by 13;; the Free Software Foundation, either version 3 of the License, or 14;; (at your option) any later version. 15 16;; GNU Emacs is distributed in the hope that it will be useful, 17;; but WITHOUT ANY WARRANTY; without even the implied warranty of 18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 19;; GNU General Public License for more details. 20 21;; You should have received a copy of the GNU General Public License 22;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. 23 24;;; Commentary: 25 26;; This is a major mode documented in the Emacs Lisp manual. 27 28;;; Code: 29 30(require 'cl-lib) 31(require 'backtrace) 32 33(defgroup debugger nil 34 "Debuggers and related commands for Emacs." 35 :prefix "debugger-" 36 :group 'debug) 37 38(defcustom debugger-mode-hook nil 39 "Hooks run when `debugger-mode' is turned on." 40 :type 'hook 41 :group 'debugger 42 :version "20.3") 43 44(defcustom debugger-batch-max-lines 40 45 "Maximum lines to show in debugger buffer in a noninteractive Emacs. 46When the debugger is entered and Emacs is running in batch mode, 47if the backtrace text has more than this many lines, 48the middle is discarded, and just the beginning and end are displayed." 49 :type 'integer 50 :group 'debugger 51 :version "21.1") 52 53(defcustom debugger-print-function #'cl-prin1 54 "Function used to print values in the debugger backtraces." 55 :type '(choice (const cl-prin1) 56 (const prin1) 57 function) 58 :version "26.1") 59 60(defcustom debugger-bury-or-kill 'bury 61 "What to do with the debugger buffer when exiting `debug'. 62The value affects the behavior of operations on any window 63previously showing the debugger buffer. 64 65nil means that if its window is not deleted when exiting the 66 debugger, invoking `switch-to-prev-buffer' will usually show 67 the debugger buffer again. 68 69`append' means that if the window is not deleted, the debugger 70 buffer moves to the end of the window's previous buffers so 71 it's less likely that a future invocation of 72 `switch-to-prev-buffer' will switch to it. Also, it moves the 73 buffer to the end of the frame's buffer list. 74 75`bury' means that if the window is not deleted, its buffer is 76 removed from the window's list of previous buffers. Also, it 77 moves the buffer to the end of the frame's buffer list. This 78 value provides the most reliable remedy to not have 79 `switch-to-prev-buffer' switch to the debugger buffer again 80 without killing the buffer. 81 82`kill' means to kill the debugger buffer. 83 84The value used here is passed to `quit-restore-window'." 85 :type '(choice 86 (const :tag "Keep alive" nil) 87 (const :tag "Append" append) 88 (const :tag "Bury" bury) 89 (const :tag "Kill" kill)) 90 :group 'debugger 91 :version "24.3") 92 93(defvar debugger-step-after-exit nil 94 "Non-nil means \"single-step\" after the debugger exits.") 95 96(defvar debugger-value nil 97 "This is the value for the debugger to return, when it returns.") 98 99(defvar debugger-old-buffer nil 100 "This is the buffer that was current when the debugger was entered.") 101 102(defvar debugger-previous-window nil 103 "This is the window last showing the debugger buffer.") 104 105(defvar debugger-previous-window-height nil 106 "The last recorded height of `debugger-previous-window'.") 107 108(defvar debugger-previous-backtrace nil 109 "The contents of the previous backtrace (including text properties). 110This is to optimize `debugger-make-xrefs'.") 111 112(defvar debugger-outer-match-data) 113(defvar debugger-will-be-back nil 114 "Non-nil if we expect to get back in the debugger soon.") 115 116(defvar inhibit-debug-on-entry nil 117 "Non-nil means that `debug-on-entry' is disabled.") 118 119(defvar debugger-jumping-flag nil 120 "Non-nil means that `debug-on-entry' is disabled. 121This variable is used by `debugger-jump', `debugger-step-through', 122and `debugger-reenable' to temporarily disable `debug-on-entry'.") 123 124(defvar inhibit-trace) ;Not yet implemented. 125 126(defvar debugger-args nil 127 "Arguments with which the debugger was called. 128It is a list expected to take the form (CAUSE . REST) 129where CAUSE can be: 130- debug: called for entry to a flagged function. 131- t: called because of `debug-on-next-call'. 132- lambda: same thing but via `funcall'. 133- exit: called because of exit of a flagged function. 134- error: called because of `debug-on-error'.") 135 136(cl-defstruct (debugger--buffer-state 137 (:constructor debugger--save-buffer-state 138 (&aux (mode major-mode) 139 (header backtrace-insert-header-function) 140 (frames backtrace-frames) 141 (content (buffer-string)) 142 (pos (point))))) 143 mode header frames content pos) 144 145(defun debugger--restore-buffer-state (state) 146 (unless (derived-mode-p (debugger--buffer-state-mode state)) 147 (funcall (debugger--buffer-state-mode state))) 148 (setq backtrace-insert-header-function (debugger--buffer-state-header state) 149 backtrace-frames (debugger--buffer-state-frames state)) 150 (let ((inhibit-read-only t)) 151 (erase-buffer) 152 (insert (debugger--buffer-state-content state))) 153 (goto-char (debugger--buffer-state-pos state))) 154 155;;;###autoload 156(setq debugger 'debug) 157;;;###autoload 158(defun debug (&rest args) 159 "Enter debugger. \\<debugger-mode-map>`\\[debugger-continue]' returns from the debugger. 160Arguments are mainly for use when this is called from the internals 161of the evaluator. 162 163You may call with no args, or you may pass nil as the first arg and 164any other args you like. In that case, the list of args after the 165first will be printed into the backtrace buffer. 166 167If `inhibit-redisplay' is non-nil when this function is called, 168the debugger will not be entered." 169 (interactive) 170 (if inhibit-redisplay 171 ;; Don't really try to enter debugger within an eval from redisplay. 172 debugger-value 173 (let ((non-interactive-frame 174 (or noninteractive ;FIXME: Presumably redundant. 175 ;; If we're in the initial-frame (where `message' just 176 ;; outputs to stdout) so there's no tty or GUI frame to 177 ;; display the backtrace and interact with it: just dump a 178 ;; backtrace to stdout. This happens for example while 179 ;; handling an error in code from early-init.el with 180 ;; --debug-init. 181 (and (eq t (framep (selected-frame))) 182 (equal "initial_terminal" (terminal-name))))) 183 ;; Don't let `inhibit-message' get in our way (especially important if 184 ;; `non-interactive-frame' evaluated to a non-nil value. 185 (inhibit-message nil) 186 ;; We may be entering the debugger from a context that has 187 ;; let-bound `inhibit-read-only', which means that all 188 ;; buffers would be read/write while the debugger is running. 189 (inhibit-read-only nil)) 190 (unless non-interactive-frame 191 (message "Entering debugger...")) 192 (let (debugger-value 193 (debugger-previous-state 194 (if (get-buffer "*Backtrace*") 195 (with-current-buffer (get-buffer "*Backtrace*") 196 (debugger--save-buffer-state)))) 197 (debugger-args args) 198 (debugger-buffer (get-buffer-create "*Backtrace*")) 199 (debugger-old-buffer (current-buffer)) 200 (debugger-window nil) 201 (debugger-step-after-exit nil) 202 (debugger-will-be-back nil) 203 ;; Don't keep reading from an executing kbd macro! 204 (executing-kbd-macro nil) 205 ;; Save the outer values of these vars for the `e' command 206 ;; before we replace the values. 207 (debugger-outer-match-data (match-data)) 208 (debugger-with-timeout-suspend (with-timeout-suspend))) 209 ;; Set this instead of binding it, so that `q' 210 ;; will not restore it. 211 (setq overriding-terminal-local-map nil) 212 ;; Don't let these magic variables affect the debugger itself. 213 (let ((last-command nil) this-command track-mouse 214 (inhibit-trace t) 215 unread-command-events 216 unread-post-input-method-events 217 last-input-event last-command-event last-nonmenu-event 218 last-event-frame 219 overriding-local-map 220 (load-read-function #'read) 221 ;; If we are inside a minibuffer, allow nesting 222 ;; so that we don't get an error from the `e' command. 223 (enable-recursive-minibuffers 224 (or enable-recursive-minibuffers (> (minibuffer-depth) 0))) 225 (standard-input t) (standard-output t) 226 inhibit-redisplay 227 (cursor-in-echo-area nil) 228 (window-configuration (current-window-configuration))) 229 (unwind-protect 230 (save-excursion 231 (when (eq (car debugger-args) 'debug) 232 ;; Skip the frames for backtrace-debug, byte-code, 233 ;; debug--implement-debug-on-entry and the advice's `apply'. 234 (backtrace-debug 4 t) 235 ;; Place an extra debug-on-exit for macro's. 236 (when (eq 'lambda (car-safe (cadr (backtrace-frame 4)))) 237 (backtrace-debug 5 t))) 238 (with-current-buffer debugger-buffer 239 (unless (derived-mode-p 'debugger-mode) 240 (debugger-mode)) 241 (debugger-setup-buffer debugger-args) 242 (when non-interactive-frame 243 ;; If the backtrace is long, save the beginning 244 ;; and the end, but discard the middle. 245 (let ((inhibit-read-only t)) 246 (when (> (count-lines (point-min) (point-max)) 247 debugger-batch-max-lines) 248 (goto-char (point-min)) 249 (forward-line (/ debugger-batch-max-lines 2)) 250 (let ((middlestart (point))) 251 (goto-char (point-max)) 252 (forward-line (- (/ debugger-batch-max-lines 2))) 253 (delete-region middlestart (point))) 254 (insert "...\n"))) 255 (message "%s" (buffer-string)) 256 (kill-emacs -1))) 257 (pop-to-buffer 258 debugger-buffer 259 `((display-buffer-reuse-window 260 display-buffer-in-previous-window 261 display-buffer-below-selected) 262 . ((window-min-height . 10) 263 (window-height . fit-window-to-buffer) 264 ,@(when (and (window-live-p debugger-previous-window) 265 (frame-visible-p 266 (window-frame debugger-previous-window))) 267 `((previous-window . ,debugger-previous-window)))))) 268 (setq debugger-window (selected-window)) 269 (when debugger-jumping-flag 270 ;; Try to restore previous height of debugger 271 ;; window. 272 (condition-case nil 273 (window-resize 274 debugger-window 275 (- debugger-previous-window-height 276 (window-total-height debugger-window))) 277 (error nil)) 278 (setq debugger-previous-window debugger-window)) 279 (message "") 280 (let ((standard-output nil) 281 (buffer-read-only t)) 282 (message "") 283 ;; Make sure we unbind buffer-read-only in the right buffer. 284 (save-excursion 285 (recursive-edit)))) 286 (when (and (window-live-p debugger-window) 287 (eq (window-buffer debugger-window) debugger-buffer)) 288 ;; Record height of debugger window. 289 (setq debugger-previous-window-height 290 (window-total-height debugger-window))) 291 (if debugger-will-be-back 292 ;; Restore previous window configuration (Bug#12623). 293 (set-window-configuration window-configuration) 294 (when (and (window-live-p debugger-window) 295 (eq (window-buffer debugger-window) debugger-buffer)) 296 (progn 297 ;; Unshow debugger-buffer. 298 (quit-restore-window debugger-window debugger-bury-or-kill) 299 ;; Restore current buffer (Bug#12502). 300 (set-buffer debugger-old-buffer))) 301 ;; Forget debugger window, it won't be back (Bug#17882). 302 (setq debugger-previous-window nil)) 303 ;; Restore previous state of debugger-buffer in case we were 304 ;; in a recursive invocation of the debugger, otherwise just 305 ;; erase the buffer. 306 (when (buffer-live-p debugger-buffer) 307 (with-current-buffer debugger-buffer 308 (if debugger-previous-state 309 (debugger--restore-buffer-state debugger-previous-state) 310 (setq backtrace-insert-header-function nil) 311 (setq backtrace-frames nil) 312 (backtrace-print)))) 313 (with-timeout-unsuspend debugger-with-timeout-suspend) 314 (set-match-data debugger-outer-match-data))) 315 (setq debug-on-next-call debugger-step-after-exit) 316 debugger-value)))) 317 318(defun debugger--print (obj &optional stream) 319 (condition-case err 320 (funcall debugger-print-function obj stream) 321 (error 322 (message "Error in debug printer: %S" err) 323 (prin1 obj stream)))) 324 325(make-obsolete 'debugger-insert-backtrace 326 "use a `backtrace-mode' buffer or `backtrace-to-string'." 327 "27.1") 328 329(defun debugger-insert-backtrace (frames do-xrefs) 330 "Format and insert the backtrace FRAMES at point. 331Make functions into cross-reference buttons if DO-XREFS is non-nil." 332 (insert (if do-xrefs 333 (backtrace--to-string frames) 334 (backtrace-to-string frames)))) 335 336(defun debugger-setup-buffer (args) 337 "Initialize the `*Backtrace*' buffer for entry to the debugger. 338That buffer should be current already and in `debugger-mode'." 339 (setq backtrace-frames (nthcdr 340 ;; Remove debug--implement-debug-on-entry and the 341 ;; advice's `apply' frame. 342 (if (eq (car args) 'debug) 3 1) 343 (backtrace-get-frames 'debug))) 344 (when (eq (car-safe args) 'exit) 345 (setq debugger-value (nth 1 args)) 346 (setf (cl-getf (backtrace-frame-flags (car backtrace-frames)) 347 :debug-on-exit) 348 nil)) 349 350 (setq backtrace-view (plist-put backtrace-view :show-flags t) 351 backtrace-insert-header-function (lambda () 352 (debugger--insert-header args)) 353 backtrace-print-function debugger-print-function) 354 (backtrace-print) 355 ;; Place point on "stack frame 0" (bug#15101). 356 (goto-char (point-min)) 357 (search-forward ":" (line-end-position) t) 358 (when (and (< (point) (line-end-position)) 359 (= (char-after) ?\s)) 360 (forward-char))) 361 362(defun debugger--insert-header (args) 363 "Insert the header for the debugger's Backtrace buffer. 364Include the reason for debugger entry from ARGS." 365 (insert "Debugger entered") 366 (pcase (car args) 367 ;; lambda is for debug-on-call when a function call is next. 368 ;; debug is for debug-on-entry function called. 369 ((or 'lambda 'debug) 370 (insert "--entering a function:\n")) 371 ;; Exiting a function. 372 ('exit 373 (insert "--returning value: ") 374 (insert (backtrace-print-to-string debugger-value)) 375 (insert ?\n)) 376 ;; Watchpoint triggered. 377 ((and 'watchpoint (let `(,symbol ,newval . ,details) (cdr args))) 378 (insert 379 "--" 380 (pcase details 381 ('(makunbound nil) (format "making %s void" symbol)) 382 (`(makunbound ,buffer) (format "killing local value of %s in buffer %s" 383 symbol buffer)) 384 (`(defvaralias ,_) (format "aliasing %s to %s" symbol newval)) 385 (`(let ,_) (format "let-binding %s to %s" symbol 386 (backtrace-print-to-string newval))) 387 (`(unlet ,_) (format "ending let-binding of %s" symbol)) 388 ('(set nil) (format "setting %s to %s" symbol 389 (backtrace-print-to-string newval))) 390 (`(set ,buffer) (format "setting %s in buffer %s to %s" 391 symbol buffer 392 (backtrace-print-to-string newval))) 393 (_ (error "Unrecognized watchpoint triggered %S" (cdr args)))) 394 ": ") 395 (insert ?\n)) 396 ;; Debugger entered for an error. 397 ('error 398 (insert "--Lisp error: ") 399 (insert (backtrace-print-to-string (nth 1 args))) 400 (insert ?\n)) 401 ;; debug-on-call, when the next thing is an eval. 402 ('t 403 (insert "--beginning evaluation of function call form:\n")) 404 ;; User calls debug directly. 405 (_ 406 (insert ": ") 407 (insert (backtrace-print-to-string (if (eq (car args) 'nil) 408 (cdr args) args))) 409 (insert ?\n)))) 410 411 412(defun debugger-step-through () 413 "Proceed, stepping through subexpressions of this expression. 414Enter another debugger on next entry to eval, apply or funcall." 415 (interactive) 416 (setq debugger-step-after-exit t) 417 (setq debugger-jumping-flag t) 418 (setq debugger-will-be-back t) 419 (add-hook 'post-command-hook 'debugger-reenable) 420 (message "Proceeding, will debug on next eval or call.") 421 (exit-recursive-edit)) 422 423(defun debugger-continue () 424 "Continue, evaluating this expression without stopping." 425 (interactive) 426 (unless debugger-may-continue 427 (error "Cannot continue")) 428 (message "Continuing.") 429 430 ;; Check to see if we've flagged some frame for debug-on-exit, in which 431 ;; case we'll probably come back to the debugger soon. 432 (dolist (frame backtrace-frames) 433 (when (plist-get (backtrace-frame-flags frame) :debug-on-exit) 434 (setq debugger-will-be-back t))) 435 (exit-recursive-edit)) 436 437(defun debugger-return-value (val) 438 "Continue, specifying value to return. 439This is only useful when the value returned from the debugger 440will be used, such as in a debug on exit from a frame." 441 (interactive "XReturn value (evaluated): ") 442 (when (memq (car debugger-args) '(t lambda error debug)) 443 (error "Cannot return a value %s" 444 (if (eq (car debugger-args) 'error) 445 "from an error" "at function entrance"))) 446 (setq debugger-value val) 447 (princ "Returning " t) 448 (debugger--print debugger-value) 449 ;; Check to see if we've flagged some frame for debug-on-exit, in which 450 ;; case we'll probably come back to the debugger soon. 451 (dolist (frame backtrace-frames) 452 (when (plist-get (backtrace-frame-flags frame) :debug-on-exit) 453 (setq debugger-will-be-back t))) 454 (exit-recursive-edit)) 455 456(defun debugger-jump () 457 "Continue to exit from this frame, with all `debug-on-entry' suspended." 458 (interactive) 459 (debugger-frame) 460 (setq debugger-jumping-flag t) 461 (add-hook 'post-command-hook 'debugger-reenable) 462 (message "Continuing through this frame") 463 (setq debugger-will-be-back t) 464 (exit-recursive-edit)) 465 466(defun debugger-reenable () 467 "Turn all `debug-on-entry' functions back on. 468This function is put on `post-command-hook' by `debugger-jump' and 469removes itself from that hook." 470 (setq debugger-jumping-flag nil) 471 (remove-hook 'post-command-hook 'debugger-reenable)) 472 473(defun debugger-frame-number (&optional skip-base) 474 "Return number of frames in backtrace before the one point points at." 475 (let ((index (backtrace-get-index)) 476 (count 0)) 477 (unless index 478 (error "This line is not a function call")) 479 (unless skip-base 480 (while (not (eq (cadr (backtrace-frame count)) 'debug)) 481 (setq count (1+ count))) 482 ;; Skip debug--implement-debug-on-entry frame. 483 (when (eq 'debug--implement-debug-on-entry 484 (cadr (backtrace-frame (1+ count)))) 485 (setq count (+ 2 count)))) 486 (+ count index))) 487 488(defun debugger-frame () 489 "Request entry to debugger when this frame exits. 490Applies to the frame whose line point is on in the backtrace." 491 (interactive) 492 (backtrace-debug (debugger-frame-number) t) 493 (setf 494 (cl-getf (backtrace-frame-flags (nth (backtrace-get-index) backtrace-frames)) 495 :debug-on-exit) 496 t) 497 (backtrace-update-flags)) 498 499(defun debugger-frame-clear () 500 "Do not enter debugger when this frame exits. 501Applies to the frame whose line point is on in the backtrace." 502 (interactive) 503 (backtrace-debug (debugger-frame-number) nil) 504 (setf 505 (cl-getf (backtrace-frame-flags (nth (backtrace-get-index) backtrace-frames)) 506 :debug-on-exit) 507 nil) 508 (backtrace-update-flags)) 509 510(defmacro debugger-env-macro (&rest body) 511 "Run BODY in original environment." 512 (declare (indent 0)) 513 `(progn 514 (set-match-data debugger-outer-match-data) 515 (prog1 516 (progn ,@body) 517 (setq debugger-outer-match-data (match-data))))) 518 519(defun debugger--backtrace-base () 520 "Return the function name that marks the top of the backtrace. 521See `backtrace-frame'." 522 (cond ((eq 'debug--implement-debug-on-entry 523 (cadr (backtrace-frame 1 'debug))) 524 'debug--implement-debug-on-entry) 525 (t 'debug))) 526 527(defun debugger-eval-expression (exp &optional nframe) 528 "Eval an expression, in an environment like that outside the debugger. 529The environment used is the one when entering the activation frame at point." 530 (interactive 531 (list (read--expression "Eval in stack frame: "))) 532 (let ((nframe (or nframe 533 (condition-case nil (1+ (debugger-frame-number 'skip-base)) 534 (error 0)))) ;; If on first line. 535 (base (debugger--backtrace-base))) 536 (debugger-env-macro 537 (let ((val (backtrace-eval exp nframe base))) 538 (prog1 539 (debugger--print val t) 540 (let ((str (eval-expression-print-format val))) 541 (if str (princ str t)))))))) 542 543(define-obsolete-function-alias 'debugger-toggle-locals 544 'backtrace-toggle-locals "28.1") 545 546 547(defvar debugger-mode-map 548 (let ((map (make-keymap))) 549 (set-keymap-parent map backtrace-mode-map) 550 (define-key map "b" 'debugger-frame) 551 (define-key map "c" 'debugger-continue) 552 (define-key map "j" 'debugger-jump) 553 (define-key map "r" 'debugger-return-value) 554 (define-key map "u" 'debugger-frame-clear) 555 (define-key map "d" 'debugger-step-through) 556 (define-key map "l" 'debugger-list-functions) 557 (define-key map "q" 'debugger-quit) 558 (define-key map "e" 'debugger-eval-expression) 559 (define-key map "R" 'debugger-record-expression) 560 (define-key map [mouse-2] 'push-button) 561 (easy-menu-define nil map "" 562 '("Debugger" 563 ["Step through" debugger-step-through 564 :help "Proceed, stepping through subexpressions of this expression"] 565 ["Continue" debugger-continue 566 :help "Continue, evaluating this expression without stopping"] 567 ["Jump" debugger-jump 568 :help "Continue to exit from this frame, with all debug-on-entry suspended"] 569 ["Eval Expression..." debugger-eval-expression 570 :help "Eval an expression, in an environment like that outside the debugger"] 571 ["Display and Record Expression" debugger-record-expression 572 :help "Display a variable's value and record it in `*Backtrace-record*' buffer"] 573 ["Return value..." debugger-return-value 574 :help "Continue, specifying value to return."] 575 "--" 576 ["Debug frame" debugger-frame 577 :help "Request entry to debugger when this frame exits"] 578 ["Cancel debug frame" debugger-frame-clear 579 :help "Do not enter debugger when this frame exits"] 580 ["List debug on entry functions" debugger-list-functions 581 :help "Display a list of all the functions now set to debug on entry"] 582 "--" 583 ["Next Line" next-line 584 :help "Move cursor down"] 585 ["Help for Symbol" backtrace-help-follow-symbol 586 :help "Show help for symbol at point"] 587 ["Describe Debugger Mode" describe-mode 588 :help "Display documentation for debugger-mode"] 589 "--" 590 ["Quit" debugger-quit 591 :help "Quit debugging and return to top level"])) 592 map)) 593 594(put 'debugger-mode 'mode-class 'special) 595 596(define-derived-mode debugger-mode backtrace-mode "Debugger" 597 "Mode for debugging Emacs Lisp using a backtrace. 598\\<debugger-mode-map> 599A frame marked with `*' in the backtrace means that exiting that 600frame will enter the debugger. You can flag frames to enter the 601debugger when frame is exited with \\[debugger-frame], and remove 602the flag with \\[debugger-frame-clear]. 603 604When in debugger invoked due to exiting a frame which was flagged 605with a `*', you can use the \\[debugger-return-value] command to 606override the value being returned from that frame when the debugger 607exits. 608 609Use \\[debug-on-entry] and \\[cancel-debug-on-entry] to control 610which functions will enter the debugger when called. 611 612Complete list of commands: 613\\{debugger-mode-map}" 614 (add-hook 'kill-buffer-hook 615 (lambda () (if (> (recursion-depth) 0) (top-level))) 616 nil t) 617 (use-local-map debugger-mode-map)) 618 619(defcustom debugger-record-buffer "*Debugger-record*" 620 "Buffer name for expression values, for \\[debugger-record-expression]." 621 :type 'string 622 :group 'debugger 623 :version "20.3") 624 625(defun debugger-record-expression (exp) 626 "Display a variable's value and record it in `*Backtrace-record*' buffer." 627 (interactive 628 (list (read--expression "Record Eval: "))) 629 (let* ((buffer (get-buffer-create debugger-record-buffer)) 630 (standard-output buffer)) 631 (princ (format "Debugger Eval (%s): " exp)) 632 (princ (debugger-eval-expression exp)) 633 (terpri)) 634 635 (with-current-buffer (get-buffer debugger-record-buffer) 636 (message "%s" 637 (buffer-substring (line-beginning-position 0) 638 (line-end-position 0))))) 639 640(define-obsolete-function-alias 'debug-help-follow 641 'backtrace-help-follow-symbol "28.1") 642 643 644;; When you change this, you may also need to change the number of 645;; frames that the debugger skips. 646(defun debug--implement-debug-on-entry (&rest _ignore) 647 "Conditionally call the debugger. 648A call to this function is inserted by `debug-on-entry' to cause 649functions to break on entry." 650 (if (or inhibit-debug-on-entry debugger-jumping-flag) 651 nil 652 (let ((inhibit-debug-on-entry t)) 653 (funcall debugger 'debug)))) 654 655;;;###autoload 656(defun debug-on-entry (function) 657 "Request FUNCTION to invoke debugger each time it is called. 658 659When called interactively, prompt for FUNCTION in the minibuffer. 660 661This works by modifying the definition of FUNCTION. If you tell the 662debugger to continue, FUNCTION's execution proceeds. If FUNCTION is a 663normal function or a macro written in Lisp, you can also step through 664its execution. FUNCTION can also be a primitive that is not a special 665form, in which case stepping is not possible. Break-on-entry for 666primitive functions only works when that function is called from Lisp. 667 668Use \\[cancel-debug-on-entry] to cancel the effect of this command. 669Redefining FUNCTION also cancels it." 670 (interactive 671 (let ((fn (function-called-at-point)) val) 672 (when (special-form-p fn) 673 (setq fn nil)) 674 (setq val (completing-read 675 (format-prompt "Debug on entry to function" fn) 676 obarray 677 #'(lambda (symbol) 678 (and (fboundp symbol) 679 (not (special-form-p symbol)))) 680 'confirm nil nil (symbol-name fn))) 681 (list (if (equal val "") fn (intern val))))) 682 (advice-add function :before #'debug--implement-debug-on-entry 683 '((depth . -100))) 684 function) 685 686(defun debug--function-list () 687 "List of functions currently set for debug on entry." 688 (let ((funs '())) 689 (mapatoms 690 (lambda (s) 691 (when (advice-member-p #'debug--implement-debug-on-entry s) 692 (push s funs)))) 693 funs)) 694 695;;;###autoload 696(defun cancel-debug-on-entry (&optional function) 697 "Undo effect of \\[debug-on-entry] on FUNCTION. 698If FUNCTION is nil, cancel `debug-on-entry' for all functions. 699When called interactively, prompt for FUNCTION in the minibuffer. 700To specify a nil argument interactively, exit with an empty minibuffer." 701 (interactive 702 (list (let ((name 703 (completing-read 704 (format-prompt "Cancel debug on entry to function" 705 "all functions") 706 (mapcar #'symbol-name (debug--function-list)) nil t))) 707 (when name 708 (unless (string= name "") 709 (intern name)))))) 710 (if function 711 (progn 712 (advice-remove function #'debug--implement-debug-on-entry) 713 function) 714 (message "Canceling debug-on-entry for all functions") 715 (mapcar #'cancel-debug-on-entry (debug--function-list)))) 716 717(defun debugger-list-functions () 718 "Display a list of all the functions now set to debug on entry." 719 (interactive) 720 (require 'help-mode) 721 (help-setup-xref '(debugger-list-functions) 722 (called-interactively-p 'interactive)) 723 (with-output-to-temp-buffer (help-buffer) 724 (with-current-buffer standard-output 725 (let ((funs (debug--function-list))) 726 (if (null funs) 727 (princ "No debug-on-entry functions now\n") 728 (princ "Functions set to debug on entry:\n\n") 729 (dolist (fun funs) 730 (make-text-button (point) (progn (prin1 fun) (point)) 731 'type 'help-function 732 'help-args (list fun)) 733 (terpri)) 734 ;; Now that debug--function-list uses advice-member-p, its 735 ;; output should be reliable (except for bugs and the exceptional 736 ;; case where some other advice ends up overriding ours). 737 ;;(terpri) 738 ;;(princ "Note: if you have redefined a function, then it may no longer\n") 739 ;;(princ "be set to debug on entry, even if it is in the list.") 740 ))))) 741 742(defun debugger-quit () 743 "Quit debugging and return to the top level." 744 (interactive) 745 (if (= (recursion-depth) 0) 746 (quit-window) 747 (top-level))) 748 749(defun debug--implement-debug-watch (symbol newval op where) 750 "Conditionally call the debugger. 751This function is called when SYMBOL's value is modified." 752 (if (or inhibit-debug-on-entry debugger-jumping-flag) 753 nil 754 (let ((inhibit-debug-on-entry t)) 755 (funcall debugger 'watchpoint symbol newval op where)))) 756 757;;;###autoload 758(defun debug-on-variable-change (variable) 759 "Trigger a debugger invocation when VARIABLE is changed. 760 761When called interactively, prompt for VARIABLE in the minibuffer. 762 763This works by calling `add-variable-watcher' on VARIABLE. If you 764quit from the debugger, this will abort the change (unless the 765change is caused by the termination of a let-binding). 766 767The watchpoint may be circumvented by C code that changes the 768variable directly (i.e., not via `set'). Changing the value of 769the variable (e.g., `setcar' on a list variable) will not trigger 770watchpoint. 771 772Use \\[cancel-debug-on-variable-change] to cancel the effect of 773this command. Uninterning VARIABLE or making it an alias of 774another symbol also cancels it." 775 (interactive 776 (let* ((var-at-point (variable-at-point)) 777 (var (and (symbolp var-at-point) var-at-point)) 778 (val (completing-read 779 (format-prompt "Debug when setting variable" var) 780 obarray #'boundp 781 t nil nil (and var (symbol-name var))))) 782 (list (if (equal val "") var (intern val))))) 783 (add-variable-watcher variable #'debug--implement-debug-watch)) 784 785;;;###autoload 786(defalias 'debug-watch #'debug-on-variable-change) 787 788 789(defun debug--variable-list () 790 "List of variables currently set for debug on set." 791 (let ((vars '())) 792 (mapatoms 793 (lambda (s) 794 (when (memq #'debug--implement-debug-watch 795 (get s 'watchers)) 796 (push s vars)))) 797 vars)) 798 799;;;###autoload 800(defun cancel-debug-on-variable-change (&optional variable) 801 "Undo effect of \\[debug-on-variable-change] on VARIABLE. 802If VARIABLE is nil, cancel `debug-on-variable-change' for all variables. 803When called interactively, prompt for VARIABLE in the minibuffer. 804To specify a nil argument interactively, exit with an empty minibuffer." 805 (interactive 806 (list (let ((name 807 (completing-read 808 (format-prompt "Cancel debug on set for variable" 809 "all variables") 810 (mapcar #'symbol-name (debug--variable-list)) nil t))) 811 (when name 812 (unless (string= name "") 813 (intern name)))))) 814 (if variable 815 (remove-variable-watcher variable #'debug--implement-debug-watch) 816 (message "Canceling debug-watch for all variables") 817 (mapc #'cancel-debug-watch (debug--variable-list)))) 818 819;;;###autoload 820(defalias 'cancel-debug-watch #'cancel-debug-on-variable-change) 821 822(provide 'debug) 823 824;;; debug.el ends here 825