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 fun, EMACS_INT offset)
 506 /* Use EMACS_INT because we get offset from pointer subtraction.  */
 507 {
 508   fun = indirect_function (fun);
 509
 510   /* The type determines where the docstring is stored.  */
 511
 512   /* Lisp_Subrs have a slot for it.  */
 513   if (SUBRP (fun))
 514     {
 515       intptr_t negative_offset = - offset;
 516       XSUBR (fun)->doc = (char *) negative_offset;
 517     }
 518
 519   /* If it's a lisp form, stick it in the form.  */
 520   else if (CONSP (fun))
 521     {
 522       Lisp_Object tem;
 523
 524       tem = XCAR (fun);
 525       if (EQ (tem, Qlambda) || EQ (tem, Qautoload)
 526           || (EQ (tem, Qclosure) && (fun = XCDR (fun), 1)))
 527         {
 528           tem = Fcdr (Fcdr (fun));
 529           if (CONSP (tem) && INTEGERP (XCAR (tem)))
 530             XSETCAR (tem, make_number (offset));
 531         }
 532       else if (EQ (tem, Qmacro))
 533         store_function_docstring (XCDR (fun), offset);
 534     }
 535
 536   /* Bytecode objects sometimes have slots for it.  */
 537   else if (COMPILEDP (fun))
 538     {
 539       /* This bytecode object must have a slot for the
 540          docstring, since we've found a docstring for it.  */
 541       if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) > COMPILED_DOC_STRING)
 542         ASET (fun, COMPILED_DOC_STRING, make_number (offset));
 543     }
 544 }
 545
 546 static const char buildobj[] = BUILDOBJ;
 547
 548 DEFUN ("Snarf-documentation", Fsnarf_documentation, Ssnarf_documentation,
 549        1, 1, 0,
 550        doc: /* Used during Emacs initialization to scan the `etc/DOC...' file.
 551 This searches the `etc/DOC...' file for doc strings and
 552 records them in function and variable definitions.
 553 The function takes one argument, FILENAME, a string;
 554 it specifies the file name (without a directory) of the DOC file.
 555 That file is found in `../etc' now; later, when the dumped Emacs is run,
 556 the same file name is found in the `doc-directory'.  */)
 557   (Lisp_Object filename)
 558 {
 559   int fd;
 560   char buf[1024 + 1];
 561   register EMACS_INT filled;
 562   register EMACS_INT pos;
 563   register char *p;
 564   Lisp_Object sym;
 565   char *name;
 566   int 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 = (char *) alloca (SCHARS (filename) + 14);
 578       strcpy (name, "../etc/");
 579     }
 580   else
 581     {
 582       CHECK_STRING (Vdoc_directory);
 583       name = (char *) alloca (SCHARS (filename)
 584                           + SCHARS (Vdoc_directory) + 1);
 585       strcpy (name, SSDATA (Vdoc_directory));
 586     }
 587   strcat (name, SSDATA (filename));     /*** Add this line ***/
 588
 589   /* Vbuild_files is nil when temacs is run, and non-nil after that.  */
 590   if (NILP (Vbuild_files))
 591   {
 592     const char *beg, *end;
 593
 594     for (beg = buildobj; *beg; beg = end)
 595       {
 596         EMACS_INT len;
 597
 598         while (*beg && isspace (*beg)) ++beg;
 599
 600         for (end = beg; *end && ! isspace (*end); ++end)
 601           if (*end == '/') beg = end+1;  /* skip directory part  */
 602
 603         len = end - beg;
 604         if (len > 4 && end[-4] == '.' && end[-3] == 'o')
 605           len -= 2;  /* Just take .o if it ends in .obj  */
 606
 607         if (len > 0)
 608           Vbuild_files = Fcons (make_string (beg, len), Vbuild_files);
 609       }
 610     Vbuild_files = Fpurecopy (Vbuild_files);
 611   }
 612
 613   fd = emacs_open (name, O_RDONLY, 0);
 614   if (fd < 0)
 615     report_file_error ("Opening doc string file",
 616                        Fcons (build_string (name), Qnil));
 617   Vdoc_file_name = filename;
 618   filled = 0;
 619   pos = 0;
 620   while (1)
 621     {
 622       register char *end;
 623       if (filled < 512)
 624         filled += emacs_read (fd, &buf[filled], sizeof buf - 1 - filled);
 625       if (!filled)
 626         break;
 627
 628       buf[filled] = 0;
 629       p = buf;
 630       end = buf + (filled < 512 ? filled : filled - 128);
 631       while (p != end && *p != '\037') p++;
 632       /* p points to ^_Ffunctionname\n or ^_Vvarname\n or ^_Sfilename\n.  */
 633       if (p != end)
 634         {
 635           end = strchr (p, '\n');
 636
 637           /* See if this is a file name, and if it is a file in build-files.  */
 638           if (p[1] == 'S')
 639             {
 640               skip_file = 0;
 641               if (end - p > 4 && end[-2] == '.'
 642                   && (end[-1] == 'o' || end[-1] == 'c'))
 643                 {
 644                   EMACS_INT len = end - p - 2;
 645                   char *fromfile = alloca (len + 1);
 646                   strncpy (fromfile, &p[2], len);
 647                   fromfile[len] = 0;
 648                   if (fromfile[len-1] == 'c')
 649                     fromfile[len-1] = 'o';
 650
 651                   skip_file = NILP (Fmember (build_string (fromfile),
 652                                              Vbuild_files));
 653                 }
 654             }
 655
 656           sym = oblookup (Vobarray, p + 2,
 657                           multibyte_chars_in_text ((unsigned char *) p + 2,
 658                                                    end - p - 2),
 659                           end - p - 2);
 660           /* Check skip_file so that when a function is defined several
 661              times in different files (typically, once in xterm, once in
 662              w32term, ...), we only pay attention to the one that
 663              matters.  */
 664           if (! skip_file && SYMBOLP (sym))
 665             {
 666               /* Attach a docstring to a variable?  */
 667               if (p[1] == 'V')
 668                 {
 669                   /* Install file-position as variable-documentation property
 670                      and make it negative for a user-variable
 671                      (doc starts with a `*').  */
 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                 store_function_docstring (sym, pos + end + 1 - buf);
 680
 681               else if (p[1] == 'S')
 682                 ; /* Just a source file name boundary marker.  Ignore it.  */
 683
 684               else
 685                 error ("DOC file invalid at position %"pI"d", pos);
 686             }
 687         }
 688       pos += end - buf;
 689       filled -= end - buf;
 690       memmove (buf, end, filled);
 691     }
 692   emacs_close (fd);
 693   return Qnil;
 694 }
 695 \f
 696 DEFUN ("substitute-command-keys", Fsubstitute_command_keys,
 697        Ssubstitute_command_keys, 1, 1, 0,
 698        doc: /* Substitute key descriptions for command names in STRING.
 699 Substrings of the form \\=\\[COMMAND] replaced by either: a keystroke
 700 sequence that will invoke COMMAND, or "M-x COMMAND" if COMMAND is not
 701 on any keys.
 702 Substrings of the form \\=\\{MAPVAR} are replaced by summaries
 703 \(made by `describe-bindings') of the value of MAPVAR, taken as a keymap.
 704 Substrings of the form \\=\\<MAPVAR> specify to use the value of MAPVAR
 705 as the keymap for future \\=\\[COMMAND] substrings.
 706 \\=\\= quotes the following character and is discarded;
 707 thus, \\=\\=\\=\\= puts \\=\\= into the output, and \\=\\=\\=\\[ puts \\=\\[ into the output.
 708
 709 Returns original STRING if no substitutions were made.  Otherwise,
 710 a new string, without any text properties, is returned.  */)
 711   (Lisp_Object string)
 712 {
 713   char *buf;
 714   int changed = 0;
 715   register unsigned char *strp;
 716   register char *bufp;
 717   ptrdiff_t idx;
 718   ptrdiff_t bsize;
 719   Lisp_Object tem;
 720   Lisp_Object keymap;
 721   unsigned char *start;
 722   ptrdiff_t length, length_byte;
 723   Lisp_Object name;
 724   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
 725   int multibyte;
 726   ptrdiff_t nchars;
 727
 728   if (NILP (string))
 729     return Qnil;
 730
 731   CHECK_STRING (string);
 732   tem = Qnil;
 733   keymap = Qnil;
 734   name = Qnil;
 735   GCPRO4 (string, tem, keymap, name);
 736
 737   multibyte = STRING_MULTIBYTE (string);
 738   nchars = 0;
 739
 740   /* KEYMAP is either nil (which means search all the active keymaps)
 741      or a specified local map (which means search just that and the
 742      global map).  If non-nil, it might come from Voverriding_local_map,
 743      or from a \\<mapname> construct in STRING itself..  */
 744   keymap = KVAR (current_kboard, Voverriding_terminal_local_map);
 745   if (NILP (keymap))
 746     keymap = Voverriding_local_map;
 747
 748   bsize = SBYTES (string);
 749   bufp = buf = (char *) xmalloc (bsize);
 750
 751   strp = SDATA (string);
 752   while (strp < SDATA (string) + SBYTES (string))
 753     {
 754       if (strp[0] == '\\' && strp[1] == '=')
 755         {
 756           /* \= quotes the next character;
 757              thus, to put in \[ without its special meaning, use \=\[.  */
 758           changed = 1;
 759           strp += 2;
 760           if (multibyte)
 761             {
 762               int len;
 763
 764               STRING_CHAR_AND_LENGTH (strp, len);
 765               if (len == 1)
 766                 *bufp = *strp;
 767               else
 768                 memcpy (bufp, strp, len);
 769               strp += len;
 770               bufp += len;
 771               nchars++;
 772             }
 773           else
 774             *bufp++ = *strp++, nchars++;
 775         }
 776       else if (strp[0] == '\\' && strp[1] == '[')
 777         {
 778           ptrdiff_t start_idx;
 779           int follow_remap = 1;
 780
 781           changed = 1;
 782           strp += 2;            /* skip \[ */
 783           start = strp;
 784           start_idx = start - SDATA (string);
 785
 786           while ((strp - SDATA (string)
 787                   < SBYTES (string))
 788                  && *strp != ']')
 789             strp++;
 790           length_byte = strp - start;
 791
 792           strp++;               /* skip ] */
 793
 794           /* Save STRP in IDX.  */
 795           idx = strp - SDATA (string);
 796           name = Fintern (make_string ((char *) start, length_byte), Qnil);
 797
 798         do_remap:
 799           tem = Fwhere_is_internal (name, keymap, Qt, Qnil, Qnil);
 800
 801           if (VECTORP (tem) && ASIZE (tem) > 1
 802               && EQ (AREF (tem, 0), Qremap) && SYMBOLP (AREF (tem, 1))
 803               && follow_remap)
 804             {
 805               name = AREF (tem, 1);
 806               follow_remap = 0;
 807               goto do_remap;
 808             }
 809
 810           /* Note the Fwhere_is_internal can GC, so we have to take
 811              relocation of string contents into account.  */
 812           strp = SDATA (string) + idx;
 813           start = SDATA (string) + start_idx;
 814
 815           if (NILP (tem))       /* but not on any keys */
 816             {
 817               ptrdiff_t offset = bufp - buf;
 818               if (STRING_BYTES_BOUND - 4 < bsize)
 819                 string_overflow ();
 820               buf = (char *) xrealloc (buf, bsize += 4);
 821               bufp = buf + offset;
 822               memcpy (bufp, "M-x ", 4);
 823               bufp += 4;
 824               nchars += 4;
 825               if (multibyte)
 826                 length = multibyte_chars_in_text (start, length_byte);
 827               else
 828                 length = length_byte;
 829               goto subst;
 830             }
 831           else
 832             {                   /* function is on a key */
 833               tem = Fkey_description (tem, Qnil);
 834               goto subst_string;
 835             }
 836         }
 837       /* \{foo} is replaced with a summary of the keymap (symbol-value foo).
 838          \<foo> just sets the keymap used for \[cmd].  */
 839       else if (strp[0] == '\\' && (strp[1] == '{' || strp[1] == '<'))
 840         {
 841           struct buffer *oldbuf;
 842           ptrdiff_t start_idx;
 843           /* This is for computing the SHADOWS arg for describe_map_tree.  */
 844           Lisp_Object active_maps = Fcurrent_active_maps (Qnil, Qnil);
 845           Lisp_Object earlier_maps;
 846
 847           changed = 1;
 848           strp += 2;            /* skip \{ or \< */
 849           start = strp;
 850           start_idx = start - SDATA (string);
 851
 852           while ((strp - SDATA (string) < SBYTES (string))
 853                  && *strp != '}' && *strp != '>')
 854             strp++;
 855
 856           length_byte = strp - start;
 857           strp++;                       /* skip } or > */
 858
 859           /* Save STRP in IDX.  */
 860           idx = strp - SDATA (string);
 861
 862           /* Get the value of the keymap in TEM, or nil if undefined.
 863              Do this while still in the user's current buffer
 864              in case it is a local variable.  */
 865           name = Fintern (make_string ((char *) start, length_byte), Qnil);
 866           tem = Fboundp (name);
 867           if (! NILP (tem))
 868             {
 869               tem = Fsymbol_value (name);
 870               if (! NILP (tem))
 871                 {
 872                   tem = get_keymap (tem, 0, 1);
 873                   /* Note that get_keymap can GC.  */
 874                   strp = SDATA (string) + idx;
 875                   start = SDATA (string) + start_idx;
 876                 }
 877             }
 878
 879           /* Now switch to a temp buffer.  */
 880           oldbuf = current_buffer;
 881           set_buffer_internal (XBUFFER (Vprin1_to_string_buffer));
 882
 883           if (NILP (tem))
 884             {
 885               name = Fsymbol_name (name);
 886               insert_string ("\nUses keymap \"");
 887               insert_from_string (name, 0, 0,
 888                                   SCHARS (name),
 889                                   SBYTES (name), 1);
 890               insert_string ("\", which is not currently defined.\n");
 891               if (start[-1] == '<') keymap = Qnil;
 892             }
 893           else if (start[-1] == '<')
 894             keymap = tem;
 895           else
 896             {
 897               /* Get the list of active keymaps that precede this one.
 898                  If this one's not active, get nil.  */
 899               earlier_maps = Fcdr (Fmemq (tem, Freverse (active_maps)));
 900               describe_map_tree (tem, 1, Fnreverse (earlier_maps),
 901                                  Qnil, (char *)0, 1, 0, 0, 1);
 902             }
 903           tem = Fbuffer_string ();
 904           Ferase_buffer ();
 905           set_buffer_internal (oldbuf);
 906
 907         subst_string:
 908           start = SDATA (tem);
 909           length = SCHARS (tem);
 910           length_byte = SBYTES (tem);
 911         subst:
 912           {
 913             ptrdiff_t offset = bufp - buf;
 914             if (STRING_BYTES_BOUND - length_byte < bsize)
 915               string_overflow ();
 916             buf = (char *) xrealloc (buf, bsize += length_byte);
 917             bufp = buf + offset;
 918             memcpy (bufp, start, length_byte);
 919             bufp += length_byte;
 920             nchars += length;
 921             /* Check STRING again in case gc relocated it.  */
 922             strp = SDATA (string) + idx;
 923           }
 924         }
 925       else if (! multibyte)             /* just copy other chars */
 926         *bufp++ = *strp++, nchars++;
 927       else
 928         {
 929           int len;
 930
 931           STRING_CHAR_AND_LENGTH (strp, len);
 932           if (len == 1)
 933             *bufp = *strp;
 934           else
 935             memcpy (bufp, strp, len);
 936           strp += len;
 937           bufp += len;
 938           nchars++;
 939         }
 940     }
 941
 942   if (changed)                  /* don't bother if nothing substituted */
 943     tem = make_string_from_bytes (buf, nchars, bufp - buf);
 944   else
 945     tem = string;
 946   xfree (buf);
 947   RETURN_UNGCPRO (tem);
 948 }
 949 \f
 950 void
 951 syms_of_doc (void)
 952 {
 953   DEFSYM (Qfunction_documentation, "function-documentation");
 954
 955   DEFVAR_LISP ("internal-doc-file-name", Vdoc_file_name,
 956                doc: /* Name of file containing documentation strings of built-in symbols.  */);
 957   Vdoc_file_name = Qnil;
 958
 959   DEFVAR_LISP ("build-files", Vbuild_files,
 960                doc: /* A list of files used to build this Emacs binary.  */);
 961   Vbuild_files = Qnil;
 962
 963   defsubr (&Sdocumentation);
 964   defsubr (&Sdocumentation_property);
 965   defsubr (&Ssnarf_documentation);
 966   defsubr (&Ssubstitute_command_keys);
 967 }