Re: describe-function and advised C functions

[Tassilo Horn]

Stefan Monnier <address@hidden> 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