src/doc.c

   1 /* Record indices of function doc strings stored in a file.
   2    Copyright (C) 1985, 1986, 1993, 1994, 1995, 1997, 1998, 1999, 2000, 2001,
   3                  2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011
   4                  Free Software Foundation, Inc.
   5
   6 This file is part of GNU Emacs.
   7
   8 GNU Emacs is free software: you can redistribute it and/or modify
   9 it under the terms of the GNU General Public License as published by
  10 the Free Software Foundation, either version 3 of the License, or
  11 (at your option) any later version.
  12
  13 GNU Emacs is distributed in the hope that it will be useful,
  14 but WITHOUT ANY WARRANTY; without even the implied warranty of
  15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16 GNU General Public License for more details.
  17
  18 You should have received a copy of the GNU General Public License
  19 along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
  20
  21
  22 #include <config.h>
  23
  24 #include <sys/types.h>
  25 #include <sys/file.h>   /* Must be after sys/types.h for USG*/
  26 #include <ctype.h>
  27 #include <setjmp.h>
  28 #include <fcntl.h>
  29
  30 #ifdef HAVE_UNISTD_H
  31 #include <unistd.h>
  32 #endif
  33
  34 #include "lisp.h"
  35 #include "buffer.h"
  36 #include "keyboard.h"
  37 #include "character.h"
  38 #include "keymap.h"
  39 #include "buildobj.h"
  40
  41 Lisp_Object Vdoc_file_name;
  42
  43 Lisp_Object Qfunction_documentation;
  44
  45 /* A list of files used to build this Emacs binary.  */
  46 static Lisp_Object Vbuild_files;
  47
  48 /* Buffer used for reading from documentation file.  */
  49 static char *get_doc_string_buffer;
  50 static int get_doc_string_buffer_size;
  51
  52 static unsigned char *read_bytecode_pointer;
  53 Lisp_Object Fsnarf_documentation (Lisp_Object);
  54
  55 /* readchar in lread.c calls back here to fetch the next byte.
  56    If UNREADFLAG is 1, we unread a byte.  */
  57
  58 int
  59 read_bytecode_char (int unreadflag)
  60 {
  61   if (unreadflag)
  62     {
  63       read_bytecode_pointer--;
  64       return 0;
  65     }
  66   return *read_bytecode_pointer++;
  67 }
  68
  69 /* Extract a doc string from a file.  FILEPOS says where to get it.
  70    If it is an integer, use that position in the standard DOC-... file.
  71    If it is (FILE . INTEGER), use FILE as the file name
  72    and INTEGER as the position in that file.
  73    But if INTEGER is negative, make it positive.
  74    (A negative integer is used for user variables, so we can distinguish
  75    them without actually fetching the doc string.)
  76
  77    If the location does not point to the beginning of a docstring
  78    (e.g. because the file has been modified and the location is stale),
  79    return nil.
  80
  81    If UNIBYTE is nonzero, always make a unibyte string.
  82
  83    If DEFINITION is nonzero, assume this is for reading
  84    a dynamic function definition; convert the bytestring
  85    and the constants vector with appropriate byte handling,
  86    and return a cons cell.  */
  87
  88 Lisp_Object
  89 get_doc_string (Lisp_Object filepos, int unibyte, int definition)
  90 {
  91   char *from, *to;
  92   register int fd;
  93   register char *name;
  94   register char *p, *p1;
  95   EMACS_INT minsize;
  96   EMACS_INT offset, position;
  97   Lisp_Object file, tem;
  98
  99   if (INTEGERP (filepos))
 100     {
 101       file = Vdoc_file_name;
 102       position = XINT (filepos);
 103     }
 104   else if (CONSP (filepos))
 105     {
 106       file = XCAR (filepos);
 107       position = XINT (XCDR (filepos));
 108     }
 109   else
 110     return Qnil;
 111
 112   if (position < 0)
 113     position = - position;
 114
 115   if (!STRINGP (Vdoc_directory))
 116     return Qnil;
 117
 118   if (!STRINGP (file))
 119     return Qnil;
 120
 121   /* Put the file name in NAME as a C string.
 122      If it is relative, combine it with Vdoc_directory.  */
 123
 124   tem = Ffile_name_absolute_p (file);
 125   if (NILP (tem))
 126     {
 127       minsize = SCHARS (Vdoc_directory);
 128       /* sizeof ("../etc/") == 8 */
 129       if (minsize < 8)
 130         minsize = 8;
 131       name = (char *) alloca (minsize + SCHARS (file) + 8);
 132       strcpy (name, SDATA (Vdoc_directory));
 133       strcat (name, SDATA (file));
 134     }
 135   else
 136     {
 137       name = (char *) SDATA (file);
 138     }
 139
 140   fd = emacs_open (name, O_RDONLY, 0);
 141   if (fd < 0)
 142     {
 143 #ifndef CANNOT_DUMP
 144       if (!NILP (Vpurify_flag))
 145         {
 146           /* Preparing to dump; DOC file is probably not installed.
 147              So check in ../etc. */
 148           strcpy (name, "../etc/");
 149           strcat (name, SDATA (file));
 150
 151           fd = emacs_open (name, O_RDONLY, 0);
 152         }
 153 #endif
 154       if (fd < 0)
 155         error ("Cannot open doc string file \"%s\"", name);
 156     }
 157
 158   /* Seek only to beginning of disk block.  */
 159   /* Make sure we read at least 1024 bytes before `position'
 160      so we can check the leading text for consistency.  */
 161   offset = min (position, max (1024, position % (8 * 1024)));
 162   if (0 > lseek (fd, position - offset, 0))
 163     {
 164       emacs_close (fd);
 165       error ("Position %ld out of range in doc string file \"%s\"",
 166              position, name);
 167     }
 168
 169   /* Read the doc string into get_doc_string_buffer.
 170      P points beyond the data just read.  */
 171
 172   p = get_doc_string_buffer;
 173   while (1)
 174     {
 175       EMACS_INT space_left = (get_doc_string_buffer_size
 176                               - (p - get_doc_string_buffer));
 177       int nread;
 178
 179       /* Allocate or grow the buffer if we need to.  */
 180       if (space_left == 0)
 181         {
 182           EMACS_INT in_buffer = p - get_doc_string_buffer;
 183           get_doc_string_buffer_size += 16 * 1024;
 184           get_doc_string_buffer
 185             = (char *) xrealloc (get_doc_string_buffer,
 186                                  get_doc_string_buffer_size + 1);
 187           p = get_doc_string_buffer + in_buffer;
 188           space_left = (get_doc_string_buffer_size
 189                         - (p - get_doc_string_buffer));
 190         }
 191
 192       /* Read a disk block at a time.
 193          If we read the same block last time, maybe skip this?  */
 194       if (space_left > 1024 * 8)
 195         space_left = 1024 * 8;
 196       nread = emacs_read (fd, p, space_left);
 197       if (nread < 0)
 198         {
 199           emacs_close (fd);
 200           error ("Read error on documentation file");
 201         }
 202       p[nread] = 0;
 203       if (!nread)
 204         break;
 205       if (p == get_doc_string_buffer)
 206         p1 = strchr (p + offset, '\037');
 207       else
 208         p1 = strchr (p, '\037');
 209       if (p1)
 210         {
 211           *p1 = 0;
 212           p = p1;
 213           break;
 214         }
 215       p += nread;
 216     }
 217   emacs_close (fd);
 218
 219   /* Sanity checking.  */
 220   if (CONSP (filepos))
 221     {
 222       int test = 1;
 223       if (get_doc_string_buffer[offset - test++] != ' ')
 224         return Qnil;
 225       while (get_doc_string_buffer[offset - test] >= '0'
 226              && get_doc_string_buffer[offset - test] <= '9')
 227         test++;
 228       if (get_doc_string_buffer[offset - test++] != '@'
 229           || get_doc_string_buffer[offset - test] != '#')
 230         return Qnil;
 231     }
 232   else
 233     {
 234       int test = 1;
 235       if (get_doc_string_buffer[offset - test++] != '\n')
 236         return Qnil;
 237       while (get_doc_string_buffer[offset - test] > ' ')
 238         test++;
 239       if (get_doc_string_buffer[offset - test] != '\037')
 240         return Qnil;
 241     }
 242
 243   /* Scan the text and perform quoting with ^A (char code 1).
 244      ^A^A becomes ^A, ^A0 becomes a null char, and ^A_ becomes a ^_.  */
 245   from = get_doc_string_buffer + offset;
 246   to = get_doc_string_buffer + offset;
 247   while (from != p)
 248     {
 249       if (*from == 1)
 250         {
 251           int c;
 252
 253           from++;
 254           c = *from++;
 255           if (c == 1)
 256             *to++ = c;
 257           else if (c == '0')
 258             *to++ = 0;
 259           else if (c == '_')
 260             *to++ = 037;
 261           else
 262             error ("Invalid data in documentation file -- ^A followed by code 0%o", c);
 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 = 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 = multibyte_chars_in_text (get_doc_string_buffer + offset,
 283                                                   to - (get_doc_string_buffer + offset));
 284       return make_string_from_bytes (get_doc_string_buffer + offset,
 285                                      nchars,
 286                                      to - (get_doc_string_buffer + offset));
 287     }
 288 }
 289
 290 /* Get a string from position FILEPOS and pass it through the Lisp reader.
 291    We use this for fetching the bytecode string and constants vector
 292    of a compiled function from the .elc file.  */
 293
 294 Lisp_Object
 295 read_doc_string (Lisp_Object filepos)
 296 {
 297   return get_doc_string (filepos, 0, 1);
 298 }
 299
 300 static int
 301 reread_doc_file (Lisp_Object file)
 302 {
 303 #if 0
 304   Lisp_Object reply, prompt[3];
 305   struct gcpro gcpro1;
 306   GCPRO1 (file);
 307   prompt[0] = build_string ("File ");
 308   prompt[1] = NILP (file) ? Vdoc_file_name : file;
 309   prompt[2] = build_string (" is out of sync.  Reload? ");
 310   reply = Fy_or_n_p (Fconcat (3, prompt));
 311   UNGCPRO;
 312   if (NILP (reply))
 313     return 0;
 314 #endif
 315
 316   if (NILP (file))
 317     Fsnarf_documentation (Vdoc_file_name);
 318   else
 319     Fload (file, Qt, Qt, Qt, Qnil);
 320
 321   return 1;
 322 }
 323
 324 DEFUN ("documentation", Fdocumentation, Sdocumentation, 1, 2, 0,
 325        doc: /* Return the documentation string of FUNCTION.
 326 Unless a non-nil second argument RAW is given, the
 327 string is passed through `substitute-command-keys'.  */)
 328   (Lisp_Object function, Lisp_Object raw)
 329 {
 330   Lisp_Object fun;
 331   Lisp_Object funcar;
 332   Lisp_Object tem, doc;
 333   int try_reload = 1;
 334
 335  documentation:
 336
 337   doc = Qnil;
 338
 339   if (SYMBOLP (function)
 340       && (tem = Fget (function, Qfunction_documentation),
 341           !NILP (tem)))
 342     return Fdocumentation_property (function, Qfunction_documentation, raw);
 343
 344   fun = Findirect_function (function, Qnil);
 345   if (SUBRP (fun))
 346     {
 347       if (XSUBR (fun)->doc == 0)
 348         return Qnil;
 349       else if ((EMACS_INT) XSUBR (fun)->doc >= 0)
 350         doc = build_string (XSUBR (fun)->doc);
 351       else
 352         doc = make_number ((EMACS_INT) XSUBR (fun)->doc);
 353     }
 354   else if (COMPILEDP (fun))
 355     {
 356       if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) <= COMPILED_DOC_STRING)
 357         return Qnil;
 358       tem = AREF (fun, COMPILED_DOC_STRING);
 359       if (STRINGP (tem))
 360         doc = tem;
 361       else if (NATNUMP (tem) || CONSP (tem))
 362         doc = tem;
 363       else
 364         return Qnil;
 365     }
 366   else if (STRINGP (fun) || VECTORP (fun))
 367     {
 368       return build_string ("Keyboard macro.");
 369     }
 370   else if (CONSP (fun))
 371     {
 372       funcar = Fcar (fun);
 373       if (!SYMBOLP (funcar))
 374         xsignal1 (Qinvalid_function, fun);
 375       else if (EQ (funcar, Qkeymap))
 376         return build_string ("Prefix command (definition is a keymap associating keystrokes with commands).");
 377       else if (EQ (funcar, Qlambda)
 378                || EQ (funcar, Qautoload))
 379         {
 380           Lisp_Object tem1;
 381           tem1 = Fcdr (Fcdr (fun));
 382           tem = Fcar (tem1);
 383           if (STRINGP (tem))
 384             doc = tem;
 385           /* Handle a doc reference--but these never come last
 386              in the function body, so reject them if they are last.  */
 387           else if ((NATNUMP (tem) || (CONSP (tem) && INTEGERP (XCDR (tem))))
 388                    && !NILP (XCDR (tem1)))
 389             doc = tem;
 390           else
 391             return Qnil;
 392         }
 393       else if (EQ (funcar, Qmacro))
 394         return Fdocumentation (Fcdr (fun), raw);
 395       else
 396         goto oops;
 397     }
 398   else
 399     {
 400     oops:
 401       xsignal1 (Qinvalid_function, fun);
 402     }
 403
 404   /* Check for an advised function.  Its doc string
 405      has an `ad-advice-info' text property.  */
 406   if (STRINGP (doc))
 407     {
 408       Lisp_Object innerfunc;
 409       innerfunc = Fget_text_property (make_number (0),
 410                                       intern ("ad-advice-info"),
 411                                       doc);
 412       if (! NILP (innerfunc))
 413         doc = call1 (intern ("ad-make-advised-docstring"), innerfunc);
 414     }
 415
 416   /* If DOC is 0, it's typically because of a dumped file missing
 417      from the DOC file (bug in src/Makefile.in).  */
 418   if (EQ (doc, make_number (0)))
 419     doc = Qnil;
 420   if (INTEGERP (doc) || CONSP (doc))
 421     {
 422       Lisp_Object tem;
 423       tem = get_doc_string (doc, 0, 0);
 424       if (NILP (tem) && try_reload)
 425         {
 426           /* The file is newer, we need to reset the pointers.  */
 427           struct gcpro gcpro1, gcpro2;
 428           GCPRO2 (function, raw);
 429           try_reload = reread_doc_file (Fcar_safe (doc));
 430           UNGCPRO;
 431           if (try_reload)
 432             {
 433               try_reload = 0;
 434               goto documentation;
 435             }
 436         }
 437       else
 438         doc = tem;
 439     }
 440
 441   if (NILP (raw))
 442     doc = Fsubstitute_command_keys (doc);
 443   return doc;
 444 }
 445
 446 DEFUN ("documentation-property", Fdocumentation_property,
 447        Sdocumentation_property, 2, 3, 0,
 448        doc: /* Return the documentation string that is SYMBOL's PROP property.
 449 Third argument RAW omitted or nil means pass the result through
 450 `substitute-command-keys' if it is a string.
 451
 452 This differs from `get' in that it can refer to strings stored in the
 453 `etc/DOC' file; and that it evaluates documentation properties that
 454 aren't strings.  */)
 455   (Lisp_Object symbol, Lisp_Object prop, Lisp_Object raw)
 456 {
 457   int try_reload = 1;
 458   Lisp_Object tem;
 459
 460  documentation_property:
 461
 462   tem = Fget (symbol, prop);
 463   if (EQ (tem, make_number (0)))
 464     tem = Qnil;
 465   if (INTEGERP (tem) || (CONSP (tem) && INTEGERP (XCDR (tem))))
 466     {
 467       Lisp_Object doc = tem;
 468       tem = get_doc_string (tem, 0, 0);
 469       if (NILP (tem) && try_reload)
 470         {
 471           /* The file is newer, we need to reset the pointers.  */
 472           struct gcpro gcpro1, gcpro2, gcpro3;
 473           GCPRO3 (symbol, prop, raw);
 474           try_reload = reread_doc_file (Fcar_safe (doc));
 475           UNGCPRO;
 476           if (try_reload)
 477             {
 478               try_reload = 0;
 479               goto documentation_property;
 480             }
 481         }
 482     }
 483   else if (!STRINGP (tem))
 484     /* Feval protects its argument.  */
 485     tem = Feval (tem);
 486
 487   if (NILP (raw) && STRINGP (tem))
 488     tem = Fsubstitute_command_keys (tem);
 489   return tem;
 490 }
 491 \f
 492 /* Scanning the DOC files and placing docstring offsets into functions.  */
 493
 494 static void
 495 store_function_docstring (Lisp_Object fun, EMACS_INT offset)
 496 /* Use EMACS_INT because we get offset from pointer subtraction.  */
 497 {
 498   fun = indirect_function (fun);
 499
 500   /* The type determines where the docstring is stored.  */
 501
 502   /* Lisp_Subrs have a slot for it.  */
 503   if (SUBRP (fun))
 504     XSUBR (fun)->doc = (char *) - offset;
 505
 506   /* If it's a lisp form, stick it in the form.  */
 507   else if (CONSP (fun))
 508     {
 509       Lisp_Object tem;
 510
 511       tem = XCAR (fun);
 512       if (EQ (tem, Qlambda) || EQ (tem, Qautoload))
 513         {
 514           tem = Fcdr (Fcdr (fun));
 515           if (CONSP (tem) && INTEGERP (XCAR (tem)))
 516             XSETCAR (tem, make_number (offset));
 517         }
 518       else if (EQ (tem, Qmacro))
 519         store_function_docstring (XCDR (fun), offset);
 520     }
 521
 522   /* Bytecode objects sometimes have slots for it.  */
 523   else if (COMPILEDP (fun))
 524     {
 525       /* This bytecode object must have a slot for the
 526          docstring, since we've found a docstring for it.  */
 527       if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) > COMPILED_DOC_STRING)
 528         ASET (fun, COMPILED_DOC_STRING, make_number (offset));
 529     }
 530 }
 531
 532 static const char buildobj[] = BUILDOBJ;
 533
 534 DEFUN ("Snarf-documentation", Fsnarf_documentation, Ssnarf_documentation,
 535        1, 1, 0,
 536        doc: /* Used during Emacs initialization to scan the `etc/DOC...' file.
 537 This searches the `etc/DOC...' file for doc strings and
 538 records them in function and variable definitions.
 539 The function takes one argument, FILENAME, a string;
 540 it specifies the file name (without a directory) of the DOC file.
 541 That file is found in `../etc' now; later, when the dumped Emacs is run,
 542 the same file name is found in the `doc-directory'.  */)
 543   (Lisp_Object filename)
 544 {
 545   int fd;
 546   char buf[1024 + 1];
 547   register EMACS_INT filled;
 548   register EMACS_INT pos;
 549   register char *p, *end;
 550   Lisp_Object sym;
 551   char *name;
 552   int skip_file = 0;
 553
 554   CHECK_STRING (filename);
 555
 556   if
 557 #ifndef CANNOT_DUMP
 558     (!NILP (Vpurify_flag))
 559 #else /* CANNOT_DUMP */
 560       (0)
 561 #endif /* CANNOT_DUMP */
 562     {
 563       name = (char *) alloca (SCHARS (filename) + 14);
 564       strcpy (name, "../etc/");
 565     }
 566   else
 567     {
 568       CHECK_STRING (Vdoc_directory);
 569       name = (char *) alloca (SCHARS (filename)
 570                           + SCHARS (Vdoc_directory) + 1);
 571       strcpy (name, SDATA (Vdoc_directory));
 572     }
 573   strcat (name, SDATA (filename));      /*** Add this line ***/
 574
 575   /* Vbuild_files is nil when temacs is run, and non-nil after that.  */
 576   if (NILP (Vbuild_files))
 577   {
 578     const char *beg, *end;
 579
 580     for (beg = buildobj; *beg; beg = end)
 581       {
 582         EMACS_INT len;
 583
 584         while (*beg && isspace (*beg)) ++beg;
 585
 586         for (end = beg; *end && ! isspace (*end); ++end)
 587           if (*end == '/') beg = end+1;  /* skip directory part  */
 588
 589         len = end - beg;
 590         if (len > 4 && end[-4] == '.' && end[-3] == 'o')
 591           len -= 2;  /* Just take .o if it ends in .obj  */
 592
 593         if (len > 0)
 594           Vbuild_files = Fcons (make_string (beg, len), Vbuild_files);
 595       }
 596     Vbuild_files = Fpurecopy (Vbuild_files);
 597   }
 598
 599   fd = emacs_open (name, O_RDONLY, 0);
 600   if (fd < 0)
 601     report_file_error ("Opening doc string file",
 602                        Fcons (build_string (name), Qnil));
 603   Vdoc_file_name = filename;
 604   filled = 0;
 605   pos = 0;
 606   while (1)
 607     {
 608       if (filled < 512)
 609         filled += emacs_read (fd, &buf[filled], sizeof buf - 1 - filled);
 610       if (!filled)
 611         break;
 612
 613       buf[filled] = 0;
 614       p = buf;
 615       end = buf + (filled < 512 ? filled : filled - 128);
 616       while (p != end && *p != '\037') p++;
 617       /* p points to ^_Ffunctionname\n or ^_Vvarname\n or ^_Sfilename\n.  */
 618       if (p != end)
 619         {
 620           end = strchr (p, '\n');
 621
 622           /* See if this is a file name, and if it is a file in build-files.  */
 623           if (p[1] == 'S')
 624             {
 625               skip_file = 0;
 626               if (end - p > 4 && end[-2] == '.'
 627                   && (end[-1] == 'o' || end[-1] == 'c'))
 628                 {
 629                   EMACS_INT len = end - p - 2;
 630                   char *fromfile = alloca (len + 1);
 631                   strncpy (fromfile, &p[2], len);
 632                   fromfile[len] = 0;
 633                   if (fromfile[len-1] == 'c')
 634                     fromfile[len-1] = 'o';
 635
 636                   skip_file = NILP (Fmember (build_string (fromfile),
 637                                              Vbuild_files));
 638                 }
 639             }
 640
 641           sym = oblookup (Vobarray, p + 2,
 642                           multibyte_chars_in_text (p + 2, 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   unsigned char *buf;
 698   int changed = 0;
 699   register unsigned char *strp;
 700   register unsigned 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 = current_kboard->Voverriding_terminal_local_map;
 729   if (NILP (keymap))
 730     keymap = Voverriding_local_map;
 731
 732   bsize = SBYTES (string);
 733   bufp = buf = (unsigned 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 (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 = (unsigned 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 (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 = (unsigned 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 = (unsigned char *) 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 }
 949