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