Mercurial > emacs
changeset 61084:e5ed594355d5
(debug-on-entry): Handle autoloaded functions and compiled macros.
(debug-convert-byte-code): Handle macros too.
(debug-on-entry-1): Don't signal an error when trying to clear a
function that is not set to debug on entry.
| author | Lute Kamstra <lute@gnu.org> |
|---|---|
| date | Tue, 29 Mar 2005 13:58:55 +0000 |
| parents | 2e8d32a5f75a |
| children | 6519d9f54165 |
| files | lisp/emacs-lisp/debug.el |
| diffstat | 1 files changed, 57 insertions(+), 43 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/emacs-lisp/debug.el Tue Mar 29 11:53:18 2005 +0000 +++ b/lisp/emacs-lisp/debug.el Tue Mar 29 13:58:55 2005 +0000 @@ -632,24 +632,31 @@ Use \\[cancel-debug-on-entry] to cancel the effect of this command. Redefining FUNCTION also cancels it." (interactive "aDebug on entry (to function): ") - ;; Handle a function that has been aliased to some other 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)) + (when (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. + ;; The function is built-in or aliased to another function. + ;; Create a wrapper in which we can add the debug call. (fset function `(lambda (&rest debug-on-entry-args) ,(interactive-form (symbol-function function)) - (apply ',(symbol-function function) - debug-on-entry-args)))) - (or (consp (symbol-function function)) - (debug-convert-byte-code function)) - (or (consp (symbol-function function)) - (error "Definition of %s is not a list" function)) + (apply ',(symbol-function function) + debug-on-entry-args))) + (when (eq (car-safe (symbol-function function)) 'autoload) + ;; The function is autoloaded. Load its real definition. + (load (cadr (symbol-function function)) nil noninteractive nil t)) + (when (or (not (consp (symbol-function function))) + (and (eq (car (symbol-function function)) 'macro) + (not (consp (cdr (symbol-function function)))))) + ;; The function is byte-compiled. Create a wrapper in which + ;; we can add the debug call. + (debug-convert-byte-code function))) + (unless (consp (symbol-function function)) + (error "Definition of %s is not a list" function)) (fset function (debug-on-entry-1 function t)) - (or (memq function debug-function-list) - (push function debug-function-list)) + (unless (memq function debug-function-list) + (push function debug-function-list)) function) ;;;###autoload @@ -664,45 +671,52 @@ (if name (intern name))))) (if (and function (not (string= function ""))) (progn - (let ((f (debug-on-entry-1 function nil))) + (let ((defn (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)) - ;; `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))))) + (when (and (equal (nth 1 defn) '(&rest debug-on-entry-args)) + (eq (car (nth 3 defn)) 'apply)) + ;; `defn' is a wrapper introduced in debug-on-entry. + ;; Get rid of it since we don't need it any more. + (setq defn (nth 1 (nth 1 (nth 3 defn))))) (error nil)) - (fset function f)) + (fset function defn)) (setq debug-function-list (delq function debug-function-list)) function) (message "Cancelling debug-on-entry for all functions") (mapcar 'cancel-debug-on-entry debug-function-list))) (defun debug-convert-byte-code (function) - (let ((defn (symbol-function function))) - (if (not (consp defn)) - ;; Assume a compiled code object. - (let* ((contents (append defn nil)) - (body - (list (list 'byte-code (nth 1 contents) - (nth 2 contents) (nth 3 contents))))) - (if (nthcdr 5 contents) - (setq body (cons (list 'interactive (nth 5 contents)) body))) - (if (nth 4 contents) - ;; Use `documentation' here, to get the actual string, - ;; in case the compiled function has a reference - ;; to the .elc file. - (setq body (cons (documentation function) body))) - (fset function (cons 'lambda (cons (car contents) body))))))) + (let* ((defn (symbol-function function)) + (macro (eq (car-safe defn) 'macro))) + (when macro (setq defn (cdr defn))) + (unless (consp defn) + ;; Assume a compiled code object. + (let* ((contents (append defn nil)) + (body + (list (list 'byte-code (nth 1 contents) + (nth 2 contents) (nth 3 contents))))) + (if (nthcdr 5 contents) + (setq body (cons (list 'interactive (nth 5 contents)) body))) + (if (nth 4 contents) + ;; Use `documentation' here, to get the actual string, + ;; in case the compiled function has a reference + ;; to the .elc file. + (setq body (cons (documentation function) body))) + (setq defn (cons 'lambda (cons (car contents) body)))) + (when macro (setq defn (cons 'macro defn))) + (fset function 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))) - (if (eq (car tail) 'lambda) (setq tail (cdr tail)) - (error "%s not user-defined Lisp function" function)) + (when (eq (car-safe tail) 'macro) + (setq tail (cdr tail))) + (if (not (eq (car-safe tail) 'lambda)) + ;; Only signal an error when we try to set debug-on-entry. + ;; When we try to clear debug-on-entry, we are now done. + (when flag + (error "%s is not a user-defined Lisp function" function)) + (setq tail (cdr tail)) ;; Skip the docstring. (when (and (stringp (cadr tail)) (cddr tail)) (setq tail (cdr tail))) @@ -713,8 +727,8 @@ ;; Add/remove debug statement as needed. (if flag (setcdr tail (cons '(implement-debug-on-entry) (cdr tail))) - (setcdr tail (cddr tail)))) - defn))) + (setcdr tail (cddr tail))))) + defn)) (defun debugger-list-functions () "Display a list of all the functions now set to debug on entry."