# HG changeset patch # User Stefan Monnier # Date 1026073349 0 # Node ID 4a0f567d3c5fa6861e7591d1d203911851dfc2c7 # Parent 00a9017b13654d828cfec3a541c6d16d22c5876f (debug-on-entry): Fix the wrapper used for aliases to also work for interactive functions. Use the same wrapper for subroutines. (cancel-debug-on-entry): Get rid of the now-useless wrapper. (debug-on-entry-1): Correctly skip docstrings and interactive forms. diff -r 00a9017b1365 -r 4a0f567d3c5f lisp/emacs-lisp/debug.el --- a/lisp/emacs-lisp/debug.el Sun Jul 07 20:14:28 2002 +0000 +++ b/lisp/emacs-lisp/debug.el Sun Jul 07 20:22:29 2002 +0000 @@ -611,12 +611,16 @@ (interactive "aDebug on entry (to function): ") (debugger-reenable) ;; Handle a function that has been aliased to some other function. - (if (symbolp (symbol-function function)) + (if (and (subrp (symbol-function function)) + (eq (cdr (subr-arity (symbol-function function))) 'unevalled)) + (error "Function %s is a special form" function)) + (if (or (symbolp (symbol-function function)) + (subrp (symbol-function function))) + ;; Create a wrapper in which we can then add the necessary debug call. (fset function `(lambda (&rest debug-on-entry-args) + ,(interactive-form (symbol-function function)) (apply ',(symbol-function function) debug-on-entry-args)))) - (if (subrp (symbol-function function)) - (error "Function %s is a primitive" function)) (or (consp (symbol-function function)) (debug-convert-byte-code function)) (or (consp (symbol-function function)) @@ -639,8 +643,15 @@ (debugger-reenable) (if (and function (not (string= function ""))) (progn - (fset function - (debug-on-entry-1 function (symbol-function function) nil)) + (let ((f (debug-on-entry-1 function (symbol-function function) nil))) + (condition-case nil + (if (and (equal (nth 1 f) '(&rest debug-on-entry-args)) + (eq (car (nth 3 f)) 'apply)) + ;; `f' is a wrapper introduced in debug-on-entry. + ;; Get rid of it since we don't need it any more. + (setq f (nth 1 (nth 1 (nth 3 f))))) + (error nil)) + (fset function f)) (setq debug-function-list (delq function debug-function-list)) function) (message "Cancelling debug-on-entry for all functions") @@ -670,18 +681,19 @@ (debug-on-entry-1 function (cdr defn) flag) (or (eq (car defn) 'lambda) (error "%s not user-defined Lisp function" function)) - (let (tail prec) - (if (stringp (car (nthcdr 2 defn))) - (setq tail (nthcdr 3 defn) - prec (list (car defn) (car (cdr defn)) - (car (cdr (cdr defn))))) - (setq tail (nthcdr 2 defn) - prec (list (car defn) (car (cdr defn))))) - (if (eq flag (equal (car tail) '(debug 'debug))) - defn - (if flag - (nconc prec (cons '(debug 'debug) tail)) - (nconc prec (cdr tail)))))))) + (let ((tail (cddr defn))) + ;; Skip the docstring. + (if (stringp (car tail)) (setq tail (cdr tail))) + ;; Skip the interactive form. + (if (eq 'interactive (car-safe (car tail))) (setq tail (cdr tail))) + (unless (eq flag (equal (car tail) '(debug 'debug))) + ;; Add/remove debug statement as needed. + (if (not flag) + (progn (setcar tail (cadr tail)) + (setcdr tail (cddr tail))) + (setcdr tail (cons (car tail) (cdr tail))) + (setcar tail '(debug 'debug)))) + defn)))) (defun debugger-list-functions () "Display a list of all the functions now set to debug on entry."