[Emacs-diffs] scratch/raeburn-startup a6adefd 2/7: Clear out doc strings matching DOC file before dumping.

[Ken Raeburn]

branch: scratch/raeburn-startup
commit a6adefdda948a1040edc2ad6c88c9014bf581df8
Author: Ken Raeburn <address@hidden>
Commit: Ken Raeburn <address@hidden>

    Clear out doc strings matching DOC file before dumping.
    
    Since we have to call Snarf-documentation when reloading the saved
    Lisp environment to get the subr doc pointers correct, we should omit
    from the saved environment any doc strings that will be re-acquired
    via Snarf-documentation anyway.
    
    * src/doc.c (store_function_docstring): Add a new argument which,
    if true, causes documentation slots to be set to indicate a zero
    offset, which will be replaced next time Snarf-documentation is
    called.
    (Fsnarf_documentation): Add an optional second argument that says to
    clear out as much as possible any documentation that can be found
    later with a normal call to Fsnarf_documentation.
    (reread_doc_file): Supply nil as the new argument to
    Fsnarf_documentation.
    * lisp/loadup.el: When preparing to dump the environment, call
    Snarf-documentation with the extra argument to clear out the doc
    strings that we can reload at startup time.
---
 lisp/loadup.el |  2 +-
 src/doc.c      | 66 +++++++++++++++++++++++++++++++++++++++++++++-------------
 2 files changed, 52 insertions(+), 16 deletions(-)

diff --git a/lisp/loadup.el b/lisp/loadup.el
index ad45f0c..2b5bb3e 100644
--- a/lisp/loadup.el
+++ b/lisp/loadup.el
@@ -373,7 +373,7 @@ lost after dumping")))
 
 (message "Finding pointers to doc strings...")
 (if (equal (last command-line-args) '("dump"))
-    (Snarf-documentation "DOC")
+    (Snarf-documentation "DOC" 'clear)
   (condition-case nil
       (Snarf-documentation "DOC")
     (error nil)))
diff --git a/src/doc.c b/src/doc.c
index ce4f89b..8dbc41e 100644
--- a/src/doc.c
+++ b/src/doc.c
@@ -305,7 +305,7 @@ static bool
 reread_doc_file (Lisp_Object file)
 {
   if (NILP (file))
-    Fsnarf_documentation (Vdoc_file_name);
+    Fsnarf_documentation (Vdoc_file_name, Qnil);
   else
     Fload (file, Qt, Qt, Qt, Qnil);
 
@@ -464,7 +464,7 @@ aren't strings.  */)
 /* Scanning the DOC files and placing docstring offsets into functions.  */
 
 static void
-store_function_docstring (Lisp_Object obj, EMACS_INT offset)
+store_function_docstring (Lisp_Object obj, EMACS_INT offset, bool clear)
 {
   /* Don't use indirect_function here, or defaliases will apply their
      docstrings to the base functions (Bug#2603).  */
@@ -484,10 +484,16 @@ store_function_docstring (Lisp_Object obj, EMACS_INT 
offset)
          || (EQ (tem, Qclosure) && (fun = XCDR (fun), 1)))
        {
          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));
+         if (CONSP (tem))
+           {
+             if (clear)
+               /* Discard any string we may have loaded.
+                  Also, 0 is a shorter placeholder in the dumped
+                  environment file than the actual offset.  */
+               XSETCAR (tem, make_number (0));
+             else if (INTEGERP (XCAR (tem)))
+               XSETCAR (tem, make_number (offset));
+           }
        }
     }
 
@@ -501,7 +507,7 @@ store_function_docstring (Lisp_Object obj, EMACS_INT offset)
       /* This bytecode object must have a slot for the
         docstring, since we've found a docstring for it.  */
       if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) > COMPILED_DOC_STRING)
-       ASET (fun, COMPILED_DOC_STRING, make_number (offset));
+       ASET (fun, COMPILED_DOC_STRING, make_number (clear ? 0 : offset));
       else
        {
          AUTO_STRING (format, "No docstring slot for %s");
@@ -515,15 +521,22 @@ store_function_docstring (Lisp_Object obj, EMACS_INT 
offset)
 
 
 DEFUN ("Snarf-documentation", Fsnarf_documentation, Ssnarf_documentation,
-       1, 1, 0,
+       1, 2, 0,
        doc: /* Used during Emacs initialization to scan the `etc/DOC...' file.
 This searches the `etc/DOC...' file for doc strings and
 records them in function and variable definitions.
-The function takes one argument, FILENAME, a string;
+The function takes one required argument, FILENAME, a string;
 it specifies the file name (without a directory) of the DOC file.
 That file is found in `../etc' now; later, when the dumped Emacs is run,
-the same file name is found in the `doc-directory'.  */)
-  (Lisp_Object filename)
+the same file name is found in the `doc-directory'.
+
+Optional second argument CLEAR, if set, causes the removal of
+variable-documentation properties and the replacement of function doc
+strings with dummy DOC file offsets when the documentation is found in
+the DOC file, to minimize storage use in preparation for dumping the
+Lisp environment state, with the expectation that Snarf-documentation
+will be called again after loading the dumped environment.  */)
+  (Lisp_Object filename, Lisp_Object clear)
 {
   int fd;
   char buf[1024 + 1];
@@ -643,16 +656,39 @@ the same file name is found in the `doc-directory'.  */)
                     (doc starts with a `*').  */
                   if (!NILP (Fboundp (sym))
                       || !NILP (Fmemq (sym, delayed_init)))
-                    Fput (sym, Qvariable_documentation,
-                          make_number ((pos + end + 1 - buf)
-                                       * (end[1] == '*' ? -1 : 1)));
+                   {
+                     if (NILP (clear))
+                       Fput (sym, Qvariable_documentation,
+                             make_number ((pos + end + 1 - buf)
+                                          * (end[1] == '*' ? -1 : 1)));
+                     else
+                       /* Remove the variable-documentation property,
+                          if present, even if it's nil (which makes
+                          Fget unhelpful).  */
+                       {
+                         Lisp_Object plist = Fsymbol_plist (sym);
+                         Lisp_Object prev, prop;
+                         if (EQ (Fcar (plist), Qvariable_documentation))
+                           set_symbol_plist (sym, Fcdr (Fcdr (plist)));
+                         else
+                           for (prev = Fcdr (plist), prop = Fcdr (prev);
+                                !NILP (prop);
+                                prev = Fcdr (prop), prop = Fcdr (prev))
+                             if (EQ (Fcar (prop), Qvariable_documentation))
+                               {
+                                 Fsetcdr (prev, Fcdr (Fcdr (prop)));
+                                 break;
+                               }
+                       }
+                   }
                }
 
              /* Attach a docstring to a function?  */
              else if (p[1] == 'F')
                 {
                   if (!NILP (Ffboundp (sym)))
-                    store_function_docstring (sym, pos + end + 1 - buf);
+                    store_function_docstring (sym, pos + end + 1 - buf,
+                                             !NILP (clear));
                 }
              else if (p[1] == 'S')
                ; /* Just a source file name boundary marker.  Ignore it.  */