describe-function and advised C functions

describe-function and advised C functions

[Tassilo Horn]

Hi all,

when advising a C function foo, C-h f foo just says that "foo is an
compiled lisp function" without a link to the source.

With Emacs 23 and 24.3, it said "foo is a built-in function in `C source
code'."  which is much more helpful.

The following patch restores that behavior for the current trunk.  Good
to commit?

--8<---------------cut here---------------start------------->8---
=== modified file 'lisp/help-fns.el'
--- lisp/help-fns.el	2013-06-15 01:12:05 +0000
+++ lisp/help-fns.el	2013-12-03 09:03:21 +0000
@@ -541,9 +541,10 @@
 		     (and (fboundp origname) origname)))
 	      function))
 	 ;; Get the real definition.
-	 (def (if (symbolp real-function)
-		  (symbol-function real-function)
-		function))
+	 (def (cond
+	       (advised (ad-get-orig-definition real-function))
+	       ((symbolp real-function) (symbol-function real-function))
+	       (t function)))
 	 (aliased (symbolp def))
 	 (real-def (if aliased
 		       (let ((f def))
--8<---------------cut here---------------end--------------->8---

Bye,
Tassilo

Re: describe-function and advised C functions

[Stefan Monnier]

> The following patch restores that behavior for the current trunk.  Good
> to commit?

No: Anything that starts with "ad-" means that it will only work with
functions advised via the old advice.el but not with the new nadvice.el.

Can you try and adjust your patch to use advice-* functions?


        Stefan

Re: describe-function and advised C functions

[Tassilo Horn]

Stefan Monnier <monnier@iro.umontreal.ca> writes:

>> The following patch restores that behavior for the current trunk.  Good
>> to commit?
>
> No: Anything that starts with "ad-" means that it will only work with
> functions advised via the old advice.el but not with the new nadvice.el.
>
> Can you try and adjust your patch to use advice-* functions?

Yeah.  Here's a patch that removes all ad-* function usages in
help-fns.el which also fixes the original regression.  It's a bit hairy,
especially when you have pieces of advice on aliases, but it seems to do
the trick.  It wouldn't be bad if someone else could have a look at the
patch.

--8<---------------cut here---------------start------------->8---
=== modified file 'lisp/help-fns.el'
--- lisp/help-fns.el	2013-06-15 01:12:05 +0000
+++ lisp/help-fns.el	2013-12-04 10:43:34 +0000
@@ -382,8 +382,6 @@
 			    (match-string 1 str))))
 	(and src-file (file-readable-p src-file) src-file))))))
 
