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.

2 files changed, 31 insertions, 46 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);
diff --git a/src/print.c b/src/print.c
index c6a3dba3163..c2beff0ed55 100644
--- a/src/print.c
+++ b/src/print.c
@@ -1412,7 +1412,7 @@ print_preprocess (Lisp_Object obj)
                   && SYMBOLP (obj)
                   && !SYMBOL_INTERNED_P (obj)))
             { /* OBJ appears more than once.  Let's remember that.  */
-              if (!FIXNUMP (num))
+              if (SYMBOLP (num)) /* In practice, nil or t.  */
                 {
                   print_number_index++;
                   /* Negative number indicates it hasn't been printed yet.  */
@@ -2265,6 +2265,11 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
               goto next_obj;
             }
         }
+      else if (STRINGP (num))
+        {
+          strout (SDATA (num), SCHARS (num), SBYTES (num), printcharfun);
+          goto next_obj;
+        }
     }
 
   print_depth++;
@@ -2554,11 +2559,6 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
           goto next_obj;
         case PVEC_SUB_CHAR_TABLE:
           {
-            /* Make each lowest sub_char_table start a new line.
-               Otherwise we'll make a line extremely long, which
-               results in slow redisplay.  */
-            if (XSUB_CHAR_TABLE (obj)->depth == 3)
-              printchar ('\n', printcharfun);
             print_c_string ("#^^[", printcharfun);
             int n = sprintf (buf, "%d %d",
                              XSUB_CHAR_TABLE (obj)->depth,
@@ -2664,7 +2664,7 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
                     /* With the print-circle feature.  */
                     Lisp_Object num = Fgethash (next, Vprint_number_table,
                                                 Qnil);
-                    if (FIXNUMP (num))
+                    if (!(NILP (num) || EQ (num, Qt)))
                       {
                         print_c_string (" . ", printcharfun);
                         obj = next;
@@ -2928,7 +2928,10 @@ This variable should not be set with `setq'; bind it with a `let' instead.  */);
   DEFVAR_LISP ("print-number-table", Vprint_number_table,
                doc: /* A vector used internally to produce `#N=' labels and `#N#' references.
 The Lisp printer uses this vector to detect Lisp objects referenced more
-than once.
+than once.  If an entry contains a number, then the corresponding key is
+referenced more than once: a positive sign indicates that it's already been
+printed, and the absolute value indicates the number to use when printing.
+If an entry contains a string, that string is printed instead.
 
 When you bind `print-continuous-numbering' to t, you should probably
 also bind `print-number-table' to nil.  This ensures that the value of