src/doc.c

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