src/doc.c

   1 /* Record indices of function doc strings stored in a file.
   2
   3 Copyright (C) 1985-1986, 1993-1995, 1997-2014 Free Software Foundation, Inc.
   4
   5 This file is part of GNU Emacs.
   6
   7 GNU Emacs is free software: you can redistribute it and/or modify
   8 it under the terms of the GNU General Public License as published by
   9 the Free Software Foundation, either version 3 of the License, or
  10 (at your option) any later version.
  11
  12 GNU Emacs is distributed in the hope that it will be useful,
  13 but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 GNU General Public License for more details.
  16
  17 You should have received a copy of the GNU General Public License
  18 along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
  19
  20
  21 #include <config.h>
  22
  23 #include <errno.h>
  24 #include <sys/types.h>
  25 #include <sys/file.h>   /* Must be after sys/types.h for USG.  */
  26 #include <fcntl.h>
  27 #include <unistd.h>
  28
  29 #include <c-ctype.h>
  30
  31 #include "lisp.h"
  32 #include "character.h"
  33 #include "buffer.h"
  34 #include "keyboard.h"
  35 #include "keymap.h"
  36
  37 Lisp_Object Qfunction_documentation;
  38
  39 /* Buffer used for reading from documentation file.  */
  40 static char *get_doc_string_buffer;
  41 static ptrdiff_t get_doc_string_buffer_size;
  42
  43 static unsigned char *read_bytecode_pointer;
  44
  45 /* `readchar' in lread.c calls back here to fetch the next byte.
  46    If UNREADFLAG is 1, we unread a byte.  */
  47
  48 int
  49 read_bytecode_char (bool unreadflag)
  50 {
  51   if (unreadflag)
  52     {
  53       read_bytecode_pointer--;
  54       return 0;
  55     }
  56   return *read_bytecode_pointer++;
  57 }
  58
  59 /* Extract a doc string from a file.  FILEPOS says where to get it.
  60    If it is an integer, use that position in the standard DOC file.
  61    If it is (FILE . INTEGER), use FILE as the file name
  62    and INTEGER as the position in that file.
  63    But if INTEGER is negative, make it positive.
  64    (A negative integer is used for user variables, so we can distinguish
  65    them without actually fetching the doc string.)
  66
  67    If the location does not point to the beginning of a docstring
  68    (e.g. because the file has been modified and the location is stale),
  69    return nil.
  70
  71    If UNIBYTE, always make a unibyte string.
  72
  73    If DEFINITION, assume this is for reading
  74    a dynamic function definition; convert the bytestring
  75    and the constants vector with appropriate byte handling,
  76    and return a cons cell.  */
  77
  78 Lisp_Object
  79 get_doc_string (Lisp_Object filepos, bool unibyte, bool definition)
  80 {
  81   char *from, *to, *name, *p, *p1;
  82   int fd;
  83   ptrdiff_t minsize;
  84   int offset;
  85   EMACS_INT position;
  86   Lisp_Object file, tem, pos;
  87   ptrdiff_t count;
  88   USE_SAFE_ALLOCA;
  89
  90   if (INTEGERP (filepos))
  91     {
  92       file = Vdoc_file_name;
  93       pos = filepos;
  94     }
  95   else if (CONSP (filepos))
  96     {
  97       file = XCAR (filepos);
  98       pos = XCDR (filepos);
  99     }
 100   else
 101     return Qnil;
 102
 103   position = eabs (XINT (pos));
 104
 105   if (!STRINGP (Vdoc_directory))
 106     return Qnil;
 107
 108   if (!STRINGP (file))
 109     return Qnil;
 110
 111   /* Put the file name in NAME as a C string.
 112      If it is relative, combine it with Vdoc_directory.  */
 113
 114   tem = Ffile_name_absolute_p (file);
 115   file = ENCODE_FILE (file);
 116   if (NILP (tem))
 117     {
 118       Lisp_Object docdir = ENCODE_FILE (Vdoc_directory);
 119       minsize = SCHARS (docdir);
 120       /* sizeof ("../etc/") == 8 */
 121       if (minsize < 8)
 122         minsize = 8;
 123       name = SAFE_ALLOCA (minsize + SCHARS (file) + 8);
 124       strcpy (name, SSDATA (docdir));
 125       strcat (name, SSDATA (file));
 126     }
 127   else
 128     {
 129       name = SSDATA (file);
 130     }
 131
 132   fd = emacs_open (name, O_RDONLY, 0);
 133   if (fd < 0)
 134     {
 135 #ifndef CANNOT_DUMP
 136       if (!NILP (Vpurify_flag))
 137         {
 138           /* Preparing to dump; DOC file is probably not installed.
 139              So check in ../etc.  */
 140           strcpy (name, "../etc/");
 141           strcat (name, SSDATA (file));
 142
 143           fd = emacs_open (name, O_RDONLY, 0);
 144         }
 145 #endif
 146       if (fd < 0)
 147         {
 148           SAFE_FREE ();
 149           return concat3 (build_string ("Cannot open doc string file \""),
 150                           file, build_string ("\"\n"));
 151         }
 152     }
 153   count = SPECPDL_INDEX ();
 154   record_unwind_protect_int (close_file_unwind, fd);
 155
 156   /* Seek only to beginning of disk block.  */
 157   /* Make sure we read at least 1024 bytes before `position'
 158      so we can check the leading text for consistency.  */
 159   offset = min (position, max (1024, position % (8 * 1024)));
 160   if (TYPE_MAXIMUM (off_t) < position
 161       || lseek (fd, position - offset, 0) < 0)
 162     error ("Position %"pI"d out of range in doc string file \"%s\"",
 163            position, name);
 164
 165   /* Read the doc string into get_doc_string_buffer.
 166      P points beyond the data just read.  */
 167
 168   p = get_doc_string_buffer;
 169   while (1)
 170     {
 171       ptrdiff_t space_left = (get_doc_string_buffer_size - 1
 172                               - (p - get_doc_string_buffer));
 173       int nread;
 174
 175       /* Allocate or grow the buffer if we need to.  */
 176       if (space_left <= 0)
 177         {
 178           ptrdiff_t in_buffer = p - get_doc_string_buffer;
 179           get_doc_string_buffer
 180             = xpalloc (get_doc_string_buffer, &get_doc_string_buffer_size,
 181                        16 * 1024, -1, 1);
 182           p = get_doc_string_buffer + in_buffer;
 183           space_left = (get_doc_string_buffer_size - 1
 184                         - (p - get_doc_string_buffer));
 185         }
 186
 187       /* Read a disk block at a time.
 188          If we read the same block last time, maybe skip this?  */
 189       if (space_left > 1024 * 8)
 190         space_left = 1024 * 8;
 191       nread = emacs_read (fd, p, space_left);
 192       if (nread < 0)
 193         report_file_error ("Read error on documentation file", file);
 194       p[nread] = 0;
 195       if (!nread)
 196         break;
 197       if (p == get_doc_string_buffer)
 198         p1 = strchr (p + offset, '\037');
 199       else
 200         p1 = strchr (p, '\037');
 201       if (p1)
 202         {
 203           *p1 = 0;
 204           p = p1;
 205           break;
 206         }
 207       p += nread;
 208     }
 209   unbind_to (count, Qnil);
 210   SAFE_FREE ();
 211
 212   /* Sanity checking.  */
 213   if (CONSP (filepos))
 214     {
 215       int test = 1;
 216       /* A dynamic docstring should be either at the very beginning of a "#@
 217          comment" or right after a dynamic docstring delimiter (in case we
 218          pack several such docstrings within the same comment).  */
 219       if (get_doc_string_buffer[offset - test] != '\037')
 220         {
 221           if (get_doc_string_buffer[offset - test++] != ' ')
 222             return Qnil;
 223           while (get_doc_string_buffer[offset - test] >= '0'
 224                  && get_doc_string_buffer[offset - test] <= '9')
 225             test++;
 226           if (get_doc_string_buffer[offset - test++] != '@'
 227               || get_doc_string_buffer[offset - test] != '#')
 228             return Qnil;
 229         }
 230     }
 231   else
 232     {
 233       int test = 1;
 234       if (get_doc_string_buffer[offset - test++] != '\n')
 235         return Qnil;
 236       while (get_doc_string_buffer[offset - test] > ' ')
 237         test++;
 238       if (get_doc_string_buffer[offset - test] != '\037')
 239         return Qnil;
 240     }
 241
 242   /* Scan the text and perform quoting with ^A (char code 1).
 243      ^A^A becomes ^A, ^A0 becomes a null char, and ^A_ becomes a ^_.  */
 244   from = get_doc_string_buffer + offset;
 245   to = get_doc_string_buffer + offset;
 246   while (from != p)
 247     {
 248       if (*from == 1)
 249         {
 250           int c;
 251
 252           from++;
 253           c = *from++;
 254           if (c == 1)
 255             *to++ = c;
 256           else if (c == '0')
 257             *to++ = 0;
 258           else if (c == '_')
 259             *to++ = 037;
 260           else
 261             {
 262               unsigned char uc = c;
 263               error ("\
 264 Invalid data in documentation file -- %c followed by code %03o",
 265                      1, uc);
 266             }
 267         }
 268       else
 269         *to++ = *from++;
 270     }
 271
 272   /* If DEFINITION, read from this buffer
 273      the same way we would read bytes from a file.  */
 274   if (definition)
 275     {
 276       read_bytecode_pointer = (unsigned char *) get_doc_string_buffer + offset;
 277       return Fread (Qlambda);
 278     }
 279
 280   if (unibyte)
 281     return make_unibyte_string (get_doc_string_buffer + offset,
 282                                 to - (get_doc_string_buffer + offset));
 283   else
 284     {
 285       /* The data determines whether the string is multibyte.  */
 286       ptrdiff_t nchars
 287         = multibyte_chars_in_text (((unsigned char *) get_doc_string_buffer
 288                                     + offset),
 289                                    to - (get_doc_string_buffer + offset));
 290       return make_string_from_bytes (get_doc_string_buffer + offset,
 291                                      nchars,
 292                                      to - (get_doc_string_buffer + offset));
 293     }
 294 }
 295
 296 /* Get a string from position FILEPOS and pass it through the Lisp reader.
 297    We use this for fetching the bytecode string and constants vector
 298    of a compiled function from the .elc file.  */
 299
 300 Lisp_Object
 301 read_doc_string (Lisp_Object filepos)
 302 {
 303   return get_doc_string (filepos, 0, 1);
 304 }
 305
 306 static bool
 307 reread_doc_file (Lisp_Object file)
 308 {
 309 #if 0
 310   Lisp_Object reply, prompt[3];
 311   struct gcpro gcpro1;
 312   GCPRO1 (file);
 313   prompt[0] = build_string ("File ");
 314   prompt[1] = NILP (file) ? Vdoc_file_name : file;
 315   prompt[2] = build_string (" is out of sync.  Reload? ");
 316   reply = Fy_or_n_p (Fconcat (3, prompt));
 317   UNGCPRO;
 318   if (NILP (reply))
 319     return 0;
 320 #endif
 321
 322   if (NILP (file))
 323     Fsnarf_documentation (Vdoc_file_name);
 324   else
 325     Fload (file, Qt, Qt, Qt, Qnil);
 326
 327   return 1;
 328 }
 329
 330 DEFUN ("documentation", Fdocumentation, Sdocumentation, 1, 2, 0,
 331        doc: /* Return the documentation string of FUNCTION.
 332 Unless a non-nil second argument RAW is given, the
 333 string is passed through `substitute-command-keys'.  */)
 334   (Lisp_Object function, Lisp_Object raw)
 335 {
 336   Lisp_Object fun;
 337   Lisp_Object funcar;
 338   Lisp_Object doc;
 339   bool try_reload = 1;
 340
 341  documentation:
 342
 343   doc = Qnil;
 344
 345   if (SYMBOLP (function))
 346     {
 347       Lisp_Object tem = Fget (function, Qfunction_documentation);
 348       if (!NILP (tem))
 349         return Fdocumentation_property (function, Qfunction_documentation,
 350                                         raw);
 351     }
 352
 353   fun = Findirect_function (function, Qnil);
 354   if (CONSP (fun) && EQ (XCAR (fun), Qmacro))
 355     fun = XCDR (fun);
 356   if (SUBRP (fun))
 357     {
 358       if (XSUBR (fun)->doc == 0)
 359         return Qnil;
 360       /* FIXME: This is not portable, as it assumes that string
 361          pointers have the top bit clear.  */
 362       else if ((intptr_t) XSUBR (fun)->doc >= 0)
 363         doc = build_string (XSUBR (fun)->doc);
 364       else
 365         doc = make_number ((intptr_t) XSUBR (fun)->doc);
 366     }
 367   else if (COMPILEDP (fun))
 368     {
 369       if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) <= COMPILED_DOC_STRING)
 370         return Qnil;
 371       else
 372         {
 373           Lisp_Object tem = AREF (fun, COMPILED_DOC_STRING);
 374           if (STRINGP (tem))
 375             doc = tem;
 376           else if (NATNUMP (tem) || CONSP (tem))
 377             doc = tem;
 378           else
 379             return Qnil;
 380         }
 381     }
 382   else if (STRINGP (fun) || VECTORP (fun))
 383     {
 384       return build_string ("Keyboard macro.");
 385     }
 386   else if (CONSP (fun))
 387     {
 388       funcar = XCAR (fun);
 389       if (!SYMBOLP (funcar))
 390         xsignal1 (Qinvalid_function, fun);
 391       else if (EQ (funcar, Qkeymap))
 392         return build_string ("Prefix command (definition is a keymap associating keystrokes with commands).");
 393       else if (EQ (funcar, Qlambda)
 394                || (EQ (funcar, Qclosure) && (fun = XCDR (fun), 1))
 395                || EQ (funcar, Qautoload))
 396         {
 397           Lisp_Object tem1 = Fcdr (Fcdr (fun));
 398           Lisp_Object tem = Fcar (tem1);
 399           if (STRINGP (tem))
 400             doc = tem;
 401           /* Handle a doc reference--but these never come last
 402              in the function body, so reject them if they are last.  */
 403           else if ((NATNUMP (tem) || (CONSP (tem) && INTEGERP (XCDR (tem))))
 404                    && !NILP (XCDR (tem1)))
 405             doc = tem;
 406           else
 407             return Qnil;
 408         }
 409       else
 410         goto oops;
 411     }
 412   else
 413     {
 414     oops:
 415       xsignal1 (Qinvalid_function, fun);
 416     }
 417
 418   /* If DOC is 0, it's typically because of a dumped file missing
 419      from the DOC file (bug in src/Makefile.in).  */
 420   if (EQ (doc, make_number (0)))
 421     doc = Qnil;
 422   if (INTEGERP (doc) || CONSP (doc))
 423     {
 424       Lisp_Object tem;
 425       tem = get_doc_string (doc, 0, 0);
 426       if (NILP (tem) && try_reload)
 427         {
 428           /* The file is newer, we need to reset the pointers.  */
 429           struct gcpro gcpro1, gcpro2;
 430           GCPRO2 (function, raw);
 431           try_reload = reread_doc_file (Fcar_safe (doc));
 432           UNGCPRO;
 433           if (try_reload)
 434             {
 435               try_reload = 0;
 436               goto documentation;
 437             }
 438         }
 439       else
 440         doc = tem;
 441     }
 442
 443   if (NILP (raw))
 444     doc = Fsubstitute_command_keys (doc);
 445   return doc;
 446 }
 447
 448 DEFUN ("documentation-property", Fdocumentation_property,
 449        Sdocumentation_property, 2, 3, 0,
 450        doc: /* Return the documentation string that is SYMBOL's PROP property.
 451 Third argument RAW omitted or nil means pass the result through
 452 `substitute-command-keys' if it is a string.
 453
 454 This differs from `get' in that it can refer to strings stored in the
 455 `etc/DOC' file; and that it evaluates documentation properties that
 456 aren't strings.  */)
 457   (Lisp_Object symbol, Lisp_Object prop, Lisp_Object raw)
 458 {
 459   bool try_reload = 1;
 460   Lisp_Object tem;
 461
 462  documentation_property:
 463
 464   tem = Fget (symbol, prop);
 465   if (EQ (tem, make_number (0)))
 466     tem = Qnil;
 467   if (INTEGERP (tem) || (CONSP (tem) && INTEGERP (XCDR (tem))))
 468     {
 469       Lisp_Object doc = tem;
 470       tem = get_doc_string (tem, 0, 0);
 471       if (NILP (tem) && try_reload)
 472         {
 473           /* The file is newer, we need to reset the pointers.  */
 474           struct gcpro gcpro1, gcpro2, gcpro3;
 475           GCPRO3 (symbol, prop, raw);
 476           try_reload = reread_doc_file (Fcar_safe (doc));
 477           UNGCPRO;
 478           if (try_reload)
 479             {
 480               try_reload = 0;
 481               goto documentation_property;
 482             }
 483         }
 484     }
 485   else if (!STRINGP (tem))
 486     /* Feval protects its argument.  */
 487     tem = Feval (tem, Qnil);
 488
 489   if (NILP (raw) && STRINGP (tem))
 490     tem = Fsubstitute_command_keys (tem);
 491   return tem;
 492 }
 493 \f
 494 /* Scanning the DOC files and placing docstring offsets into functions.  */
 495
 496 static void
 497 store_function_docstring (Lisp_Object obj, ptrdiff_t offset)
 498 {
 499   /* Don't use indirect_function here, or defaliases will apply their
 500      docstrings to the base functions (Bug#2603).  */
 501   Lisp_Object fun = SYMBOLP (obj) ? XSYMBOL (obj)->function : obj;
 502
 503   /* The type determines where the docstring is stored.  */
 504
 505   /* Lisp_Subrs have a slot for it.  */
 506   if (SUBRP (fun))
 507     {
 508       intptr_t negative_offset = - offset;
 509       XSUBR (fun)->doc = (char *) negative_offset;
 510     }
 511
 512   /* If it's a lisp form, stick it in the form.  */
 513   else if (CONSP (fun))
 514     {
 515       Lisp_Object tem;
 516
 517       tem = XCAR (fun);
 518       if (EQ (tem, Qlambda) || EQ (tem, Qautoload)
 519           || (EQ (tem, Qclosure) && (fun = XCDR (fun), 1)))
 520         {
 521           tem = Fcdr (Fcdr (fun));
 522           if (CONSP (tem) && INTEGERP (XCAR (tem)))
 523             /* FIXME: This modifies typically pure hash-cons'd data, so its
 524                correctness is quite delicate.  */
 525             XSETCAR (tem, make_number (offset));
 526         }
 527       else if (EQ (tem, Qmacro))
 528         store_function_docstring (XCDR (fun), offset);
 529     }
 530
 531   /* Bytecode objects sometimes have slots for it.  */
 532   else if (COMPILEDP (fun))
 533     {
 534       /* This bytecode object must have a slot for the
 535          docstring, since we've found a docstring for it.  */
 536       if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) > COMPILED_DOC_STRING)
 537         ASET (fun, COMPILED_DOC_STRING, make_number (offset));
 538       else
 539         message ("No docstring slot for %s",
 540                  SYMBOLP (obj) ? SSDATA (SYMBOL_NAME (obj)) : "<anonymous>");
 541     }
 542 }
 543
 544
 545 DEFUN ("Snarf-documentation", Fsnarf_documentation, Ssnarf_documentation,
 546        1, 1, 0,
 547        doc: /* Used during Emacs initialization to scan the `etc/DOC...' file.
 548 This searches the `etc/DOC...' file for doc strings and
 549 records them in function and variable definitions.
 550 The function takes one argument, FILENAME, a string;
 551 it specifies the file name (without a directory) of the DOC file.
 552 That file is found in `../etc' now; later, when the dumped Emacs is run,
 553 the same file name is found in the `doc-directory'.  */)
 554   (Lisp_Object filename)
 555 {
 556   int fd;
 557   char buf[1024 + 1];
 558   int filled;
 559   EMACS_INT pos;
 560   Lisp_Object sym;
 561   char *p, *name;
 562   bool skip_file = 0;
 563   ptrdiff_t count;
 564   /* Preloaded defcustoms using custom-initialize-delay are added to
 565      this list, but kept unbound.  See http://debbugs.gnu.org/11565  */
 566   Lisp_Object delayed_init =
 567     find_symbol_value (intern ("custom-delayed-init-variables"));
 568
 569   if (EQ (delayed_init, Qunbound)) delayed_init = Qnil;
 570
 571   CHECK_STRING (filename);
 572
 573   if
 574 #ifndef CANNOT_DUMP
 575     (!NILP (Vpurify_flag))
 576 #else /* CANNOT_DUMP */
 577       (0)
 578 #endif /* CANNOT_DUMP */
 579     {
 580       name = alloca (SCHARS (filename) + 14);
 581       strcpy (name, "../etc/");
 582     }
 583   else
 584     {
 585       CHECK_STRING (Vdoc_directory);
 586       name = alloca (SCHARS (filename) + SCHARS (Vdoc_directory) + 1);
 587       strcpy (name, SSDATA (Vdoc_directory));
 588     }
 589   strcat (name, SSDATA (filename));     /*** Add this line ***/
 590
 591   /* Vbuild_files is nil when temacs is run, and non-nil after that.  */
 592   if (NILP (Vbuild_files))
 593     {
 594       static char const *const buildobj[] =
 595         {
 596           #include "buildobj.h"
 597         };
 598       int i = ARRAYELTS (buildobj);
 599       while (0 <= --i)
 600         Vbuild_files = Fcons (build_string (buildobj[i]), Vbuild_files);
 601       Vbuild_files = Fpurecopy (Vbuild_files);
 602     }
 603
 604   fd = emacs_open (name, O_RDONLY, 0);
 605   if (fd < 0)
 606     {
 607       int open_errno = errno;
 608       report_file_errno ("Opening doc string file", build_string (name),
 609                          open_errno);
 610     }
 611   count = SPECPDL_INDEX ();
 612   record_unwind_protect_int (close_file_unwind, fd);
 613   Vdoc_file_name = filename;
 614   filled = 0;
 615   pos = 0;
 616   while (1)
 617     {
 618       register char *end;
 619       if (filled < 512)
 620         filled += emacs_read (fd, &buf[filled], sizeof buf - 1 - filled);
 621       if (!filled)
 622         break;
 623
 624       buf[filled] = 0;
 625       end = buf + (filled < 512 ? filled : filled - 128);
 626       p = memchr (buf, '\037', end - buf);
 627       /* p points to ^_Ffunctionname\n or ^_Vvarname\n or ^_Sfilename\n.  */
 628       if (p)
 629         {
 630           end = strchr (p, '\n');
 631
 632           /* See if this is a file name, and if it is a file in build-files.  */
 633           if (p[1] == 'S')
 634             {
 635               skip_file = 0;
 636               if (end - p > 4 && end[-2] == '.'
 637                   && (end[-1] == 'o' || end[-1] == 'c'))
 638                 {
 639                   ptrdiff_t len = end - p - 2;
 640                   char *fromfile = alloca (len + 1);
 641                   memcpy (fromfile, &p[2], len);
 642                   fromfile[len] = 0;
 643                   if (fromfile[len-1] == 'c')
 644                     fromfile[len-1] = 'o';
 645
 646                   skip_file = NILP (Fmember (build_string (fromfile),
 647                                              Vbuild_files));
 648                 }
 649             }
 650
 651           sym = oblookup (Vobarray, p + 2,
 652                           multibyte_chars_in_text ((unsigned char *) p + 2,
 653                                                    end - p - 2),
 654                           end - p - 2);
 655           /* Check skip_file so that when a function is defined several
 656              times in different files (typically, once in xterm, once in
 657              w32term, ...), we only pay attention to the one that
 658              matters.  */
 659           if (! skip_file && SYMBOLP (sym))
 660             {
 661               /* Attach a docstring to a variable?  */
 662               if (p[1] == 'V')
 663                 {
 664                   /* Install file-position as variable-documentation property
 665                      and make it negative for a user-variable
 666                      (doc starts with a `*').  */
 667                   if (!NILP (Fboundp (sym))
 668                       || !NILP (Fmemq (sym, delayed_init)))
 669                     Fput (sym, Qvariable_documentation,
 670                           make_number ((pos + end + 1 - buf)
 671                                        * (end[1] == '*' ? -1 : 1)));
 672                 }
 673
 674               /* Attach a docstring to a function?  */
 675               else if (p[1] == 'F')
 676                 {
 677                   if (!NILP (Ffboundp (sym)))
 678                     store_function_docstring (sym, pos + end + 1 - buf);
 679                 }
 680               else if (p[1] == 'S')
 681                 ; /* Just a source file name boundary marker.  Ignore it.  */
 682
 683               else
 684                 error ("DOC file invalid at position %"pI"d", pos);
 685             }
 686         }
 687       pos += end - buf;
 688       filled -= end - buf;
 689       memmove (buf, end, filled);
 690     }
 691   return unbind_to (count, Qnil);
 692 }
 693 \f
 694 DEFUN ("substitute-command-keys", Fsubstitute_command_keys,
 695        Ssubstitute_command_keys, 1, 1, 0,
 696        doc: /* Substitute key descriptions for command names in STRING.
 697 Each substring of the form \\=\\[COMMAND] is replaced by either a
 698 keystroke sequence that invokes COMMAND, or "M-x COMMAND" if COMMAND
 699 is not on any keys.
 700
 701 Each substring of the form \\=\\{MAPVAR} is replaced by a summary of
 702 the value of MAPVAR as a keymap.  This summary is similar to the one
 703 produced by `describe-bindings'.  The summary ends in two newlines
 704 \(used by the helper function `help-make-xrefs' to find the end of the
 705 summary).
 706
 707 Each substring of the form \\=\\<MAPVAR> specifies the use of MAPVAR
 708 as the keymap for future \\=\\[COMMAND] substrings.
 709 \\=\\= quotes the following character and is discarded;
 710 thus, \\=\\=\\=\\= puts \\=\\= into the output, and \\=\\=\\=\\[ puts \\=\\[ into the output.
 711
 712 Return the original STRING if no substitutions are made.
 713 Otherwise, return a new string.  */)
 714   (Lisp_Object string)
 715 {
 716   char *buf;
 717   bool changed = 0;
 718   unsigned char *strp;
 719   char *bufp;
 720   ptrdiff_t idx;
 721   ptrdiff_t bsize;
 722   Lisp_Object tem;
 723   Lisp_Object keymap;
 724   unsigned char *start;
 725   ptrdiff_t length, length_byte;
 726   Lisp_Object name;
 727   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
 728   bool multibyte;
 729   ptrdiff_t nchars;
 730
 731   if (NILP (string))
 732     return Qnil;
 733
 734   CHECK_STRING (string);
 735   tem = Qnil;
 736   keymap = Qnil;
 737   name = Qnil;
 738   GCPRO4 (string, tem, keymap, name);
 739
 740   multibyte = STRING_MULTIBYTE (string);
 741   nchars = 0;
 742
 743   /* KEYMAP is either nil (which means search all the active keymaps)
 744      or a specified local map (which means search just that and the
 745      global map).  If non-nil, it might come from Voverriding_local_map,
 746      or from a \\<mapname> construct in STRING itself..  */
 747   keymap = Voverriding_local_map;
 748
 749   bsize = SBYTES (string);
 750   bufp = buf = xmalloc (bsize);
 751
 752   strp = SDATA (string);
 753   while (strp < SDATA (string) + SBYTES (string))
 754     {
 755       if (strp[0] == '\\' && strp[1] == '=')
 756         {
 757           /* \= quotes the next character;
 758              thus, to put in \[ without its special meaning, use \=\[.  */
 759           changed = 1;
 760           strp += 2;
 761           if (multibyte)
 762             {
 763               int len;
 764
 765               STRING_CHAR_AND_LENGTH (strp, len);
 766               if (len == 1)
 767                 *bufp = *strp;
 768               else
 769                 memcpy (bufp, strp, len);
 770               strp += len;
 771               bufp += len;
 772               nchars++;
 773             }
 774           else
 775             *bufp++ = *strp++, nchars++;
 776         }
 777       else if (strp[0] == '\\' && strp[1] == '[')
 778         {
 779           ptrdiff_t start_idx;
 780           bool follow_remap = 1;
 781
 782           changed = 1;
 783           strp += 2;            /* skip \[ */
 784           start = strp;
 785           start_idx = start - SDATA (string);
 786
 787           while ((strp - SDATA (string)
 788                   < SBYTES (string))
 789                  && *strp != ']')
 790             strp++;
 791           length_byte = strp - start;
 792
 793           strp++;               /* skip ] */
 794
 795           /* Save STRP in IDX.  */
 796           idx = strp - SDATA (string);
 797           name = Fintern (make_string ((char *) start, length_byte), Qnil);
 798
 799         do_remap:
 800           tem = Fwhere_is_internal (name, keymap, Qt, Qnil, Qnil);
 801
 802           if (VECTORP (tem) && ASIZE (tem) > 1
 803               && EQ (AREF (tem, 0), Qremap) && SYMBOLP (AREF (tem, 1))
 804               && follow_remap)
 805             {
 806               name = AREF (tem, 1);
 807               follow_remap = 0;
 808               goto do_remap;
 809             }
 810
 811           /* Note the Fwhere_is_internal can GC, so we have to take
 812              relocation of string contents into account.  */
 813           strp = SDATA (string) + idx;
 814           start = SDATA (string) + start_idx;
 815
 816           if (NILP (tem))       /* but not on any keys */
 817             {
 818               ptrdiff_t offset = bufp - buf;
 819               if (STRING_BYTES_BOUND - 4 < bsize)
 820                 string_overflow ();
 821               buf = xrealloc (buf, bsize += 4);
 822               bufp = buf + offset;
 823               memcpy (bufp, "M-x ", 4);
 824               bufp += 4;
 825               nchars += 4;
 826               if (multibyte)
 827                 length = multibyte_chars_in_text (start, length_byte);
 828               else
 829                 length = length_byte;
 830               goto subst;
 831             }
 832           else
 833             {                   /* function is on a key */
 834               tem = Fkey_description (tem, Qnil);
 835               goto subst_string;
 836             }
 837         }
 838       /* \{foo} is replaced with a summary of the keymap (symbol-value foo).
 839          \<foo> just sets the keymap used for \[cmd].  */
 840       else if (strp[0] == '\\' && (strp[1] == '{' || strp[1] == '<'))
 841         {
 842           struct buffer *oldbuf;
 843           ptrdiff_t start_idx;
 844           /* This is for computing the SHADOWS arg for describe_map_tree.  */
 845           Lisp_Object active_maps = Fcurrent_active_maps (Qnil, Qnil);
 846           Lisp_Object earlier_maps;
 847           ptrdiff_t count = SPECPDL_INDEX ();
 848
 849           changed = 1;
 850           strp += 2;            /* skip \{ or \< */
 851           start = strp;
 852           start_idx = start - SDATA (string);
 853
 854           while ((strp - SDATA (string) < SBYTES (string))
 855                  && *strp != '}' && *strp != '>')
 856             strp++;
 857
 858           length_byte = strp - start;
 859           strp++;                       /* skip } or > */
 860
 861           /* Save STRP in IDX.  */
 862           idx = strp - SDATA (string);
 863
 864           /* Get the value of the keymap in TEM, or nil if undefined.
 865              Do this while still in the user's current buffer
 866              in case it is a local variable.  */
 867           name = Fintern (make_string ((char *) start, length_byte), Qnil);
 868           tem = Fboundp (name);
 869           if (! NILP (tem))
 870             {
 871               tem = Fsymbol_value (name);
 872               if (! NILP (tem))
 873                 {
 874                   tem = get_keymap (tem, 0, 1);
 875                   /* Note that get_keymap can GC.  */
 876                   strp = SDATA (string) + idx;
 877                   start = SDATA (string) + start_idx;
 878                 }
 879             }
 880
 881           /* Now switch to a temp buffer.  */
 882           oldbuf = current_buffer;
 883           set_buffer_internal (XBUFFER (Vprin1_to_string_buffer));
 884           /* This is for an unusual case where some after-change
 885              function uses 'format' or 'prin1' or something else that
 886              will thrash Vprin1_to_string_buffer we are using.  */
 887           specbind (Qinhibit_modification_hooks, Qt);
 888
 889           if (NILP (tem))
 890             {
 891               name = Fsymbol_name (name);
 892               insert_string ("\nUses keymap `");
 893               insert_from_string (name, 0, 0,
 894                                   SCHARS (name),
 895                                   SBYTES (name), 1);
 896               insert_string ("', which is not currently defined.\n");
 897               if (start[-1] == '<') keymap = Qnil;
 898             }
 899           else if (start[-1] == '<')
 900             keymap = tem;
 901           else
 902             {
 903               /* Get the list of active keymaps that precede this one.
 904                  If this one's not active, get nil.  */
 905               earlier_maps = Fcdr (Fmemq (tem, Freverse (active_maps)));
 906               describe_map_tree (tem, 1, Fnreverse (earlier_maps),
 907                                  Qnil, 0, 1, 0, 0, 1);
 908             }
 909           tem = Fbuffer_string ();
 910           Ferase_buffer ();
 911           set_buffer_internal (oldbuf);
 912           unbind_to (count, Qnil);
 913
 914         subst_string:
 915           start = SDATA (tem);
 916           length = SCHARS (tem);
 917           length_byte = SBYTES (tem);
 918         subst:
 919           {
 920             ptrdiff_t offset = bufp - buf;
 921             if (STRING_BYTES_BOUND - length_byte < bsize)
 922               string_overflow ();
 923             buf = xrealloc (buf, bsize += length_byte);
 924             bufp = buf + offset;
 925             memcpy (bufp, start, length_byte);
 926             bufp += length_byte;
 927             nchars += length;
 928             /* Check STRING again in case gc relocated it.  */
 929             strp = SDATA (string) + idx;
 930           }
 931         }
 932       else if (! multibyte)             /* just copy other chars */
 933         *bufp++ = *strp++, nchars++;
 934       else
 935         {
 936           int len;
 937
 938           STRING_CHAR_AND_LENGTH (strp, len);
 939           if (len == 1)
 940             *bufp = *strp;
 941           else
 942             memcpy (bufp, strp, len);
 943           strp += len;
 944           bufp += len;
 945           nchars++;
 946         }
 947     }
 948
 949   if (changed)                  /* don't bother if nothing substituted */
 950     tem = make_string_from_bytes (buf, nchars, bufp - buf);
 951   else
 952     tem = string;
 953   xfree (buf);
 954   RETURN_UNGCPRO (tem);
 955 }
 956 \f
 957 void
 958 syms_of_doc (void)
 959 {
 960   DEFSYM (Qfunction_documentation, "function-documentation");
 961
 962   DEFVAR_LISP ("internal-doc-file-name", Vdoc_file_name,
 963                doc: /* Name of file containing documentation strings of built-in symbols.  */);
 964   Vdoc_file_name = Qnil;
 965
 966   DEFVAR_LISP ("build-files", Vbuild_files,
 967                doc: /* A list of files used to build this Emacs binary.  */);
 968   Vbuild_files = Qnil;
 969
 970   defsubr (&Sdocumentation);
 971   defsubr (&Sdocumentation_property);
 972   defsubr (&Ssnarf_documentation);
 973   defsubr (&Ssubstitute_command_keys);
 974 }