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