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     }
 539 }
 540
 541
 542 DEFUN ("Snarf-documentation", Fsnarf_documentation, Ssnarf_documentation,
 543        1, 1, 0,
 544        doc: /* Used during Emacs initialization to scan the `etc/DOC...' file.
 545 This searches the `etc/DOC...' file for doc strings and
 546 records them in function and variable definitions.
 547 The function takes one argument, FILENAME, a string;
 548 it specifies the file name (without a directory) of the DOC file.
 549 That file is found in `../etc' now; later, when the dumped Emacs is run,
 550 the same file name is found in the `doc-directory'.  */)
 551   (Lisp_Object filename)
 552 {
 553   int fd;
 554   char buf[1024 + 1];
 555   int filled;
 556   EMACS_INT pos;
 557   Lisp_Object sym;
 558   char *p, *name;
 559   bool skip_file = 0;
 560   ptrdiff_t count;
 561   /* Preloaded defcustoms using custom-initialize-delay are added to
 562      this list, but kept unbound.  See http://debbugs.gnu.org/11565  */
 563   Lisp_Object delayed_init =
 564     find_symbol_value (intern ("custom-delayed-init-variables"));
 565
 566   if (EQ (delayed_init, Qunbound)) delayed_init = Qnil;
 567
 568   CHECK_STRING (filename);
 569
 570   if
 571 #ifndef CANNOT_DUMP
 572     (!NILP (Vpurify_flag))
 573 #else /* CANNOT_DUMP */
 574       (0)
 575 #endif /* CANNOT_DUMP */
 576     {
 577       name = alloca (SCHARS (filename) + 14);
 578       strcpy (name, "../etc/");
 579     }
 580   else
 581     {
 582       CHECK_STRING (Vdoc_directory);
 583       name = alloca (SCHARS (filename) + SCHARS (Vdoc_directory) + 1);
 584       strcpy (name, SSDATA (Vdoc_directory));
 585     }
 586   strcat (name, SSDATA (filename));     /*** Add this line ***/
 587
 588   /* Vbuild_files is nil when temacs is run, and non-nil after that.  */
 589   if (NILP (Vbuild_files))
 590     {
 591       static char const *const buildobj[] =
 592         {
 593           #include "buildobj.h"
 594         };
 595       int i = sizeof buildobj / sizeof *buildobj;
 596       while (0 <= --i)
 597         Vbuild_files = Fcons (build_string (buildobj[i]), Vbuild_files);
 598       Vbuild_files = Fpurecopy (Vbuild_files);
 599     }
 600
 601   fd = emacs_open (name, O_RDONLY, 0);
 602   if (fd < 0)
 603     {
 604       int open_errno = errno;
 605       report_file_errno ("Opening doc string file", build_string (name),
 606                          open_errno);
 607     }
 608   count = SPECPDL_INDEX ();
 609   record_unwind_protect_int (close_file_unwind, fd);
 610   Vdoc_file_name = filename;
 611   filled = 0;
 612   pos = 0;
 613   while (1)
 614     {
 615       register char *end;
 616       if (filled < 512)
 617         filled += emacs_read (fd, &buf[filled], sizeof buf - 1 - filled);
 618       if (!filled)
 619         break;
 620
 621       buf[filled] = 0;
 622       end = buf + (filled < 512 ? filled : filled - 128);
 623       p = memchr (buf, '\037', end - buf);
 624       /* p points to ^_Ffunctionname\n or ^_Vvarname\n or ^_Sfilename\n.  */
 625       if (p)
 626         {
 627           end = strchr (p, '\n');
 628
 629           /* See if this is a file name, and if it is a file in build-files.  */
 630           if (p[1] == 'S')
 631             {
 632               skip_file = 0;
 633               if (end - p > 4 && end[-2] == '.'
 634                   && (end[-1] == 'o' || end[-1] == 'c'))
 635                 {
 636                   ptrdiff_t len = end - p - 2;
 637                   char *fromfile = alloca (len + 1);
 638                   memcpy (fromfile, &p[2], len);
 639                   fromfile[len] = 0;
 640                   if (fromfile[len-1] == 'c')
 641                     fromfile[len-1] = 'o';
 642
 643                   skip_file = NILP (Fmember (build_string (fromfile),
 644                                              Vbuild_files));
 645                 }
 646             }
 647
 648           sym = oblookup (Vobarray, p + 2,
 649                           multibyte_chars_in_text ((unsigned char *) p + 2,
 650                                                    end - p - 2),
 651                           end - p - 2);
 652           /* Check skip_file so that when a function is defined several
 653              times in different files (typically, once in xterm, once in
 654              w32term, ...), we only pay attention to the one that
 655              matters.  */
 656           if (! skip_file && SYMBOLP (sym))
 657             {
 658               /* Attach a docstring to a variable?  */
 659               if (p[1] == 'V')
 660                 {
 661                   /* Install file-position as variable-documentation property
 662                      and make it negative for a user-variable
 663                      (doc starts with a `*').  */
 664                   if (!NILP (Fboundp (sym))
 665                       || !NILP (Fmemq (sym, delayed_init)))
 666                     Fput (sym, Qvariable_documentation,
 667                           make_number ((pos + end + 1 - buf)
 668                                        * (end[1] == '*' ? -1 : 1)));
 669                 }
 670
 671               /* Attach a docstring to a function?  */
 672               else if (p[1] == 'F')
 673                 {
 674                   if (!NILP (Ffboundp (sym)))
 675                     store_function_docstring (sym, pos + end + 1 - buf);
 676                 }
 677               else if (p[1] == 'S')
 678                 ; /* Just a source file name boundary marker.  Ignore it.  */
 679
 680               else
 681                 error ("DOC file invalid at position %"pI"d", pos);
 682             }
 683         }
 684       pos += end - buf;
 685       filled -= end - buf;
 686       memmove (buf, end, filled);
 687     }
 688   return unbind_to (count, Qnil);
 689 }
 690 \f
 691 DEFUN ("substitute-command-keys", Fsubstitute_command_keys,
 692        Ssubstitute_command_keys, 1, 1, 0,
 693        doc: /* Substitute key descriptions for command names in STRING.
 694 Each substring of the form \\=\\[COMMAND] is replaced by either a
 695 keystroke sequence that invokes COMMAND, or "M-x COMMAND" if COMMAND
 696 is not on any keys.
 697
 698 Each substring of the form \\=\\{MAPVAR} is replaced by a summary of
 699 the value of MAPVAR as a keymap.  This summary is similar to the one
 700 produced by `describe-bindings'.  The summary ends in two newlines
 701 \(used by the helper function `help-make-xrefs' to find the end of the
 702 summary).
 703
 704 Each substring of the form \\=\\<MAPVAR> specifies the use of MAPVAR
 705 as the keymap for future \\=\\[COMMAND] substrings.
 706 \\=\\= quotes the following character and is discarded;
 707 thus, \\=\\=\\=\\= puts \\=\\= into the output, and \\=\\=\\=\\[ puts \\=\\[ into the output.
 708
 709 Return the original STRING if no substitutions are made.
 710 Otherwise, return a new string, without any text properties.  */)
 711   (Lisp_Object string)
 712 {
 713   char *buf;
 714   bool changed = 0;
 715   unsigned char *strp;
 716   char *bufp;
 717   ptrdiff_t idx;
 718   ptrdiff_t bsize;
 719   Lisp_Object tem;
 720   Lisp_Object keymap;
 721   unsigned char *start;
 722   ptrdiff_t length, length_byte;
 723   Lisp_Object name;
 724   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
 725   bool multibyte;
 726   ptrdiff_t nchars;
 727
 728   if (NILP (string))
 729     return Qnil;
 730
 731   CHECK_STRING (string);
 732   tem = Qnil;
 733   keymap = Qnil;
 734   name = Qnil;
 735   GCPRO4 (string, tem, keymap, name);
 736
 737   multibyte = STRING_MULTIBYTE (string);
 738   nchars = 0;
 739
 740   /* KEYMAP is either nil (which means search all the active keymaps)
 741      or a specified local map (which means search just that and the
 742      global map).  If non-nil, it might come from Voverriding_local_map,
 743      or from a \\<mapname> construct in STRING itself..  */
 744   keymap = Voverriding_local_map;
 745
 746   bsize = SBYTES (string);
 747   bufp = buf = xmalloc (bsize);
 748
 749   strp = SDATA (string);
 750   while (strp < SDATA (string) + SBYTES (string))
 751     {
 752       if (strp[0] == '\\' && strp[1] == '=')
 753         {
 754           /* \= quotes the next character;
 755              thus, to put in \[ without its special meaning, use \=\[.  */
 756           changed = 1;
 757           strp += 2;
 758           if (multibyte)
 759             {
 760               int len;
 761
 762               STRING_CHAR_AND_LENGTH (strp, len);
 763               if (len == 1)
 764                 *bufp = *strp;
 765               else
 766                 memcpy (bufp, strp, len);
 767               strp += len;
 768               bufp += len;
 769               nchars++;
 770             }
 771           else
 772             *bufp++ = *strp++, nchars++;
 773         }
 774       else if (strp[0] == '\\' && strp[1] == '[')
 775         {
 776           ptrdiff_t start_idx;
 777           bool follow_remap = 1;
 778
 779           changed = 1;
 780           strp += 2;            /* skip \[ */
 781           start = strp;
 782           start_idx = start - SDATA (string);
 783
 784           while ((strp - SDATA (string)
 785                   < SBYTES (string))
 786                  && *strp != ']')
 787             strp++;
 788           length_byte = strp - start;
 789
 790           strp++;               /* skip ] */
 791
 792           /* Save STRP in IDX.  */
 793           idx = strp - SDATA (string);
 794           name = Fintern (make_string ((char *) start, length_byte), Qnil);
 795
 796         do_remap:
 797           tem = Fwhere_is_internal (name, keymap, Qt, Qnil, Qnil);
 798
 799           if (VECTORP (tem) && ASIZE (tem) > 1
 800               && EQ (AREF (tem, 0), Qremap) && SYMBOLP (AREF (tem, 1))
 801               && follow_remap)
 802             {
 803               name = AREF (tem, 1);
 804               follow_remap = 0;
 805               goto do_remap;
 806             }
 807
 808           /* Note the Fwhere_is_internal can GC, so we have to take
 809              relocation of string contents into account.  */
 810           strp = SDATA (string) + idx;
 811           start = SDATA (string) + start_idx;
 812
 813           if (NILP (tem))       /* but not on any keys */
 814             {
 815               ptrdiff_t offset = bufp - buf;
 816               if (STRING_BYTES_BOUND - 4 < bsize)
 817                 string_overflow ();
 818               buf = xrealloc (buf, bsize += 4);
 819               bufp = buf + offset;
 820               memcpy (bufp, "M-x ", 4);
 821               bufp += 4;
 822               nchars += 4;
 823               if (multibyte)
 824                 length = multibyte_chars_in_text (start, length_byte);
 825               else
 826                 length = length_byte;
 827               goto subst;
 828             }
 829           else
 830             {                   /* function is on a key */
 831               tem = Fkey_description (tem, Qnil);
 832               goto subst_string;
 833             }
 834         }
 835       /* \{foo} is replaced with a summary of the keymap (symbol-value foo).
 836          \<foo> just sets the keymap used for \[cmd].  */
 837       else if (strp[0] == '\\' && (strp[1] == '{' || strp[1] == '<'))
 838         {
 839           struct buffer *oldbuf;
 840           ptrdiff_t start_idx;
 841           /* This is for computing the SHADOWS arg for describe_map_tree.  */
 842           Lisp_Object active_maps = Fcurrent_active_maps (Qnil, Qnil);
 843           Lisp_Object earlier_maps;
 844           ptrdiff_t count = SPECPDL_INDEX ();
 845
 846           changed = 1;
 847           strp += 2;            /* skip \{ or \< */
 848           start = strp;
 849           start_idx = start - SDATA (string);
 850
 851           while ((strp - SDATA (string) < SBYTES (string))
 852                  && *strp != '}' && *strp != '>')
 853             strp++;
 854
 855           length_byte = strp - start;
 856           strp++;                       /* skip } or > */
 857
 858           /* Save STRP in IDX.  */
 859           idx = strp - SDATA (string);
 860
 861           /* Get the value of the keymap in TEM, or nil if undefined.
 862              Do this while still in the user's current buffer
 863              in case it is a local variable.  */
 864           name = Fintern (make_string ((char *) start, length_byte), Qnil);
 865           tem = Fboundp (name);
 866           if (! NILP (tem))
 867             {
 868               tem = Fsymbol_value (name);
 869               if (! NILP (tem))
 870                 {
 871                   tem = get_keymap (tem, 0, 1);
 872                   /* Note that get_keymap can GC.  */
 873                   strp = SDATA (string) + idx;
 874                   start = SDATA (string) + start_idx;
 875                 }
 876             }
 877
 878           /* Now switch to a temp buffer.  */
 879           oldbuf = current_buffer;
 880           set_buffer_internal (XBUFFER (Vprin1_to_string_buffer));
 881           /* This is for an unusual case where some after-change
 882              function uses 'format' or 'prin1' or something else that
 883              will thrash Vprin1_to_string_buffer we are using.  */
 884           specbind (Qinhibit_modification_hooks, Qt);
 885
 886           if (NILP (tem))
 887             {
 888               name = Fsymbol_name (name);
 889               insert_string ("\nUses keymap `");
 890               insert_from_string (name, 0, 0,
 891                                   SCHARS (name),
 892                                   SBYTES (name), 1);
 893               insert_string ("', which is not currently defined.\n");
 894               if (start[-1] == '<') keymap = Qnil;
 895             }
 896           else if (start[-1] == '<')
 897             keymap = tem;
 898           else
 899             {
 900               /* Get the list of active keymaps that precede this one.
 901                  If this one's not active, get nil.  */
 902               earlier_maps = Fcdr (Fmemq (tem, Freverse (active_maps)));
 903               describe_map_tree (tem, 1, Fnreverse (earlier_maps),
 904                                  Qnil, 0, 1, 0, 0, 1);
 905             }
 906           tem = Fbuffer_string ();
 907           Ferase_buffer ();
 908           set_buffer_internal (oldbuf);
 909           unbind_to (count, Qnil);
 910
 911         subst_string:
 912           start = SDATA (tem);
 913           length = SCHARS (tem);
 914           length_byte = SBYTES (tem);
 915         subst:
 916           {
 917             ptrdiff_t offset = bufp - buf;
 918             if (STRING_BYTES_BOUND - length_byte < bsize)
 919               string_overflow ();
 920             buf = xrealloc (buf, bsize += length_byte);
 921             bufp = buf + offset;
 922             memcpy (bufp, start, length_byte);
 923             bufp += length_byte;
 924             nchars += length;
 925             /* Check STRING again in case gc relocated it.  */
 926             strp = SDATA (string) + idx;
 927           }
 928         }
 929       else if (! multibyte)             /* just copy other chars */
 930         *bufp++ = *strp++, nchars++;
 931       else
 932         {
 933           int len;
 934
 935           STRING_CHAR_AND_LENGTH (strp, len);
 936           if (len == 1)
 937             *bufp = *strp;
 938           else
 939             memcpy (bufp, strp, len);
 940           strp += len;
 941           bufp += len;
 942           nchars++;
 943         }
 944     }
 945
 946   if (changed)                  /* don't bother if nothing substituted */
 947     tem = make_string_from_bytes (buf, nchars, bufp - buf);
 948   else
 949     tem = string;
 950   xfree (buf);
 951   RETURN_UNGCPRO (tem);
 952 }
 953 \f
 954 void
 955 syms_of_doc (void)
 956 {
 957   DEFSYM (Qfunction_documentation, "function-documentation");
 958
 959   DEFVAR_LISP ("internal-doc-file-name", Vdoc_file_name,
 960                doc: /* Name of file containing documentation strings of built-in symbols.  */);
 961   Vdoc_file_name = Qnil;
 962
 963   DEFVAR_LISP ("build-files", Vbuild_files,
 964                doc: /* A list of files used to build this Emacs binary.  */);
 965   Vbuild_files = Qnil;
 966
 967   defsubr (&Sdocumentation);
 968   defsubr (&Sdocumentation_property);
 969   defsubr (&Ssnarf_documentation);
 970   defsubr (&Ssubstitute_command_keys);
 971 }