aboutsummaryrefslogtreecommitdiffstats
path: root/lisp/emacs-lisp/debug.el
diff options
context:
space:
mode:
authorKaroly Lorentey2005-06-15 12:57:51 +0000
committerKaroly Lorentey2005-06-15 12:57:51 +0000
commitef85512e51f043d73788f00a2aed13cccde0682c (patch)
treefc1fa1378533250f260ef8eaa9a84ae882d9df84 /lisp/emacs-lisp/debug.el
parent8736257554f49445f7b4402ac7a9436b38ce6452 (diff)
parentef88a9999004e6c26148c8d280d6a41f623d7249 (diff)
downloademacs-ef85512e51f043d73788f00a2aed13cccde0682c.tar.gz
emacs-ef85512e51f043d73788f00a2aed13cccde0682c.zip
Merged from miles@gnu.org--gnu-2005 (patch 80-82, 350-422)
Patches applied: * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-350 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-351 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-352 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-353 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-354 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-355 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-356 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-357 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-358 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-359 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-360 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-361 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-362 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-363 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-364 Remove "-face" suffix from widget faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-365 Remove "-face" suffix from custom faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-366 Remove "-face" suffix from change-log faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-367 Remove "-face" suffix from compilation faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-368 Remove "-face" suffix from diff-mode faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-369 lisp/longlines.el (longlines-visible-face): Face removed * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-370 Remove "-face" suffix from woman faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-371 Remove "-face" suffix from whitespace-highlight face * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-372 Remove "-face" suffix from ruler-mode faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-373 Remove "-face" suffix from show-paren faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-374 Remove "-face" suffix from log-view faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-375 Remove "-face" suffix from smerge faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-376 Remove "-face" suffix from show-tabs faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-377 Remove "-face" suffix from highlight-changes faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-378 Remove "-face" suffix from and downcase info faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-379 Remove "-face" suffix from pcvs faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-380 Update uses of renamed pcvs faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-381 Tweak ChangeLog * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-382 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-383 Remove "-face" suffix from strokes-char face * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-384 Remove "-face" suffix from compare-windows face * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-385 Remove "-face" suffix from calendar faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-386 Remove "-face" suffix from diary-button face * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-387 Remove "-face" suffix from testcover faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-388 Remove "-face" suffix from viper faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-389 Remove "-face" suffix from org faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-390 Remove "-face" suffix from sgml-namespace face * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-391 Remove "-face" suffix from table-cell face * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-392 Remove "-face" suffix from tex-mode faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-393 Remove "-face" suffix from texinfo-heading face * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-394 Remove "-face" suffix from flyspell faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-395 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-396 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-397 Remove "-face" suffix from gomoku faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-398 Remove "-face" suffix from mpuz faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-399 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-400 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-401 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-402 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-403 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-404 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-405 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-406 Merge from gnus--rel--5.10 * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-407 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-408 Remove "-face" suffix from Buffer-menu-buffer face * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-409 Remove "-face" suffix from antlr-mode faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-410 Remove "-face" suffix from ebrowse faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-411 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-412 Remove "-face" suffix from flymake faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-413 Remove "-face" suffix from idlwave faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-414 Remove "-face" suffix from sh-script faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-415 Remove "-face" suffix from vhdl-mode faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-416 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-417 Remove "-face" suffix from which-func face * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-418 Remove "-face" suffix from cperl-mode faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-419 Remove "-face" suffix from ld-script faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-420 Fix cperl-mode font-lock problem * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-421 Tweak which-func face * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-422 Update from CVS * miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-80 Merge from emacs--cvs-trunk--0 * miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-81 Update from CVS * miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-82 Update from CVS git-archimport-id: lorentey@elte.hu--2004/emacs--multi-tty--0--patch-350
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.