1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-23 22:20:24 -08:00

(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.
This commit is contained in:
Stefan Monnier 2002-07-07 20:25:23 +00:00
parent 287360825e
commit 7473b6ad84
2 changed files with 52 additions and 18 deletions

View file

@ -1,3 +1,15 @@
2002-07-07 Stefan Monnier <monnier@cs.yale.edu>
* emacs-lisp/debug.el (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.
* textmodes/texinfo.el (texinfo-font-lock-keywords): Disable the
automatic environment name update.
(texinfo-clone-environment): Fix it not to incorrectly match prefixes.
2002-07-07 Richard M. Stallman <rms@gnu.org> 2002-07-07 Richard M. Stallman <rms@gnu.org>
* emacs-lisp/easymenu.el (easy-menu-popup-menu): Function deleted. * emacs-lisp/easymenu.el (easy-menu-popup-menu): Function deleted.
@ -10,7 +22,7 @@
Also allow `safe-local-eval-function' property to be a function Also allow `safe-local-eval-function' property to be a function
or a list of functions. or a list of functions.
(c-add-style): Delete `safe-local-eval-function' property. (c-add-style): Delete `safe-local-eval-function' property.
* files.el (after-find-file): Make buffer read-only if file is * files.el (after-find-file): Make buffer read-only if file is
marked that way, even for root. marked that way, even for root.
@ -33,6 +45,16 @@
FCT if current column is outside rectangle. FCT if current column is outside rectangle.
(cua--delete-rectangle): Do nothing if zero width or out of bounds. (cua--delete-rectangle): Do nothing if zero width or out of bounds.
2002-07-04 Stefan Monnier <monnier@cs.yale.edu>
* net/ange-ftp.el: Use add-hook and find-file-hook.
(ange-ftp-parse-netrc): Use run-hooks and find-file-hook.
(ange-ftp-ls-parser): Make it into a function.
Ignore trailing @ in symlink targets.
(ange-ftp-file-entry-p): Ignore FTP errors.
(ange-ftp-insert-directory): Use ange-ftp-expand-symlink
to correctly expand "/flint:/bla -> ./etc" to /flint:/etc.
2002-07-04 Per Abrahamsen <abraham@dina.kvl.dk> 2002-07-04 Per Abrahamsen <abraham@dina.kvl.dk>
* simple.el (toggle-truncate-lines): New command. * simple.el (toggle-truncate-lines): New command.

View file

@ -611,12 +611,16 @@ Redefining FUNCTION also cancels it."
(interactive "aDebug on entry (to function): ") (interactive "aDebug on entry (to function): ")
(debugger-reenable) (debugger-reenable)
;; Handle a function that has been aliased to some other function. ;; 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) (fset function `(lambda (&rest debug-on-entry-args)
,(interactive-form (symbol-function function))
(apply ',(symbol-function function) (apply ',(symbol-function function)
debug-on-entry-args)))) debug-on-entry-args))))
(if (subrp (symbol-function function))
(error "Function %s is a primitive" function))
(or (consp (symbol-function function)) (or (consp (symbol-function function))
(debug-convert-byte-code function)) (debug-convert-byte-code function))
(or (consp (symbol-function function)) (or (consp (symbol-function function))
@ -639,8 +643,15 @@ If argument is nil or an empty string, cancel for all functions."
(debugger-reenable) (debugger-reenable)
(if (and function (not (string= function ""))) (if (and function (not (string= function "")))
(progn (progn
(fset function (let ((f (debug-on-entry-1 function (symbol-function function) nil)))
(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)) (setq debug-function-list (delq function debug-function-list))
function) function)
(message "Cancelling debug-on-entry for all functions") (message "Cancelling debug-on-entry for all functions")
@ -670,18 +681,19 @@ If argument is nil or an empty string, cancel for all functions."
(debug-on-entry-1 function (cdr defn) flag) (debug-on-entry-1 function (cdr defn) flag)
(or (eq (car defn) 'lambda) (or (eq (car defn) 'lambda)
(error "%s not user-defined Lisp function" function)) (error "%s not user-defined Lisp function" function))
(let (tail prec) (let ((tail (cddr defn)))
(if (stringp (car (nthcdr 2 defn))) ;; Skip the docstring.
(setq tail (nthcdr 3 defn) (if (stringp (car tail)) (setq tail (cdr tail)))
prec (list (car defn) (car (cdr defn)) ;; Skip the interactive form.
(car (cdr (cdr defn))))) (if (eq 'interactive (car-safe (car tail))) (setq tail (cdr tail)))
(setq tail (nthcdr 2 defn) (unless (eq flag (equal (car tail) '(debug 'debug)))
prec (list (car defn) (car (cdr defn))))) ;; Add/remove debug statement as needed.
(if (eq flag (equal (car tail) '(debug 'debug))) (if (not flag)
defn (progn (setcar tail (cadr tail))
(if flag (setcdr tail (cddr tail)))
(nconc prec (cons '(debug 'debug) tail)) (setcdr tail (cons (car tail) (cdr tail)))
(nconc prec (cdr tail)))))))) (setcar tail '(debug 'debug))))
defn))))
(defun debugger-list-functions () (defun debugger-list-functions ()
"Display a list of all the functions now set to debug on entry." "Display a list of all the functions now set to debug on entry."