src/doc.c

   1 /* Record indices of function doc strings stored in a file.
   2    Copyright (C) 1985-1986, 1993-1995, 1997-2012
   3                  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 "buffer.h"
  32 #include "keyboard.h"
  33 #include "character.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 static Lisp_Object Fdocumentation_property (Lisp_Object, Lisp_Object,
  46                                             Lisp_Object);
  47 static Lisp_Object Fsnarf_documentation (Lisp_Object);
  48
  49 /* readchar in lread.c calls back here to fetch the next byte.
  50    If UNREADFLAG is 1, we unread a byte.  */
  51
  52 int
  53 read_bytecode_char (int unreadflag)
  54 {
  55   if (unreadflag)
  56     {
  57       read_bytecode_pointer--;
  58       return 0;
  59     }
  60   return *read_bytecode_pointer++;
  61 }
  62
  63 /* Extract a doc string from a file.  FILEPOS says where to get it.
  64    If it is an integer, use that position in the standard DOC-... file.
  65    If it is (FILE . INTEGER), use FILE as the file name
  66    and INTEGER as the position in that file.
  67    But if INTEGER is negative, make it positive.
  68    (A negative integer is used for user variables, so we can distinguish
  69    them without actually fetching the doc string.)
  70
  71    If the location does not point to the beginning of a docstring
  72    (e.g. because the file has been modified and the location is stale),
  73    return nil.
  74
  75    If UNIBYTE is nonzero, always make a unibyte string.
  76
  77    If DEFINITION is nonzero, assume this is for reading
  78    a dynamic function definition; convert the bytestring
  79    and the constants vector with appropriate byte handling,
  80    and return a cons cell.  */
  81
  82 Lisp_Object
  83 get_doc_string (Lisp_Object filepos, int unibyte, int definition)
  84 {
  85   char *from, *to;
  86   register int fd;
  87   register char *name;
  88   register char *p, *p1;
  89   EMACS_INT minsize;
  90   EMACS_INT offset, position;
  91   Lisp_Object file, tem;
  92
  93   if (INTEGERP (filepos))
  94     {
  95       file = Vdoc_file_name;
  96       position = XINT (filepos);
  97     }
  98   else if (CONSP (filepos))
  99     {
 100       file = XCAR (filepos);
 101       position = XINT (XCDR (filepos));
 102     }
 103   else
 104     return Qnil;
 105
 106   if (position < 0)
 107     position = - position;
 108
 109   if (!STRINGP (Vdoc_directory))
 110     return Qnil;
 111
 112   if (!STRINGP (file))
 113     return Qnil;
 114
 115   /* Put the file name in NAME as a C string.
 116      If it is relative, combine it with Vdoc_directory.  */
 117
 118   tem = Ffile_name_absolute_p (file);
 119   file = ENCODE_FILE (file);
 120   if (NILP (tem))
 121     {
 122       Lisp_Object docdir = ENCODE_FILE (Vdoc_directory);
 123       minsize = SCHARS (docdir);
 124       /* sizeof ("../etc/") == 8 */
 125       if (minsize < 8)
 126         minsize = 8;
 127       name = (char *) alloca (minsize + SCHARS (file) + 8);
 128       strcpy (name, SSDATA (docdir));
 129       strcat (name, SSDATA (file));
 130     }
 131   else
 132     {
 133       name = SSDATA (file);
 134     }
 135
 136   fd = emacs_open (name, O_RDONLY, 0);
 137   if (fd < 0)
 138     {
 139 #ifndef CANNOT_DUMP
 140       if (!NILP (Vpurify_flag))
 141         {
 142           /* Preparing to dump; DOC file is probably not installed.
 143              So check in ../etc.  */
 144           strcpy (name, "../etc/");
 145           strcat (name, SSDATA (file));
 146
 147           fd = emacs_open (name, O_RDONLY, 0);
 148         }
 149 #endif
 150       if (fd < 0)
 151         error ("Cannot open doc string file \"%s\"", name);
 152     }
 153
 154   /* Seek only to beginning of disk block.  */
 155   /* Make sure we read at least 1024 bytes before `position'
 156      so we can check the leading text for consistency.  */
 157   offset = min (position, max (1024, position % (8 * 1024)));
 158   if (0 > lseek (fd, position - offset, 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   /* 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       EMACS_INT 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 int
 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   int 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 (SUBRP (fun))
 351     {
 352       if (XSUBR (fun)->doc == 0)
 353         return Qnil;
 354       /* FIXME: This is not portable, as it assumes that string
 355          pointers have the top bit clear.  */
 356       else if ((intptr_t) XSUBR (fun)->doc >= 0)
 357         doc = build_string (XSUBR (fun)->doc);
 358       else
 359         doc = make_number ((intptr_t) XSUBR (fun)->doc);
 360     }
 361   else if (COMPILEDP (fun))
 362     {
 363       if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) <= COMPILED_DOC_STRING)
 364         return Qnil;
 365       else
 366         {
 367           Lisp_Object tem = AREF (fun, COMPILED_DOC_STRING);
 368           if (STRINGP (tem))
 369             doc = tem;
 370           else if (NATNUMP (tem) || CONSP (tem))
 371             doc = tem;
 372           else
 373             return Qnil;
 374         }
 375     }
 376   else if (STRINGP (fun) || VECTORP (fun))
 377     {
 378       return build_string ("Keyboard macro.");
 379     }
 380   else if (CONSP (fun))
 381     {
 382       funcar = Fcar (fun);
 383       if (!SYMBOLP (funcar))
 384         xsignal1 (Qinvalid_function, fun);
 385       else if (EQ (funcar, Qkeymap))
 386         return build_string ("Prefix command (definition is a keymap associating keystrokes with commands).");
 387       else if (EQ (funcar, Qlambda)
 388                || (EQ (funcar, Qclosure) && (fun = XCDR (fun), 1))
 389                || EQ (funcar, Qautoload))
 390         {
 391           Lisp_Object tem1 = Fcdr (Fcdr (fun));
 392           Lisp_Object tem = Fcar (tem1);
 393           if (STRINGP (tem))
 394             doc = tem;
 395           /* Handle a doc reference--but these never come last
 396              in the function body, so reject them if they are last.  */
 397           else if ((NATNUMP (tem) || (CONSP (tem) && INTEGERP (XCDR (tem))))
 398                    && !NILP (XCDR (tem1)))
 399             doc = tem;
 400           else
 401             return Qnil;
 402         }
 403       else if (EQ (funcar, Qmacro))
 404         return Fdocumentation (Fcdr (fun), raw);
 405       else
 406         goto oops;
 407     }
 408   else
 409     {
 410     oops:
 411       xsignal1 (Qinvalid_function, fun);
 412     }
 413
 414   /* Check for an advised function.  Its doc string
 415      has an `ad-advice-info' text property.  */
 416   if (STRINGP (doc))
 417     {
 418       Lisp_Object innerfunc;
 419       innerfunc = Fget_text_property (make_number (0),
 420                                       intern ("ad-advice-info"),
 421                                       doc);
 422       if (! NILP (innerfunc))
 423         doc = call1 (intern ("ad-make-advised-docstring"), innerfunc);
 424     }
 425
 426   /* If DOC is 0, it's typically because of a dumped file missing
 427      from the DOC file (bug in src/Makefile.in).  */
 428   if (EQ (doc, make_number (0)))
 429     doc = Qnil;
 430   if (INTEGERP (doc) || CONSP (doc))
 431     {
 432       Lisp_Object tem;
 433       tem = get_doc_string (doc, 0, 0);
 434       if (NILP (tem) && try_reload)
 435         {
 436           /* The file is newer, we need to reset the pointers.  */
 437           struct gcpro gcpro1, gcpro2;
 438           GCPRO2 (function, raw);
 439           try_reload = reread_doc_file (Fcar_safe (doc));
 440           UNGCPRO;
 441           if (try_reload)
 442             {
 443               try_reload = 0;
 444               goto documentation;
 445             }
 446         }
 447       else
 448         doc = tem;
 449     }
 450
 451   if (NILP (raw))
 452     doc = Fsubstitute_command_keys (doc);
 453   return doc;
 454 }
 455
 456 DEFUN ("documentation-property", Fdocumentation_property,
 457        Sdocumentation_property, 2, 3, 0,
 458        doc: /* Return the documentation string that is SYMBOL's PROP property.
 459 Third argument RAW omitted or nil means pass the result through
 460 `substitute-command-keys' if it is a string.
 461
 462 This differs from `get' in that it can refer to strings stored in the
 463 `etc/DOC' file; and that it evaluates documentation properties that
 464 aren't strings.  */)
 465   (Lisp_Object symbol, Lisp_Object prop, Lisp_Object raw)
 466 {
 467   int try_reload = 1;
 468   Lisp_Object tem;
 469
 470  documentation_property:
 471
 472   tem = Fget (symbol, prop);
 473   if (EQ (tem, make_number (0)))
 474     tem = Qnil;
 475   if (INTEGERP (tem) || (CONSP (tem) && INTEGERP (XCDR (tem))))
 476     {
 477       Lisp_Object doc = tem;
 478       tem = get_doc_string (tem, 0, 0);
 479       if (NILP (tem) && try_reload)
 480         {
 481           /* The file is newer, we need to reset the pointers.  */
 482           struct gcpro gcpro1, gcpro2, gcpro3;
 483           GCPRO3 (symbol, prop, raw);
 484           try_reload = reread_doc_file (Fcar_safe (doc));
 485           UNGCPRO;
 486           if (try_reload)
 487             {
 488               try_reload = 0;
 489               goto documentation_property;
 490             }
 491         }
 492     }
 493   else if (!STRINGP (tem))
 494     /* Feval protects its argument.  */
 495     tem = Feval (tem, Qnil);
 496
 497   if (NILP (raw) && STRINGP (tem))
 498     tem = Fsubstitute_command_keys (tem);
 499   return tem;
 500 }
 501 \f
 502 /* Scanning the DOC files and placing docstring offsets into functions.  */
 503
 504 static void
 505 store_function_docstring (Lisp_Object obj, EMACS_INT offset)
 506 /* Use EMACS_INT because we get offset from pointer subtraction.  */
 507 {
 508   /* Don't use indirect_function here, or defaliases will apply their
 509      docstrings to the base functions (Bug#2603).  */
 510   Lisp_Object fun = SYMBOLP (obj) ? XSYMBOL (obj)->function : obj;
 511
 512   /* The type determines where the docstring is stored.  */
 513
 514   /* Lisp_Subrs have a slot for it.  */
 515   if (SUBRP (fun))
 516     {
 517       intptr_t negative_offset = - offset;
 518       XSUBR (fun)->doc = (char *) negative_offset;
 519     }
 520
 521   /* If it's a lisp form, stick it in the form.  */
 522   else if (CONSP (fun))
 523     {
 524       Lisp_Object tem;
 525
 526       tem = XCAR (fun);
 527       if (EQ (tem, Qlambda) || EQ (tem, Qautoload)
 528           || (EQ (tem, Qclosure) && (fun = XCDR (fun), 1)))
 529         {
 530           tem = Fcdr (Fcdr (fun));
 531           if (CONSP (tem) && INTEGERP (XCAR (tem)))
 532             XSETCAR (tem, make_number (offset));
 533         }
 534       else if (EQ (tem, Qmacro))
 535         store_function_docstring (XCDR (fun), offset);
 536     }
 537
 538   /* Bytecode objects sometimes have slots for it.  */
 539   else if (COMPILEDP (fun))
 540     {
 541       /* This bytecode object must have a slot for the
 542          docstring, since we've found a docstring for it.  */
 543       if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) > COMPILED_DOC_STRING)
 544         ASET (fun, COMPILED_DOC_STRING, make_number (offset));
 545     }
 546 }
 547
 548 static const char buildobj[] = BUILDOBJ;
 549
 550 DEFUN ("Snarf-documentation", Fsnarf_documentation, Ssnarf_documentation,
 551        1, 1, 0,
 552        doc: /* Used during Emacs initialization to scan the `etc/DOC...' file.
 553 This searches the `etc/DOC...' file for doc strings and
 554 records them in function and variable definitions.
 555 The function takes one argument, FILENAME, a string;
 556 it specifies the file name (without a directory) of the DOC file.
 557 That file is found in `../etc' now; later, when the dumped Emacs is run,
 558 the same file name is found in the `doc-directory'.  */)
 559   (Lisp_Object filename)
 560 {
 561   int fd;
 562   char buf[1024 + 1];
 563   register EMACS_INT filled;
 564   register EMACS_INT pos;
 565   register char *p;
 566   Lisp_Object sym;
 567   char *name;
 568   int skip_file = 0;
 569
 570   CHECK_STRING (filename);
 571
 572   if
 573 #ifndef CANNOT_DUMP
 574     (!NILP (Vpurify_flag))
 575 #else /* CANNOT_DUMP */
 576       (0)
 577 #endif /* CANNOT_DUMP */
 578     {
 579       name = (char *) alloca (SCHARS (filename) + 14);
 580       strcpy (name, "../etc/");
 581     }
 582   else
 583     {
 584       CHECK_STRING (Vdoc_directory);
 585       name = (char *) alloca (SCHARS (filename)
 586                           + 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         EMACS_INT 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                   EMACS_INT len = end - p - 2;
 647                   char *fromfile = alloca (len + 1);
 648                   strncpy (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                   Fput (sym, Qvariable_documentation,
 675                         make_number ((pos + end + 1 - buf)
 676                                      * (end[1] == '*' ? -1 : 1)));
 677                 }
 678
 679               /* Attach a docstring to a function?  */
 680               else if (p[1] == 'F')
 681                 store_function_docstring (sym, pos + end + 1 - buf);
 682
 683               else if (p[1] == 'S')
 684                 ; /* Just a source file name boundary marker.  Ignore it.  */
 685
 686               else
 687                 error ("DOC file invalid at position %"pI"d", pos);
 688             }
 689         }
 690       pos += end - buf;
 691       filled -= end - buf;
 692       memmove (buf, end, filled);
 693     }
 694   emacs_close (fd);
 695   return Qnil;
 696 }
 697 \f
 698 DEFUN ("substitute-command-keys", Fsubstitute_command_keys,
 699        Ssubstitute_command_keys, 1, 1, 0,
 700        doc: /* Substitute key descriptions for command names in STRING.
 701 Substrings of the form \\=\\[COMMAND] replaced by either: a keystroke
 702 sequence that will invoke COMMAND, or "M-x COMMAND" if COMMAND is not
 703 on any keys.
 704 Substrings of the form \\=\\{MAPVAR} are replaced by summaries
 705 \(made by `describe-bindings') of the value of MAPVAR, taken as a keymap.
 706 Substrings of the form \\=\\<MAPVAR> specify to use the value of MAPVAR
 707 as the keymap for future \\=\\[COMMAND] substrings.
 708 \\=\\= quotes the following character and is discarded;
 709 thus, \\=\\=\\=\\= puts \\=\\= into the output, and \\=\\=\\=\\[ puts \\=\\[ into the output.
 710
 711 Returns original STRING if no substitutions were made.  Otherwise,
 712 a new string, without any text properties, is returned.  */)
 713   (Lisp_Object string)
 714 {
 715   char *buf;
 716   int changed = 0;
 717   register unsigned char *strp;
 718   register char *bufp;
 719   ptrdiff_t idx;
 720   ptrdiff_t bsize;
 721   Lisp_Object tem;
 722   Lisp_Object keymap;
 723   unsigned char *start;
 724   ptrdiff_t length, length_byte;
 725   Lisp_Object name;
 726   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
 727   int multibyte;
 728   ptrdiff_t nchars;
 729
 730   if (NILP (string))
 731     return Qnil;
 732
 733   CHECK_STRING (string);
 734   tem = Qnil;
 735   keymap = Qnil;
 736   name = Qnil;
 737   GCPRO4 (string, tem, keymap, name);
 738
 739   multibyte = STRING_MULTIBYTE (string);
 740   nchars = 0;
 741
 742   /* KEYMAP is either nil (which means search all the active keymaps)
 743      or a specified local map (which means search just that and the
 744      global map).  If non-nil, it might come from Voverriding_local_map,
 745      or from a \\<mapname> construct in STRING itself..  */
 746   keymap = KVAR (current_kboard, Voverriding_terminal_local_map);
 747   if (NILP (keymap))
 748     keymap = Voverriding_local_map;
 749
 750   bsize = SBYTES (string);
 751   bufp = buf = (char *) xmalloc (bsize);
 752
 753   strp = SDATA (string);
 754   while (strp < SDATA (string) + SBYTES (string))
 755     {
 756       if (strp[0] == '\\' && strp[1] == '=')
 757         {
 758           /* \= quotes the next character;
 759              thus, to put in \[ without its special meaning, use \=\[.  */
 760           changed = 1;
 761           strp += 2;
 762           if (multibyte)
 763             {
 764               int len;
 765
 766               STRING_CHAR_AND_LENGTH (strp, len);
 767               if (len == 1)
 768                 *bufp = *strp;
 769               else
 770                 memcpy (bufp, strp, len);
 771               strp += len;
 772               bufp += len;
 773               nchars++;
 774             }
 775           else
 776             *bufp++ = *strp++, nchars++;
 777         }
 778       else if (strp[0] == '\\' && strp[1] == '[')
 779         {
 780           ptrdiff_t start_idx;
 781           int follow_remap = 1;
 782
 783           changed = 1;
 784           strp += 2;            /* skip \[ */
 785           start = strp;
 786           start_idx = start - SDATA (string);
 787
 788           while ((strp - SDATA (string)
 789                   < SBYTES (string))
 790                  && *strp != ']')
 791             strp++;
 792           length_byte = strp - start;
 793
 794           strp++;               /* skip ] */
 795
 796           /* Save STRP in IDX.  */
 797           idx = strp - SDATA (string);
 798           name = Fintern (make_string ((char *) start, length_byte), Qnil);
 799
 800         do_remap:
 801           tem = Fwhere_is_internal (name, keymap, Qt, Qnil, Qnil);
 802
 803           if (VECTORP (tem) && ASIZE (tem) > 1
 804               && EQ (AREF (tem, 0), Qremap) && SYMBOLP (AREF (tem, 1))
 805               && follow_remap)
 806             {
 807               name = AREF (tem, 1);
 808               follow_remap = 0;
 809               goto do_remap;
 810             }
 811
 812           /* Note the Fwhere_is_internal can GC, so we have to take
 813              relocation of string contents into account.  */
 814           strp = SDATA (string) + idx;
 815           start = SDATA (string) + start_idx;
 816
 817           if (NILP (tem))       /* but not on any keys */
 818             {
 819               ptrdiff_t offset = bufp - buf;
 820               if (STRING_BYTES_BOUND - 4 < bsize)
 821                 string_overflow ();
 822               buf = (char *) xrealloc (buf, bsize += 4);
 823               bufp = buf + offset;
 824               memcpy (bufp, "M-x ", 4);
 825               bufp += 4;
 826               nchars += 4;
 827               if (multibyte)
 828                 length = multibyte_chars_in_text (start, length_byte);
 829               else
 830                 length = length_byte;
 831               goto subst;
 832             }
 833           else
 834             {                   /* function is on a key */
 835               tem = Fkey_description (tem, Qnil);
 836               goto subst_string;
 837             }
 838         }
 839       /* \{foo} is replaced with a summary of the keymap (symbol-value foo).
 840          \<foo> just sets the keymap used for \[cmd].  */
 841       else if (strp[0] == '\\' && (strp[1] == '{' || strp[1] == '<'))
 842         {
 843           struct buffer *oldbuf;
 844           ptrdiff_t start_idx;
 845           /* This is for computing the SHADOWS arg for describe_map_tree.  */
 846           Lisp_Object active_maps = Fcurrent_active_maps (Qnil, Qnil);
 847           Lisp_Object earlier_maps;
 848
 849           changed = 1;
 850           strp += 2;            /* skip \{ or \< */
 851           start = strp;
 852           start_idx = start - SDATA (string);
 853
 854           while ((strp - SDATA (string) < SBYTES (string))
 855                  && *strp != '}' && *strp != '>')
 856             strp++;
 857
 858           length_byte = strp - start;
 859           strp++;                       /* skip } or > */
 860
 861           /* Save STRP in IDX.  */
 862           idx = strp - SDATA (string);
 863
 864           /* Get the value of the keymap in TEM, or nil if undefined.
 865              Do this while still in the user's current buffer
 866              in case it is a local variable.  */
 867           name = Fintern (make_string ((char *) start, length_byte), Qnil);
 868           tem = Fboundp (name);
 869           if (! NILP (tem))
 870             {
 871               tem = Fsymbol_value (name);
 872               if (! NILP (tem))
 873                 {
 874                   tem = get_keymap (tem, 0, 1);
 875                   /* Note that get_keymap can GC.  */
 876                   strp = SDATA (string) + idx;
 877                   start = SDATA (string) + start_idx;
 878                 }
 879             }
 880
 881           /* Now switch to a temp buffer.  */
 882           oldbuf = current_buffer;
 883           set_buffer_internal (XBUFFER (Vprin1_to_string_buffer));
 884
 885           if (NILP (tem))
 886             {
 887               name = Fsymbol_name (name);
 888               insert_string ("\nUses keymap \"");
 889               insert_from_string (name, 0, 0,
 890                                   SCHARS (name),
 891                                   SBYTES (name), 1);
 892               insert_string ("\", which is not currently defined.\n");
 893               if (start[-1] == '<') keymap = Qnil;
 894             }
 895           else if (start[-1] == '<')
 896             keymap = tem;
 897           else
 898             {
 899               /* Get the list of active keymaps that precede this one.
 900                  If this one's not active, get nil.  */
 901               earlier_maps = Fcdr (Fmemq (tem, Freverse (active_maps)));
 902               describe_map_tree (tem, 1, Fnreverse (earlier_maps),
 903                                  Qnil, (char *)0, 1, 0, 0, 1);
 904             }
 905           tem = Fbuffer_string ();
 906           Ferase_buffer ();
 907           set_buffer_internal (oldbuf);
 908
 909         subst_string:
 910           start = SDATA (tem);
 911           length = SCHARS (tem);
 912           length_byte = SBYTES (tem);
 913         subst:
 914           {
 915             ptrdiff_t offset = bufp - buf;
 916             if (STRING_BYTES_BOUND - length_byte < bsize)
 917               string_overflow ();
 918             buf = (char *) xrealloc (buf, bsize += length_byte);
 919             bufp = buf + offset;
 920             memcpy (bufp, start, length_byte);
 921             bufp += length_byte;
 922             nchars += length;
 923             /* Check STRING again in case gc relocated it.  */
 924             strp = SDATA (string) + idx;
 925           }
 926         }
 927       else if (! multibyte)             /* just copy other chars */
 928         *bufp++ = *strp++, nchars++;
 929       else
 930         {
 931           int len;
 932
 933           STRING_CHAR_AND_LENGTH (strp, len);
 934           if (len == 1)
 935             *bufp = *strp;
 936           else
 937             memcpy (bufp, strp, len);
 938           strp += len;
 939           bufp += len;
 940           nchars++;
 941         }
 942     }
 943
 944   if (changed)                  /* don't bother if nothing substituted */
 945     tem = make_string_from_bytes (buf, nchars, bufp - buf);
 946   else
 947     tem = string;
 948   xfree (buf);
 949   RETURN_UNGCPRO (tem);
 950 }
 951 \f
 952 void
 953 syms_of_doc (void)
 954 {
 955   DEFSYM (Qfunction_documentation, "function-documentation");
 956
 957   DEFVAR_LISP ("internal-doc-file-name", Vdoc_file_name,
 958                doc: /* Name of file containing documentation strings of built-in symbols.  */);
 959   Vdoc_file_name = Qnil;
 960
 961   DEFVAR_LISP ("build-files", Vbuild_files,
 962                doc: /* A list of files used to build this Emacs binary.  */);
 963   Vbuild_files = Qnil;
 964
 965   defsubr (&Sdocumentation);
 966   defsubr (&Sdocumentation_property);
 967   defsubr (&Ssnarf_documentation);
 968   defsubr (&Ssubstitute_command_keys);
 969 }