From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Lute Kamstra Newsgroups: gmane.emacs.devel Subject: lisp/emacs-lisp/debug.el patch. Date: Wed, 23 Mar 2005 13:38:31 +0100 Message-ID: <874qf2bkqg.fsf@xs4all.nl> NNTP-Posting-Host: main.gmane.org Mime-Version: 1.0 Content-Type: text/plain; charset=us-ascii X-Trace: sea.gmane.org 1111581689 14893 80.91.229.2 (23 Mar 2005 12:41:29 GMT) X-Complaints-To: usenet@sea.gmane.org NNTP-Posting-Date: Wed, 23 Mar 2005 12:41:29 +0000 (UTC) Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Wed Mar 23 13:41:28 2005 Original-Received: from lists.gnu.org ([199.232.76.165]) by ciao.gmane.org with esmtp (Exim 4.43) id 1DE5Am-0005Y0-DC for ged-emacs-devel@m.gmane.org; Wed, 23 Mar 2005 13:41:21 +0100 Original-Received: from localhost ([127.0.0.1] helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1DE5SG-0002KA-8h for ged-emacs-devel@m.gmane.org; Wed, 23 Mar 2005 07:59:24 -0500 Original-Received: from mailman by lists.gnu.org with tmda-scanned (Exim 4.43) id 1DE5NT-0000Wg-2C for emacs-devel@gnu.org; Wed, 23 Mar 2005 07:54:27 -0500 Original-Received: from exim by lists.gnu.org with spam-scanned (Exim 4.43) id 1DE5NO-0000TS-0X for emacs-devel@gnu.org; Wed, 23 Mar 2005 07:54:23 -0500 Original-Received: from [199.232.76.173] (helo=monty-python.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1DE5NN-0000Sf-RH for emacs-devel@gnu.org; Wed, 23 Mar 2005 07:54:21 -0500 Original-Received: from [194.109.24.27] (helo=smtp-vbr7.xs4all.nl) by monty-python.gnu.org with esmtp (Exim 4.34) id 1DE586-0006lZ-4r for emacs-devel@gnu.org; Wed, 23 Mar 2005 07:38:34 -0500 Original-Received: from pijl (a80-127-67-124.adsl.xs4all.nl [80.127.67.124]) by smtp-vbr7.xs4all.nl (8.12.11/8.12.11) with ESMTP id j2NCcWB8002215 for ; Wed, 23 Mar 2005 13:38:33 +0100 (CET) (envelope-from Lute.Kamstra@xs4all.nl) Original-Received: from lute by pijl with local (Exim 3.36 #1 (Debian)) id 1DE583-0003D4-00 for ; Wed, 23 Mar 2005 13:38:31 +0100 Original-To: emacs-devel@gnu.org User-Agent: Gnus/5.11 (Gnus v5.11) Emacs/22.0.50 (gnu/linux) Original-Lines: 218 X-Virus-Scanned: by XS4ALL Virus Scanner X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.5 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Original-Sender: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org X-MailScanner-To: ged-emacs-devel@m.gmane.org Xref: news.gmane.org gmane.emacs.devel:35034 X-Report-Spam: http://spam.gmane.org/gmane.emacs.devel:35034 Here's a patch to handle debug-on-entry for autoloaded functions and compiled macros. The patch also solves a problem with cancel-debug-on-entry. Currently, it signals an error for built-in functions, autoloaded functions, and aliases that are not set to debug-on entry. The patch makes cancel-debug-on-entry a no-op in these cases. Ok to commit? Lute. Index: lisp/ChangeLog =================================================================== RCS file: /cvsroot/emacs/emacs/lisp/ChangeLog,v retrieving revision 1.7147 diff -c -r1.7147 ChangeLog *** lisp/ChangeLog 23 Mar 2005 10:48:20 -0000 1.7147 --- lisp/ChangeLog 23 Mar 2005 12:14:14 -0000 *************** *** 1,5 **** --- 1,11 ---- 2005-03-23 Lute Kamstra + * emacs-lisp/debug.el (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. + * generic-x.el: Code cleanup: make arguments constant whenever possible. (installshield-statement-keyword-list) Index: lisp/emacs-lisp/debug.el =================================================================== RCS file: /cvsroot/emacs/emacs/lisp/emacs-lisp/debug.el,v retrieving revision 1.77 diff -c -r1.77 debug.el *** lisp/emacs-lisp/debug.el 14 Mar 2005 17:44:56 -0000 1.77 --- lisp/emacs-lisp/debug.el 23 Mar 2005 12:14:15 -0000 *************** *** 633,656 **** 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)) (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)))) ! (or (consp (symbol-function function)) ! (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 t)) ! (or (memq function debug-function-list) ! (push function debug-function-list)) function) ;;;###autoload --- 633,663 ---- Use \\[cancel-debug-on-entry] to cancel the effect of this command. Redefining FUNCTION also cancels it." (interactive "aDebug on entry (to 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))) ! ;; 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))) ! (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)) ! (unless (memq function debug-function-list) ! (push function debug-function-list)) function) ;;;###autoload *************** *** 665,709 **** (if name (intern name))))) (if (and function (not (string= function ""))) (progn ! (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)) ! ;; `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") (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))))))) (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)) ;; Skip the docstring. (when (and (stringp (cadr tail)) (cddr tail)) (setq tail (cdr tail))) --- 672,723 ---- (if name (intern name))))) (if (and function (not (string= function ""))) (progn ! (let ((defn (debug-on-entry-1 function nil))) (condition-case nil ! (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 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)) ! (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)) ! (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))) *************** *** 714,721 **** ;; Add/remove debug statement as needed. (if flag (setcdr tail (cons '(implement-debug-on-entry) (cdr tail))) ! (setcdr tail (cddr tail)))) ! defn))) (defun debugger-list-functions () "Display a list of all the functions now set to debug on entry." --- 728,735 ---- ;; Add/remove debug statement as needed. (if flag (setcdr tail (cons '(implement-debug-on-entry) (cdr tail))) ! (setcdr tail (cddr tail))))) ! defn)) (defun debugger-list-functions () "Display a list of all the functions now set to debug on entry."