--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/doc.c	Mon Aug 13 11:28:15 2007 +0200
@@ -0,0 +1,1006 @@
+/* Record indices of function doc strings stored in a file.
+   Copyright (C) 1985, 1986, 1992, 1993, 1994, 1995
+   Free Software Foundation, Inc.
+
+This file is part of XEmacs.
+
+XEmacs is free software; you can redistribute it and/or modify it
+under the terms of the GNU General Public License as published by the
+Free Software Foundation; either version 2, or (at your option) any
+later version.
+
+XEmacs is distributed in the hope that it will be useful, but WITHOUT
+ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License
+along with XEmacs; see the file COPYING.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
+
+/* Synched up with: FSF 19.30. */
+
+/* This file has been Mule-ized except as noted. */
+
+#include <config.h>
+#include "lisp.h"
+
+#include "buffer.h"
+#include "bytecode.h"
+#include "insdel.h"
+#include "keymap.h"
+#include "sysfile.h"
+
+Lisp_Object Vinternal_doc_file_name;
+
+Lisp_Object QSsubstitute;
+
+/* Read and return doc string from open file descriptor FD
+   at position POSITION.  Does not close the file.  Returns
+   string; or if error, returns a cons holding the error
+   data to pass to Fsignal.  NAME_NONRELOC and NAME_RELOC
+   are only used for the error messages. */
+
+Lisp_Object
+unparesseuxify_doc_string (int fd, EMACS_INT position,
+                           char *name_nonreloc, Lisp_Object name_reloc)
+{
+  char buf[512 * 32 + 1];
+  char *buffer = buf;
+  int buffer_size = sizeof (buf);
+  char *from, *to;
+  REGISTER char *p = buffer;
+  Lisp_Object return_me;
+
+  if (0 > lseek (fd, position, 0))
+    {
+      if (name_nonreloc)
+	name_reloc = build_string (name_nonreloc);
+      return_me = list3 (build_string
+			 ("Position out of range in doc string file"),
+			  name_reloc, make_int (position));
+      goto done;
+    }
+
+  /* Read the doc string into a buffer.
+     Use the fixed buffer BUF if it is big enough; otherwise allocate one.
+     We store the buffer in use in BUFFER and its size in BUFFER_SIZE.  */
+
+  while (1)
+    {
+      int space_left = buffer_size - (p - buffer);
+      int nread;
+
+      /* Switch to a bigger buffer if we need one.  */
+      if (space_left == 0)
+	{
+          char * old_buffer = buffer;
+	  if (buffer == buf) {
+            buffer = (char *) xmalloc (buffer_size *= 2);
+            memcpy (buffer, old_buffer, p - old_buffer);
+          } else {
+            buffer = (char *) xrealloc (buffer, buffer_size *= 2);
+          }
+          p += buffer - old_buffer;
+	  space_left = buffer_size - (p - buffer);
+	}
+
+      /* Don't read too much at one go.  */
+      if (space_left > 1024 * 8)
+	space_left = 1024 * 8;
+      nread = read (fd, p, space_left);
+      if (nread < 0)
+	{
+	  return_me = list1 (build_string
+			     ("Read error on documentation file"));
+	  goto done;
+	}
+      p[nread] = 0;
+      if (!nread)
+	break;
+      {
+        char *p1 = strchr (p, '\037'); /* End of doc string marker */
+        if (p1)
+          {
+            *p1 = 0;
+            p = p1;
+            break;
+          }
+      }
+      p += nread;
+    }
+
+  /* Scan the text and remove quoting with ^A (char code 1).
+     ^A^A becomes ^A, ^A0 becomes a null char, and ^A_ becomes a ^_.  */
+  from = to = buffer;
+  while (from < p)
+    {
+      if (*from != 1 /*^A*/)
+	*to++ = *from++;
+      else
+	{
+	  int c = *(++from);
+
+	  from++;
+          switch (c)
+            {
+            case 1:   *to++ =  c;     break;
+            case '0': *to++ = '\0';   break;
+            case '_': *to++ = '\037'; break;
+            default:
+              return_me = list2 (build_string
+	("Invalid data in documentation file -- ^A followed by weird code"),
+                                 make_int (c));
+              goto done;
+            }
+	}
+    }
+
+  /* #### mrb: following STILL completely broken */
+  return_me = make_ext_string ((Bufbyte *) buffer, to - buffer, FORMAT_BINARY);
+
+ done:
+  if (buffer != buf) /* We must have allocated buffer above */
+    xfree (buffer);
+  return return_me;
+}
+
+#define string_join(dest, s1, s2) \
+  memcpy ((void *) dest, (void *) XSTRING_DATA (s1), XSTRING_LENGTH (s1)); \
+  memcpy ((void *) ((Bufbyte *) dest + XSTRING_LENGTH (s1)), \
+          (void *) XSTRING_DATA (s2), XSTRING_LENGTH (s2));  \
+          dest[XSTRING_LENGTH (s1) + XSTRING_LENGTH (s2)] = '\0'
+
+/* Extract a doc string from a file.  FILEPOS says where to get it.
+   (This could actually be byte code instructions/constants instead
+   of a doc string.)
+   If it is an integer, use that position in the standard DOC file.
+   If it is (FILE . INTEGER), use FILE as the file name
+   and INTEGER as the position in that file.
+   But if INTEGER is negative, make it positive.
+   (A negative integer is used for user variables, so we can distinguish
+   them without actually fetching the doc string.)  */
+
+static Lisp_Object
+get_doc_string (Lisp_Object filepos)
+{
+  /* !!#### This function has not been Mule-ized */
+  REGISTER int fd;
+  REGISTER char *name_nonreloc = 0;
+  int minsize;
+  EMACS_INT position;
+  Lisp_Object file, tem;
+  Lisp_Object name_reloc = Qnil;
+
+  if (INTP (filepos))
+    {
+      file = Vinternal_doc_file_name;
+      position = XINT (filepos);
+    }
+  else if (CONSP (filepos) && INTP (XCDR (filepos)))
+    {
+      file = XCAR (filepos);
+      position = XINT (XCDR (filepos));
+      if (position < 0)
+	position = - position;
+    }
+  else
+    return Qnil;
+
+  if (!STRINGP (file))
+    return Qnil;
+
+  /* Put the file name in NAME as a C string.
+     If it is relative, combine it with Vdoc_directory.  */
+
+  tem = Ffile_name_absolute_p (file);
+  if (NILP (tem))
+    {
+      /* XEmacs: Move this check here.  OK if called during loadup to
+	 load byte code instructions. */
+      if (!STRINGP (Vdoc_directory))
+	return Qnil;
+
+      minsize = XSTRING_LENGTH (Vdoc_directory);
+      /* sizeof ("../lib-src/") == 12 */
+      if (minsize < 12)
+	minsize = 12;
+      name_nonreloc = (char *) alloca (minsize + XSTRING_LENGTH (file) + 8);
+      string_join (name_nonreloc, Vdoc_directory, file);
+    }
+  else
+    name_reloc = file;
+
+  fd = open (name_nonreloc ? name_nonreloc :
+	     (char *) XSTRING_DATA (name_reloc), O_RDONLY | OPEN_BINARY, 0);
+  if (fd < 0)
+    {
+#ifndef CANNOT_DUMP
+      if (purify_flag)
+	{
+	    /* sizeof ("../lib-src/") == 12 */
+	  name_nonreloc = (char *) alloca (12 + XSTRING_LENGTH (file) + 8);
+	  /* Preparing to dump; DOC file is probably not installed.
+	     So check in ../lib-src. */
+	  strcpy (name_nonreloc, "../lib-src/");
+	  strcat (name_nonreloc, (char *) XSTRING_DATA (file));
+
+	  fd = open (name_nonreloc, O_RDONLY | OPEN_BINARY, 0);
+	}
+#endif /* CANNOT_DUMP */
+
+      if (fd < 0)
+	error ("Cannot open doc string file \"%s\"",
+	       name_nonreloc ? name_nonreloc :
+	       (char *) XSTRING_DATA (name_reloc));
+    }
+
+  tem = unparesseuxify_doc_string (fd, position, name_nonreloc, name_reloc);
+  close (fd);
+
+  if (!STRINGP (tem))
+    signal_error (Qerror, tem);
+
+  return tem;
+}
+
+/* Get a string from position FILEPOS and pass it through the Lisp reader.
+   We use this for fetching the bytecode string and constants vector
+   of a compiled function from the .elc file.  */
+
+Lisp_Object
+read_doc_string (Lisp_Object filepos)
+{
+  Lisp_Object string = get_doc_string (filepos);
+
+  if (!STRINGP (string))
+    signal_simple_error ("loading bytecode failed to return string", string);
+  return Fread (string);
+}
+
+DEFUN ("documentation", Fdocumentation, 1, 2, 0, /*
+Return the documentation string of FUNCTION.
+Unless a non-nil second argument is given, the
+string is passed through `substitute-command-keys'.
+*/
+       (function, raw))
+{
+  /* This function can GC */
+  Lisp_Object fun;
+  Lisp_Object doc;
+
+  fun = Findirect_function (function);
+
+  if (SUBRP (fun))
+    {
+      if (XSUBR (fun)->doc == 0)
+	return Qnil;
+      if ((EMACS_INT) XSUBR (fun)->doc >= 0)
+	doc = build_string (XSUBR (fun)->doc);
+      else
+        doc = get_doc_string (make_int (- (EMACS_INT) XSUBR (fun)->doc));
+    }
+  else if (COMPILED_FUNCTIONP (fun))
+    {
+      Lisp_Object tem;
+      struct Lisp_Compiled_Function *f = XCOMPILED_FUNCTION (fun);
+      if (! (f->flags.documentationp))
+        return Qnil;
+      tem = compiled_function_documentation (f);
+      if (STRINGP (tem))
+	doc = tem;
+      else if (NATNUMP (tem) || CONSP (tem))
+	doc = get_doc_string (tem);
+      else
+        return Qnil;
+    }
+  else if (KEYMAPP (fun))
+    return build_translated_string ("Prefix command (definition is a keymap of subcommands).");
+  else if (STRINGP (fun) || VECTORP (fun))
+    return build_translated_string ("Keyboard macro.");
+  else if (CONSP (fun))
+    {
+      Lisp_Object funcar = Fcar (fun);
+
+      if (!SYMBOLP (funcar))
+	return Fsignal (Qinvalid_function, list1 (fun));
+      else if (EQ (funcar, Qlambda)
+             || EQ (funcar, Qautoload))
+	{
+	  Lisp_Object tem, tem1;
+	  tem1 = Fcdr (Fcdr (fun));
+	  tem = Fcar (tem1);
+	  if (STRINGP (tem))
+	    doc = tem;
+	  /* Handle a doc reference--but these never come last
+	     in the function body, so reject them if they are last.  */
+	  else if ((NATNUMP (tem) || CONSP (tem))
+		   && ! NILP (XCDR (tem1)))
+	    doc = get_doc_string (tem);
+	  else
+	    return Qnil;
+	}
+      else if (EQ (funcar, Qmacro))
+	return Fdocumentation (Fcdr (fun), raw);
+      else
+	goto oops;
+    }
+  else
+    {
+    oops:
+      return Fsignal (Qinvalid_function, list1 (fun));
+    }
+
+  if (NILP (raw))
+    {
+      struct gcpro gcpro1;
+#ifdef I18N3
+      Lisp_Object domain = Qnil;
+      if (COMPILED_FUNCTIONP (fun))
+	domain = compiled_function_domain (XCOMPILED_FUNCTION (fun));
+      if (NILP (domain))
+	doc = Fgettext (doc);
+      else
+	doc = Fdgettext (domain, doc);
+#endif
+
+      GCPRO1 (doc);
+      doc = Fsubstitute_command_keys (doc);
+      UNGCPRO;
+    }
+  return doc;
+}
+
+DEFUN ("documentation-property", Fdocumentation_property, 2, 3, 0, /*
+Return the documentation string that is SYMBOL's PROP property.
+This is like `get', but it can refer to strings stored in the
+`doc-directory/DOC' file; and if the value is a string, it is passed
+through `substitute-command-keys'.  A non-nil third argument avoids this
+translation.
+*/
+       (sym, prop, raw))
+{
+  /* This function can GC */
+  REGISTER Lisp_Object doc = Qnil;
+#ifdef I18N3
+  REGISTER Lisp_Object domain;
+#endif
+  struct gcpro gcpro1;
+
+  GCPRO1 (doc);
+
+  doc = Fget (sym, prop, Qnil);
+  if (INTP (doc))
+    doc = get_doc_string (XINT (doc) > 0 ? doc : make_int (- XINT (doc)));
+  else if (CONSP (doc))
+    doc = get_doc_string (doc);
+#ifdef I18N3
+  if (!NILP (doc))
+    {
+      domain = Fget (sym, Qvariable_domain, Qnil);
+      if (NILP (domain))
+	doc = Fgettext (doc);
+      else
+	doc = Fdgettext (domain, doc);
+    }
+#endif
+  if (NILP (raw) && STRINGP (doc))
+    doc = Fsubstitute_command_keys (doc);
+  UNGCPRO;
+  return doc;
+}
+
+static void
+weird_doc (Lisp_Object sym, CONST char *weirdness, CONST char *type, int pos)
+{
+  if (!strcmp (weirdness, GETTEXT ("duplicate"))) return;
+  message ("Note: Strange doc (%s) for %s %s @ %d",
+           weirdness, type, string_data (XSYMBOL (sym)->name), pos);
+}
+
+
+DEFUN ("Snarf-documentation", Fsnarf_documentation, 1, 1, 0, /*
+Used during Emacs initialization, before dumping runnable Emacs,
+to find pointers to doc strings stored in `.../lib-src/DOC' and
+record them in function definitions.
+One arg, FILENAME, a string which does not include a directory.
+The file is written to `../lib-src', and later found in `exec-directory'
+when doc strings are referred to in the dumped Emacs.
+*/
+       (filename))
+{
+  /* !!#### This function has not been Mule-ized */
+  int fd;
+  char buf[1024 + 1];
+  REGISTER int filled;
+  REGISTER int pos;
+  REGISTER char *p, *end;
+  Lisp_Object sym, fun, tem;
+  char *name;
+
+#ifndef CANNOT_DUMP
+  if (!purify_flag)
+    error ("Snarf-documentation can only be called in an undumped Emacs");
+#endif
+
+  CHECK_STRING (filename);
+
+#ifdef CANNOT_DUMP
+  if (!NILP(Vdoc_directory))
+    {
+      CHECK_STRING (Vdoc_directory);
+      name = (char *) alloca (XSTRING_LENGTH (filename)
+			      + XSTRING_LENGTH (Vdoc_directory)
+			      + 1);
+      strcpy (name, (char *) XSTRING_DATA (Vdoc_directory));
+    }
+  else
+#endif /* CANNOT_DUMP */
+    {
+      name = (char *) alloca (XSTRING_LENGTH (filename) + 14);
+      strcpy (name, "../lib-src/");
+    }
+
+  strcat (name, (char *) XSTRING_DATA (filename));
+
+  fd = open (name, O_RDONLY | OPEN_BINARY, 0);
+  if (fd < 0)
+    report_file_error ("Opening doc string file",
+		       Fcons (build_string (name), Qnil));
+  Vinternal_doc_file_name = filename;
+  filled = 0;
+  pos = 0;
+  while (1)
+    {
+      if (filled < 512)
+	filled += read (fd, &buf[filled], sizeof buf - 1 - filled);
+      if (!filled)
+	break;
+
+      buf[filled] = 0;
+      p = buf;
+      end = buf + (filled < 512 ? filled : filled - 128);
+      while (p != end && *p != '\037') p++;
+      /* p points to ^_Ffunctionname\n or ^_Vvarname\n.  */
+      if (p != end)
+	{
+	  end = strchr (p, '\n');
+	  sym = oblookup (Vobarray, (Bufbyte *) p + 2, end - p - 2);
+	  if (SYMBOLP (sym))
+	    {
+              Lisp_Object offset = make_int (pos + end + 1 - buf);
+	      /* Attach a docstring to a variable */
+	      if (p[1] == 'V')
+		{
+		  /* Install file-position as variable-documentation property
+		     and make it negative for a user-variable
+		     (doc starts with a `*').  */
+		  Lisp_Object old = Fget (sym, Qvariable_documentation, Qzero);
+                  if (!ZEROP (old))
+		    {
+		      weird_doc (sym, GETTEXT ("duplicate"),
+				 GETTEXT ("variable"), pos);
+		      /* In the case of duplicate doc file entries, always
+			 take the later one.  But if the doc is not an int
+			 (a string, say) leave it alone. */
+		      if (!INTP (old))
+			goto weird;
+		    }
+		  Fput (sym, Qvariable_documentation,
+                        ((end[1] == '*')
+                         ? make_int (- XINT (offset))
+                         : offset));
+		}
+	      /* Attach a docstring to a function.
+                 The type determines where the docstring is stored.  */
+	      else if (p[1] == 'F')
+		{
+                  fun = indirect_function (sym,0);
+
+		  if (CONSP (fun) && EQ (XCAR (fun), Qmacro))
+		    fun = XCDR (fun);
+
+                  if (UNBOUNDP (fun))
+		    {
+		      /* May have been #if'ed out or something */
+		      weird_doc (sym, GETTEXT ("not fboundp"),
+				 GETTEXT ("function"), pos);
+		      goto weird;
+		    }
+		  else if (SUBRP (fun))
+		    {
+		      /* Lisp_Subrs have a slot for it.  */
+		      if (XSUBR (fun)->doc)
+			{
+			  weird_doc (sym, GETTEXT ("duplicate"),
+				     GETTEXT ("subr"), pos);
+			  goto weird;
+			}
+		      XSUBR (fun)->doc = (char *) (- XINT (offset));
+		    }
+		  else if (CONSP (fun))
+		    {
+                      /* If it's a lisp form, stick it in the form.  */
+		      tem = XCAR (fun);
+		      if (EQ (tem, Qlambda) || EQ (tem, Qautoload))
+			{
+			  tem = Fcdr (Fcdr (fun));
+			  if (CONSP (tem) &&
+			      INTP (XCAR (tem)))
+			    {
+			      Lisp_Object old = XCAR (tem);
+			      if (!ZEROP (old))
+				{
+				  weird_doc (sym, GETTEXT ("duplicate"),
+					     (EQ (tem, Qlambda)
+					      ? GETTEXT ("lambda")
+					      : GETTEXT ("autoload")),
+					     pos);
+				  /* In the case of duplicate doc file entries,
+				     always take the later one.  But if the doc
+				     is not an int (a string, say) leave it
+				     alone. */
+				  if (!INTP (old))
+				    goto weird;
+				}
+			      XCAR (tem) = offset;
+			    }
+                          else if (!CONSP (tem))
+			    {
+			      weird_doc (sym, GETTEXT ("!CONSP(tem)"),
+					 GETTEXT ("function"), pos);
+			      goto cont;
+			    }
+                          else
+			    {
+			      /* DOC string is a string not integer 0 */
+#if 0
+			      weird_doc (sym, GETTEXT ("!INTP(XCAR(tem))"),
+					 GETTEXT ("function"), pos);
+#endif
+			      goto cont;
+			    }
+                        }
+                      else
+			{
+			  weird_doc (sym, GETTEXT ("not lambda or autoload"),
+				     GETTEXT ("function"), pos);
+			  goto cont;
+			}
+		    }
+		  else if (COMPILED_FUNCTIONP (fun))
+		    {
+                      /* Compiled-Function objects sometimes have
+                         slots for it.  */
+                      struct Lisp_Compiled_Function *f =
+			XCOMPILED_FUNCTION (fun);
+
+		      /* This compiled-function object must have a
+			 slot for the docstring, since we've found a
+			 docstring for it.  Unless there were multiple
+			 definitions of it, and the latter one didn't
+			 have any doc, which is a legal if slightly
+			 bogus situation, so don't blow up. */
+
+                      if (! (f->flags.documentationp))
+			{
+			  weird_doc (sym, GETTEXT ("no doc slot"),
+				     GETTEXT ("bytecode"), pos);
+			  goto weird;
+			}
+		      else
+			{
+			  Lisp_Object old =
+			    compiled_function_documentation (f);
+			  if (!ZEROP (old))
+			    {
+			      weird_doc (sym, GETTEXT ("duplicate"),
+					 GETTEXT ("bytecode"), pos);
+			      /* In the case of duplicate doc file entries,
+				 always take the later one.  But if the doc is
+				 not an int (a string, say) leave it alone. */
+			      if (!INTP (old))
+				goto weird;
+			    }
+			  set_compiled_function_documentation (f, offset);
+			}
+                    }
+                  else
+                    {
+                      /* Otherwise the function is undefined or
+                         otherwise weird.   Ignore it. */
+                      weird_doc (sym, GETTEXT ("weird function"),
+				 GETTEXT ("function"), pos);
+                      goto weird;
+                    }
+                }
+	      else
+                {
+                /* lose: */
+                  error ("DOC file invalid at position %d", pos);
+                weird:
+                  /* goto lose */;
+                }
+            }
+	}
+    cont:
+      pos += end - buf;
+      filled -= end - buf;
+      memmove (buf, end, filled);
+    }
+  close (fd);
+  return Qnil;
+}
+
+
+#if 1	/* Don't warn about functions whose doc was lost because they were
+	   wrapped by advice-freeze.el... */
+static int
+kludgily_ignore_lost_doc_p (Lisp_Object sym)
+{
+# define kludge_prefix "ad-Orig-"
+  struct Lisp_String *name = XSYMBOL (sym)->name;
+  return (string_length (name) > (Bytecount) (sizeof (kludge_prefix)) &&
+	  !strncmp ((char *) string_data (name), kludge_prefix,
+		    sizeof (kludge_prefix) - 1));
+# undef kludge_prefix
+}
+#else
+# define kludgily_ignore_lost_doc_p(sym) 0
+#endif
+
+
+static int
+verify_doc_mapper (Lisp_Object sym, void *arg)
+{
+  Lisp_Object closure = *(Lisp_Object *)arg;
+
+  if (!NILP (Ffboundp (sym)))
+    {
+      int doc = 0;
+      Lisp_Object fun = XSYMBOL (sym)->function;
+      if (CONSP (fun) &&
+	  EQ (XCAR (fun), Qmacro))
+	fun = XCDR (fun);
+
+      if (SUBRP (fun))
+	doc = (EMACS_INT) XSUBR (fun)->doc;
+      else if (SYMBOLP (fun))
+	doc = -1;
+      else if (KEYMAPP (fun))
+	doc = -1;
+      else if (CONSP (fun))
+	{
+	  Lisp_Object tem = XCAR (fun);
+	  if (EQ (tem, Qlambda) || EQ (tem, Qautoload))
+	    {
+	      doc = -1;
+	      tem = Fcdr (Fcdr (fun));
+	      if (CONSP (tem) &&
+		  INTP (XCAR (tem)))
+		doc = XINT (XCAR (tem));
+	    }
+	}
+      else if (COMPILED_FUNCTIONP (fun))
+	{
+          struct Lisp_Compiled_Function *f = XCOMPILED_FUNCTION (fun);
+          if (! (f->flags.documentationp))
+            doc = -1;
+          else
+            {
+              Lisp_Object tem = compiled_function_documentation (f);
+              if (INTP (tem))
+                doc = XINT (tem);
+            }
+	}
+
+      if (doc == 0 && !kludgily_ignore_lost_doc_p (sym))
+	{
+	  message ("Warning: doc lost for function %s.",
+		   string_data (XSYMBOL (sym)->name));
+	  XCDR (closure) = Qt;
+	}
+    }
+  if (!NILP (Fboundp (sym)))
+    {
+      Lisp_Object doc = Fget (sym, Qvariable_documentation, Qnil);
+      if (ZEROP (doc))
+	{
+	  message ("Warning: doc lost for variable %s.",
+		   string_data (XSYMBOL (sym)->name));
+	  XCDR (closure) = Qt;
+	}
+    }
+  return 0; /* Never stop */
+}
+
+DEFUN ("Verify-documentation", Fverify_documentation, 0, 0, 0, /*
+Used to make sure everything went well with Snarf-documentation.
+Writes to stderr if not.
+*/
+       ())
+{
+  Lisp_Object closure = Fcons (Qnil, Qnil);
+  struct gcpro gcpro1;
+  GCPRO1 (closure);
+  map_obarray (Vobarray, verify_doc_mapper, &closure);
+  if (!NILP (Fcdr (closure)))
+    message ("\n"
+"This is usually because some files were preloaded by loaddefs.el or\n"
+"site-load.el, but were not passed to make-docfile by Makefile.\n");
+  UNGCPRO;
+  return NILP (Fcdr (closure)) ? Qt : Qnil;
+}
+
+
+DEFUN ("substitute-command-keys", Fsubstitute_command_keys, 1, 1, 0, /*
+Substitute key descriptions for command names in STRING.
+Return a new string which is STRING with substrings of the form \\=\\[COMMAND]
+replaced by either:  a keystroke sequence that will invoke COMMAND,
+or "M-x COMMAND" if COMMAND is not on any keys.
+Substrings of the form \\=\\{MAPVAR} are replaced by summaries
+\(made by describe-bindings) of the value of MAPVAR, taken as a keymap.
+Substrings of the form \\=\\<MAPVAR> specify to use the value of MAPVAR
+as the keymap for future \\=\\[COMMAND] substrings.
+\\=\\= quotes the following character and is discarded;
+thus, \\=\\=\\=\\= puts \\=\\= into the output, and \\=\\=\\=\\[ puts \\=\\[ into the output.
+*/
+       (str))
+{
+  /* This function can GC */
+  Bufbyte *buf;
+  int changed = 0;
+  REGISTER Bufbyte *strdata;
+  REGISTER Bufbyte *bufp;
+  Bytecount strlength;
+  Bytecount idx;
+  Bytecount bsize;
+  Bufbyte *new;
+  Lisp_Object tem;
+  Lisp_Object keymap;
+  Bufbyte *start;
+  Bytecount length;
+  Lisp_Object name;
+  struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
+
+  if (NILP (str))
+    return Qnil;
+
+  CHECK_STRING (str);
+  tem = Qnil;
+  keymap = Qnil;
+  name = Qnil;
+  GCPRO4 (str, tem, keymap, name);
+
+  /* There is the possibility that the string is not destined for a
+     translating stream, and it could be argued that we should do the
+     same thing here as in Fformat(), but there are very few times
+     when this will be the case and many calls to this function
+     would have to have `gettext' calls added. (I18N3) */
+  str = LISP_GETTEXT (str);
+
+  /* KEYMAP is either nil (which means search all the active keymaps)
+     or a specified local map (which means search just that and the
+     global map).  If non-nil, it might come from Voverriding_local_map,
+     or from a \\<mapname> construct in STR itself..  */
+#if 0 /* FSFmacs */
+  /* This is really weird and garbagey.  If keymap is nil and there's
+     an overriding-local-map, `where-is-internal' will correctly note
+     this, so there's no reason to do it here.  Maybe FSFmacs
+     `where-is-internal' is broken. */
+  /*
+  keymap = current_kboard->Voverriding_terminal_local_map;
+  if (NILP (keymap))
+    keymap = Voverriding_local_map;
+  */
+#endif
+
+  strlength = XSTRING_LENGTH (str);
+  bsize = 1 + strlength;
+  buf = (Bufbyte *) xmalloc (bsize);
+  bufp = buf;
+
+  /* Have to reset strdata every time GC might be called */
+  strdata = XSTRING_DATA (str);
+  for (idx = 0; idx < strlength; )
+    {
+      Bufbyte *strp = strdata + idx;
+
+      if (strp[0] != '\\')
+	{
+	  /* just copy other chars */
+	  /* As it happens, this will work with Mule even if the
+	     character quoted is multi-byte; the remaining multi-byte
+	     characters will just be copied by this loop. */
+	  *bufp++ = *strp;
+	  idx++;
+	}
+      else switch (strp[1])
+	{
+	default:
+	  {
+	    /* just copy unknown escape sequences */
+	    *bufp++ = *strp;
+	    idx++;
+	    break;
+	  }
+	case '=':
+	  {
+	    /* \= quotes the next character;
+	       thus, to put in \[ without its special meaning, use \=\[.  */
+	    /* As it happens, this will work with Mule even if the
+	       character quoted is multi-byte; the remaining multi-byte
+	       characters will just be copied by this loop. */
+	    changed = 1;
+	    *bufp++ = strp[2];
+	    idx += 3;
+	    break;
+	  }
+	case '[':
+	  {
+	    changed = 1;
+	    idx += 2;		/* skip \[ */
+	    strp += 2;
+	    start = strp;
+
+	    while ((idx < strlength)
+		   && *strp != ']')
+	      {
+		strp++;
+		idx++;
+	      }
+	    length = strp - start;
+	    idx++;		/* skip ] */
+
+	    tem = Fintern (make_string (start, length), Qnil);
+	    tem = Fwhere_is_internal (tem, keymap, Qt, Qnil, Qnil);
+
+#if 0 /* FSFmacs */
+	  /* Disregard menu bar bindings; it is positively annoying to
+	     mention them when there's no menu bar, and it isn't terribly
+	     useful even when there is a menu bar.  */
+	  if (!NILP (tem))
+	    {
+	      firstkey = Faref (tem, Qzero);
+	      if (EQ (firstkey, Qmenu_bar))
+		tem = Qnil;
+	    }
+#endif
+
+	    if (NILP (tem))	/* but not on any keys */
+	      {
+		new = (Bufbyte *) xrealloc (buf, bsize += 4);
+		bufp += new - buf;
+		buf = new;
+		memcpy (bufp, "M-x ", 4);
+		bufp += 4;
+		goto subst;
+	      }
+	    else
+	      {			/* function is on a key */
+		tem = Fkey_description (tem);
+		goto subst_string;
+	      }
+	  }
+	case '{':
+	case '<':
+	  {
+	    /* ### jump to label `subst_string|subst' crosses
+               initialization of `buffer|_buf' */
+	    Lisp_Object buffer;
+	    struct buffer *buf_;
+
+	    buffer = Fget_buffer_create (QSsubstitute);
+	    buf_ = XBUFFER (buffer);
+
+	    Fbuffer_disable_undo (buffer);
+	    Ferase_buffer (buffer);
+
+	    /* \{foo} is replaced with a summary of keymap (symbol-value foo).
+	       \<foo> just sets the keymap used for \[cmd].  */
+	    changed = 1;
+	    idx += 2;		/* skip \{ or \< */
+	    strp += 2;
+	    start = strp;
+
+	    while ((idx < strlength)
+		   && *strp != '}' && *strp != '>')
+	      {
+		strp++;
+		idx++;
+	      }
+	    length = strp - start;
+	    idx++;		/* skip } or > */
+
+	    /* Get the value of the keymap in TEM, or nil if undefined.
+	       Do this while still in the user's current buffer
+	       in case it is a local variable.  */
+	    name = Fintern (make_string (start, length), Qnil);
+	    tem = Fboundp (name);
+	    if (! NILP (tem))
+	      {
+		tem = Fsymbol_value (name);
+		if (! NILP (tem))
+		  tem = get_keymap (tem, 0, 1);
+	      }
+
+	    if (NILP (tem))
+	      {
+		char boof[255], *b = boof;
+		*b++ = '\n';
+		/* #### This sprintf() is potentially dangerous!  */
+		sprintf (b, GETTEXT (
+		"Uses keymap \"%s\", which is not currently defined."),
+			 (char *) XSTRING_DATA (Fsymbol_name (name)));
+		b += strlen (b);
+		*b++ = '\n';
+		*b++ = 0;
+		buffer_insert_c_string (buf_, boof);
+
+		if (start[-1] == '<') keymap = Qnil;
+	      }
+	    else if (start[-1] == '<')
+	      keymap = tem;
+	    else
+	      describe_map_tree (tem, 1, Qnil, Qnil, 0, buffer);
+
+	    tem = make_string_from_buffer (buf_, BUF_BEG (buf_),
+					   BUF_Z (buf_) - BUF_BEG (buf_));
+	    Ferase_buffer (buffer);
+	    goto subst_string;
+
+	  subst_string:
+	    start = XSTRING_DATA (tem);
+	    length = XSTRING_LENGTH (tem);
+	  subst:
+	    bsize += length;
+	    new = (Bufbyte *) xrealloc (buf, bsize);
+	    bufp += new - buf;
+	    buf = new;
+	    memcpy (bufp, start, length);
+	    bufp += length;
+
+	    /* Reset STRDATA in case gc relocated it.  */
+	    strdata = XSTRING_DATA (str);
+
+	    break;
+	  }
+	}
+    }
+
+  if (changed)			/* don't bother if nothing substituted */
+    tem = make_string (buf, bufp - buf);
+  else
+    tem = str;
+  xfree (buf);
+  UNGCPRO;
+  return tem;
+}
+
+
+/************************************************************************/
+/*                            initialization                            */
+/************************************************************************/
+
+void
+syms_of_doc (void)
+{
+  DEFSUBR (Fdocumentation);
+  DEFSUBR (Fdocumentation_property);
+  DEFSUBR (Fsnarf_documentation);
+  DEFSUBR (Fverify_documentation);
+  DEFSUBR (Fsubstitute_command_keys);
+}
+
+void
+vars_of_doc (void)
+{
+  DEFVAR_LISP ("internal-doc-file-name", &Vinternal_doc_file_name /*
+Name of file containing documentation strings of built-in symbols.
+*/ );
+  Vinternal_doc_file_name = Qnil;
+
+  QSsubstitute = build_string (" *substitute*");
+  staticpro (&QSsubstitute);
+}