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