summaryrefslogtreecommitdiff
path: root/lisp/emacs-lisp
diff options
context:
space:
mode:
authorMiles Bader <miles@gnu.org>2005-03-10 23:36:47 +0000
committerMiles Bader <miles@gnu.org>2005-03-10 23:36:47 +0000
commit4a670293279d61e9bdf88d9a86caefc6de4e60e3 (patch)
tree29d376c4c602d6ecac1d7d31d56030dc9e8087ca /lisp/emacs-lisp
parent8ab43fb27aa9d02d0ed06e0080f9b4f6e76b94ae (diff)
parent14f56b66c3b1641c90d1390a1381bc27aa91c0e1 (diff)
downloademacs-4a670293279d61e9bdf88d9a86caefc6de4e60e3.tar.gz
emacs-4a670293279d61e9bdf88d9a86caefc6de4e60e3.tar.bz2
emacs-4a670293279d61e9bdf88d9a86caefc6de4e60e3.zip
Revision: miles@gnu.org--gnu-2005/emacs--unicode--0--patch-24
Merge from emacs--cvs-trunk--0 Patches applied: * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0 (patch 166-172) - Update from CVS - Tweak obsolete function/variable warning message - Merge from gnus--rel--5.10 * miles@gnu.org--gnu-2005/gnus--rel--5.10 (patch 38) - Update from CVS
Diffstat (limited to 'lisp/emacs-lisp')
-rw-r--r--lisp/emacs-lisp/bytecomp.el4
-rw-r--r--lisp/emacs-lisp/debug.el39
2 files changed, 23 insertions, 20 deletions
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 3c5a1d14d72..950193463f7 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -1039,7 +1039,7 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'."
(byte-compile-set-symbol-position (car form))
(if (memq 'obsolete byte-compile-warnings)
(byte-compile-warn "`%s' is an obsolete function%s; %s" (car form)
- (if when (concat " since " when) "")
+ (if when (concat " (as of Emacs " when ")") "")
(if (stringp (car new))
(car new)
(format "use `%s' instead." (car new)))))
@@ -2779,7 +2779,7 @@ That command is designed for interactive use only" fn))
(let* ((ob (get var 'byte-obsolete-variable))
(when (cdr ob)))
(byte-compile-warn "`%s' is an obsolete variable%s; %s" var
- (if when (concat " since " when) "")
+ (if when (concat " (as of Emacs " when ")") "")
(if (stringp (car ob))
(car ob)
(format "use `%s' instead." (car ob))))))
diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el
index fc665cb973f..668157fc52a 100644
--- a/lisp/emacs-lisp/debug.el
+++ b/lisp/emacs-lisp/debug.el
@@ -97,14 +97,6 @@ This is to optimize `debugger-make-xrefs'.")
This variable is used by `debugger-jump', `debugger-step-through',
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
(setq debugger 'debug)
;;;###autoload
@@ -200,7 +192,7 @@ first will be printed into the backtrace buffer."
(kill-emacs))
(if (eq (car debugger-args) 'debug)
;; Skip the frames for backtrace-debug, byte-code,
- ;; and debug-entry-code.
+ ;; and implement-debug-on-entry.
(backtrace-debug 4 t))
(message "")
(let ((standard-output nil)
@@ -264,7 +256,7 @@ That buffer should be current already."
(progn
(search-forward "\n debug(")
(forward-line (if (eq (car debugger-args) 'debug)
- 2 ; Remove debug-entry-code frame.
+ 2 ; Remove implement-debug-on-entry frame.
1))
(point)))
(insert "Debugger entered")
@@ -432,8 +424,8 @@ removes itself from that hook."
(count 0))
(while (not (eq (cadr (backtrace-frame count)) 'debug))
(setq count (1+ count)))
- ;; Skip debug-entry-code frame.
- (when (member '(debug (quote debug)) (cdr (backtrace-frame (1+ count))))
+ ;; Skip implement-debug-on-entry frame.
+ (when (eq 'implement-debug-on-entry (cadr (backtrace-frame (1+ count))))
(setq count (1+ count)))
(goto-char (point-min))
(when (looking-at "Debugger entered--\\(Lisp error\\|returning value\\):")
@@ -623,6 +615,16 @@ Complete list of commands:
(use-local-map debugger-mode-map)
(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
(defun debug-on-entry (function)
"Request FUNCTION to invoke debugger each time it is called.
@@ -647,7 +649,7 @@ Redefining FUNCTION also cancels it."
(debug-convert-byte-code function))
(or (consp (symbol-function 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)
(push function debug-function-list))
function)
@@ -664,7 +666,7 @@ If argument is nil or an empty string, cancel for all functions."
(if name (intern name)))))
(if (and function (not (string= function "")))
(progn
- (let ((f (debug-on-entry-1 function (symbol-function function) nil)))
+ (let ((f (debug-on-entry-1 function nil)))
(condition-case nil
(if (and (equal (nth 1 f) '(&rest debug-on-entry-args))
(eq (car (nth 3 f)) 'apply))
@@ -695,8 +697,9 @@ If argument is nil or an empty string, cancel for all functions."
(setq body (cons (documentation function) body)))
(fset function (cons 'lambda (cons (car contents) body)))))))
-(defun debug-on-entry-1 (function defn flag)
- (let ((tail defn))
+(defun debug-on-entry-1 (function flag)
+ (let* ((defn (symbol-function function))
+ (tail defn))
(if (subrp tail)
(error "%s is a built-in function" function)
(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."
;; Skip the interactive form.
(when (eq 'interactive (car-safe (cadr 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.
(if flag
- (setcdr tail (cons debug-entry-code (cdr tail)))
+ (setcdr tail (cons '(implement-debug-on-entry) (cdr tail)))
(setcdr tail (cddr tail))))
defn)))