src/doc.c

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