Mercurial > emacs

changeset 46217:4a0f567d3c5f

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
(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.
author Stefan Monnier <monnier@iro.umontreal.ca>
date Sun, 07 Jul 2002 20:22:29 +0000
parents 00a9017b1365
children 3bf04111920d
files lisp/emacs-lisp/debug.el
diffstat 1 files changed, 29 insertions(+), 17 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/emacs-lisp/debug.el	Sun Jul 07 20:14:28 2002 +0000
+++ b/lisp/emacs-lisp/debug.el	Sun Jul 07 20:22:29 2002 +0000
@@ -611,12 +611,16 @@
   (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 @@
   (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 @@
 	(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."