New property dynamic-docstring-function for docstrings.

* src/doc.c (Fdocumentation): Handle new property
dynamic-docstring-function to replace the old ad-advice-info.
* lisp/emacs-lisp/advice.el: Use new dynamic docstrings.
(ad-make-advised-definition-docstring, ad-advised-definition-p):
Use dynamic-docstring-function instead of ad-advice-info.
(ad--make-advised-docstring): New function extracted from
ad-make-advised-docstring.
(ad-make-advised-docstring): Use it.
* lisp/progmodes/sql.el (sql--make-help-docstring): New function, extracted
from sql-help.
(sql-help): Use it with dynamic-docstring-function.

diff --git a/etc/NEWS b/etc/NEWS
index 2b56ea9f540a9bab40a23114089be771db6752e1..bb8bcd6cb56c8db008c92b9e9ee808b528532a19 100644 (file)
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -29,6 +29,10 @@ so we will look at it and add it to the manual.
 * New Modes and Packages in Emacs 24.4
 * Incompatible Lisp Changes in Emacs 24.4
 * Lisp changes in Emacs 24.4
+
+** Docstrings can be made dynamic by adding a `dynamic-docstring-function'
+text-property on the first char.
+
 * Changes in Emacs 24.4 on non-free operating systems
 
 \f

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index b54a3e281afa8807a45aed52db7a8d501f7c4fc1..f0af63ac094e0223c53fcc49f25b19b526672ca3 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,5 +1,15 @@
 2012-11-09  Stefan Monnier  <monnier@iro.umontreal.ca>
 
+       * emacs-lisp/advice.el: Use new dynamic docstrings.
+       (ad-make-advised-definition-docstring, ad-advised-definition-p):
+       Use dynamic-docstring-function instead of ad-advice-info.
+       (ad--make-advised-docstring): New function extracted from
+       ad-make-advised-docstring.
+       (ad-make-advised-docstring): Use it.
+       * progmodes/sql.el (sql--make-help-docstring): New function, extracted
+       from sql-help.
+       (sql-help): Use it with dynamic-docstring-function.
+
        * env.el (env--substitute-vars-regexp): Don't use rx (for bootstrap).
 
 2012-11-08  Stefan Monnier  <monnier@iro.umontreal.ca>

diff --git a/lisp/emacs-lisp/advice.el b/lisp/emacs-lisp/advice.el
index bd85238e23e9ff81015ae69ba54baa917e258ecf..33805836db2c35eb51cdf01a367e4dba8aa1c761 100644 (file)
--- a/lisp/emacs-lisp/advice.el
+++ b/lisp/emacs-lisp/advice.el
@@ -2414,13 +2414,15 @@ Like `interactive-form', but also works on pieces of advice."
                    (if (ad-interactive-form definition) 1 0))
                 (cdr (cdr (ad-lambda-expression definition)))))))
 
