aboutsummaryrefslogtreecommitdiffstats
path: root/lisp/emacs-lisp/debug.el
diff options
context:
space:
mode:
Diffstat (limited to 'lisp/emacs-lisp/debug.el')
-rw-r--r--lisp/emacs-lisp/debug.el82
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'.")
97This variable is used by `debugger-jump', `debugger-step-through', 99This variable is used by `debugger-jump', `debugger-step-through',
98and `debugger-reenable' to temporarily disable debug-on-entry.") 100and `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.
629If you tell the debugger to continue, FUNCTION's execution proceeds. 659
630This works by modifying the definition of FUNCTION, 660When called interactively, prompt for FUNCTION in the minibuffer.
631which must be written in Lisp, not predefined. 661
662This works by modifying the definition of FUNCTION. If you tell the
663debugger to continue, FUNCTION's execution proceeds. If FUNCTION is a
664normal function or a macro written in Lisp, you can also step through
665its execution. FUNCTION can also be a primitive that is not a special
666form, in which case stepping is not possible. Break-on-entry for
667primitive functions only works when that function is called from Lisp.
668
632Use \\[cancel-debug-on-entry] to cancel the effect of this command. 669Use \\[cancel-debug-on-entry] to cancel the effect of this command.
633Redefining FUNCTION also cancels it." 670Redefining 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.
665If argument is nil or an empty string, cancel for all functions." 702If FUNCTION is nil, cancel debug-on-entry for all functions.
703When called interactively, prompt for FUNCTION in the minibuffer.
704To 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.