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