src/doc.c

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