src/doc.c

   1 /* Record indices of function doc strings stored in a file.
   2
   3 Copyright (C) 1985-1986, 1993-1995, 1997-2015 Free Software Foundation,
   4 Inc.
   5
   6 This file is part of GNU Emacs.
   7
   8 GNU Emacs is free software: you can redistribute it and/or modify
   9 it under the terms of the GNU General Public License as published by
  10 the Free Software Foundation, either version 3 of the License, or
  11 (at your option) any later version.
  12
  13 GNU Emacs is distributed in the hope that it will be useful,
  14 but WITHOUT ANY WARRANTY; without even the implied warranty of
  15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16 GNU General Public License for more details.
  17
  18 You should have received a copy of the GNU General Public License
  19 along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
  20
  21
  22 #include <config.h>
  23
  24 #include <errno.h>
  25 #include <sys/types.h>
  26 #include <sys/file.h>   /* Must be after sys/types.h for USG.  */
  27 #include <fcntl.h>
  28 #include <unistd.h>
  29
  30 #include <c-ctype.h>
  31
  32 #include "lisp.h"
  33 #include "character.h"
  34 #include "buffer.h"
  35 #include "keyboard.h"
  36 #include "keymap.h"
  37
  38 /* Buffer used for reading from documentation file.  */
  39 static char *get_doc_string_buffer;
  40 static ptrdiff_t get_doc_string_buffer_size;
  41
  42 static unsigned char *read_bytecode_pointer;
  43
  44 static char const sibling_etc[] = "../etc/";
  45
  46 /* `readchar' in lread.c calls back here to fetch the next byte.
  47    If UNREADFLAG is 1, we unread a byte.  */
  48
  49 int
  50 read_bytecode_char (bool unreadflag)
  51 {
  52   if (unreadflag)
  53     {
  54       read_bytecode_pointer--;
  55       return 0;
  56     }
  57   return *read_bytecode_pointer++;
  58 }
  59
  60 /* Extract a doc string from a file.  FILEPOS says where to get it.
  61    If it is an integer, use that position in the standard DOC file.
  62    If it is (FILE . INTEGER), use FILE as the file name
  63    and INTEGER as the position in that file.
  64    But if INTEGER is negative, make it positive.
  65    (A negative integer is used for user variables, so we can distinguish
  66    them without actually fetching the doc string.)
  67
  68    If the location does not point to the beginning of a docstring
  69    (e.g. because the file has been modified and the location is stale),
  70    return nil.
  71
  72    If UNIBYTE, always make a unibyte string.
  73
  74    If DEFINITION, assume this is for reading
  75    a dynamic function definition; convert the bytestring
  76    and the constants vector with appropriate byte handling,
  77    and return a cons cell.  */
  78
  79 Lisp_Object
  80 get_doc_string (Lisp_Object filepos, bool unibyte, bool definition)
  81 {
  82   char *from, *to, *name, *p, *p1;
  83   int fd;
  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   Lisp_Object docdir
 117     = NILP (tem) ? ENCODE_FILE (Vdoc_directory) : empty_unibyte_string;
 118   ptrdiff_t docdir_sizemax = SBYTES (docdir) + 1;
 119 #ifndef CANNOT_DUMP
 120   docdir_sizemax = max (docdir_sizemax, sizeof sibling_etc);
 121 #endif
 122   name = SAFE_ALLOCA (docdir_sizemax + SBYTES (file));
 123   lispstpcpy (lispstpcpy (name, docdir), file);
 124
 125   fd = emacs_open (name, O_RDONLY, 0);
 126   if (fd < 0)
 127     {
 128 #ifndef CANNOT_DUMP
 129       if (!NILP (Vpurify_flag))
 130         {
 131           /* Preparing to dump; DOC file is probably not installed.
 132              So check in ../etc.  */
 133           lispstpcpy (stpcpy (name, sibling_etc), file);
 134
 135           fd = emacs_open (name, O_RDONLY, 0);
 136         }
 137 #endif
 138       if (fd < 0)
 139         {
 140           SAFE_FREE ();
 141           AUTO_STRING (cannot_open, "Cannot open doc string file \"");
 142           AUTO_STRING (quote_nl, "\"\n");
 143           return concat3 (cannot_open, file, quote_nl);
 144         }
 145     }
 146   count = SPECPDL_INDEX ();
 147   record_unwind_protect_int (close_file_unwind, fd);
 148
 149   /* Seek only to beginning of disk block.  */
 150   /* Make sure we read at least 1024 bytes before `position'
 151      so we can check the leading text for consistency.  */
 152   offset = min (position, max (1024, position % (8 * 1024)));
 153   if (TYPE_MAXIMUM (off_t) < position
 154       || lseek (fd, position - offset, 0) < 0)
 155     error ("Position %"pI"d out of range in doc string file \"%s\"",
 156            position, name);
 157
 158   /* Read the doc string into get_doc_string_buffer.
 159      P points beyond the data just read.  */
 160
 161   p = get_doc_string_buffer;
 162   while (1)
 163     {
 164       ptrdiff_t space_left = (get_doc_string_buffer_size - 1
 165                               - (p - get_doc_string_buffer));
 166       int nread;
 167
 168       /* Allocate or grow the buffer if we need to.  */
 169       if (space_left <= 0)
 170         {
 171           ptrdiff_t in_buffer = p - get_doc_string_buffer;
 172           get_doc_string_buffer
 173             = xpalloc (get_doc_string_buffer, &get_doc_string_buffer_size,
 174                        16 * 1024, -1, 1);
 175           p = get_doc_string_buffer + in_buffer;
 176           space_left = (get_doc_string_buffer_size - 1
 177                         - (p - get_doc_string_buffer));
 178         }
 179
 180       /* Read a disk block at a time.
 181          If we read the same block last time, maybe skip this?  */
 182       if (space_left > 1024 * 8)
 183         space_left = 1024 * 8;
 184       nread = emacs_read (fd, p, space_left);
 185       if (nread < 0)
 186         report_file_error ("Read error on documentation file", file);
 187       p[nread] = 0;
 188       if (!nread)
 189         break;
 190       if (p == get_doc_string_buffer)
 191         p1 = strchr (p + offset, '\037');
 192       else
 193         p1 = strchr (p, '\037');
 194       if (p1)
 195         {
 196           *p1 = 0;
 197           p = p1;
 198           break;
 199         }
 200       p += nread;
 201     }
 202   unbind_to (count, Qnil);
 203   SAFE_FREE ();
 204
 205   /* Sanity checking.  */
 206   if (CONSP (filepos))
 207     {
 208       int test = 1;
 209       /* A dynamic docstring should be either at the very beginning of a "#@
 210          comment" or right after a dynamic docstring delimiter (in case we
 211          pack several such docstrings within the same comment).  */
 212       if (get_doc_string_buffer[offset - test] != '\037')
 213         {
 214           if (get_doc_string_buffer[offset - test++] != ' ')
 215             return Qnil;
 216           while (get_doc_string_buffer[offset - test] >= '0'
 217                  && get_doc_string_buffer[offset - test] <= '9')
 218             test++;
 219           if (get_doc_string_buffer[offset - test++] != '@'
 220               || get_doc_string_buffer[offset - test] != '#')
 221             return Qnil;
 222         }
 223     }
 224   else
 225     {
 226       int test = 1;
 227       if (get_doc_string_buffer[offset - test++] != '\n')
 228         return Qnil;
 229       while (get_doc_string_buffer[offset - test] > ' ')
 230         test++;
 231       if (get_doc_string_buffer[offset - test] != '\037')
 232         return Qnil;
 233     }
 234
 235   /* Scan the text and perform quoting with ^A (char code 1).
 236      ^A^A becomes ^A, ^A0 becomes a null char, and ^A_ becomes a ^_.  */
 237   from = get_doc_string_buffer + offset;
 238   to = get_doc_string_buffer + offset;
 239   while (from != p)
 240     {
 241       if (*from == 1)
 242         {
 243           int c;
 244
 245           from++;
 246           c = *from++;
 247           if (c == 1)
 248             *to++ = c;
 249           else if (c == '0')
 250             *to++ = 0;
 251           else if (c == '_')
 252             *to++ = 037;
 253           else
 254             {
 255               unsigned char uc = c;
 256               error ("\
 257 Invalid data in documentation file -- %c followed by code %03o",
 258                      1, uc);
 259             }
 260         }
 261       else
 262         *to++ = *from++;
 263     }
 264
 265   /* If DEFINITION, read from this buffer
 266      the same way we would read bytes from a file.  */
 267   if (definition)
 268     {
 269       read_bytecode_pointer = (unsigned char *) get_doc_string_buffer + offset;
 270       return Fread (Qlambda);
 271     }
 272
 273   if (unibyte)
 274     return make_unibyte_string (get_doc_string_buffer + offset,
 275                                 to - (get_doc_string_buffer + offset));
 276   else
 277     {
 278       /* The data determines whether the string is multibyte.  */
 279       ptrdiff_t nchars
 280         = multibyte_chars_in_text (((unsigned char *) get_doc_string_buffer
 281                                     + offset),
 282                                    to - (get_doc_string_buffer + offset));
 283       return make_string_from_bytes (get_doc_string_buffer + offset,
 284                                      nchars,
 285                                      to - (get_doc_string_buffer + offset));
 286     }
 287 }
 288
 289 /* Get a string from position FILEPOS and pass it through the Lisp reader.
 290    We use this for fetching the bytecode string and constants vector
 291    of a compiled function from the .elc file.  */
 292
 293 Lisp_Object
 294 read_doc_string (Lisp_Object filepos)
 295 {
 296   return get_doc_string (filepos, 0, 1);
 297 }
 298
 299 static bool
 300 reread_doc_file (Lisp_Object file)
 301 {
 302 #if 0
 303   Lisp_Object reply, prompt[3];
 304   struct gcpro gcpro1;
 305   GCPRO1 (file);
 306   prompt[0] = build_string ("File ");
 307   prompt[1] = NILP (file) ? Vdoc_file_name : file;
 308   prompt[2] = build_string (" is out of sync.  Reload? ");
 309   reply = Fy_or_n_p (Fconcat (3, prompt));
 310   UNGCPRO;
 311   if (NILP (reply))
 312     return 0;
 313 #endif
 314
 315   if (NILP (file))
 316     Fsnarf_documentation (Vdoc_file_name);
 317   else
 318     Fload (file, Qt, Qt, Qt, Qnil);
 319
 320   return 1;
 321 }
 322
 323 DEFUN ("documentation", Fdocumentation, Sdocumentation, 1, 2, 0,
 324        doc: /* Return the documentation string of FUNCTION.
 325 Unless a non-nil second argument RAW is given, the
 326 string is passed through `substitute-command-keys'.  */)
 327   (Lisp_Object function, Lisp_Object raw)
 328 {
 329   Lisp_Object fun;
 330   Lisp_Object funcar;
 331   Lisp_Object doc;
 332   bool try_reload = 1;
 333
 334  documentation:
 335
 336   doc = Qnil;
 337
 338   if (SYMBOLP (function))
 339     {
 340       Lisp_Object tem = Fget (function, Qfunction_documentation);
 341       if (!NILP (tem))
 342         return Fdocumentation_property (function, Qfunction_documentation,
 343                                         raw);
 344     }
 345
 346   fun = Findirect_function (function, Qnil);
 347   if (CONSP (fun) && EQ (XCAR (fun), Qmacro))
 348     fun = XCDR (fun);
 349   if (SUBRP (fun))
 350     {
 351       if (XSUBR (fun)->doc == 0)
 352         return Qnil;
 353       /* FIXME: This is not portable, as it assumes that string
 354          pointers have the top bit clear.  */
 355       else if ((intptr_t) XSUBR (fun)->doc >= 0)
 356         doc = build_string (XSUBR (fun)->doc);
 357       else
 358         doc = make_number ((intptr_t) XSUBR (fun)->doc);
 359     }
 360   else if (COMPILEDP (fun))
 361     {
 362       if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) <= COMPILED_DOC_STRING)
 363         return Qnil;
 364       else
 365         {
 366           Lisp_Object tem = AREF (fun, COMPILED_DOC_STRING);
 367           if (STRINGP (tem))
 368             doc = tem;
 369           else if (NATNUMP (tem) || CONSP (tem))
 370             doc = tem;
 371           else
 372             return Qnil;
 373         }
 374     }
 375   else if (STRINGP (fun) || VECTORP (fun))
 376     {
 377       return build_string ("Keyboard macro.");
 378     }
 379   else if (CONSP (fun))
 380     {
 381       funcar = XCAR (fun);
 382       if (!SYMBOLP (funcar))
 383         xsignal1 (Qinvalid_function, fun);
 384       else if (EQ (funcar, Qkeymap))
 385         return build_string ("Prefix command (definition is a keymap associating keystrokes with commands).");
 386       else if (EQ (funcar, Qlambda)
 387                || (EQ (funcar, Qclosure) && (fun = XCDR (fun), 1))
 388                || EQ (funcar, Qautoload))
 389         {
 390           Lisp_Object tem1 = Fcdr (Fcdr (fun));
 391           Lisp_Object tem = Fcar (tem1);
 392           if (STRINGP (tem))
 393             doc = tem;
 394           /* Handle a doc reference--but these never come last
 395              in the function body, so reject them if they are last.  */
 396           else if ((NATNUMP (tem) || (CONSP (tem) && INTEGERP (XCDR (tem))))
 397                    && !NILP (XCDR (tem1)))
 398             doc = tem;
 399           else
 400             return Qnil;
 401         }
 402       else
 403         goto oops;
 404     }
 405   else
 406     {
 407     oops:
 408       xsignal1 (Qinvalid_function, fun);
 409     }
 410
 411   /* If DOC is 0, it's typically because of a dumped file missing
 412      from the DOC file (bug in src/Makefile.in).  */
 413   if (EQ (doc, make_number (0)))
 414     doc = Qnil;
 415   if (INTEGERP (doc) || CONSP (doc))
 416     {
 417       Lisp_Object tem;
 418       tem = get_doc_string (doc, 0, 0);
 419       if (NILP (tem) && try_reload)
 420         {
 421           /* The file is newer, we need to reset the pointers.  */
 422           struct gcpro gcpro1, gcpro2;
 423           GCPRO2 (function, raw);
 424           try_reload = reread_doc_file (Fcar_safe (doc));
 425           UNGCPRO;
 426           if (try_reload)
 427             {
 428               try_reload = 0;
 429               goto documentation;
 430             }
 431         }
 432       else
 433         doc = tem;
 434     }
 435
 436   if (NILP (raw))
 437     doc = Fsubstitute_command_keys (doc);
 438   return doc;
 439 }
 440
 441 DEFUN ("documentation-property", Fdocumentation_property,
 442        Sdocumentation_property, 2, 3, 0,
 443        doc: /* Return the documentation string that is SYMBOL's PROP property.
 444 Third argument RAW omitted or nil means pass the result through
 445 `substitute-command-keys' if it is a string.
 446
 447 This differs from `get' in that it can refer to strings stored in the
 448 `etc/DOC' file; and that it evaluates documentation properties that
 449 aren't strings.  */)
 450   (Lisp_Object symbol, Lisp_Object prop, Lisp_Object raw)
 451 {
 452   bool try_reload = 1;
 453   Lisp_Object tem;
 454
 455  documentation_property:
 456
 457   tem = Fget (symbol, prop);
 458   if (EQ (tem, make_number (0)))
 459     tem = Qnil;
 460   if (INTEGERP (tem) || (CONSP (tem) && INTEGERP (XCDR (tem))))
 461     {
 462       Lisp_Object doc = tem;
 463       tem = get_doc_string (tem, 0, 0);
 464       if (NILP (tem) && try_reload)
 465         {
 466           /* The file is newer, we need to reset the pointers.  */
 467           struct gcpro gcpro1, gcpro2, gcpro3;
 468           GCPRO3 (symbol, prop, raw);
 469           try_reload = reread_doc_file (Fcar_safe (doc));
 470           UNGCPRO;
 471           if (try_reload)
 472             {
 473               try_reload = 0;
 474               goto documentation_property;
 475             }
 476         }
 477     }
 478   else if (!STRINGP (tem))
 479     /* Feval protects its argument.  */
 480     tem = Feval (tem, Qnil);
 481
 482   if (NILP (raw) && STRINGP (tem))
 483     tem = Fsubstitute_command_keys (tem);
 484   return tem;
 485 }
 486 \f
 487 /* Scanning the DOC files and placing docstring offsets into functions.  */
 488
 489 static void
 490 store_function_docstring (Lisp_Object obj, ptrdiff_t offset)
 491 {
 492   /* Don't use indirect_function here, or defaliases will apply their
 493      docstrings to the base functions (Bug#2603).  */
 494   Lisp_Object fun = SYMBOLP (obj) ? XSYMBOL (obj)->function : obj;
 495
 496   /* The type determines where the docstring is stored.  */
 497
 498   /* Lisp_Subrs have a slot for it.  */
 499   if (SUBRP (fun))
 500     {
 501       intptr_t negative_offset = - offset;
 502       XSUBR (fun)->doc = (char *) negative_offset;
 503     }
 504
 505   /* If it's a lisp form, stick it in the form.  */
 506   else if (CONSP (fun))
 507     {
 508       Lisp_Object tem;
 509
 510       tem = XCAR (fun);
 511       if (EQ (tem, Qlambda) || EQ (tem, Qautoload)
 512           || (EQ (tem, Qclosure) && (fun = XCDR (fun), 1)))
 513         {
 514           tem = Fcdr (Fcdr (fun));
 515           if (CONSP (tem) && INTEGERP (XCAR (tem)))
 516             /* FIXME: This modifies typically pure hash-cons'd data, so its
 517                correctness is quite delicate.  */
 518             XSETCAR (tem, make_number (offset));
 519         }
 520       else if (EQ (tem, Qmacro))
 521         store_function_docstring (XCDR (fun), offset);
 522     }
 523
 524   /* Bytecode objects sometimes have slots for it.  */
 525   else if (COMPILEDP (fun))
 526     {
 527       /* This bytecode object must have a slot for the
 528          docstring, since we've found a docstring for it.  */
 529       if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) > COMPILED_DOC_STRING)
 530         ASET (fun, COMPILED_DOC_STRING, make_number (offset));
 531       else
 532         message ("No docstring slot for %s",
 533                  SYMBOLP (obj) ? SSDATA (SYMBOL_NAME (obj)) : "<anonymous>");
 534     }
 535 }
 536
 537
 538 DEFUN ("Snarf-documentation", Fsnarf_documentation, Ssnarf_documentation,
 539        1, 1, 0,
 540        doc: /* Used during Emacs initialization to scan the `etc/DOC...' file.
 541 This searches the `etc/DOC...' file for doc strings and
 542 records them in function and variable definitions.
 543 The function takes one argument, FILENAME, a string;
 544 it specifies the file name (without a directory) of the DOC file.
 545 That file is found in `../etc' now; later, when the dumped Emacs is run,
 546 the same file name is found in the `doc-directory'.  */)
 547   (Lisp_Object filename)
 548 {
 549   int fd;
 550   char buf[1024 + 1];
 551   int filled;
 552   EMACS_INT pos;
 553   Lisp_Object sym;
 554   char *p, *name;
 555   bool skip_file = 0;
 556   ptrdiff_t count;
 557   char const *dirname;
 558   ptrdiff_t dirlen;
 559   /* Preloaded defcustoms using custom-initialize-delay are added to
 560      this list, but kept unbound.  See http://debbugs.gnu.org/11565  */
 561   Lisp_Object delayed_init =
 562     find_symbol_value (intern ("custom-delayed-init-variables"));
 563
 564   if (EQ (delayed_init, Qunbound)) delayed_init = Qnil;
 565
 566   CHECK_STRING (filename);
 567
 568   if
 569 #ifndef CANNOT_DUMP
 570     (!NILP (Vpurify_flag))
 571 #else /* CANNOT_DUMP */
 572       (0)
 573 #endif /* CANNOT_DUMP */
 574     {
 575       dirname = sibling_etc;
 576       dirlen = sizeof sibling_etc - 1;
 577     }
 578   else
 579     {
 580       CHECK_STRING (Vdoc_directory);
 581       dirname = SSDATA (Vdoc_directory);
 582       dirlen = SBYTES (Vdoc_directory);
 583     }
 584
 585   count = SPECPDL_INDEX ();
 586   USE_SAFE_ALLOCA;
 587   name = SAFE_ALLOCA (dirlen + SBYTES (filename) + 1);
 588   lispstpcpy (stpcpy (name, dirname), filename);        /*** Add this line ***/
 589
 590   /* Vbuild_files is nil when temacs is run, and non-nil after that.  */
 591   if (NILP (Vbuild_files))
 592     {
 593       static char const *const buildobj[] =
 594         {
 595           #include "buildobj.h"
 596         };
 597       int i = ARRAYELTS (buildobj);
 598       while (0 <= --i)
 599         Vbuild_files = Fcons (build_string (buildobj[i]), Vbuild_files);
 600       Vbuild_files = Fpurecopy (Vbuild_files);
 601     }
 602
 603   fd = emacs_open (name, O_RDONLY, 0);
 604   if (fd < 0)
 605     {
 606       int open_errno = errno;
 607       report_file_errno ("Opening doc string file", build_string (name),
 608                          open_errno);
 609     }
 610   record_unwind_protect_int (close_file_unwind, fd);
 611   Vdoc_file_name = filename;
 612   filled = 0;
 613   pos = 0;
 614   while (1)
 615     {
 616       register char *end;
 617       if (filled < 512)
 618         filled += emacs_read (fd, &buf[filled], sizeof buf - 1 - filled);
 619       if (!filled)
 620         break;
 621
 622       buf[filled] = 0;
 623       end = buf + (filled < 512 ? filled : filled - 128);
 624       p = memchr (buf, '\037', end - buf);
 625       /* p points to ^_Ffunctionname\n or ^_Vvarname\n or ^_Sfilename\n.  */
 626       if (p)
 627         {
 628           end = strchr (p, '\n');
 629
 630           /* See if this is a file name, and if it is a file in build-files.  */
 631           if (p[1] == 'S')
 632             {
 633               skip_file = 0;
 634               if (end - p > 4 && end[-2] == '.'
 635                   && (end[-1] == 'o' || end[-1] == 'c'))
 636                 {
 637                   ptrdiff_t len = end - p - 2;
 638                   char *fromfile = SAFE_ALLOCA (len + 1);
 639                   memcpy (fromfile, &p[2], len);
 640                   fromfile[len] = 0;
 641                   if (fromfile[len-1] == 'c')
 642                     fromfile[len-1] = 'o';
 643
 644                   skip_file = NILP (Fmember (build_string (fromfile),
 645                                              Vbuild_files));
 646                 }
 647             }
 648
 649           sym = oblookup (Vobarray, p + 2,
 650                           multibyte_chars_in_text ((unsigned char *) p + 2,
 651                                                    end - p - 2),
 652                           end - p - 2);
 653           /* Check skip_file so that when a function is defined several
 654              times in different files (typically, once in xterm, once in
 655              w32term, ...), we only pay attention to the one that
 656              matters.  */
 657           if (! skip_file && SYMBOLP (sym))
 658             {
 659               /* Attach a docstring to a variable?  */
 660               if (p[1] == 'V')
 661                 {
 662                   /* Install file-position as variable-documentation property
 663                      and make it negative for a user-variable
 664                      (doc starts with a `*').  */
 665                   if (!NILP (Fboundp (sym))
 666                       || !NILP (Fmemq (sym, delayed_init)))
 667                     Fput (sym, Qvariable_documentation,
 668                           make_number ((pos + end + 1 - buf)
 669                                        * (end[1] == '*' ? -1 : 1)));
 670                 }
 671
 672               /* Attach a docstring to a function?  */
 673               else if (p[1] == 'F')
 674                 {
 675                   if (!NILP (Ffboundp (sym)))
 676                     store_function_docstring (sym, pos + end + 1 - buf);
 677                 }
 678               else if (p[1] == 'S')
 679                 ; /* Just a source file name boundary marker.  Ignore it.  */
 680
 681               else
 682                 error ("DOC file invalid at position %"pI"d", pos);
 683             }
 684         }
 685       pos += end - buf;
 686       filled -= end - buf;
 687       memmove (buf, end, filled);
 688     }
 689
 690   SAFE_FREE ();
 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 }