From 7473b6ad844fe58aaf359a9d90ef17181abe451c Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sun, 7 Jul 2002 20:25:23 +0000 Subject: [PATCH] (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. --- lisp/ChangeLog | 24 ++++++++++++++++++++- lisp/emacs-lisp/debug.el | 46 +++++++++++++++++++++++++--------------- 2 files changed, 52 insertions(+), 18 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 0dc4a1c65ee..4a38c33686d 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,15 @@ +2002-07-07 Stefan Monnier + + * 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 * 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 or a list of functions. (c-add-style): Delete `safe-local-eval-function' property. - + * files.el (after-find-file): Make buffer read-only if file is marked that way, even for root. @@ -33,6 +45,16 @@ FCT if current column is outside rectangle. (cua--delete-rectangle): Do nothing if zero width or out of bounds. +2002-07-04 Stefan Monnier + + * 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 * simple.el (toggle-truncate-lines): New command. diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el index a0165a8d198..22607c7c42f 100644 --- a/lisp/emacs-lisp/debug.el +++ b/lisp/emacs-lisp/debug.el @@ -611,12 +611,16 @@ Redefining FUNCTION also cancels it." (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 @@ If argument is nil or an empty string, cancel for all functions." (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 @@ If argument is nil or an empty string, cancel for all functions." (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." -- 2.39.2