src/doc.c

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