-(defun ad-make-advised-definition-docstring (function)
+(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')."
-  (propertize "Advice doc string" 'ad-advice-info function))
+  (eval-when-compile
+    (propertize "Advice doc string" 'dynamic-docstring-function
+                #'ad--make-advised-docstring)))
 
 (defun ad-advised-definition-p (definition)
   "Return non-nil if DEFINITION was generated from advice information."
@@ -2429,7 +2431,7 @@ definition (see the code for `documentation')."
          (ad-compiled-p definition))
       (let ((docstring (ad-docstring definition)))
        (and (stringp docstring)
-            (get-text-property 0 'ad-advice-info docstring)))))
+            (get-text-property 0 'dynamic-docstring-function docstring)))))
 
 (defun ad-definition-type (definition)
   "Return symbol that describes the type of DEFINITION."
@@ -2752,6 +2754,13 @@ Example: `(ad-map-arglists '(a &rest args) '(w x y z))' will return
 (require 'help-fns)        ;For help-split-fundoc and help-add-fundoc-usage.
 
 (defun ad-make-advised-docstring (function &optional style)
+  (let* ((origdef (ad-real-orig-definition function))
+        (origdoc
+         ;; Retrieve raw doc, key substitution will be taken care of later:
+         (ad-real-documentation origdef t)))
+    (ad--make-advised-docstring origdoc function style)))
+
+(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
@@ -2761,9 +2770,6 @@ strings corresponds to before/around/after and the individual ordering
 in any of these classes."
   (let* ((origdef (ad-real-orig-definition function))
         (origtype (symbol-name (ad-definition-type origdef)))
-        (origdoc
-         ;; Retrieve raw doc, key substitution will be taken care of later:
-         (ad-real-documentation origdef t))
         (usage (help-split-fundoc origdoc function))
         paragraphs advice-docstring ad-usage)
     (setq usage (if (null usage) t (setq origdoc (cdr usage)) (car usage)))
@@ -2780,7 +2786,9 @@ in any of these classes."
                      (propertize
                       ;; separate paragraphs with blank lines:
                       (mapconcat 'identity (nreverse paragraphs) "\n\n")
-                      'ad-advice-info function)))
+                       ;; FIXME: what is this for?
+                      'dynamic-docstring-function
+                       #'ad--make-advised-docstring)))
     (help-add-fundoc-usage origdoc usage)))
 
 (defun ad-make-plain-docstring (function)

diff --git a/lisp/progmodes/sql.el b/lisp/progmodes/sql.el
index 3d5abc4df62a38396a194f5990376be8ff59f352..64b87d9e436ad178e46f13ad468e335cab79bac6 100644 (file)
--- a/lisp/progmodes/sql.el
+++ b/lisp/progmodes/sql.el
@@ -2802,8 +2802,12 @@ each line with INDENT."
     doc))
 
 ;;;###autoload
-(defun sql-help ()
-  "Show short help for the SQL modes.
+(eval
+ ;; FIXME: This dynamic-docstring-function trick doesn't work for byte-compiled
+ ;; functions, because of the lazy-loading of docstrings, which strips away
+ ;; text properties.
+ '(defun sql-help ()
+  #("Show short help for the SQL modes.
 
 Use an entry function to open an interactive SQL buffer.  This buffer is
 usually named `*SQL*'.  The name of the major mode is SQLi.
@@ -2834,32 +2838,23 @@ anything.  The name of the major mode is SQL.
 In this SQL buffer (SQL mode), you can send the region or the entire
 buffer to the interactive SQL buffer (SQLi mode).  The results are
 appended to the SQLi buffer without disturbing your SQL buffer."
+    0 1 (dynamic-docstring-function sql--make-help-docstring))
   (interactive)
+  (describe-function 'sql-help)))
 
-  ;; Insert references to loaded products into the help buffer string
-  (let ((doc (documentation 'sql-help t))
-       changedp)
-    (setq changedp nil)
-
-    ;; Insert FREE software list
-    (when (string-match "^\\(\\s-*\\)[\\\\][\\\\]FREE\\s-*\n" doc 0)
-      (setq doc (replace-match (sql-help-list-products (match-string 1 doc) t)
-                              t t doc 0)
-           changedp t))
-
-    ;; Insert non-FREE software list
-    (when (string-match "^\\(\\s-*\\)[\\\\][\\\\]NONFREE\\s-*\n" doc 0)
-      (setq doc (replace-match (sql-help-list-products (match-string 1 doc) nil)
-                              t t doc 0)
-           changedp t))
-
-    ;; If we changed the help text, save the change so that the help
-    ;; sub-system will see it
-    (when changedp
-      (put 'sql-help 'function-documentation doc)))
-
-  ;; Call help on this function
-  (describe-function 'sql-help))
+(defun sql--make-help-docstring (doc _fun)
+  "Insert references to loaded products into the help buffer string."
+
+  ;; Insert FREE software list
+  (when (string-match "^\\(\\s-*\\)[\\\\][\\\\]FREE\\s-*\n" doc 0)
+    (setq doc (replace-match (sql-help-list-products (match-string 1 doc) t)
+                             t t doc 0)))
+
+  ;; Insert non-FREE software list
+  (when (string-match "^\\(\\s-*\\)[\\\\][\\\\]NONFREE\\s-*\n" doc 0)
+    (setq doc (replace-match (sql-help-list-products (match-string 1 doc) nil)
+                             t t doc 0)))
+  doc)
 
 (defun sql-read-passwd (prompt &optional default)
   "Read a password using PROMPT.  Optional DEFAULT is password to start with."

diff --git a/src/ChangeLog b/src/ChangeLog
index 42c63b21e9551731f88c6f0e4dacb9e1ba8221e0..9bd6ccec01705bc880380c3faf3267c6e861f2fb 100644 (file)
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,8 @@
+2012-11-09  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+       * doc.c (Fdocumentation): Handle new property
+       dynamic-docstring-function to replace the old ad-advice-info.
+
 2012-11-09  Paul Eggert  <eggert@cs.ucla.edu>
 
        * fns.c (Qeql, hashtest_eq): Now static.

diff --git a/src/doc.c b/src/doc.c
index 9ead1addfbab23ada944da89ec5e562f2a0ef0ff..1d3d1e644426d18e5761943088f9b1daa893e4e4 100644 (file)
--- a/src/doc.c
+++ b/src/doc.c
@@ -21,7 +21,7 @@ along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
 #include <config.h>
 
 #include <sys/types.h>
-#include <sys/file.h>  /* Must be after sys/types.h for USG*/
+#include <sys/file.h>  /* Must be after sys/types.h for USG.  */
 #include <fcntl.h>
 #include <unistd.h>
 
@@ -42,7 +42,7 @@ static ptrdiff_t get_doc_string_buffer_size;
 
 static unsigned char *read_bytecode_pointer;
 
-/* readchar in lread.c calls back here to fetch the next byte.
+/* `readchar' in lread.c calls back here to fetch the next byte.
    If UNREADFLAG is 1, we unread a byte.  */
 
 int
@@ -338,15 +338,9 @@ string is passed through `substitute-command-keys'.  */)
 
   doc = Qnil;
 
-  if (SYMBOLP (function))
-    {
-      Lisp_Object tem = Fget (function, Qfunction_documentation);
-      if (!NILP (tem))
-       return Fdocumentation_property (function, Qfunction_documentation,
-                                       raw);
-    }
-
   fun = Findirect_function (function, Qnil);
+  if (CONSP (fun) && EQ (XCAR (fun), Qmacro))
+    fun = XCDR (fun);
   if (SUBRP (fun))
     {
       if (XSUBR (fun)->doc == 0)
@@ -400,8 +394,6 @@ string is passed through `substitute-command-keys'.  */)
          else
            return Qnil;
        }
-      else if (EQ (funcar, Qmacro))
-       return Fdocumentation (Fcdr (fun), raw);
       else
        goto oops;
     }
@@ -411,16 +403,19 @@ string is passed through `substitute-command-keys'.  */)
       xsignal1 (Qinvalid_function, fun);
     }
 
-  /* Check for an advised function.  Its doc string
-     has an `ad-advice-info' text property.  */
+  /* Check for a dynamic docstring.  These come with
+     a dynamic-docstring-function text property.  */
   if (STRINGP (doc))
     {
-      Lisp_Object innerfunc;
-      innerfunc = Fget_text_property (make_number (0),
-                                     intern ("ad-advice-info"),
+      Lisp_Object func
+       = Fget_text_property (make_number (0),
+                             intern ("dynamic-docstring-function"),
                                      doc);
-      if (! NILP (innerfunc))
-       doc = call1 (intern ("ad-make-advised-docstring"), innerfunc);
+      if (!NILP (func))
+       /* Pass both `doc' and `function' since `function' can be needed, and
+          finding `doc' can be annoying: calling `documentation' is not an
+          option because it would infloop.  */
+       doc = call2 (func, doc, function);
     }
 
   /* If DOC is 0, it's typically because of a dumped file missing
@@ -528,6 +523,8 @@ store_function_docstring (Lisp_Object obj, ptrdiff_t offset)
        {
          tem = Fcdr (Fcdr (fun));
          if (CONSP (tem) && INTEGERP (XCAR (tem)))
+           /* FIXME: This modifies typically pure hash-cons'd data, so its
+              correctness is quite delicate.  */
            XSETCAR (tem, make_number (offset));
        }
       else if (EQ (tem, Qmacro))