src/doc.c

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