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 <fcntl.h>
  26 #include <unistd.h>
  27
  28 #include <c-ctype.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 /* Buffer used for reading from documentation file.  */
  40 static char *get_doc_string_buffer;
  41 static ptrdiff_t get_doc_string_buffer_size;
  42
  43 static unsigned char *read_bytecode_pointer;
  44
  45 /* readchar in lread.c calls back here to fetch the next byte.
  46    If UNREADFLAG is 1, we unread a byte.  */
  47
  48 int
  49 read_bytecode_char (bool unreadflag)
  50 {
  51   if (unreadflag)
  52     {
  53       read_bytecode_pointer--;
  54       return 0;
  55     }
  56   return *read_bytecode_pointer++;
  57 }
  58
  59 /* Extract a doc string from a file.  FILEPOS says where to get it.
  60    If it is an integer, use that position in the standard DOC-... file.
  61    If it is (FILE . INTEGER), use FILE as the file name
  62    and INTEGER as the position in that file.
  63    But if INTEGER is negative, make it positive.
  64    (A negative integer is used for user variables, so we can distinguish
  65    them without actually fetching the doc string.)
  66
  67    If the location does not point to the beginning of a docstring
  68    (e.g. because the file has been modified and the location is stale),
  69    return nil.
  70
  71    If UNIBYTE, always make a unibyte string.
  72
  73    If DEFINITION, assume this is for reading
  74    a dynamic function definition; convert the bytestring
  75    and the constants vector with appropriate byte handling,
  76    and return a cons cell.  */
  77
  78 Lisp_Object
  79 get_doc_string (Lisp_Object filepos, bool unibyte, bool definition)
  80 {
  81   char *from, *to, *name, *p, *p1;
  82   int fd;
  83   ptrdiff_t minsize;
  84   int offset;
  85   EMACS_INT position;
  86   Lisp_Object file, tem;
  87   USE_SAFE_ALLOCA;
  88
  89   if (INTEGERP (filepos))
  90     {
  91       file = Vdoc_file_name;
  92       position = XINT (filepos);
  93     }
  94   else if (CONSP (filepos))
  95     {
  96       file = XCAR (filepos);
  97       position = XINT (XCDR (filepos));
  98     }
  99   else
 100     return Qnil;
 101
 102   if (position < 0)
 103     position = - position;
 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 (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 = XCAR (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   bool 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, ptrdiff_t offset)
 506 {
 507   /* Don't use indirect_function here, or defaliases will apply their
 508      docstrings to the base functions (Bug#2603).  */
 509   Lisp_Object fun = SYMBOLP (obj) ? XSYMBOL (obj)->function : obj;
 510
 511   /* The type determines where the docstring is stored.  */
 512
 513   /* Lisp_Subrs have a slot for it.  */
 514   if (SUBRP (fun))
 515     {
 516       intptr_t negative_offset = - offset;
 517       XSUBR (fun)->doc = (char *) negative_offset;
 518     }
 519
 520   /* If it's a lisp form, stick it in the form.  */
 521   else if (CONSP (fun))
 522     {
 523       Lisp_Object tem;
 524
 525       tem = XCAR (fun);
 526       if (EQ (tem, Qlambda) || EQ (tem, Qautoload)
 527           || (EQ (tem, Qclosure) && (fun = XCDR (fun), 1)))
 528         {
 529           tem = Fcdr (Fcdr (fun));
 530           if (CONSP (tem) && INTEGERP (XCAR (tem)))
 531             XSETCAR (tem, make_number (offset));
 532         }
 533       else if (EQ (tem, Qmacro))
 534         store_function_docstring (XCDR (fun), offset);
 535     }
 536
 537   /* Bytecode objects sometimes have slots for it.  */
 538   else if (COMPILEDP (fun))
 539     {
 540       /* This bytecode object must have a slot for the
 541          docstring, since we've found a docstring for it.  */
 542       if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) > COMPILED_DOC_STRING)
 543         ASET (fun, COMPILED_DOC_STRING, make_number (offset));
 544     }
 545 }
 546
 547 static const char buildobj[] = BUILDOBJ;
 548
 549 DEFUN ("Snarf-documentation", Fsnarf_documentation, Ssnarf_documentation,
 550        1, 1, 0,
 551        doc: /* Used during Emacs initialization to scan the `etc/DOC...' file.
 552 This searches the `etc/DOC...' file for doc strings and
 553 records them in function and variable definitions.
 554 The function takes one argument, FILENAME, a string;
 555 it specifies the file name (without a directory) of the DOC file.
 556 That file is found in `../etc' now; later, when the dumped Emacs is run,
 557 the same file name is found in the `doc-directory'.  */)
 558   (Lisp_Object filename)
 559 {
 560   int fd;
 561   char buf[1024 + 1];
 562   int filled;
 563   EMACS_INT pos;
 564   Lisp_Object sym;
 565   char *p, *name;
 566   bool skip_file = 0;
 567
 568   CHECK_STRING (filename);
 569
 570   if
 571 #ifndef CANNOT_DUMP
 572     (!NILP (Vpurify_flag))
 573 #else /* CANNOT_DUMP */
 574       (0)
 575 #endif /* CANNOT_DUMP */
 576     {
 577       name = alloca (SCHARS (filename) + 14);
 578       strcpy (name, "../etc/");
 579     }
 580   else
 581     {
 582       CHECK_STRING (Vdoc_directory);
 583       name = alloca (SCHARS (filename) + SCHARS (Vdoc_directory) + 1);
 584       strcpy (name, SSDATA (Vdoc_directory));
 585     }
 586   strcat (name, SSDATA (filename));     /*** Add this line ***/
 587
 588   /* Vbuild_files is nil when temacs is run, and non-nil after that.  */
 589   if (NILP (Vbuild_files))
 590   {
 591     const char *beg, *end;
 592
 593     for (beg = buildobj; *beg; beg = end)
 594       {
 595         ptrdiff_t len;
 596
 597         while (*beg && c_isspace (*beg)) ++beg;
 598
 599         for (end = beg; *end && ! c_isspace (*end); ++end)
 600           if (*end == '/') beg = end+1;  /* skip directory part  */
 601
 602         len = end - beg;
 603         if (len > 4 && end[-4] == '.' && end[-3] == 'o')
 604           len -= 2;  /* Just take .o if it ends in .obj  */
 605
 606         if (len > 0)
 607           Vbuild_files = Fcons (make_string (beg, len), Vbuild_files);
 608       }
 609     Vbuild_files = Fpurecopy (Vbuild_files);
 610   }
 611
 612   fd = emacs_open (name, O_RDONLY, 0);
 613   if (fd < 0)
 614     report_file_error ("Opening doc string file",
 615                        Fcons (build_string (name), Qnil));
 616   Vdoc_file_name = filename;
 617   filled = 0;
 618   pos = 0;
 619   while (1)
 620     {
 621       register char *end;
 622       if (filled < 512)
 623         filled += emacs_read (fd, &buf[filled], sizeof buf - 1 - filled);
 624       if (!filled)
 625         break;
 626
 627       buf[filled] = 0;
 628       p = buf;
 629       end = buf + (filled < 512 ? filled : filled - 128);
 630       while (p != end && *p != '\037') p++;
 631       /* p points to ^_Ffunctionname\n or ^_Vvarname\n or ^_Sfilename\n.  */
 632       if (p != end)
 633         {
 634           end = strchr (p, '\n');
 635
 636           /* See if this is a file name, and if it is a file in build-files.  */
 637           if (p[1] == 'S')
 638             {
 639               skip_file = 0;
 640               if (end - p > 4 && end[-2] == '.'
 641                   && (end[-1] == 'o' || end[-1] == 'c'))
 642                 {
 643                   ptrdiff_t len = end - p - 2;
 644                   char *fromfile = alloca (len + 1);
 645                   memcpy (fromfile, &p[2], len);
 646                   fromfile[len] = 0;
 647                   if (fromfile[len-1] == 'c')
 648                     fromfile[len-1] = 'o';
 649
 650                   skip_file = NILP (Fmember (build_string (fromfile),
 651                                              Vbuild_files));
 652                 }
 653             }
 654
 655           sym = oblookup (Vobarray, p + 2,
 656                           multibyte_chars_in_text ((unsigned char *) p + 2,
 657                                                    end - p - 2),
 658                           end - p - 2);
 659           /* Check skip_file so that when a function is defined several
 660              times in different files (typically, once in xterm, once in
 661              w32term, ...), we only pay attention to the one that
 662              matters.  */
 663           if (! skip_file && SYMBOLP (sym))
 664             {
 665               /* Attach a docstring to a variable?  */
 666               if (p[1] == 'V')
 667                 {
 668                   /* Install file-position as variable-documentation property
 669                      and make it negative for a user-variable
 670                      (doc starts with a `*').  */
 671                   if (!NILP (Fboundp (sym)))
 672                     Fput (sym, Qvariable_documentation,
 673                           make_number ((pos + end + 1 - buf)
 674                                        * (end[1] == '*' ? -1 : 1)));
 675                 }
 676
 677               /* Attach a docstring to a function?  */
 678               else if (p[1] == 'F')
 679                 {
 680                   if (!NILP (Ffboundp (sym)))
 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 Each substring of the form \\=\\[COMMAND] is replaced by either a
 702 keystroke sequence that invokes COMMAND, or "M-x COMMAND" if COMMAND
 703 is not on any keys.
 704
 705 Each substring of the form \\=\\{MAPVAR} is replaced by a summary of
 706 the value of MAPVAR as a keymap.  This summary is similar to the one
 707 produced by `describe-bindings'.  The summary ends in two newlines
 708 \(used by the helper function `help-make-xrefs' to find the end of the
 709 summary).
 710
 711 Each substring of the form \\=\\<MAPVAR> specifies the use of MAPVAR
 712 as the keymap for future \\=\\[COMMAND] substrings.
 713 \\=\\= quotes the following character and is discarded;
 714 thus, \\=\\=\\=\\= puts \\=\\= into the output, and \\=\\=\\=\\[ puts \\=\\[ into the output.
 715
 716 Return the original STRING if no substitutions are made.
 717 Otherwise, return a new string, without any text properties.  */)
 718   (Lisp_Object string)
 719 {
 720   char *buf;
 721   bool changed = 0;
 722   unsigned char *strp;
 723   char *bufp;
 724   ptrdiff_t idx;
 725   ptrdiff_t bsize;
 726   Lisp_Object tem;
 727   Lisp_Object keymap;
 728   unsigned char *start;
 729   ptrdiff_t length, length_byte;
 730   Lisp_Object name;
 731   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
 732   bool multibyte;
 733   ptrdiff_t nchars;
 734
 735   if (NILP (string))
 736     return Qnil;
 737
 738   CHECK_STRING (string);
 739   tem = Qnil;
 740   keymap = Qnil;
 741   name = Qnil;
 742   GCPRO4 (string, tem, keymap, name);
 743
 744   multibyte = STRING_MULTIBYTE (string);
 745   nchars = 0;
 746
 747   /* KEYMAP is either nil (which means search all the active keymaps)
 748      or a specified local map (which means search just that and the
 749      global map).  If non-nil, it might come from Voverriding_local_map,
 750      or from a \\<mapname> construct in STRING itself..  */
 751   keymap = KVAR (current_kboard, Voverriding_terminal_local_map);
 752   if (NILP (keymap))
 753     keymap = Voverriding_local_map;
 754
 755   bsize = SBYTES (string);
 756   bufp = buf = xmalloc (bsize);
 757
 758   strp = SDATA (string);
 759   while (strp < SDATA (string) + SBYTES (string))
 760     {
 761       if (strp[0] == '\\' && strp[1] == '=')
 762         {
 763           /* \= quotes the next character;
 764              thus, to put in \[ without its special meaning, use \=\[.  */
 765           changed = 1;
 766           strp += 2;
 767           if (multibyte)
 768             {
 769               int len;
 770
 771               STRING_CHAR_AND_LENGTH (strp, len);
 772               if (len == 1)
 773                 *bufp = *strp;
 774               else
 775                 memcpy (bufp, strp, len);
 776               strp += len;
 777               bufp += len;
 778               nchars++;
 779             }
 780           else
 781             *bufp++ = *strp++, nchars++;
 782         }
 783       else if (strp[0] == '\\' && strp[1] == '[')
 784         {
 785           ptrdiff_t start_idx;
 786           bool follow_remap = 1;
 787
 788           changed = 1;
 789           strp += 2;            /* skip \[ */
 790           start = strp;
 791           start_idx = start - SDATA (string);
 792
 793           while ((strp - SDATA (string)
 794                   < SBYTES (string))
 795                  && *strp != ']')
 796             strp++;
 797           length_byte = strp - start;
 798
 799           strp++;               /* skip ] */
 800
 801           /* Save STRP in IDX.  */
 802           idx = strp - SDATA (string);
 803           name = Fintern (make_string ((char *) start, length_byte), Qnil);
 804
 805         do_remap:
 806           tem = Fwhere_is_internal (name, keymap, Qt, Qnil, Qnil);
 807
 808           if (VECTORP (tem) && ASIZE (tem) > 1
 809               && EQ (AREF (tem, 0), Qremap) && SYMBOLP (AREF (tem, 1))
 810               && follow_remap)
 811             {
 812               name = AREF (tem, 1);
 813               follow_remap = 0;
 814               goto do_remap;
 815             }
 816
 817           /* Note the Fwhere_is_internal can GC, so we have to take
 818              relocation of string contents into account.  */
 819           strp = SDATA (string) + idx;
 820           start = SDATA (string) + start_idx;
 821
 822           if (NILP (tem))       /* but not on any keys */
 823             {
 824               ptrdiff_t offset = bufp - buf;
 825               if (STRING_BYTES_BOUND - 4 < bsize)
 826                 string_overflow ();
 827               buf = xrealloc (buf, bsize += 4);
 828               bufp = buf + offset;
 829               memcpy (bufp, "M-x ", 4);
 830               bufp += 4;
 831               nchars += 4;
 832               if (multibyte)
 833                 length = multibyte_chars_in_text (start, length_byte);
 834               else
 835                 length = length_byte;
 836               goto subst;
 837             }
 838           else
 839             {                   /* function is on a key */
 840               tem = Fkey_description (tem, Qnil);
 841               goto subst_string;
 842             }
 843         }
 844       /* \{foo} is replaced with a summary of the keymap (symbol-value foo).
 845          \<foo> just sets the keymap used for \[cmd].  */
 846       else if (strp[0] == '\\' && (strp[1] == '{' || strp[1] == '<'))
 847         {
 848           struct buffer *oldbuf;
 849           ptrdiff_t start_idx;
 850           /* This is for computing the SHADOWS arg for describe_map_tree.  */
 851           Lisp_Object active_maps = Fcurrent_active_maps (Qnil, Qnil);
 852           Lisp_Object earlier_maps;
 853
 854           changed = 1;
 855           strp += 2;            /* skip \{ or \< */
 856           start = strp;
 857           start_idx = start - SDATA (string);
 858
 859           while ((strp - SDATA (string) < SBYTES (string))
 860                  && *strp != '}' && *strp != '>')
 861             strp++;
 862
 863           length_byte = strp - start;
 864           strp++;                       /* skip } or > */
 865
 866           /* Save STRP in IDX.  */
 867           idx = strp - SDATA (string);
 868
 869           /* Get the value of the keymap in TEM, or nil if undefined.
 870              Do this while still in the user's current buffer
 871              in case it is a local variable.  */
 872           name = Fintern (make_string ((char *) start, length_byte), Qnil);
 873           tem = Fboundp (name);
 874           if (! NILP (tem))
 875             {
 876               tem = Fsymbol_value (name);
 877               if (! NILP (tem))
 878                 {
 879                   tem = get_keymap (tem, 0, 1);
 880                   /* Note that get_keymap can GC.  */
 881                   strp = SDATA (string) + idx;
 882                   start = SDATA (string) + start_idx;
 883                 }
 884             }
 885
 886           /* Now switch to a temp buffer.  */
 887           oldbuf = current_buffer;
 888           set_buffer_internal (XBUFFER (Vprin1_to_string_buffer));
 889
 890           if (NILP (tem))
 891             {
 892               name = Fsymbol_name (name);
 893               insert_string ("\nUses keymap `");
 894               insert_from_string (name, 0, 0,
 895                                   SCHARS (name),
 896                                   SBYTES (name), 1);
 897               insert_string ("', which is not currently defined.\n");
 898               if (start[-1] == '<') keymap = Qnil;
 899             }
 900           else if (start[-1] == '<')
 901             keymap = tem;
 902           else
 903             {
 904               /* Get the list of active keymaps that precede this one.
 905                  If this one's not active, get nil.  */
 906               earlier_maps = Fcdr (Fmemq (tem, Freverse (active_maps)));
 907               describe_map_tree (tem, 1, Fnreverse (earlier_maps),
 908                                  Qnil, (char *)0, 1, 0, 0, 1);
 909             }
 910           tem = Fbuffer_string ();
 911           Ferase_buffer ();
 912           set_buffer_internal (oldbuf);
 913
 914         subst_string:
 915           start = SDATA (tem);
 916           length = SCHARS (tem);
 917           length_byte = SBYTES (tem);
 918         subst:
 919           {
 920             ptrdiff_t offset = bufp - buf;
 921             if (STRING_BYTES_BOUND - length_byte < bsize)
 922               string_overflow ();
 923             buf = xrealloc (buf, bsize += length_byte);
 924             bufp = buf + offset;
 925             memcpy (bufp, start, length_byte);
 926             bufp += length_byte;
 927             nchars += length;
 928             /* Check STRING again in case gc relocated it.  */
 929             strp = SDATA (string) + idx;
 930           }
 931         }
 932       else if (! multibyte)             /* just copy other chars */
 933         *bufp++ = *strp++, nchars++;
 934       else
 935         {
 936           int len;
 937
 938           STRING_CHAR_AND_LENGTH (strp, len);
 939           if (len == 1)
 940             *bufp = *strp;
 941           else
 942             memcpy (bufp, strp, len);
 943           strp += len;
 944           bufp += len;
 945           nchars++;
 946         }
 947     }
 948
 949   if (changed)                  /* don't bother if nothing substituted */
 950     tem = make_string_from_bytes (buf, nchars, bufp - buf);
 951   else
 952     tem = string;
 953   xfree (buf);
 954   RETURN_UNGCPRO (tem);
 955 }
 956 \f
 957 void
 958 syms_of_doc (void)
 959 {
 960   DEFSYM (Qfunction_documentation, "function-documentation");
 961
 962   DEFVAR_LISP ("internal-doc-file-name", Vdoc_file_name,
 963                doc: /* Name of file containing documentation strings of built-in symbols.  */);
 964   Vdoc_file_name = Qnil;
 965
 966   DEFVAR_LISP ("build-files", Vbuild_files,
 967                doc: /* A list of files used to build this Emacs binary.  */);
 968   Vbuild_files = Qnil;
 969
 970   defsubr (&Sdocumentation);
 971   defsubr (&Sdocumentation_property);
 972   defsubr (&Ssnarf_documentation);
 973   defsubr (&Ssubstitute_command_keys);
 974 }