bytecomp.el: Rewrite the way we print dynamic docstrings

We used to print dynamic docstrings "manually" for two reasons:

- References should look like `(#$ . POS)` but `prin1` was unable
  to print just `#$` for an sexp.
- `make-docfile` needed to find those docstrings and the object
  to which they belonged.

The second point is moot now that we don't use `make-docfile` on
`.elc` files.  So this patch lifts the first restriction,
using `print-number-table`.

The rest of the patch then simplifies and regularises the
bytecompiler's generation of dynamic docstrings, which can
now also easily be done for "inner" defvars and other places.

* src/print.c (print_preprocess, print_object): Handle strings in
`print-number-table`.
(Vprint_number_table): Improve docstring.

* lisp/emacs-lisp/bytecomp.el:
(byte-compile--list-with-n): New function.
(byte-compile--docstring-style-warn): Rename from
`byte-compile-docstring-style-warn` and change calling convention.
(byte-compile--\#$, byte-compile--docstrings): New vars.
(byte-compile-close-variables): Bind them.
(byte-compile--docstring): New function.
(byte-compile-from-buffer): Set `byte-compile--\#$`.
(byte-compile-output-file-form): Use `byte-compile--\#$` instead
of special casing specific forms.
(byte-compile--output-docform-recurse, byte-compile-output-docform):
Delete functions.
(byte-compile-file-form-autoload, byte-compile-file-form-defalias)
(byte-compile-file-form-defvar-function, byte-compile-lambda):
Use `byte-compile--docstring` and `byte-compile--list-with-n`.
(byte-compile--declare-var): Add optional `not-toplevel` arg.
(byte-compile-defvar): Add `toplevel` arg.  Use `byte-compile--docstring`.
(byte-compile-file-form-defvar): Delegate to `byte-compile-defvar`.
(byte-compile--custom-declare-face): New function.  Use it for
`custom-declare-face`.
(byte-compile-file-form-defmumble): Use `byte-compile-output-file-form`

* src/doc.c (Fdocumentation_stringp): New function.
(syms_of_doc): Defsubr it.
(store_function_docstring): Remove left-over code from when we
used DOC for the docstring of some Lisp files.

* lisp/cus-face.el (custom-declare-face): Accept dynamic docstrings.
* lisp/faces.el (face-documentation): Handle dynamic docstrings.
* lisp/help-fns.el (describe-face): Simplify accordingly.

1 files changed, 20 insertions, 38 deletions

diff --git a/src/doc.c b/src/doc.c
index a451b468ef2..b5a9ed498af 100644
--- a/src/doc.c
+++ b/src/doc.c
@@ -357,6 +357,20 @@ reread_doc_file (Lisp_Object file)
   return 1;
 }
 
+DEFUN ("documentation-stringp", Fdocumentation_stringp, Sdocumentation_stringp,
+       1, 1, 0,
+       doc: /* Return non-nil if OBJECT is a well-formed docstring object.
+OBJECT can be either a string or a reference if it's kept externally.  */)
+  (Lisp_Object object)
+{
+  return (STRINGP (object)
+          || FIXNUMP (object)   /* Reference to DOC.  */
+          || (CONSP (object)    /* Reference to .elc.  */
+              && STRINGP (XCAR (object))
+              && FIXNUMP (XCDR (object)))
+          ? Qt : Qnil);
+}
+
 DEFUN ("documentation", Fdocumentation, Sdocumentation, 1, 2, 0,
        doc: /* Return the documentation string of FUNCTION.
 Unless a non-nil second argument RAW is given, the
@@ -502,46 +516,13 @@ store_function_docstring (Lisp_Object obj, EMACS_INT offset)
   /* If it's a lisp form, stick it in the form.  */
   if (CONSP (fun) && EQ (XCAR (fun), Qmacro))
     fun = XCDR (fun);
-  if (CONSP (fun))
-    {
-      Lisp_Object tem = XCAR (fun);
-      if (EQ (tem, Qlambda) || EQ (tem, Qautoload)
-          || (EQ (tem, Qclosure) && (fun = XCDR (fun), 1)))
-        {
-          tem = Fcdr (Fcdr (fun));
-          if (CONSP (tem) && FIXNUMP (XCAR (tem)))
-            /* FIXME: This modifies typically pure hash-cons'd data, so its
-               correctness is quite delicate.  */
-            XSETCAR (tem, make_fixnum (offset));
-        }
-    }
   /* Lisp_Subrs have a slot for it.  */
-  else if (SUBRP (fun) && !SUBR_NATIVE_COMPILEDP (fun))
-    {
-      XSUBR (fun)->doc = offset;
-    }
-
-  /* Bytecode objects sometimes have slots for it.  */
-  else if (COMPILEDP (fun))
+  if (SUBRP (fun) && !SUBR_NATIVE_COMPILEDP (fun))
+    XSUBR (fun)->doc = offset;
+  else
     {
-      /* This bytecode object must have a slot for the
-         docstring, since we've found a docstring for it.  */
-      if (PVSIZE (fun) > COMPILED_DOC_STRING
-          /* Don't overwrite a non-docstring value placed there,
-           * such as the symbols used for Oclosures.  */
-          && VALID_DOCSTRING_P (AREF (fun, COMPILED_DOC_STRING)))
-        ASET (fun, COMPILED_DOC_STRING, make_fixnum (offset));
-      else
-        {
-          AUTO_STRING (format,
-                       (PVSIZE (fun) > COMPILED_DOC_STRING
-                        ? "Docstring slot busy for %s"
-                        : "No docstring slot for %s"));
-          CALLN (Fmessage, format,
-                 (SYMBOLP (obj)
-                  ? SYMBOL_NAME (obj)
-                  : build_string ("<anonymous>")));
-        }
+      AUTO_STRING (format, "Ignoring DOC string on non-subr: %S");
+      CALLN (Fmessage, format, obj);
     }
 }
 
@@ -776,6 +757,7 @@ compute the correct value for the current terminal in the nil case.  */);
                doc: /* If nil, a nil `text-quoting-style' is treated as `grave'.  */);
   /* Initialized by ‘main’.  */
 
+  defsubr (&Sdocumentation_stringp);
   defsubr (&Sdocumentation);
   defsubr (&Ssubr_documentation);
   defsubr (&Sdocumentation_property);