-(declare-function ad-get-advice-info "advice" (function))
-
 (defun help-fns--key-bindings (function)
   (when (commandp function)
     (let ((pt2 (with-current-buffer standard-output (point)))
@@ -531,27 +529,46 @@
 
 ;;;###autoload
 (defun describe-function-1 (function)
-  (let* ((advised (and (symbolp function) (featurep 'advice)
-		       (ad-get-advice-info function)))
+  (let* ((advised (and (symbolp function)
+		       (featurep 'nadvice)
+		       (advice--p (advice--symbol-function function))))
 	 ;; If the function is advised, use the symbol that has the
 	 ;; real definition, if that symbol is already set up.
 	 (real-function
 	  (or (and advised
-		   (let ((origname (cdr (assq 'origname advised))))
-		     (and (fboundp origname) origname)))
+		   (let* ((f function)
+			  (advised-fn (advice--cdr (advice--symbol-function f))))
+		     (while (advice--p advised-fn)
+		       (setq f advised-fn)
+		       (setq advised-fn (advice--cdr (if (symbolp f)
+							 (advice--symbol-function f)
+						       f))))
+		     advised-fn))
 	      function))
 	 ;; Get the real definition.
 	 (def (if (symbolp real-function)
 		  (symbol-function real-function)
-		function))
-	 (aliased (symbolp def))
-	 (real-def (if aliased
-		       (let ((f def))
-			 (while (and (fboundp f)
-				     (symbolp (symbol-function f)))
-			   (setq f (symbol-function f)))
-			 f)
-		     def))
+		real-function))
+	 (aliased (or (symbolp def)
+		      ;; advised, aliased lisp function
+		      (and (symbolp function)
+			   (symbolp real-function)
+			   (not (eq function real-function)))
+		      ;; advised, aliased subr
+		      (and (symbolp function)
+			   (subrp def)
+			   (not (eq (intern (subr-name def)) function)))))
+	 (real-def (cond
+		    ((and aliased ;;(symbolp def)
+			  )
+		     (let ((f real-function))
+		       (while (and (fboundp f)
+				   (symbolp (symbol-function f)))
+			 (setq f (symbol-function f)))
+		       f))
+		    ((and aliased (symbolp real)))
+		    ((subrp def) (intern (subr-name def)))
+		    (t def)))
 	 (file-name (find-lisp-object-file-name function def))
          (pt1 (with-current-buffer (help-buffer) (point)))
 	 (beg (if (and (or (byte-code-function-p def)
@@ -567,14 +584,14 @@
     ;; Print what kind of function-like object FUNCTION is.
     (princ (cond ((or (stringp def) (vectorp def))
 		  "a keyboard macro")
+		 (aliased
+		  (format "an alias for `%s'" real-def))
 		 ((subrp def)
 		  (if (eq 'unevalled (cdr (subr-arity def)))
 		      (concat beg "special form")
 		    (concat beg "built-in function")))
 		 ((byte-code-function-p def)
 		  (concat beg "compiled Lisp function"))
-		 (aliased
-		  (format "an alias for `%s'" real-def))
 		 ((eq (car-safe def) 'lambda)
 		  (concat beg "Lisp function"))
 		 ((eq (car-safe def) 'macro)
--8<---------------cut here---------------end--------------->8---

To test it, I did the following old and new advice definitions in
*scratch*.

--8<---------------cut here---------------start------------->8---
(defadvice load (before my-load-advice activate)
  ;; do nothing
  )

(advice-add 'append :before #'ignore)

(defalias 'concat-seqs 'append)

(advice-add 'concat-seqs :after #'ignore)

(defadvice concat-seqs (around blabla activate)
  ad-do-it)

(defalias 'quack-mode 'scheme-mode)

(defadvice scheme-mode (before before-scheme-mode activate)
  ;; do nothing
  )

(advice-add 'quack-mode :before #'ignore)
--8<---------------cut here---------------end--------------->8---

Here's what I now get with C-h f:

,----[ C-h f load RET ]
| load is a built-in function in `C source code'.
| 
| (load FILE &optional NOERROR NOMESSAGE NOSUFFIX MUST-SUFFIX)
| 
| :around advice: `ad-Advice-load'
`----

,----[ C-h f append RET ]
| append is a built-in function in `C source code'.
| 
| (append &rest SEQUENCES)
| 
| :before advice: `ignore'
`----

,----[ C-h f concat-seqs RET ]
| concat-seqs is an alias for `append'.
| 
| (concat-seqs &rest SEQUENCES)
| 
| :around advice: `ad-Advice-concat-seqs'
| :after advice: `ignore'
| 
| :before advice: `ignore'
`----

,----[ C-h f scheme-mode RET ]
| scheme-mode is an interactive autoloaded compiled Lisp function in `scheme.el'.
| 
| (scheme-mode)
| 
| Parent mode: `prog-mode'.
| 
| :around advice: `ad-Advice-scheme-mode'
`----

,----[ C-h f quack-mode RET ]
| quack-mode is an alias for `scheme-mode'.
| 
| (quack-mode)
| 
| :before advice: `ignore'
| 
| :around advice: `ad-Advice-scheme-mode'
`----

That looks reasonable to me.

Bye,
Tassilo

Re: describe-function and advised C functions

[Tassilo Horn]

Hi again,

my previous patch had an unreachable code path & one always-nil test I
forgot to delete.  Here's a better patch.  The C-h f output is the same
as in my last mail.

BTW, why are the advice annotations in the *Help* buffer fontified for
`load', `append', and `concat-seqs', but not for `scheme-mode' and
`quack-mode'.

Bye,
Tassilo

--8<---------------cut here---------------start------------->8---
=== modified file 'lisp/help-fns.el'
--- lisp/help-fns.el	2013-06-15 01:12:05 +0000
+++ lisp/help-fns.el	2013-12-04 13:59:39 +0000
@@ -382,8 +382,6 @@
 			    (match-string 1 str))))
 	(and src-file (file-readable-p src-file) src-file))))))
 
-(declare-function ad-get-advice-info "advice" (function))
-
 (defun help-fns--key-bindings (function)
   (when (commandp function)
     (let ((pt2 (with-current-buffer standard-output (point)))
@@ -531,27 +529,39 @@
 
 ;;;###autoload
 (defun describe-function-1 (function)
-  (let* ((advised (and (symbolp function) (featurep 'advice)
-		       (ad-get-advice-info function)))
+  (let* ((advised (and (symbolp function)
+		       (featurep 'nadvice)
+		       (advice--p (advice--symbol-function function))))
 	 ;; If the function is advised, use the symbol that has the
 	 ;; real definition, if that symbol is already set up.
 	 (real-function
 	  (or (and advised
-		   (let ((origname (cdr (assq 'origname advised))))
-		     (and (fboundp origname) origname)))
+		   (let* ((f function)
+			  (advised-fn (advice--cdr (advice--symbol-function f))))
+		     (while (advice--p advised-fn)
+		       (setq f advised-fn)
+		       (setq advised-fn (advice--cdr (if (symbolp f)
+							 (advice--symbol-function f)
+						       f))))
+		     advised-fn))
 	      function))
 	 ;; Get the real definition.
 	 (def (if (symbolp real-function)
 		  (symbol-function real-function)
-		function))
-	 (aliased (symbolp def))
-	 (real-def (if aliased
-		       (let ((f def))
-			 (while (and (fboundp f)
-				     (symbolp (symbol-function f)))
-			   (setq f (symbol-function f)))
-			 f)
-		     def))
+		real-function))
+	 (aliased (or (symbolp def)
+		      ;; advised & aliased
+		      (and (symbolp function)
+			   (symbolp real-function)
+			   (not (eq function real-function)))))
+	 (real-def (cond
+		    (aliased (let ((f real-function))
+			       (while (and (fboundp f)
+					   (symbolp (symbol-function f)))
+				 (setq f (symbol-function f)))
+			       f))
+		    ((subrp def) (intern (subr-name def)))
+		    (t def)))
 	 (file-name (find-lisp-object-file-name function def))
          (pt1 (with-current-buffer (help-buffer) (point)))
 	 (beg (if (and (or (byte-code-function-p def)
@@ -567,14 +577,14 @@
     ;; Print what kind of function-like object FUNCTION is.
     (princ (cond ((or (stringp def) (vectorp def))
 		  "a keyboard macro")
+		 (aliased
+		  (format "an alias for `%s'" real-def))
 		 ((subrp def)
 		  (if (eq 'unevalled (cdr (subr-arity def)))
 		      (concat beg "special form")
 		    (concat beg "built-in function")))
 		 ((byte-code-function-p def)
 		  (concat beg "compiled Lisp function"))
-		 (aliased
-		  (format "an alias for `%s'" real-def))
 		 ((eq (car-safe def) 'lambda)
 		  (concat beg "Lisp function"))
 		 ((eq (car-safe def) 'macro)
--8<---------------cut here---------------end--------------->8---

Bye,
Tassilo

Re: describe-function and advised C functions

[Johan Bockgård]

Tassilo Horn <tsdh@gnu.org> writes:

> BTW, why are the advice annotations in the *Help* buffer fontified for
> `load', `append', and `concat-seqs', but not for `scheme-mode' and
> `quack-mode'.

substitute-command-keys strips the text properties.

Re: describe-function and advised C functions

[Stefan Monnier]

> Yeah.  Here's a patch that removes all ad-* function usages in
> help-fns.el which also fixes the original regression.  It's a bit hairy,

Thanks.  It looks pretty good, see nitpicks below.  It's pretty messy
over all, to some extent because reality is messy, but also because the
existing code is already messy, what with def, function, real-function,
real-def and no clear description of how they differ from each other.

> BTW, why are the advice annotations in the *Help* buffer fontified for
> `load', `append', and `concat-seqs', but not for `scheme-mode' and
> `quack-mode'.

I don't know, but I suspect the reason is not a good one.

> -  (let* ((advised (and (symbolp function) (featurep 'advice)
> -		       (ad-get-advice-info function)))
> +  (let* ((advised (and (symbolp function)
> +		       (featurep 'nadvice)
> +		       (advice--p (advice--symbol-function function))))

Looks fine.

>  	 ;; If the function is advised, use the symbol that has the
>  	 ;; real definition, if that symbol is already set up.
>  	 (real-function
>  	  (or (and advised
> -		   (let ((origname (cdr (assq 'origname advised))))
> -		     (and (fboundp origname) origname)))
> +		   (let* ((f function)
> +			  (advised-fn (advice--cdr (advice--symbol-function f))))
> +		     (while (advice--p advised-fn)
> +		       (setq f advised-fn)
> +		       (setq advised-fn (advice--cdr (if (symbolp f)
> +							 (advice--symbol-function f)
> +						       f))))
> +		     advised-fn))

Here `f' is unnecessary (you can always replace it either with
`function' or with `advised-fn').
Doesn't this break the 80-columns limit?
Also, the (symbolp f) test is always nil since (advice--p
advised-fn) can't be true at the same time.

More important, for an advised macro, your `real-definition' will be
a function (either a lambda expression or a byte-code-function-p).

> +	 (aliased (or (symbolp def)
> +		      ;; advised & aliased
> +		      (and (symbolp function)
> +			   (symbolp real-function)
> +			   (not (eq function real-function)))))

Please capitalize and punctuate your comments.
Also, why not use replace the `and' with

   (and advised (symbolp real-function))

> +	 (real-def (cond
> +		    (aliased (let ((f real-function))
> +			       (while (and (fboundp f)
> +					   (symbolp (symbol-function f)))
> +				 (setq f (symbol-function f)))
> +			       f))
> +		    ((subrp def) (intern (subr-name def)))
> +		    (t def)))

Why do we need `subr-name'?

> @@ -567,14 +577,14 @@
>      ;; Print what kind of function-like object FUNCTION is.
>      (princ (cond ((or (stringp def) (vectorp def))
>  		  "a keyboard macro")
> +		 (aliased
> +		  (format "an alias for `%s'" real-def))
>  		 ((subrp def)
>  		  (if (eq 'unevalled (cdr (subr-arity def)))
>  		      (concat beg "special form")
>  		    (concat beg "built-in function")))
>  		 ((byte-code-function-p def)
>  		  (concat beg "compiled Lisp function"))
> -		 (aliased
> -		  (format "an alias for `%s'" real-def))
>  		 ((eq (car-safe def) 'lambda)
>  		  (concat beg "Lisp function"))
>  		 ((eq (car-safe def) 'macro)

Hmm... Why was this move necessary?  You'll probably want to add
a comment explaining it.


        Stefan

Re: describe-function and advised C functions

[Tassilo Horn]

Stefan Monnier <monnier@iro.umontreal.ca> writes:

>>  	 ;; If the function is advised, use the symbol that has the
>>  	 ;; real definition, if that symbol is already set up.
>>  	 (real-function
>>  	  (or (and advised
>> -		   (let ((origname (cdr (assq 'origname advised))))
>> -		     (and (fboundp origname) origname)))
>> +		   (let* ((f function)
>> +			  (advised-fn (advice--cdr (advice--symbol-function f))))
>> +		     (while (advice--p advised-fn)
>> +		       (setq f advised-fn)
>> +		       (setq advised-fn (advice--cdr (if (symbolp f)
>> +							 (advice--symbol-function f)
>> +						       f))))
>> +		     advised-fn))
>
> Here `f' is unnecessary (you can always replace it either with
> `function' or with `advised-fn').

Right.

> Doesn't this break the 80-columns limit?

Yes.  The new attached patch is at most 76 columns wide.

> Also, the (symbolp f) test is always nil since (advice--p advised-fn)
> can't be true at the same time.

Indeed.

> More important, for an advised macro, your `real-definition' will be
> a function (either a lambda expression or a byte-code-function-p).

Oh, yes.  I didn't test advising macros, but the new patch contains a
fix.

>> +	 (aliased (or (symbolp def)
>> +		      ;; advised & aliased
>> +		      (and (symbolp function)
>> +			   (symbolp real-function)
>> +			   (not (eq function real-function)))))
>
> Please capitalize and punctuate your comments.

Done.

> Also, why not use replace the `and' with
>
>    (and advised (symbolp real-function))

That's better.

>> +	 (real-def (cond
>> +		    (aliased (let ((f real-function))
>> +			       (while (and (fboundp f)
>> +					   (symbolp (symbol-function f)))
>> +				 (setq f (symbol-function f)))
>> +			       f))
>> +		    ((subrp def) (intern (subr-name def)))
>> +		    (t def)))
>
> Why do we need `subr-name'?

Later comes an `fboundp' check which errors when given a subr.

    (if (and aliased (not (fboundp real-def)))
	(princ ",\nwhich is not defined.  Please make a bug report.")

>> @@ -567,14 +577,14 @@
>>      ;; Print what kind of function-like object FUNCTION is.
>>      (princ (cond ((or (stringp def) (vectorp def))
>>  		  "a keyboard macro")
>> +		 (aliased
>> +		  (format "an alias for `%s'" real-def))
>>  		 ((subrp def)
>>  		  (if (eq 'unevalled (cdr (subr-arity def)))
>>  		      (concat beg "special form")
>>  		    (concat beg "built-in function")))
>>  		 ((byte-code-function-p def)
>>  		  (concat beg "compiled Lisp function"))
>> -		 (aliased
>> -		  (format "an alias for `%s'" real-def))
>>  		 ((eq (car-safe def) 'lambda)
>>  		  (concat beg "Lisp function"))
>>  		 ((eq (car-safe def) 'macro)
>
> Hmm... Why was this move necessary?  You'll probably want to add a
> comment explaining it.

Done so.  For the adviced macro thingy, I also had to move the macro
clause upwards and add (macrop function) check.

Bye,
Tassilo

--8<---------------cut here---------------start------------->8---
=== modified file 'lisp/help-fns.el'
--- lisp/help-fns.el	2013-06-15 01:12:05 +0000
+++ lisp/help-fns.el	2013-12-05 09:45:15 +0000
@@ -382,8 +382,6 @@
 			    (match-string 1 str))))
 	(and src-file (file-readable-p src-file) src-file))))))
 
-(declare-function ad-get-advice-info "advice" (function))
-
 (defun help-fns--key-bindings (function)
   (when (commandp function)
     (let ((pt2 (with-current-buffer standard-output (point)))
@@ -531,27 +529,34 @@
 
 ;;;###autoload
 (defun describe-function-1 (function)
-  (let* ((advised (and (symbolp function) (featurep 'advice)
-		       (ad-get-advice-info function)))
+  (let* ((advised (and (symbolp function)
+		       (featurep 'nadvice)
+		       (advice--p (advice--symbol-function function))))
 	 ;; If the function is advised, use the symbol that has the
 	 ;; real definition, if that symbol is already set up.
 	 (real-function
 	  (or (and advised
-		   (let ((origname (cdr (assq 'origname advised))))
-		     (and (fboundp origname) origname)))
+		   (let* ((advised-fn (advice--cdr
+				       (advice--symbol-function function))))
+		     (while (advice--p advised-fn)
+		       (setq advised-fn (advice--cdr advised-fn)))
+		     advised-fn))
 	      function))
 	 ;; Get the real definition.
 	 (def (if (symbolp real-function)
 		  (symbol-function real-function)
-		function))
-	 (aliased (symbolp def))
-	 (real-def (if aliased
-		       (let ((f def))
-			 (while (and (fboundp f)
-				     (symbolp (symbol-function f)))
-			   (setq f (symbol-function f)))
-			 f)
-		     def))
+		real-function))
+	 (aliased (or (symbolp def)
+		      ;; Advised & aliased function.
+		      (and advised (symbolp real-function))))
+	 (real-def (cond
+		    (aliased (let ((f real-function))
+			       (while (and (fboundp f)
+					   (symbolp (symbol-function f)))
+				 (setq f (symbol-function f)))
+			       f))
+		    ((subrp def) (intern (subr-name def)))
+		    (t def)))
 	 (file-name (find-lisp-object-file-name function def))
          (pt1 (with-current-buffer (help-buffer) (point)))
 	 (beg (if (and (or (byte-code-function-p def)
@@ -571,14 +576,20 @@
 		  (if (eq 'unevalled (cdr (subr-arity def)))
 		      (concat beg "special form")
 		    (concat beg "built-in function")))
-		 ((byte-code-function-p def)
-		  (concat beg "compiled Lisp function"))
+		 ;; Aliases are Lisp functions, so we need to check
+		 ;; aliases before functions.
 		 (aliased
 		  (format "an alias for `%s'" real-def))
+		 ((or (eq (car-safe def) 'macro)
+		      ;; For advised macros, def is a lambda
+		      ;; expression or a byte-code-function-p, so we
+		      ;; need to check macros before functions.
+		      (macrop function))
+		  (concat beg "Lisp macro"))
+		 ((byte-code-function-p def)
+		  (concat beg "compiled Lisp function"))
 		 ((eq (car-safe def) 'lambda)
 		  (concat beg "Lisp function"))
-		 ((eq (car-safe def) 'macro)
-		  (concat beg "Lisp macro"))
 		 ((eq (car-safe def) 'closure)
 		  (concat beg "Lisp closure"))
 		 ((autoloadp def)
--8<---------------cut here---------------end--------------->8---

Bye,
Tassilo

Re: describe-function and advised C functions

[Tassilo Horn]

Hi again,

FWIW, I've just committed the patch attached to my last mail.

Bye,
Tassilo