src/doc.c

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