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