Commit 449808f7 authored by Lute Kamstra's avatar Lute Kamstra
Browse files

(debug-entry-code): Delete it.

(implement-debug-on-entry): New function to replace debug-entry-code.
(debug-on-entry-1): Use implement-debug-on-entry.  Delete the second
argument as the 2005-03-07 change makes it obsolete.
(debug-on-entry, cancel-debug-on-entry): Update call to
debug-on-entry-1.
(debug, debugger-setup-buffer): Comment update.
(debugger-frame-number): Update to work with implement-debug-on-entry.
parent 134d277e
2005-03-10 Lute Kamstra <lute@gnu.org>
* emacs-lisp/debug.el (debug-entry-code): Delete it.
(implement-debug-on-entry): New function to replace
debug-entry-code.
(debug-on-entry-1): Use implement-debug-on-entry. Delete the
second argument as the 2005-03-07 change makes it obsolete.
(debug-on-entry, cancel-debug-on-entry): Update call to
debug-on-entry-1.
(debug, debugger-setup-buffer): Comment update.
(debugger-frame-number): Update to work with
implement-debug-on-entry.
2005-03-10 Jay Belanger <belanger@truman.edu> 2005-03-10 Jay Belanger <belanger@truman.edu>
   
* calc/calc-embed.el (math-ms-args): Declare it. * calc/calc-embed.el (math-ms-args): Declare it.
...@@ -19,7 +32,7 @@ ...@@ -19,7 +32,7 @@
(gdb-tooltip-print): Remove newline for tooltip-use-echo-area. (gdb-tooltip-print): Remove newline for tooltip-use-echo-area.
   
* bindings.el (mode-line-mode-menu): Add tooltip-mode to mode-line. * bindings.el (mode-line-mode-menu): Add tooltip-mode to mode-line.
2005-03-09 Kim F. Storm <storm@cua.dk> 2005-03-09 Kim F. Storm <storm@cua.dk>
   
* play/animate.el (animate-place-char): Use forward-line instead * play/animate.el (animate-place-char): Use forward-line instead
...@@ -40,7 +53,7 @@ ...@@ -40,7 +53,7 @@
set-case-syntax-set-multibyte is nil. set-case-syntax-set-multibyte is nil.
   
* textmodes/ispell.el (ispell-insert-word): New function. * textmodes/ispell.el (ispell-insert-word): New function.
(ispell-word): Use ispell-insert-word to isnert a new word. (ispell-word): Use ispell-insert-word to insert a new word.
(ispell-process-line): Likewise (ispell-process-line): Likewise
(ispell-complete-word): Likewise. (ispell-complete-word): Likewise.
   
