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