diff options
Diffstat (limited to 'lisp/emacs-lisp/debug.el')
| -rw-r--r-- | lisp/emacs-lisp/debug.el | 82 |
1 files changed, 62 insertions, 20 deletions
diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el index 2149cba8720..0ee67355bf4 100644 --- a/lisp/emacs-lisp/debug.el +++ b/lisp/emacs-lisp/debug.el | |||
| @@ -88,6 +88,8 @@ This is to optimize `debugger-make-xrefs'.") | |||
| 88 | (defvar debugger-outer-standard-output) | 88 | (defvar debugger-outer-standard-output) |
| 89 | (defvar debugger-outer-inhibit-redisplay) | 89 | (defvar debugger-outer-inhibit-redisplay) |
| 90 | (defvar debugger-outer-cursor-in-echo-area) | 90 | (defvar debugger-outer-cursor-in-echo-area) |
| 91 | (defvar debugger-will-be-back nil | ||
| 92 | "Non-nil if we expect to get back in the debugger soon.") | ||
| 91 | 93 | ||
| 92 | (defvar inhibit-debug-on-entry nil | 94 | (defvar inhibit-debug-on-entry nil |
| 93 | "Non-nil means that debug-on-entry is disabled.") | 95 | "Non-nil means that debug-on-entry is disabled.") |
| @@ -97,6 +99,8 @@ This is to optimize `debugger-make-xrefs'.") | |||
| 97 | This variable is used by `debugger-jump', `debugger-step-through', | 99 | This variable is used by `debugger-jump', `debugger-step-through', |
| 98 | and `debugger-reenable' to temporarily disable debug-on-entry.") | 100 | and `debugger-reenable' to temporarily disable debug-on-entry.") |
| 99 | 101 | ||
| 102 | (defvar inhibit-trace) ;Not yet implemented. | ||
| 103 | |||
| 100 | ;;;###autoload | 104 | ;;;###autoload |
| 101 | (setq debugger 'debug) | 105 | (setq debugger 'debug) |
| 102 | ;;;###autoload | 106 | ;;;###autoload |
| @@ -121,6 +125,7 @@ first will be printed into the backtrace buffer." | |||
| 121 | (get-buffer-create "*Backtrace*"))) | 125 | (get-buffer-create "*Backtrace*"))) |
| 122 | (debugger-old-buffer (current-buffer)) | 126 | (debugger-old-buffer (current-buffer)) |
| 123 | (debugger-step-after-exit nil) | 127 | (debugger-step-after-exit nil) |
| 128 | (debugger-will-be-back nil) | ||
| 124 | ;; Don't keep reading from an executing kbd macro! | 129 | ;; Don't keep reading from an executing kbd macro! |
| 125 | (executing-kbd-macro nil) | 130 | (executing-kbd-macro nil) |
| 126 | ;; Save the outer values of these vars for the `e' command | 131 | ;; Save the outer values of these vars for the `e' command |
| @@ -178,7 +183,7 @@ first will be printed into the backtrace buffer." | |||
| 178 | ;; Place an extra debug-on-exit for macro's. | 183 | ;; Place an extra debug-on-exit for macro's. |
| 179 | (when (eq 'lambda (car-safe (cadr (backtrace-frame 4)))) | 184 | (when (eq 'lambda (car-safe (cadr (backtrace-frame 4)))) |
| 180 | (backtrace-debug 5 t))) | 185 | (backtrace-debug 5 t))) |
| 181 | (pop-to-buffer debugger-buffer) | 186 | (pop-to-buffer debugger-buffer) |
| 182 | (debugger-mode) | 187 | (debugger-mode) |
| 183 | (debugger-setup-buffer debugger-args) | 188 | (debugger-setup-buffer debugger-args) |
| 184 | (when noninteractive | 189 | (when noninteractive |
| @@ -210,12 +215,23 @@ first will be printed into the backtrace buffer." | |||
| 210 | ;; Still visible despite the save-window-excursion? Maybe it | 215 | ;; Still visible despite the save-window-excursion? Maybe it |
| 211 | ;; it's in a pop-up frame. It would be annoying to delete and | 216 | ;; it's in a pop-up frame. It would be annoying to delete and |
| 212 | ;; recreate it every time the debugger stops, so instead we'll | 217 | ;; recreate it every time the debugger stops, so instead we'll |
| 213 | ;; erase it and hide it but keep it alive. | 218 | ;; erase it (and maybe hide it) but keep it alive. |
| 214 | (with-current-buffer debugger-buffer | 219 | (with-current-buffer debugger-buffer |
| 215 | (erase-buffer) | 220 | (erase-buffer) |
| 216 | (fundamental-mode) | 221 | (fundamental-mode) |
| 217 | (with-selected-window (get-buffer-window debugger-buffer 0) | 222 | (with-selected-window (get-buffer-window debugger-buffer 0) |
| 218 | (bury-buffer))) | 223 | (when (and (window-dedicated-p (selected-window)) |
| 224 | (not debugger-will-be-back)) | ||
| 225 | ;; If the window is not dedicated, burying the buffer | ||
| 226 | ;; will mean that the frame created for it is left | ||
| 227 | ;; around showing some random buffer, and next time we | ||
| 228 | ;; pop to the debugger buffer we'll create yet | ||
| 229 | ;; another frame. | ||
| 230 | ;; If debugger-will-be-back is non-nil, the frame | ||
| 231 | ;; would need to be de-iconified anyway immediately | ||
| 232 | ;; after when we re-enter the debugger, so iconifying it | ||
| 233 | ;; here would cause flashing. | ||
| 234 | (bury-buffer)))) | ||
| 219 | (kill-buffer debugger-buffer)) | 235 | (kill-buffer debugger-buffer)) |
| 220 | (set-match-data debugger-outer-match-data))) | 236 | (set-match-data debugger-outer-match-data))) |
| 221 | ;; Put into effect the modified values of these variables | 237 | ;; Put into effect the modified values of these variables |
| @@ -307,7 +323,7 @@ That buffer should be current already." | |||
| 307 | (save-excursion | 323 | (save-excursion |
| 308 | (set-buffer (or buffer (current-buffer))) | 324 | (set-buffer (or buffer (current-buffer))) |
| 309 | (setq buffer (current-buffer)) | 325 | (setq buffer (current-buffer)) |
| 310 | (let ((buffer-read-only nil) | 326 | (let ((inhibit-read-only t) |
| 311 | (old-end (point-min)) (new-end (point-min))) | 327 | (old-end (point-min)) (new-end (point-min))) |
| 312 | ;; If we saved an old backtrace, find the common part | 328 | ;; If we saved an old backtrace, find the common part |
| 313 | ;; between the new and the old. | 329 | ;; between the new and the old. |
| @@ -377,6 +393,7 @@ Enter another debugger on next entry to eval, apply or funcall." | |||
| 377 | (interactive) | 393 | (interactive) |
| 378 | (setq debugger-step-after-exit t) | 394 | (setq debugger-step-after-exit t) |
| 379 | (setq debugger-jumping-flag t) | 395 | (setq debugger-jumping-flag t) |
| 396 | (setq debugger-will-be-back t) | ||
| 380 | (add-hook 'post-command-hook 'debugger-reenable) | 397 | (add-hook 'post-command-hook 'debugger-reenable) |
| 381 | (message "Proceeding, will debug on next eval or call.") | 398 | (message "Proceeding, will debug on next eval or call.") |
| 382 | (exit-recursive-edit)) | 399 | (exit-recursive-edit)) |
| @@ -387,6 +404,12 @@ Enter another debugger on next entry to eval, apply or funcall." | |||
| 387 | (unless debugger-may-continue | 404 | (unless debugger-may-continue |
| 388 | (error "Cannot continue")) | 405 | (error "Cannot continue")) |
| 389 | (message "Continuing.") | 406 | (message "Continuing.") |
| 407 | (save-excursion | ||
| 408 | ;; Check to see if we've flagged some frame for debug-on-exit, in which | ||
| 409 | ;; case we'll probably come back to the debugger soon. | ||
| 410 | (goto-char (point-min)) | ||
| 411 | (if (re-search-forward "^\\* " nil t) | ||
| 412 | (setq debugger-will-be-back t))) | ||
| 390 | (exit-recursive-edit)) | 413 | (exit-recursive-edit)) |
| 391 | 414 | ||
| 392 | (defun debugger-return-value (val) | 415 | (defun debugger-return-value (val) |
| @@ -397,6 +420,12 @@ will be used, such as in a debug on exit from a frame." | |||
| 397 | (setq debugger-value val) | 420 | (setq debugger-value val) |
| 398 | (princ "Returning " t) | 421 | (princ "Returning " t) |
| 399 | (prin1 debugger-value) | 422 | (prin1 debugger-value) |
| 423 | (save-excursion | ||
| 424 | ;; Check to see if we've flagged some frame for debug-on-exit, in which | ||
| 425 | ;; case we'll probably come back to the debugger soon. | ||
| 426 | (goto-char (point-min)) | ||
| 427 | (if (re-search-forward "^\\* " nil t) | ||
| 428 | (setq debugger-will-be-back t))) | ||
| 400 | (exit-recursive-edit)) | 429 | (exit-recursive-edit)) |
| 401 | 430 | ||
| 402 | (defun debugger-jump () | 431 | (defun debugger-jump () |
| @@ -406,6 +435,7 @@ will be used, such as in a debug on exit from a frame." | |||
| 406 | (setq debugger-jumping-flag t) | 435 | (setq debugger-jumping-flag t) |
| 407 | (add-hook 'post-command-hook 'debugger-reenable) | 436 | (add-hook 'post-command-hook 'debugger-reenable) |
| 408 | (message "Continuing through this frame") | 437 | (message "Continuing through this frame") |
| 438 | (setq debugger-will-be-back t) | ||
| 409 | (exit-recursive-edit)) | 439 | (exit-recursive-edit)) |
| 410 | 440 | ||
| 411 | (defun debugger-reenable () | 441 | (defun debugger-reenable () |
| @@ -454,7 +484,7 @@ Applies to the frame whose line point is on in the backtrace." | |||
| 454 | (beginning-of-line) | 484 | (beginning-of-line) |
| 455 | (backtrace-debug (debugger-frame-number) t) | 485 | (backtrace-debug (debugger-frame-number) t) |
| 456 | (if (= (following-char) ? ) | 486 | (if (= (following-char) ? ) |
| 457 | (let ((buffer-read-only nil)) | 487 | (let ((inhibit-read-only t)) |
| 458 | (delete-char 1) | 488 | (delete-char 1) |
| 459 | (insert ?*))) | 489 | (insert ?*))) |
| 460 | (beginning-of-line)) | 490 | (beginning-of-line)) |
| @@ -470,7 +500,7 @@ Applies to the frame whose line point is on in the backtrace." | |||
| 470 | (beginning-of-line) | 500 | (beginning-of-line) |
| 471 | (backtrace-debug (debugger-frame-number) nil) | 501 | (backtrace-debug (debugger-frame-number) nil) |
| 472 | (if (= (following-char) ?*) | 502 | (if (= (following-char) ?*) |
| 473 | (let ((buffer-read-only nil)) | 503 | (let ((inhibit-read-only t)) |
| 474 | (delete-char 1) | 504 | (delete-char 1) |
| 475 | (insert ? ))) | 505 | (insert ? ))) |
| 476 | (beginning-of-line)) | 506 | (beginning-of-line)) |
| @@ -584,7 +614,7 @@ Applies to the frame whose line point is on in the backtrace." | |||
| 584 | (terpri)) | 614 | (terpri)) |
| 585 | 615 | ||
| 586 | (with-current-buffer (get-buffer debugger-record-buffer) | 616 | (with-current-buffer (get-buffer debugger-record-buffer) |
| 587 | (message "%s" | 617 | (message "%s" |
| 588 | (buffer-substring (line-beginning-position 0) | 618 | (buffer-substring (line-beginning-position 0) |
| 589 | (line-end-position 0))))) | 619 | (line-end-position 0))))) |
| 590 | 620 | ||
| @@ -626,22 +656,29 @@ functions to break on entry." | |||
| 626 | ;;;###autoload | 656 | ;;;###autoload |
| 627 | (defun debug-on-entry (function) | 657 | (defun debug-on-entry (function) |
| 628 | "Request FUNCTION to invoke debugger each time it is called. | 658 | "Request FUNCTION to invoke debugger each time it is called. |
| 629 | If you tell the debugger to continue, FUNCTION's execution proceeds. | 659 | |
| 630 | This works by modifying the definition of FUNCTION, | 660 | When called interactively, prompt for FUNCTION in the minibuffer. |
| 631 | which must be written in Lisp, not predefined. | 661 | |
| 662 | This works by modifying the definition of FUNCTION. If you tell the | ||
| 663 | debugger to continue, FUNCTION's execution proceeds. If FUNCTION is a | ||
| 664 | normal function or a macro written in Lisp, you can also step through | ||
| 665 | its execution. FUNCTION can also be a primitive that is not a special | ||
| 666 | form, in which case stepping is not possible. Break-on-entry for | ||
| 667 | primitive functions only works when that function is called from Lisp. | ||
| 668 | |||
| 632 | Use \\[cancel-debug-on-entry] to cancel the effect of this command. | 669 | Use \\[cancel-debug-on-entry] to cancel the effect of this command. |
| 633 | Redefining FUNCTION also cancels it." | 670 | Redefining FUNCTION also cancels it." |
| 634 | (interactive "aDebug on entry (to function): ") | 671 | (interactive "aDebug on entry (to function): ") |
| 635 | (when (and (subrp (symbol-function function)) | 672 | (when (and (subrp (symbol-function function)) |
| 636 | (eq (cdr (subr-arity (symbol-function function))) 'unevalled)) | 673 | (eq (cdr (subr-arity (symbol-function function))) 'unevalled)) |
| 637 | (error "Function %s is a special form" function)) | 674 | (error "Function %s is a special form" function)) |
| 638 | (if (or (symbolp (symbol-function function)) | 675 | (if (or (symbolp (symbol-function function)) |
| 639 | (subrp (symbol-function function))) | 676 | (subrp (symbol-function function))) |
| 640 | ;; The function is built-in or aliased to another function. | 677 | ;; The function is built-in or aliased to another function. |
| 641 | ;; Create a wrapper in which we can add the debug call. | 678 | ;; Create a wrapper in which we can add the debug call. |
| 642 | (fset function `(lambda (&rest debug-on-entry-args) | 679 | (fset function `(lambda (&rest debug-on-entry-args) |
| 643 | ,(interactive-form (symbol-function function)) | 680 | ,(interactive-form (symbol-function function)) |
| 644 | (apply ',(symbol-function function) | 681 | (apply ',(symbol-function function) |
| 645 | debug-on-entry-args))) | 682 | debug-on-entry-args))) |
| 646 | (when (eq (car-safe (symbol-function function)) 'autoload) | 683 | (when (eq (car-safe (symbol-function function)) 'autoload) |
| 647 | ;; The function is autoloaded. Load its real definition. | 684 | ;; The function is autoloaded. Load its real definition. |
| @@ -662,14 +699,19 @@ Redefining FUNCTION also cancels it." | |||
| 662 | ;;;###autoload | 699 | ;;;###autoload |
| 663 | (defun cancel-debug-on-entry (&optional function) | 700 | (defun cancel-debug-on-entry (&optional function) |
| 664 | "Undo effect of \\[debug-on-entry] on FUNCTION. | 701 | "Undo effect of \\[debug-on-entry] on FUNCTION. |
| 665 | If argument is nil or an empty string, cancel for all functions." | 702 | If FUNCTION is nil, cancel debug-on-entry for all functions. |
| 703 | When called interactively, prompt for FUNCTION in the minibuffer. | ||
| 704 | To specify a nil argument interactively, exit with an empty minibuffer." | ||
| 666 | (interactive | 705 | (interactive |
| 667 | (list (let ((name | 706 | (list (let ((name |
| 668 | (completing-read "Cancel debug on entry (to function): " | 707 | (completing-read |
| 669 | (mapcar 'symbol-name debug-function-list) | 708 | "Cancel debug on entry to function (default: all functions): " |
| 670 | nil t nil))) | 709 | (mapcar 'symbol-name debug-function-list) nil t))) |
| 671 | (if name (intern name))))) | 710 | (when name |
| 672 | (if (and function (not (string= function ""))) | 711 | (unless (string= name "") |
| 712 | (intern name)))))) | ||
| 713 | (if (and function | ||
| 714 | (not (string= function ""))) ; Pre 22.1 compatibility test. | ||
| 673 | (progn | 715 | (progn |
| 674 | (let ((defn (debug-on-entry-1 function nil))) | 716 | (let ((defn (debug-on-entry-1 function nil))) |
| 675 | (condition-case nil | 717 | (condition-case nil |
| @@ -709,7 +751,7 @@ If argument is nil or an empty string, cancel for all functions." | |||
| 709 | (defun debug-on-entry-1 (function flag) | 751 | (defun debug-on-entry-1 (function flag) |
| 710 | (let* ((defn (symbol-function function)) | 752 | (let* ((defn (symbol-function function)) |
| 711 | (tail defn)) | 753 | (tail defn)) |
| 712 | (when (eq (car-safe tail) 'macro) | 754 | (when (eq (car-safe tail) 'macro) |
| 713 | (setq tail (cdr tail))) | 755 | (setq tail (cdr tail))) |
| 714 | (if (not (eq (car-safe tail) 'lambda)) | 756 | (if (not (eq (car-safe tail) 'lambda)) |
| 715 | ;; Only signal an error when we try to set debug-on-entry. | 757 | ;; Only signal an error when we try to set debug-on-entry. |