lisp/emacs-lisp/debug.el patch.

lisp/emacs-lisp/debug.el patch.

[Lute Kamstra]

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."

Re: lisp/emacs-lisp/debug.el patch.

[David Kastrup]

Lute Kamstra <Lute.Kamstra.lists@xs4all.nl> writes:

> 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?

On a (maybe?) completely different track: since AUCTeX and
preview-latex are up to now distributed separately (and there will be
a separate preview-latex available for a while to come, to use with
older AUCTeX versions as well), preview-latex uses defadvice on AUCTeX
functions.

The advice was originally given with

2 matches for "defadvice" in buffer: preview.el
   2007:(defadvice TeX-region-create (around preview-counters preactivate)
   3151:(defadvice TeX-region-create (before preview-preamble preactivate)

It turned out, however, that in certain autoload constellations (where
stuff got loaded in order dictated by a combination of mode-hooks and
requires and autoloads) the activation of the advice did not happen.
It was possible to explicitly activate it manually, however.
Possibly relevant dependency scraps would be

-*- mode: grep; default-directory: "/home/tmp/auctex/preview/" -*-
grep -nH -e TeX-region-create /home/tmp/auctex/*.el
/home/tmp/auctex/tex-buf.el:176:    (TeX-region-create (TeX-region-file TeX-default-extension)
/home/tmp/auctex/tex-buf.el:1123:(defun TeX-region-create (file region original offset)
/home/tmp/auctex/tex.el:580:(autoload 'TeX-region-create "tex-buf" no-doc nil)

Grep finished (matches found) at Wed Mar 23 14:04:09

Looking at the dependencies, it would appear that the autoload for
TeX-region-create itself was unnecessary.

We have now changed this to

2 matches for "defadvice" in buffer: preview.el
   2007:(defadvice TeX-region-create (around preview-counters)
   3151:(defadvice TeX-region-create (before preview-preamble preactivate activate)

Both tex.el and tex-buf.el are required (in that order) upon both
compilation and execution of preview.el, but it is conceivable that
with some use the load order might be different.

Another issue is that byte compiler warnings seemed to indicate that
preactivation does not work: the advice still gets compiled at load
time.

It is probably some interaction with autoload forms here that comes
into play.  They current workaround at least works, but it would
probably be prudent to figure why preacticivation seems to fail in
some settings involving autoload.

Does any of that ring a bell with anybody?

-- 
David Kastrup, Kriemhildstr. 15, 44793 Bochum