From: Lute Kamstra <Lute.Kamstra.lists@xs4all.nl>
Subject: lisp/emacs-lisp/debug.el patch.
Date: Wed, 23 Mar 2005 13:38:31 +0100 [thread overview]
Message-ID: <874qf2bkqg.fsf@xs4all.nl> (raw)
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 <lute@gnu.org>
+ * 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."
next reply other threads:[~2005-03-23 12:38 UTC|newest]
Thread overview: 2+ messages / expand[flat|nested] mbox.gz Atom feed top
2005-03-23 12:38 Lute Kamstra [this message]
2005-03-23 13:14 ` lisp/emacs-lisp/debug.el patch David Kastrup
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.gnu.org/software/emacs/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=874qf2bkqg.fsf@xs4all.nl \
--to=lute.kamstra.lists@xs4all.nl \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).