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 (NILP (file))
 303     Fsnarf_documentation (Vdoc_file_name);
 304   else
 305     Fload (file, Qt, Qt, Qt, Qnil);
 306
 307   return 1;
 308 }
 309
 310 DEFUN ("documentation", Fdocumentation, Sdocumentation, 1, 2, 0,
 311        doc: /* Return the documentation string of FUNCTION.
 312 Unless a non-nil second argument RAW is given, the
 313 string is passed through `substitute-command-keys'.  */)
 314   (Lisp_Object function, Lisp_Object raw)
 315 {
 316   Lisp_Object fun;
 317   Lisp_Object funcar;
 318   Lisp_Object doc;
 319   bool try_reload = 1;
 320
 321  documentation:
 322
 323   doc = Qnil;
 324
 325   if (SYMBOLP (function))
 326     {
 327       Lisp_Object tem = Fget (function, Qfunction_documentation);
 328       if (!NILP (tem))
 329         return Fdocumentation_property (function, Qfunction_documentation,
 330                                         raw);
 331     }
 332
 333   fun = Findirect_function (function, Qnil);
 334   if (CONSP (fun) && EQ (XCAR (fun), Qmacro))
 335     fun = XCDR (fun);
 336   if (SUBRP (fun))
 337     {
 338       if (XSUBR (fun)->doc == 0)
 339         return Qnil;
 340       /* FIXME: This is not portable, as it assumes that string
 341          pointers have the top bit clear.  */
 342       else if ((intptr_t) XSUBR (fun)->doc >= 0)
 343         doc = build_string (XSUBR (fun)->doc);
 344       else
 345         doc = make_number ((intptr_t) XSUBR (fun)->doc);
 346     }
 347   else if (COMPILEDP (fun))
 348     {
 349       if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) <= COMPILED_DOC_STRING)
 350         return Qnil;
 351       else
 352         {
 353           Lisp_Object tem = AREF (fun, COMPILED_DOC_STRING);
 354           if (STRINGP (tem))
 355             doc = tem;
 356           else if (NATNUMP (tem) || CONSP (tem))
 357             doc = tem;
 358           else
 359             return Qnil;
 360         }
 361     }
 362   else if (STRINGP (fun) || VECTORP (fun))
 363     {
 364       return build_string ("Keyboard macro.");
 365     }
 366   else if (CONSP (fun))
 367     {
 368       funcar = XCAR (fun);
 369       if (!SYMBOLP (funcar))
 370         xsignal1 (Qinvalid_function, fun);
 371       else if (EQ (funcar, Qkeymap))
 372         return build_string ("Prefix command (definition is a keymap associating keystrokes with commands).");
 373       else if (EQ (funcar, Qlambda)
 374                || (EQ (funcar, Qclosure) && (fun = XCDR (fun), 1))
 375                || EQ (funcar, Qautoload))
 376         {
 377           Lisp_Object tem1 = Fcdr (Fcdr (fun));
 378           Lisp_Object tem = Fcar (tem1);
 379           if (STRINGP (tem))
 380             doc = tem;
 381           /* Handle a doc reference--but these never come last
 382              in the function body, so reject them if they are last.  */
 383           else if ((NATNUMP (tem) || (CONSP (tem) && INTEGERP (XCDR (tem))))
 384                    && !NILP (XCDR (tem1)))
 385             doc = tem;
 386           else
 387             return Qnil;
 388         }
 389       else
 390         goto oops;
 391     }
 392   else
 393     {
 394     oops:
 395       xsignal1 (Qinvalid_function, fun);
 396     }
 397
 398   /* If DOC is 0, it's typically because of a dumped file missing
 399      from the DOC file (bug in src/Makefile.in).  */
 400   if (EQ (doc, make_number (0)))
 401     doc = Qnil;
 402   if (INTEGERP (doc) || CONSP (doc))
 403     {
 404       Lisp_Object tem;
 405       tem = get_doc_string (doc, 0, 0);
 406       if (NILP (tem) && try_reload)
 407         {
 408           /* The file is newer, we need to reset the pointers.  */
 409           struct gcpro gcpro1, gcpro2;
 410           GCPRO2 (function, raw);
 411           try_reload = reread_doc_file (Fcar_safe (doc));
 412           UNGCPRO;
 413           if (try_reload)
 414             {
 415               try_reload = 0;
 416               goto documentation;
 417             }
 418         }
 419       else
 420         doc = tem;
 421     }
 422
 423   if (NILP (raw))
 424     doc = Fsubstitute_command_keys (doc);
 425   return doc;
 426 }
 427
 428 DEFUN ("documentation-property", Fdocumentation_property,
 429        Sdocumentation_property, 2, 3, 0,
 430        doc: /* Return the documentation string that is SYMBOL's PROP property.
 431 Third argument RAW omitted or nil means pass the result through
 432 `substitute-command-keys' if it is a string.
 433
 434 This differs from `get' in that it can refer to strings stored in the
 435 `etc/DOC' file; and that it evaluates documentation properties that
 436 aren't strings.  */)
 437   (Lisp_Object symbol, Lisp_Object prop, Lisp_Object raw)
 438 {
 439   bool try_reload = 1;
 440   Lisp_Object tem;
 441
 442  documentation_property:
 443
 444   tem = Fget (symbol, prop);
 445   if (EQ (tem, make_number (0)))
 446     tem = Qnil;
 447   if (INTEGERP (tem) || (CONSP (tem) && INTEGERP (XCDR (tem))))
 448     {
 449       Lisp_Object doc = tem;
 450       tem = get_doc_string (tem, 0, 0);
 451       if (NILP (tem) && try_reload)
 452         {
 453           /* The file is newer, we need to reset the pointers.  */
 454           struct gcpro gcpro1, gcpro2, gcpro3;
 455           GCPRO3 (symbol, prop, raw);
 456           try_reload = reread_doc_file (Fcar_safe (doc));
 457           UNGCPRO;
 458           if (try_reload)
 459             {
 460               try_reload = 0;
 461               goto documentation_property;
 462             }
 463         }
 464     }
 465   else if (!STRINGP (tem))
 466     /* Feval protects its argument.  */
 467     tem = Feval (tem, Qnil);
 468
 469   if (NILP (raw) && STRINGP (tem))
 470     tem = Fsubstitute_command_keys (tem);
 471   return tem;
 472 }
 473 \f
 474 /* Scanning the DOC files and placing docstring offsets into functions.  */
 475
 476 static void
 477 store_function_docstring (Lisp_Object obj, ptrdiff_t offset)
 478 {
 479   /* Don't use indirect_function here, or defaliases will apply their
 480      docstrings to the base functions (Bug#2603).  */
 481   Lisp_Object fun = SYMBOLP (obj) ? XSYMBOL (obj)->function : obj;
 482
 483   /* The type determines where the docstring is stored.  */
 484
 485   /* Lisp_Subrs have a slot for it.  */
 486   if (SUBRP (fun))
 487     {
 488       intptr_t negative_offset = - offset;
 489       XSUBR (fun)->doc = (char *) negative_offset;
 490     }
 491
 492   /* If it's a lisp form, stick it in the form.  */
 493   else if (CONSP (fun))
 494     {
 495       Lisp_Object tem;
 496
 497       tem = XCAR (fun);
 498       if (EQ (tem, Qlambda) || EQ (tem, Qautoload)
 499           || (EQ (tem, Qclosure) && (fun = XCDR (fun), 1)))
 500         {
 501           tem = Fcdr (Fcdr (fun));
 502           if (CONSP (tem) && INTEGERP (XCAR (tem)))
 503             /* FIXME: This modifies typically pure hash-cons'd data, so its
 504                correctness is quite delicate.  */
 505             XSETCAR (tem, make_number (offset));
 506         }
 507       else if (EQ (tem, Qmacro))
 508         store_function_docstring (XCDR (fun), offset);
 509     }
 510
 511   /* Bytecode objects sometimes have slots for it.  */
 512   else if (COMPILEDP (fun))
 513     {
 514       /* This bytecode object must have a slot for the
 515          docstring, since we've found a docstring for it.  */
 516       if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) > COMPILED_DOC_STRING)
 517         ASET (fun, COMPILED_DOC_STRING, make_number (offset));
 518       else
 519         message ("No docstring slot for %s",
 520                  SYMBOLP (obj) ? SSDATA (SYMBOL_NAME (obj)) : "<anonymous>");
 521     }
 522 }
 523
 524
 525 DEFUN ("Snarf-documentation", Fsnarf_documentation, Ssnarf_documentation,
 526        1, 1, 0,
 527        doc: /* Used during Emacs initialization to scan the `etc/DOC...' file.
 528 This searches the `etc/DOC...' file for doc strings and
 529 records them in function and variable definitions.
 530 The function takes one argument, FILENAME, a string;
 531 it specifies the file name (without a directory) of the DOC file.
 532 That file is found in `../etc' now; later, when the dumped Emacs is run,
 533 the same file name is found in the `doc-directory'.  */)
 534   (Lisp_Object filename)
 535 {
 536   int fd;
 537   char buf[1024 + 1];
 538   int filled;
 539   EMACS_INT pos;
 540   Lisp_Object sym;
 541   char *p, *name;
 542   bool skip_file = 0;
 543   ptrdiff_t count;
 544   char const *dirname;
 545   ptrdiff_t dirlen;
 546   /* Preloaded defcustoms using custom-initialize-delay are added to
 547      this list, but kept unbound.  See http://debbugs.gnu.org/11565  */
 548   Lisp_Object delayed_init =
 549     find_symbol_value (intern ("custom-delayed-init-variables"));
 550
 551   if (EQ (delayed_init, Qunbound)) delayed_init = Qnil;
 552
 553   CHECK_STRING (filename);
 554
 555   if
 556 #ifndef CANNOT_DUMP
 557     (!NILP (Vpurify_flag))
 558 #else /* CANNOT_DUMP */
 559       (0)
 560 #endif /* CANNOT_DUMP */
 561     {
 562       dirname = sibling_etc;
 563       dirlen = sizeof sibling_etc - 1;
 564     }
 565   else
 566     {
 567       CHECK_STRING (Vdoc_directory);
 568       dirname = SSDATA (Vdoc_directory);
 569       dirlen = SBYTES (Vdoc_directory);
 570     }
 571
 572   count = SPECPDL_INDEX ();
 573   USE_SAFE_ALLOCA;
 574   name = SAFE_ALLOCA (dirlen + SBYTES (filename) + 1);
 575   lispstpcpy (stpcpy (name, dirname), filename);        /*** Add this line ***/
 576
 577   /* Vbuild_files is nil when temacs is run, and non-nil after that.  */
 578   if (NILP (Vbuild_files))
 579     {
 580       static char const *const buildobj[] =
 581         {
 582           #include "buildobj.h"
 583         };
 584       int i = ARRAYELTS (buildobj);
 585       while (0 <= --i)
 586         Vbuild_files = Fcons (build_string (buildobj[i]), Vbuild_files);
 587       Vbuild_files = Fpurecopy (Vbuild_files);
 588     }
 589
 590   fd = emacs_open (name, O_RDONLY, 0);
 591   if (fd < 0)
 592     {
 593       int open_errno = errno;
 594       report_file_errno ("Opening doc string file", build_string (name),
 595                          open_errno);
 596     }
 597   record_unwind_protect_int (close_file_unwind, fd);
 598   Vdoc_file_name = filename;
 599   filled = 0;
 600   pos = 0;
 601   while (1)
 602     {
 603       register char *end;
 604       if (filled < 512)
 605         filled += emacs_read (fd, &buf[filled], sizeof buf - 1 - filled);
 606       if (!filled)
 607         break;
 608
 609       buf[filled] = 0;
 610       end = buf + (filled < 512 ? filled : filled - 128);
 611       p = memchr (buf, '\037', end - buf);
 612       /* p points to ^_Ffunctionname\n or ^_Vvarname\n or ^_Sfilename\n.  */
 613       if (p)
 614         {
 615           end = strchr (p, '\n');
 616
 617           /* See if this is a file name, and if it is a file in build-files.  */
 618           if (p[1] == 'S')
 619             {
 620               skip_file = 0;
 621               if (end - p > 4 && end[-2] == '.'
 622                   && (end[-1] == 'o' || end[-1] == 'c'))
 623                 {
 624                   ptrdiff_t len = end - p - 2;
 625                   char *fromfile = SAFE_ALLOCA (len + 1);
 626                   memcpy (fromfile, &p[2], len);
 627                   fromfile[len] = 0;
 628                   if (fromfile[len-1] == 'c')
 629                     fromfile[len-1] = 'o';
 630
 631                   skip_file = NILP (Fmember (build_string (fromfile),
 632                                              Vbuild_files));
 633                 }
 634             }
 635
 636           sym = oblookup (Vobarray, p + 2,
 637                           multibyte_chars_in_text ((unsigned char *) p + 2,
 638                                                    end - p - 2),
 639                           end - p - 2);
 640           /* Check skip_file so that when a function is defined several
 641              times in different files (typically, once in xterm, once in
 642              w32term, ...), we only pay attention to the one that
 643              matters.  */
 644           if (! skip_file && SYMBOLP (sym))
 645             {
 646               /* Attach a docstring to a variable?  */
 647               if (p[1] == 'V')
 648                 {
 649                   /* Install file-position as variable-documentation property
 650                      and make it negative for a user-variable
 651                      (doc starts with a `*').  */
 652                   if (!NILP (Fboundp (sym))
 653                       || !NILP (Fmemq (sym, delayed_init)))
 654                     Fput (sym, Qvariable_documentation,
 655                           make_number ((pos + end + 1 - buf)
 656                                        * (end[1] == '*' ? -1 : 1)));
 657                 }
 658
 659               /* Attach a docstring to a function?  */
 660               else if (p[1] == 'F')
 661                 {
 662                   if (!NILP (Ffboundp (sym)))
 663                     store_function_docstring (sym, pos + end + 1 - buf);
 664                 }
 665               else if (p[1] == 'S')
 666                 ; /* Just a source file name boundary marker.  Ignore it.  */
 667
 668               else
 669                 error ("DOC file invalid at position %"pI"d", pos);
 670             }
 671         }
 672       pos += end - buf;
 673       filled -= end - buf;
 674       memmove (buf, end, filled);
 675     }
 676
 677   SAFE_FREE ();
 678   return unbind_to (count, Qnil);
 679 }
 680 \f
 681 DEFUN ("substitute-command-keys", Fsubstitute_command_keys,
 682        Ssubstitute_command_keys, 1, 1, 0,
 683        doc: /* Substitute key descriptions for command names in STRING.
 684 Each substring of the form \\=\\[COMMAND] is replaced by either a
 685 keystroke sequence that invokes COMMAND, or "M-x COMMAND" if COMMAND
 686 is not on any keys.
 687
 688 Each substring of the form \\=\\{MAPVAR} is replaced by a summary of
 689 the value of MAPVAR as a keymap.  This summary is similar to the one
 690 produced by `describe-bindings'.  The summary ends in two newlines
 691 \(used by the helper function `help-make-xrefs' to find the end of the
 692 summary).
 693
 694 Each substring of the form \\=\\<MAPVAR> specifies the use of MAPVAR
 695 as the keymap for future \\=\\[COMMAND] substrings.
 696 \\=\\= quotes the following character and is discarded;
 697 thus, \\=\\=\\=\\= puts \\=\\= into the output, and \\=\\=\\=\\[ puts \\=\\[ into the output.
 698
 699 Return the original STRING if no substitutions are made.
 700 Otherwise, return a new string.  */)
 701   (Lisp_Object string)
 702 {
 703   char *buf;
 704   bool changed = 0;
 705   unsigned char *strp;
 706   char *bufp;
 707   ptrdiff_t idx;
 708   ptrdiff_t bsize;
 709   Lisp_Object tem;
 710   Lisp_Object keymap;
 711   unsigned char *start;
 712   ptrdiff_t length, length_byte;
 713   Lisp_Object name;
 714   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
 715   bool multibyte;
 716   ptrdiff_t nchars;
 717
 718   if (NILP (string))
 719     return Qnil;
 720
 721   CHECK_STRING (string);
 722   tem = Qnil;
 723   keymap = Qnil;
 724   name = Qnil;
 725   GCPRO4 (string, tem, keymap, name);
 726
 727   multibyte = STRING_MULTIBYTE (string);
 728   nchars = 0;
 729
 730   /* KEYMAP is either nil (which means search all the active keymaps)
 731      or a specified local map (which means search just that and the
 732      global map).  If non-nil, it might come from Voverriding_local_map,
 733      or from a \\<mapname> construct in STRING itself..  */
 734   keymap = Voverriding_local_map;
 735
 736   bsize = SBYTES (string);
 737   bufp = buf = xmalloc (bsize);
 738
 739   strp = SDATA (string);
 740   while (strp < SDATA (string) + SBYTES (string))
 741     {
 742       if (strp[0] == '\\' && strp[1] == '=')
 743         {
 744           /* \= quotes the next character;
 745              thus, to put in \[ without its special meaning, use \=\[.  */
 746           changed = 1;
 747           strp += 2;
 748           if (multibyte)
 749             {
 750               int len;
 751
 752               STRING_CHAR_AND_LENGTH (strp, len);
 753               if (len == 1)
 754                 *bufp = *strp;
 755               else
 756                 memcpy (bufp, strp, len);
 757               strp += len;
 758               bufp += len;
 759               nchars++;
 760             }
 761           else
 762             *bufp++ = *strp++, nchars++;
 763         }
 764       else if (strp[0] == '\\' && strp[1] == '[')
 765         {
 766           ptrdiff_t start_idx;
 767           bool follow_remap = 1;
 768
 769           changed = 1;
 770           strp += 2;            /* skip \[ */
 771           start = strp;
 772           start_idx = start - SDATA (string);
 773
 774           while ((strp - SDATA (string)
 775                   < SBYTES (string))
 776                  && *strp != ']')
 777             strp++;
 778           length_byte = strp - start;
 779
 780           strp++;               /* skip ] */
 781
 782           /* Save STRP in IDX.  */
 783           idx = strp - SDATA (string);
 784           name = Fintern (make_string ((char *) start, length_byte), Qnil);
 785
 786         do_remap:
 787           tem = Fwhere_is_internal (name, keymap, Qt, Qnil, Qnil);
 788
 789           if (VECTORP (tem) && ASIZE (tem) > 1
 790               && EQ (AREF (tem, 0), Qremap) && SYMBOLP (AREF (tem, 1))
 791               && follow_remap)
 792             {
 793               name = AREF (tem, 1);
 794               follow_remap = 0;
 795               goto do_remap;
 796             }
 797
 798           /* Note the Fwhere_is_internal can GC, so we have to take
 799              relocation of string contents into account.  */
 800           strp = SDATA (string) + idx;
 801           start = SDATA (string) + start_idx;
 802
 803           if (NILP (tem))       /* but not on any keys */
 804             {
 805               ptrdiff_t offset = bufp - buf;
 806               if (STRING_BYTES_BOUND - 4 < bsize)
 807                 string_overflow ();
 808               buf = xrealloc (buf, bsize += 4);
 809               bufp = buf + offset;
 810               memcpy (bufp, "M-x ", 4);
 811               bufp += 4;
 812               nchars += 4;
 813               if (multibyte)
 814                 length = multibyte_chars_in_text (start, length_byte);
 815               else
 816                 length = length_byte;
 817               goto subst;
 818             }
 819           else
 820             {                   /* function is on a key */
 821               tem = Fkey_description (tem, Qnil);
 822               goto subst_string;
 823             }
 824         }
 825       /* \{foo} is replaced with a summary of the keymap (symbol-value foo).
 826          \<foo> just sets the keymap used for \[cmd].  */
 827       else if (strp[0] == '\\' && (strp[1] == '{' || strp[1] == '<'))
 828         {
 829           struct buffer *oldbuf;
 830           ptrdiff_t start_idx;
 831           /* This is for computing the SHADOWS arg for describe_map_tree.  */
 832           Lisp_Object active_maps = Fcurrent_active_maps (Qnil, Qnil);
 833           Lisp_Object earlier_maps;
 834           ptrdiff_t count = SPECPDL_INDEX ();
 835
 836           changed = 1;
 837           strp += 2;            /* skip \{ or \< */
 838           start = strp;
 839           start_idx = start - SDATA (string);
 840
 841           while ((strp - SDATA (string) < SBYTES (string))
 842                  && *strp != '}' && *strp != '>')
 843             strp++;
 844
 845           length_byte = strp - start;
 846           strp++;                       /* skip } or > */
 847
 848           /* Save STRP in IDX.  */
 849           idx = strp - SDATA (string);
 850
 851           /* Get the value of the keymap in TEM, or nil if undefined.
 852              Do this while still in the user's current buffer
 853              in case it is a local variable.  */
 854           name = Fintern (make_string ((char *) start, length_byte), Qnil);
 855           tem = Fboundp (name);
 856           if (! NILP (tem))
 857             {
 858               tem = Fsymbol_value (name);
 859               if (! NILP (tem))
 860                 {
 861                   tem = get_keymap (tem, 0, 1);
 862                   /* Note that get_keymap can GC.  */
 863                   strp = SDATA (string) + idx;
 864                   start = SDATA (string) + start_idx;
 865                 }
 866             }
 867
 868           /* Now switch to a temp buffer.  */
 869           oldbuf = current_buffer;
 870           set_buffer_internal (XBUFFER (Vprin1_to_string_buffer));
 871           /* This is for an unusual case where some after-change
 872              function uses 'format' or 'prin1' or something else that
 873              will thrash Vprin1_to_string_buffer we are using.  */
 874           specbind (Qinhibit_modification_hooks, Qt);
 875
 876           if (NILP (tem))
 877             {
 878               name = Fsymbol_name (name);
 879               insert_string ("\nUses keymap `");
 880               insert_from_string (name, 0, 0,
 881                                   SCHARS (name),
 882                                   SBYTES (name), 1);
 883               insert_string ("', which is not currently defined.\n");
 884               if (start[-1] == '<') keymap = Qnil;
 885             }
 886           else if (start[-1] == '<')
 887             keymap = tem;
 888           else
 889             {
 890               /* Get the list of active keymaps that precede this one.
 891                  If this one's not active, get nil.  */
 892               earlier_maps = Fcdr (Fmemq (tem, Freverse (active_maps)));
 893               describe_map_tree (tem, 1, Fnreverse (earlier_maps),
 894                                  Qnil, 0, 1, 0, 0, 1);
 895             }
 896           tem = Fbuffer_string ();
 897           Ferase_buffer ();
 898           set_buffer_internal (oldbuf);
 899           unbind_to (count, Qnil);
 900
 901         subst_string:
 902           start = SDATA (tem);
 903           length = SCHARS (tem);
 904           length_byte = SBYTES (tem);
 905         subst:
 906           {
 907             ptrdiff_t offset = bufp - buf;
 908             if (STRING_BYTES_BOUND - length_byte < bsize)
 909               string_overflow ();
 910             buf = xrealloc (buf, bsize += length_byte);
 911             bufp = buf + offset;
 912             memcpy (bufp, start, length_byte);
 913             bufp += length_byte;
 914             nchars += length;
 915             /* Check STRING again in case gc relocated it.  */
 916             strp = SDATA (string) + idx;
 917           }
 918         }
 919       else if (! multibyte)             /* just copy other chars */
 920         *bufp++ = *strp++, nchars++;
 921       else
 922         {
 923           int len;
 924
 925           STRING_CHAR_AND_LENGTH (strp, len);
 926           if (len == 1)
 927             *bufp = *strp;
 928           else
 929             memcpy (bufp, strp, len);
 930           strp += len;
 931           bufp += len;
 932           nchars++;
 933         }
 934     }
 935
 936   if (changed)                  /* don't bother if nothing substituted */
 937     tem = make_string_from_bytes (buf, nchars, bufp - buf);
 938   else
 939     tem = string;
 940   xfree (buf);
 941   RETURN_UNGCPRO (tem);
 942 }
 943 \f
 944 void
 945 syms_of_doc (void)
 946 {
 947   DEFSYM (Qfunction_documentation, "function-documentation");
 948
 949   DEFVAR_LISP ("internal-doc-file-name", Vdoc_file_name,
 950                doc: /* Name of file containing documentation strings of built-in symbols.  */);
 951   Vdoc_file_name = Qnil;
 952
 953   DEFVAR_LISP ("build-files", Vbuild_files,
 954                doc: /* A list of files used to build this Emacs binary.  */);
 955   Vbuild_files = Qnil;
 956
 957   defsubr (&Sdocumentation);
 958   defsubr (&Sdocumentation_property);
 959   defsubr (&Ssnarf_documentation);
 960   defsubr (&Ssubstitute_command_keys);
 961 }