97 |
This variable is used by `debugger-jump', `debugger-step-through', |
This variable is used by `debugger-jump', `debugger-step-through', |
98 |
and `debugger-reenable' to temporarily disable debug-on-entry.") |
and `debugger-reenable' to temporarily disable debug-on-entry.") |
99 |
|
|
|
;; When you change this, you may also need to change the number of |
|
|
;; frames that the debugger skips. |
|
|
(defconst debug-entry-code |
|
|
'(if (or inhibit-debug-on-entry debugger-jumping-flag) |
|
|
nil |
|
|
(debug 'debug)) |
|
|
"Code added to a function to cause it to call the debugger upon entry.") |
|
|
|
|
100 |
;;;###autoload |
;;;###autoload |
101 |
(setq debugger 'debug) |
(setq debugger 'debug) |
102 |
;;;###autoload |
;;;###autoload |
192 |
(kill-emacs)) |
(kill-emacs)) |
193 |
(if (eq (car debugger-args) 'debug) |
(if (eq (car debugger-args) 'debug) |
194 |
;; Skip the frames for backtrace-debug, byte-code, |
;; Skip the frames for backtrace-debug, byte-code, |
195 |
;; and debug-entry-code. |
;; and implement-debug-on-entry. |
196 |
(backtrace-debug 4 t)) |
(backtrace-debug 4 t)) |
197 |
(message "") |
(message "") |
198 |
(let ((standard-output nil) |
(let ((standard-output nil) |
256 |
(progn |
(progn |
257 |
(search-forward "\n debug(") |
(search-forward "\n debug(") |
258 |
(forward-line (if (eq (car debugger-args) 'debug) |
(forward-line (if (eq (car debugger-args) 'debug) |
259 |
2 ; Remove debug-entry-code frame. |
2 ; Remove implement-debug-on-entry frame. |
260 |
1)) |
1)) |
261 |
(point))) |
(point))) |
262 |
(insert "Debugger entered") |
(insert "Debugger entered") |
424 |
(count 0)) |
(count 0)) |
425 |
(while (not (eq (cadr (backtrace-frame count)) 'debug)) |
(while (not (eq (cadr (backtrace-frame count)) 'debug)) |
426 |
(setq count (1+ count))) |
(setq count (1+ count))) |
427 |
;; Skip debug-entry-code frame. |
;; Skip implement-debug-on-entry frame. |
428 |
(when (member '(debug (quote debug)) (cdr (backtrace-frame (1+ count)))) |
(when (eq 'implement-debug-on-entry (cadr (backtrace-frame (1+ count)))) |
429 |
(setq count (1+ count))) |
(setq count (1+ count))) |
430 |
(goto-char (point-min)) |
(goto-char (point-min)) |
431 |
(when (looking-at "Debugger entered--\\(Lisp error\\|returning value\\):") |
(when (looking-at "Debugger entered--\\(Lisp error\\|returning value\\):") |
615 |
(use-local-map debugger-mode-map) |
(use-local-map debugger-mode-map) |
616 |
(run-mode-hooks 'debugger-mode-hook)) |
(run-mode-hooks 'debugger-mode-hook)) |
617 |
|
|
618 |
|
;; When you change this, you may also need to change the number of |
619 |
|
;; frames that the debugger skips. |
620 |
|
(defun implement-debug-on-entry () |
621 |
|
"Conditionally call the debugger. |
622 |
|
A call to this function is inserted by `debug-on-entry' to cause |
623 |
|
functions to break on entry." |
624 |
|
(if (or inhibit-debug-on-entry debugger-jumping-flag) |
625 |
|
nil |
626 |
|
(funcall debugger 'debug))) |
627 |
|
|
628 |
;;;###autoload |
;;;###autoload |
629 |
(defun debug-on-entry (function) |
(defun debug-on-entry (function) |
630 |
"Request FUNCTION to invoke debugger each time it is called. |
"Request FUNCTION to invoke debugger each time it is called. |
649 |
(debug-convert-byte-code function)) |
(debug-convert-byte-code function)) |
650 |
(or (consp (symbol-function function)) |
(or (consp (symbol-function function)) |
651 |
(error "Definition of %s is not a list" function)) |
(error "Definition of %s is not a list" function)) |
652 |
(fset function (debug-on-entry-1 function (symbol-function function) t)) |
(fset function (debug-on-entry-1 function t)) |
653 |
(or (memq function debug-function-list) |
(or (memq function debug-function-list) |
654 |
(push function debug-function-list)) |
(push function debug-function-list)) |
655 |
function) |
function) |
666 |
(if name (intern name))))) |
(if name (intern name))))) |
667 |
(if (and function (not (string= function ""))) |
(if (and function (not (string= function ""))) |
668 |
(progn |
(progn |
669 |
(let ((f (debug-on-entry-1 function (symbol-function function) nil))) |
(let ((f (debug-on-entry-1 function nil))) |
670 |
(condition-case nil |
(condition-case nil |
671 |
(if (and (equal (nth 1 f) '(&rest debug-on-entry-args)) |
(if (and (equal (nth 1 f) '(&rest debug-on-entry-args)) |
672 |
(eq (car (nth 3 f)) 'apply)) |
(eq (car (nth 3 f)) 'apply)) |
697 |
(setq body (cons (documentation function) body))) |
(setq body (cons (documentation function) body))) |
698 |
(fset function (cons 'lambda (cons (car contents) body))))))) |
(fset function (cons 'lambda (cons (car contents) body))))))) |
699 |
|
|
700 |
(defun debug-on-entry-1 (function defn flag) |
(defun debug-on-entry-1 (function flag) |
701 |
(let ((tail defn)) |
(let* ((defn (symbol-function function)) |
702 |
|
(tail defn)) |
703 |
(if (subrp tail) |
(if (subrp tail) |
704 |
(error "%s is a built-in function" function) |
(error "%s is a built-in function" function) |
705 |
(if (eq (car tail) 'macro) (setq tail (cdr tail))) |
(if (eq (car tail) 'macro) (setq tail (cdr tail))) |
711 |
;; Skip the interactive form. |
;; Skip the interactive form. |
712 |
(when (eq 'interactive (car-safe (cadr tail))) |
(when (eq 'interactive (car-safe (cadr tail))) |
713 |
(setq tail (cdr tail))) |
(setq tail (cdr tail))) |
714 |
(unless (eq flag (equal (cadr tail) debug-entry-code)) |
(unless (eq flag (equal (cadr tail) '(implement-debug-on-entry))) |
715 |
;; Add/remove debug statement as needed. |
;; Add/remove debug statement as needed. |
716 |
(if flag |
(if flag |
717 |
(setcdr tail (cons debug-entry-code (cdr tail))) |
(setcdr tail (cons '(implement-debug-on-entry) (cdr tail))) |
718 |
(setcdr tail (cddr tail)))) |
(setcdr tail (cddr tail)))) |
719 |
defn))) |
defn))) |
720 |
|
|