......
...@@ -97,14 +97,6 @@ This is to optimize `debugger-make-xrefs'.") ...@@ -97,14 +97,6 @@ This is to optimize `debugger-make-xrefs'.")
This variable is used by `debugger-jump', `debugger-step-through', This variable is used by `debugger-jump', `debugger-step-through',
and `debugger-reenable' to temporarily disable debug-on-entry.") and `debugger-reenable' to temporarily disable debug-on-entry.")
;; 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.")
;;;###autoload ;;;###autoload
(setq debugger 'debug) (setq debugger 'debug)
;;;###autoload ;;;###autoload
...@@ -200,7 +192,7 @@ first will be printed into the backtrace buffer." ...@@ -200,7 +192,7 @@ first will be printed into the backtrace buffer."
(kill-emacs)) (kill-emacs))
(if (eq (car debugger-args) 'debug) (if (eq (car debugger-args) 'debug)
;; Skip the frames for backtrace-debug, byte-code, ;; Skip the frames for backtrace-debug, byte-code,
;; and debug-entry-code. ;; and implement-debug-on-entry.
(backtrace-debug 4 t)) (backtrace-debug 4 t))
(message "") (message "")
(let ((standard-output nil) (let ((standard-output nil)
...@@ -264,7 +256,7 @@ That buffer should be current already." ...@@ -264,7 +256,7 @@ That buffer should be current already."
(progn (progn
(search-forward "\n debug(") (search-forward "\n debug(")
(forward-line (if (eq (car debugger-args) 'debug) (forward-line (if (eq (car debugger-args) 'debug)
2 ; Remove debug-entry-code frame. 2 ; Remove implement-debug-on-entry frame.
1)) 1))
(point))) (point)))
(insert "Debugger entered") (insert "Debugger entered")
...@@ -432,8 +424,8 @@ removes itself from that hook." ...@@ -432,8 +424,8 @@ removes itself from that hook."
(count 0)) (count 0))
(while (not (eq (cadr (backtrace-frame count)) 'debug)) (while (not (eq (cadr (backtrace-frame count)) 'debug))
(setq count (1+ count))) (setq count (1+ count)))
;; Skip debug-entry-code frame. ;; Skip implement-debug-on-entry frame.
(when (member '(debug (quote debug)) (cdr (backtrace-frame (1+ count)))) (when (eq 'implement-debug-on-entry (cadr (backtrace-frame (1+ count))))
(setq count (1+ count))) (setq count (1+ count)))
(goto-char (point-min)) (goto-char (point-min))
(when (looking-at "Debugger entered--\\(Lisp error\\|returning value\\):") (when (looking-at "Debugger entered--\\(Lisp error\\|returning value\\):")
...@@ -623,6 +615,16 @@ Complete list of commands: ...@@ -623,6 +615,16 @@ Complete list of commands:
(use-local-map debugger-mode-map) (use-local-map debugger-mode-map)
(run-mode-hooks 'debugger-mode-hook)) (run-mode-hooks 'debugger-mode-hook))
;; When you change this, you may also need to change the number of
;; frames that the debugger skips.
(defun implement-debug-on-entry ()
"Conditionally call the debugger.
A call to this function is inserted by `debug-on-entry' to cause
functions to break on entry."
(if (or inhibit-debug-on-entry debugger-jumping-flag)
nil
(funcall debugger 'debug)))
;;;###autoload ;;;###autoload
(defun debug-on-entry (function) (defun debug-on-entry (function)
"Request FUNCTION to invoke debugger each time it is called. "Request FUNCTION to invoke debugger each time it is called.
...@@ -647,7 +649,7 @@ Redefining FUNCTION also cancels it." ...@@ -647,7 +649,7 @@ Redefining FUNCTION also cancels it."
(debug-convert-byte-code function)) (debug-convert-byte-code function))
(or (consp (symbol-function function)) (or (consp (symbol-function function))
(error "Definition of %s is not a list" function)) (error "Definition of %s is not a list" function))
(fset function (debug-on-entry-1 function (symbol-function function) t)) (fset function (debug-on-entry-1 function t))
(or (memq function debug-function-list) (or (memq function debug-function-list)
(push function debug-function-list)) (push function debug-function-list))
function) function)
...@@ -664,7 +666,7 @@ If argument is nil or an empty string, cancel for all functions." ...@@ -664,7 +666,7 @@ If argument is nil or an empty string, cancel for all functions."
(if name (intern name))))) (if name (intern name)))))
(if (and function (not (string= function ""))) (if (and function (not (string= function "")))
(progn (progn
(let ((f (debug-on-entry-1 function (symbol-function function) nil))) (let ((f (debug-on-entry-1 function nil)))
(condition-case nil (condition-case nil
(if (and (equal (nth 1 f) '(&rest debug-on-entry-args)) (if (and (equal (nth 1 f) '(&rest debug-on-entry-args))
(eq (car (nth 3 f)) 'apply)) (eq (car (nth 3 f)) 'apply))
...@@ -695,8 +697,9 @@ If argument is nil or an empty string, cancel for all functions." ...@@ -695,8 +697,9 @@ If argument is nil or an empty string, cancel for all functions."
(setq body (cons (documentation function) body))) (setq body (cons (documentation function) body)))
(fset function (cons 'lambda (cons (car contents) body))))))) (fset function (cons 'lambda (cons (car contents) body)))))))
(defun debug-on-entry-1 (function defn flag) (defun debug-on-entry-1 (function flag)
(let ((tail defn)) (let* ((defn (symbol-function function))
(tail defn))
(if (subrp tail) (if (subrp tail)
(error "%s is a built-in function" function) (error "%s is a built-in function" function)
(if (eq (car tail) 'macro) (setq tail (cdr tail))) (if (eq (car tail) 'macro) (setq tail (cdr tail)))
...@@ -708,10 +711,10 @@ If argument is nil or an empty string, cancel for all functions." ...@@ -708,10 +711,10 @@ If argument is nil or an empty string, cancel for all functions."
;; Skip the interactive form. ;; Skip the interactive form.
(when (eq 'interactive (car-safe (cadr tail))) (when (eq 'interactive (car-safe (cadr tail)))
(setq tail (cdr tail))) (setq tail (cdr tail)))
(unless (eq flag (equal (cadr tail) debug-entry-code)) (unless (eq flag (equal (cadr tail) '(implement-debug-on-entry)))
;; Add/remove debug statement as needed. ;; Add/remove debug statement as needed.
(if flag (if flag
(setcdr tail (cons debug-entry-code (cdr tail))) (setcdr tail (cons '(implement-debug-on-entry) (cdr tail)))
(setcdr tail (cddr tail)))) (setcdr tail (cddr tail))))
defn))) defn)))
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment