Re: The dynamic-docstring-function property

[Chong Yidong <cyd@gnu.org>]

>> Because a non-string value is evaluated, the dynamic-docstring-function
>> stuff can be accomplished by setting the function-documentation property
>> to the value `(foo ,old-docstring) where `foo' is your processing
>> function.
>
> Hmm... indeed maybe that could be used instead (it's not quite
> equivalent, in that dynamic-docstring-function is used by add-function,
> whereas function-documentation would only work for advice-add, tho
> I guess we could add "dummy" symbol indirection to make it possible to
> use function-documentation in add-function as well; and in practice the
> dynamic docstring feature is only useful for advice-add anyway).

How about the following?  Some testing indicates that looking up
docstrings of adviced functions, and of the pieces of advice, works
fine.  (This could be made more elegant if we change `documentation' so
that it ignores the `function-documentation' property when the RAW
argument is non-nil.)


=== modified file 'lisp/emacs-lisp/nadvice.el'
*** lisp/emacs-lisp/nadvice.el	2013-12-12 19:47:11 +0000
--- lisp/emacs-lisp/nadvice.el	2014-01-01 05:32:15 +0000
***************
*** 67,74 ****
  (defsubst advice--cdr   (f) (aref (aref f 2) 2))
  (defsubst advice--props (f) (aref (aref f 2) 3))
  
! (defun advice--make-docstring (_string function)
!   "Build the raw doc-string of SYMBOL, presumably advised."
    (let ((flist (indirect-function function))
          (docstring nil))
      (if (eq 'macro (car-safe flist)) (setq flist (cdr flist)))
--- 67,74 ----
  (defsubst advice--cdr   (f) (aref (aref f 2) 2))
  (defsubst advice--props (f) (aref (aref f 2) 3))
  
! (defun advice--make-docstring (function)
!   "Build the raw doc-string of FUNCTION, presumably advised."
    (let ((flist (indirect-function function))
          (docstring nil))
      (if (eq 'macro (car-safe flist)) (setq flist (cdr flist)))
***************
*** 105,117 ****
                      (setq origdoc (cdr usage)) (car usage)))
        (help-add-fundoc-usage (concat docstring origdoc) usage))))
  
- (defvar advice--docstring
-   ;; Can't eval-when-compile nor use defconst because it then gets pure-copied,
-   ;; which drops the text-properties.
-   ;;(eval-when-compile
-   (propertize "Advised function"
-               'dynamic-docstring-function #'advice--make-docstring)) ;; )
- 
  (defun advice-eval-interactive-spec (spec)
    "Evaluate the interactive spec SPEC."
    (cond
--- 105,110 ----
***************
*** 144,150 ****
          (advice
           (apply #'make-byte-code 128 byte-code
                  (vector #'apply function main props) stack-depth
!                 advice--docstring
                  (and (or (commandp function) (commandp main))
  		     (not (and (symbolp main) ;; Don't autoload too eagerly!
  			       (autoloadp (symbol-function main))))
--- 137,143 ----
          (advice
           (apply #'make-byte-code 128 byte-code
                  (vector #'apply function main props) stack-depth
!                 nil
                  (and (or (commandp function) (commandp main))
  		     (not (and (symbolp main) ;; Don't autoload too eagerly!
  			       (autoloadp (symbol-function main))))
***************
*** 398,403 ****
--- 391,397 ----
                            (get symbol 'advice--pending))
                           (t (symbol-function symbol)))
                    function props)
+     (put symbol 'function-documentation `(advice--make-docstring ',symbol))
      (add-function :around (get symbol 'defalias-fset-function)
                    #'advice--defalias-fset))
    nil)
=== modified file 'lisp/emacs-lisp/advice.el'
*** lisp/emacs-lisp/advice.el	2013-12-26 03:27:45 +0000
--- lisp/emacs-lisp/advice.el	2014-01-01 05:50:44 +0000
***************
*** 2185,2201 ****
  		    (if (ad-interactive-form definition) 1 0))
  		 (cdr (cdr (ad-lambda-expression definition)))))))
  
- (defun ad-make-advised-definition-docstring (_function)
-   "Make an identifying docstring for the advised definition of FUNCTION.
- Put function name into the documentation string so we can infer
- the name of the advised function from the docstring.  This is needed
- to generate a proper advised docstring even if we are just given a
- definition (see the code for `documentation')."
-   (eval-when-compile
-     (propertize "Advice function assembled by advice.el."
-                 'dynamic-docstring-function
-                 #'ad--make-advised-docstring)))
- 
  (defun ad-advised-definition-p (definition)
    "Return non-nil if DEFINITION was generated from advice information."
    (if (or (ad-lambda-p definition)
--- 2185,2190 ----
***************
*** 2498,2504 ****
  
  (require 'help-fns)	    ;For help-split-fundoc and help-add-fundoc-usage.
  
! (defun ad--make-advised-docstring (origdoc function &optional style)
    "Construct a documentation string for the advised FUNCTION.
  It concatenates the original documentation with the documentation
  strings of the individual pieces of advice which will be formatted
--- 2487,2493 ----
  
  (require 'help-fns)	    ;For help-split-fundoc and help-add-fundoc-usage.
  
! (defun ad--make-advised-docstring (function &optional style)
    "Construct a documentation string for the advised FUNCTION.
  It concatenates the original documentation with the documentation
  strings of the individual pieces of advice which will be formatted
***************
*** 2506,2511 ****
--- 2495,2507 ----
  will be interpreted as `default'.  The order of the advice documentation
  strings corresponds to before/around/after and the individual ordering
  in any of these classes."
+   ;; Retrieve the original function documentation
+   (let* ((fun (get function 'function-documentation))
+ 	 (origdoc (unwind-protect
+ 		      (progn (put function 'function-documentation nil)
+ 			     (documentation function t))
+ 		    (put function 'function-documentation fun))))
+ 
    (if (and (symbolp function)
             (string-match "\\`ad-+Advice-" (symbol-name function)))
        (setq function
***************
*** 2528,2533 ****
--- 2524,2530 ----
  		       'dynamic-docstring-function
                         #'ad--make-advised-docstring)))
      (help-add-fundoc-usage origdoc usage)))
+   )
  
  
  ;; @@@ Accessing overriding arglists and interactive forms:
***************
*** 2575,2581 ****
  	;; Finally, build the sucker:
  	(ad-assemble-advised-definition
  	 advised-arglist
!          (ad-make-advised-definition-docstring function)
  	 interactive-form
  	 orig-form
  	 (ad-get-enabled-advices function 'before)
--- 2572,2578 ----
  	;; Finally, build the sucker:
  	(ad-assemble-advised-definition
  	 advised-arglist
! 	 nil
  	 interactive-form
  	 orig-form
  	 (ad-get-enabled-advices function 'before)
***************
*** 2889,2894 ****
--- 2886,2893 ----
      (fset advicefunname
            (or verified-cached-definition
                (ad-make-advised-definition function)))
+     (put advicefunname 'function-documentation
+ 	 `(ad--make-advised-docstring ',advicefunname))
      (unless (equal (interactive-form advicefunname) old-ispec)
        ;; If the interactive-spec of advicefunname has changed, force nadvice to
        ;; refresh its copy.