src/doc.c

   1 /* Record indices of function doc strings stored in a file.
   2    Copyright (C) 1985, 86,93,94,95,97,98,99, 2000 Free Software Foundation, Inc.
   3
   4 This file is part of GNU Emacs.
   5
   6 GNU Emacs is free software; you can redistribute it and/or modify
   7 it under the terms of the GNU General Public License as published by
   8 the Free Software Foundation; either version 2, or (at your option)
   9 any later version.
  10
  11 GNU Emacs is distributed in the hope that it will be useful,
  12 but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 GNU General Public License for more details.
  15
  16 You should have received a copy of the GNU General Public License
  17 along with GNU Emacs; see the file COPYING.  If not, write to
  18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  19 Boston, MA 02111-1307, USA.  */
  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 and BSD4_1*/
  26
  27 #ifdef USG5
  28 #include <fcntl.h>
  29 #endif
  30
  31 #ifdef HAVE_UNISTD_H
  32 #include <unistd.h>
  33 #endif
  34
  35 #ifndef O_RDONLY
  36 #define O_RDONLY 0
  37 #endif
  38
  39 #include "lisp.h"
  40 #include "buffer.h"
  41 #include "keyboard.h"
  42 #include "charset.h"
  43
  44 #ifdef HAVE_INDEX
  45 extern char *index P_ ((const char *, int));
  46 #endif
  47
  48 Lisp_Object Vdoc_file_name, Vhelp_manyarg_func_alist;
  49
  50 Lisp_Object Qfunction_documentation;
  51
  52 extern Lisp_Object Voverriding_local_map;
  53
  54 /* For VMS versions with limited file name syntax,
  55    convert the name to something VMS will allow. */
  56 static void
  57 munge_doc_file_name (name)
  58      char *name;
  59 {
  60 #ifdef VMS
  61 #ifndef NO_HYPHENS_IN_FILENAMES
  62   strcpy (name, sys_translate_unix (name));
  63 #else /* NO_HYPHENS_IN_FILENAMES */
  64   char *p = name;
  65   while (*p)
  66     {
  67       if (*p == '-')
  68         *p = '_';
  69       p++;
  70     }
  71 #endif /* NO_HYPHENS_IN_FILENAMES */
  72 #endif /* VMS */
  73 }
  74
  75 /* Buffer used for reading from documentation file.  */
  76 static char *get_doc_string_buffer;
  77 static int get_doc_string_buffer_size;
  78
  79 static unsigned char *read_bytecode_pointer;
  80
  81 /* readchar in lread.c calls back here to fetch the next byte.
  82    If UNREADFLAG is 1, we unread a byte.  */
  83
  84 int
  85 read_bytecode_char (unreadflag)
  86      int unreadflag;
  87 {
  88   if (unreadflag)
  89     {
  90       read_bytecode_pointer--;
  91       return 0;
  92     }
  93   return *read_bytecode_pointer++;
  94 }
  95
  96 /* Extract a doc string from a file.  FILEPOS says where to get it.
  97    If it is an integer, use that position in the standard DOC-... file.
  98    If it is (FILE . INTEGER), use FILE as the file name
  99    and INTEGER as the position in that file.
 100    But if INTEGER is negative, make it positive.
 101    (A negative integer is used for user variables, so we can distinguish
 102    them without actually fetching the doc string.)
 103
 104    If UNIBYTE is nonzero, always make a unibyte string.
 105
 106    If DEFINITION is nonzero, assume this is for reading
 107    a dynamic function definition; convert the bytestring
 108    and the constants vector with appropriate byte handling,
 109    and return a cons cell.  */
 110
 111 Lisp_Object
 112 get_doc_string (filepos, unibyte, definition)
 113      Lisp_Object filepos;
 114      int unibyte, definition;
 115 {
 116   char *from, *to;
 117   register int fd;
 118   register char *name;
 119   register char *p, *p1;
 120   int minsize;
 121   int offset, position;
 122   Lisp_Object file, tem;
 123
 124   if (INTEGERP (filepos))
 125     {
 126       file = Vdoc_file_name;
 127       position = XINT (filepos);
 128     }
 129   else if (CONSP (filepos))
 130     {
 131       file = XCAR (filepos);
 132       position = XINT (XCDR (filepos));
 133       if (position < 0)
 134         position = - position;
 135     }
 136   else
 137     return Qnil;
 138
 139   if (!STRINGP (Vdoc_directory))
 140     return Qnil;
 141
 142   if (!STRINGP (file))
 143     return Qnil;
 144
 145   /* Put the file name in NAME as a C string.
 146      If it is relative, combine it with Vdoc_directory.  */
 147
 148   tem = Ffile_name_absolute_p (file);
 149   if (NILP (tem))
 150     {
 151       minsize = XSTRING (Vdoc_directory)->size;
 152       /* sizeof ("../etc/") == 8 */
 153       if (minsize < 8)
 154         minsize = 8;
 155       name = (char *) alloca (minsize + XSTRING (file)->size + 8);
 156       strcpy (name, XSTRING (Vdoc_directory)->data);
 157       strcat (name, XSTRING (file)->data);
 158       munge_doc_file_name (name);
 159     }
 160   else
 161     {
 162       name = (char *) XSTRING (file)->data;
 163     }
 164
 165   fd = emacs_open (name, O_RDONLY, 0);
 166   if (fd < 0)
 167     {
 168 #ifndef CANNOT_DUMP
 169       if (!NILP (Vpurify_flag))
 170         {
 171           /* Preparing to dump; DOC file is probably not installed.
 172              So check in ../etc. */
 173           strcpy (name, "../etc/");
 174           strcat (name, XSTRING (file)->data);
 175           munge_doc_file_name (name);
 176
 177           fd = emacs_open (name, O_RDONLY, 0);
 178         }
 179 #endif
 180       if (fd < 0)
 181         error ("Cannot open doc string file \"%s\"", name);
 182     }
 183
 184   /* Seek only to beginning of disk block.  */
 185   offset = position % (8 * 1024);
 186   if (0 > lseek (fd, position - offset, 0))
 187     {
 188       emacs_close (fd);
 189       error ("Position %ld out of range in doc string file \"%s\"",
 190              position, name);
 191     }
 192
 193   /* Read the doc string into get_doc_string_buffer.
 194      P points beyond the data just read.  */
 195
 196   p = get_doc_string_buffer;
 197   while (1)
 198     {
 199       int space_left = (get_doc_string_buffer_size
 200                         - (p - get_doc_string_buffer));
 201       int nread;
 202
 203       /* Allocate or grow the buffer if we need to.  */
 204       if (space_left == 0)
 205         {
 206           int in_buffer = p - get_doc_string_buffer;
 207           get_doc_string_buffer_size += 16 * 1024;
 208           get_doc_string_buffer
 209             = (char *) xrealloc (get_doc_string_buffer,
 210                                  get_doc_string_buffer_size + 1);
 211           p = get_doc_string_buffer + in_buffer;
 212           space_left = (get_doc_string_buffer_size
 213                         - (p - get_doc_string_buffer));
 214         }
 215
 216       /* Read a disk block at a time.
 217          If we read the same block last time, maybe skip this?  */
 218       if (space_left > 1024 * 8)
 219         space_left = 1024 * 8;
 220       nread = emacs_read (fd, p, space_left);
 221       if (nread < 0)
 222         {
 223           emacs_close (fd);
 224           error ("Read error on documentation file");
 225         }
 226       p[nread] = 0;
 227       if (!nread)
 228         break;
 229       if (p == get_doc_string_buffer)
 230         p1 = (char *) index (p + offset, '\037');
 231       else
 232         p1 = (char *) index (p, '\037');
 233       if (p1)
 234         {
 235           *p1 = 0;
 236           p = p1;
 237           break;
 238         }
 239       p += nread;
 240     }
 241   emacs_close (fd);
 242
 243   /* Scan the text and perform quoting with ^A (char code 1).
 244      ^A^A becomes ^A, ^A0 becomes a null char, and ^A_ becomes a ^_.  */
 245   from = get_doc_string_buffer + offset;
 246   to = get_doc_string_buffer + offset;
 247   while (from != p)
 248     {
 249       if (*from == 1)
 250         {
 251           int c;
 252
 253           from++;
 254           c = *from++;
 255           if (c == 1)
 256             *to++ = c;
 257           else if (c == '0')
 258             *to++ = 0;
 259           else if (c == '_')
 260             *to++ = 037;
 261           else
 262             error ("Invalid data in documentation file -- ^A followed by code 0%o", c);
 263         }
 264       else
 265         *to++ = *from++;
 266     }
 267
 268   /* If DEFINITION, read from this buffer
 269      the same way we would read bytes from a file.  */
 270   if (definition)
 271     {
 272       read_bytecode_pointer = get_doc_string_buffer + offset;
 273       return Fread (Qlambda);
 274     }
 275
 276   if (unibyte)
 277     return make_unibyte_string (get_doc_string_buffer + offset,
 278                                 to - (get_doc_string_buffer + offset));
 279   else
 280     {
 281       /* Let the data determine whether the string is multibyte,
 282          even if Emacs is running in --unibyte mode.  */
 283       int nchars = multibyte_chars_in_text (get_doc_string_buffer + offset,
 284                                             to - (get_doc_string_buffer + offset));
 285       return make_string_from_bytes (get_doc_string_buffer + offset,
 286                                      nchars,
 287                                      to - (get_doc_string_buffer + offset));
 288     }
 289 }
 290
 291 /* Get a string from position FILEPOS and pass it through the Lisp reader.
 292    We use this for fetching the bytecode string and constants vector
 293    of a compiled function from the .elc file.  */
 294
 295 Lisp_Object
 296 read_doc_string (filepos)
 297      Lisp_Object filepos;
 298 {
 299   return get_doc_string (filepos, 0, 1);
 300 }
 301
 302 DEFUN ("documentation", Fdocumentation, Sdocumentation, 1, 2, 0,
 303   "Return the documentation string of FUNCTION.\n\
 304 Unless a non-nil second argument RAW is given, the\n\
 305 string is passed through `substitute-command-keys'.")
 306   (function, raw)
 307      Lisp_Object function, raw;
 308 {
 309   Lisp_Object fun;
 310   Lisp_Object funcar;
 311   Lisp_Object tem, doc;
 312
 313   doc = Qnil;
 314
 315   if (SYMBOLP (function)
 316       && (tem = Fget (function, Qfunction_documentation),
 317           !NILP (tem)))
 318     return Fdocumentation_property (function, Qfunction_documentation, raw);
 319
 320   fun = Findirect_function (function);
 321   if (SUBRP (fun))
 322     {
 323       if (XSUBR (fun)->doc == 0)
 324         return Qnil;
 325       else if ((EMACS_INT) XSUBR (fun)->doc >= 0)
 326         doc = build_string (XSUBR (fun)->doc);
 327       else
 328         doc = get_doc_string (make_number (- (EMACS_INT) XSUBR (fun)->doc),
 329                               0, 0);
 330       if (! NILP (tem = Fassq (function, Vhelp_manyarg_func_alist)))
 331         doc = concat3 (doc, build_string ("\n"), Fcdr (tem));
 332     }
 333   else if (COMPILEDP (fun))
 334     {
 335       if ((XVECTOR (fun)->size & PSEUDOVECTOR_SIZE_MASK) <= COMPILED_DOC_STRING)
 336         return Qnil;
 337       tem = XVECTOR (fun)->contents[COMPILED_DOC_STRING];
 338       if (STRINGP (tem))
 339         doc = tem;
 340       else if (NATNUMP (tem) || CONSP (tem))
 341         doc = get_doc_string (tem, 0, 0);
 342       else
 343         return Qnil;
 344     }
 345   else if (STRINGP (fun) || VECTORP (fun))
 346     {
 347       return build_string ("Keyboard macro.");
 348     }
 349   else if (CONSP (fun))
 350     {
 351       funcar = Fcar (fun);
 352       if (!SYMBOLP (funcar))
 353         return Fsignal (Qinvalid_function, Fcons (fun, Qnil));
 354       else if (EQ (funcar, Qkeymap))
 355         return build_string ("Prefix command (definition is a keymap associating keystrokes with commands).");
 356       else if (EQ (funcar, Qlambda)
 357                || EQ (funcar, Qautoload))
 358         {
 359           Lisp_Object tem1;
 360           tem1 = Fcdr (Fcdr (fun));
 361           tem = Fcar (tem1);
 362           if (STRINGP (tem))
 363             doc = tem;
 364           /* Handle a doc reference--but these never come last
 365              in the function body, so reject them if they are last.  */
 366           else if ((NATNUMP (tem) || CONSP (tem))
 367                    && ! NILP (XCDR (tem1)))
 368             doc = get_doc_string (tem, 0, 0);
 369           else
 370             return Qnil;
 371         }
 372       else if (EQ (funcar, Qmocklisp))
 373         return Qnil;
 374       else if (EQ (funcar, Qmacro))
 375         return Fdocumentation (Fcdr (fun), raw);
 376       else
 377         goto oops;
 378     }
 379   else
 380     {
 381     oops:
 382       Fsignal (Qinvalid_function, Fcons (fun, Qnil));
 383     }
 384
 385   if (NILP (raw))
 386     doc = Fsubstitute_command_keys (doc);
 387   return doc;
 388 }
 389
 390 DEFUN ("documentation-property", Fdocumentation_property,
 391        Sdocumentation_property, 2, 3, 0,
 392   "Return the documentation string that is SYMBOL's PROP property.\n\
 393 Third argument RAW omitted or nil means pass the result through\n\
 394 `substitute-command-keys' if it is a string.\n\
 395 \n\
 396 This is differs from `get' in that it can refer to strings stored in the\n\
 397 `etc/DOC' file; and that it evaluates documentation properties that\n\
 398 aren't strings.")
 399   (symbol, prop, raw)
 400      Lisp_Object symbol, prop, raw;
 401 {
 402   Lisp_Object tem;
 403
 404   tem = Fget (symbol, prop);
 405   if (INTEGERP (tem))
 406     tem = get_doc_string (XINT (tem) > 0 ? tem : make_number (- XINT (tem)), 0, 0);
 407   else if (CONSP (tem) && INTEGERP (XCDR (tem)))
 408     tem = get_doc_string (tem, 0, 0);
 409   else if (!STRINGP (tem))
 410     /* Feval protects its argument.  */
 411     tem = Feval (tem);
 412
 413   if (NILP (raw) && STRINGP (tem))
 414     tem = Fsubstitute_command_keys (tem);
 415   return tem;
 416 }
 417 \f
 418 /* Scanning the DOC files and placing docstring offsets into functions.  */
 419
 420 static void
 421 store_function_docstring (fun, offset)
 422      Lisp_Object fun;
 423      /* Use EMACS_INT because we get this from pointer subtraction.  */
 424      EMACS_INT offset;
 425 {
 426   fun = indirect_function (fun);
 427
 428   /* The type determines where the docstring is stored.  */
 429
 430   /* Lisp_Subrs have a slot for it.  */
 431   if (SUBRP (fun))
 432     XSUBR (fun)->doc = (char *) - offset;
 433
 434   /* If it's a lisp form, stick it in the form.  */
 435   else if (CONSP (fun))
 436     {
 437       Lisp_Object tem;
 438
 439       tem = XCAR (fun);
 440       if (EQ (tem, Qlambda) || EQ (tem, Qautoload))
 441         {
 442           tem = Fcdr (Fcdr (fun));
 443           if (CONSP (tem) && INTEGERP (XCAR (tem)))
 444             XSETFASTINT (XCAR (tem), offset);
 445         }
 446       else if (EQ (tem, Qmacro))
 447         store_function_docstring (XCDR (fun), offset);
 448     }
 449
 450   /* Bytecode objects sometimes have slots for it.  */
 451   else if (COMPILEDP (fun))
 452     {
 453       /* This bytecode object must have a slot for the
 454          docstring, since we've found a docstring for it.  */
 455       if ((XVECTOR (fun)->size & PSEUDOVECTOR_SIZE_MASK) > COMPILED_DOC_STRING)
 456         XSETFASTINT (XVECTOR (fun)->contents[COMPILED_DOC_STRING], offset);
 457     }
 458 }
 459
 460
 461 DEFUN ("Snarf-documentation", Fsnarf_documentation, Ssnarf_documentation,
 462   1, 1, 0,
 463   "Used during Emacs initialization, before dumping runnable Emacs,\n\
 464 to find pointers to doc strings stored in `etc/DOC...' and\n\
 465 record them in function definitions.\n\
 466 One arg, FILENAME, a string which does not include a directory.\n\
 467 The file is found in `../etc' now; found in the `data-directory'\n\
 468 when doc strings are referred to later in the dumped Emacs.")
 469   (filename)
 470      Lisp_Object filename;
 471 {
 472   int fd;
 473   char buf[1024 + 1];
 474   register int filled;
 475   register int pos;
 476   register char *p, *end;
 477   Lisp_Object sym;
 478   char *name;
 479
 480 #ifndef CANNOT_DUMP
 481   if (NILP (Vpurify_flag))
 482     error ("Snarf-documentation can only be called in an undumped Emacs");
 483 #endif
 484
 485   CHECK_STRING (filename, 0);
 486
 487 #ifndef CANNOT_DUMP
 488   name = (char *) alloca (XSTRING (filename)->size + 14);
 489   strcpy (name, "../etc/");
 490 #else /* CANNOT_DUMP */
 491   CHECK_STRING (Vdoc_directory, 0);
 492   name = (char *) alloca (XSTRING (filename)->size +
 493                           XSTRING (Vdoc_directory)->size + 1);
 494   strcpy (name, XSTRING (Vdoc_directory)->data);
 495 #endif /* CANNOT_DUMP */
 496   strcat (name, XSTRING (filename)->data);      /*** Add this line ***/
 497   munge_doc_file_name (name);
 498
 499   fd = emacs_open (name, O_RDONLY, 0);
 500   if (fd < 0)
 501     report_file_error ("Opening doc string file",
 502                        Fcons (build_string (name), Qnil));
 503   Vdoc_file_name = filename;
 504   filled = 0;
 505   pos = 0;
 506   while (1)
 507     {
 508       if (filled < 512)
 509         filled += emacs_read (fd, &buf[filled], sizeof buf - 1 - filled);
 510       if (!filled)
 511         break;
 512
 513       buf[filled] = 0;
 514       p = buf;
 515       end = buf + (filled < 512 ? filled : filled - 128);
 516       while (p != end && *p != '\037') p++;
 517       /* p points to ^_Ffunctionname\n or ^_Vvarname\n.  */
 518       if (p != end)
 519         {
 520           end = (char *) index (p, '\n');
 521           sym = oblookup (Vobarray, p + 2,
 522                           multibyte_chars_in_text (p + 2, end - p - 2),
 523                           end - p - 2);
 524           if (SYMBOLP (sym))
 525             {
 526               /* Attach a docstring to a variable?  */
 527               if (p[1] == 'V')
 528                 {
 529                   /* Install file-position as variable-documentation property
 530                      and make it negative for a user-variable
 531                      (doc starts with a `*').  */
 532                   Fput (sym, Qvariable_documentation,
 533                         make_number ((pos + end + 1 - buf)
 534                                      * (end[1] == '*' ? -1 : 1)));
 535                 }
 536
 537               /* Attach a docstring to a function?  */
 538               else if (p[1] == 'F')
 539                 store_function_docstring (sym, pos + end + 1 - buf);
 540
 541               else
 542                 error ("DOC file invalid at position %d", pos);
 543             }
 544         }
 545       pos += end - buf;
 546       filled -= end - buf;
 547       bcopy (end, buf, filled);
 548     }
 549   emacs_close (fd);
 550   return Qnil;
 551 }
 552 \f
 553 DEFUN ("substitute-command-keys", Fsubstitute_command_keys,
 554   Ssubstitute_command_keys, 1, 1, 0,
 555   "Substitute key descriptions for command names in STRING.\n\
 556 Return a new string which is STRING with substrings of the form \\=\\[COMMAND]\n\
 557 replaced by either:  a keystroke sequence that will invoke COMMAND,\n\
 558 or \"M-x COMMAND\" if COMMAND is not on any keys.\n\
 559 Substrings of the form \\=\\{MAPVAR} are replaced by summaries\n\
 560 \(made by describe-bindings) of the value of MAPVAR, taken as a keymap.\n\
 561 Substrings of the form \\=\\<MAPVAR> specify to use the value of MAPVAR\n\
 562 as the keymap for future \\=\\[COMMAND] substrings.\n\
 563 \\=\\= quotes the following character and is discarded;\n\
 564 thus, \\=\\=\\=\\= puts \\=\\= into the output, and \\=\\=\\=\\[ puts \\=\\[ into the output.")
 565   (string)
 566      Lisp_Object string;
 567 {
 568   unsigned char *buf;
 569   int changed = 0;
 570   register unsigned char *strp;
 571   register unsigned char *bufp;
 572   int idx;
 573   int bsize;
 574   Lisp_Object tem;
 575   Lisp_Object keymap;
 576   unsigned char *start;
 577   int length, length_byte;
 578   Lisp_Object name;
 579   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
 580   int multibyte;
 581   int nchars;
 582
 583   if (NILP (string))
 584     return Qnil;
 585
 586   CHECK_STRING (string, 0);
 587   tem = Qnil;
 588   keymap = Qnil;
 589   name = Qnil;
 590   GCPRO4 (string, tem, keymap, name);
 591
 592   multibyte = STRING_MULTIBYTE (string);
 593   nchars = 0;
 594
 595   /* KEYMAP is either nil (which means search all the active keymaps)
 596      or a specified local map (which means search just that and the
 597      global map).  If non-nil, it might come from Voverriding_local_map,
 598      or from a \\<mapname> construct in STRING itself..  */
 599   keymap = current_kboard->Voverriding_terminal_local_map;
 600   if (NILP (keymap))
 601     keymap = Voverriding_local_map;
 602
 603   bsize = STRING_BYTES (XSTRING (string));
 604   bufp = buf = (unsigned char *) xmalloc (bsize);
 605
 606   strp = (unsigned char *) XSTRING (string)->data;
 607   while (strp < XSTRING (string)->data + STRING_BYTES (XSTRING (string)))
 608     {
 609       if (strp[0] == '\\' && strp[1] == '=')
 610         {
 611           /* \= quotes the next character;
 612              thus, to put in \[ without its special meaning, use \=\[.  */
 613           changed = 1;
 614           strp += 2;
 615           if (multibyte)
 616             {
 617               int len;
 618               int maxlen = XSTRING (string)->data + STRING_BYTES (XSTRING (string)) - strp;
 619
 620               STRING_CHAR_AND_LENGTH (strp, maxlen, len);
 621               if (len == 1)
 622                 *bufp = *strp;
 623               else
 624                 bcopy (strp, bufp, len);
 625               strp += len;
 626               bufp += len;
 627               nchars++;
 628             }
 629           else
 630             *bufp++ = *strp++, nchars++;
 631         }
 632       else if (strp[0] == '\\' && strp[1] == '[')
 633         {
 634           Lisp_Object firstkey;
 635           int start_idx;
 636
 637           changed = 1;
 638           strp += 2;            /* skip \[ */
 639           start = strp;
 640           start_idx = start - XSTRING (string)->data;
 641
 642           while ((strp - (unsigned char *) XSTRING (string)->data
 643                   < STRING_BYTES (XSTRING (string)))
 644                  && *strp != ']')
 645             strp++;
 646           length_byte = strp - start;
 647
 648           strp++;               /* skip ] */
 649
 650           /* Save STRP in IDX.  */
 651           idx = strp - (unsigned char *) XSTRING (string)->data;
 652           tem = Fintern (make_string (start, length_byte), Qnil);
 653
 654           /* Note the Fwhere_is_internal can GC, so we have to take
 655              relocation of string contents into account.  */
 656           tem = Fwhere_is_internal (tem, keymap, Qt, Qnil);
 657           strp = XSTRING (string)->data + idx;
 658           start = XSTRING (string)->data + start_idx;
 659
 660           /* Disregard menu bar bindings; it is positively annoying to
 661              mention them when there's no menu bar, and it isn't terribly
 662              useful even when there is a menu bar.  */
 663           if (!NILP (tem))
 664             {
 665               firstkey = Faref (tem, make_number (0));
 666               if (EQ (firstkey, Qmenu_bar))
 667                 tem = Qnil;
 668             }
 669
 670           if (NILP (tem))       /* but not on any keys */
 671             {
 672               int offset = bufp - buf;
 673               buf = (unsigned char *) xrealloc (buf, bsize += 4);
 674               bufp = buf + offset;
 675               bcopy ("M-x ", bufp, 4);
 676               bufp += 4;
 677               nchars += 4;
 678               if (multibyte)
 679                 length = multibyte_chars_in_text (start, length_byte);
 680               else
 681                 length = length_byte;
 682               goto subst;
 683             }
 684           else
 685             {                   /* function is on a key */
 686               tem = Fkey_description (tem);
 687               goto subst_string;
 688             }
 689         }
 690       /* \{foo} is replaced with a summary of the keymap (symbol-value foo).
 691          \<foo> just sets the keymap used for \[cmd].  */
 692       else if (strp[0] == '\\' && (strp[1] == '{' || strp[1] == '<'))
 693         {
 694           struct buffer *oldbuf;
 695           int start_idx;
 696
 697           changed = 1;
 698           strp += 2;            /* skip \{ or \< */
 699           start = strp;
 700           start_idx = start - XSTRING (string)->data;
 701
 702           while ((strp - (unsigned char *) XSTRING (string)->data
 703                   < XSTRING (string)->size)
 704                  && *strp != '}' && *strp != '>')
 705             strp++;
 706
 707           length_byte = strp - start;
 708           strp++;                       /* skip } or > */
 709
 710           /* Save STRP in IDX.  */
 711           idx = strp - (unsigned char *) XSTRING (string)->data;
 712
 713           /* Get the value of the keymap in TEM, or nil if undefined.
 714              Do this while still in the user's current buffer
 715              in case it is a local variable.  */
 716           name = Fintern (make_string (start, length_byte), Qnil);
 717           tem = Fboundp (name);
 718           if (! NILP (tem))
 719             {
 720               tem = Fsymbol_value (name);
 721               if (! NILP (tem))
 722                 {
 723                   tem = get_keymap (tem, 0, 1);
 724                   /* Note that get_keymap can GC.  */
 725                   strp = XSTRING (string)->data + idx;
 726                   start = XSTRING (string)->data + start_idx;
 727                 }
 728             }
 729
 730           /* Now switch to a temp buffer.  */
 731           oldbuf = current_buffer;
 732           set_buffer_internal (XBUFFER (Vprin1_to_string_buffer));
 733
 734           if (NILP (tem))
 735             {
 736               name = Fsymbol_name (name);
 737               insert_string ("\nUses keymap \"");
 738               insert_from_string (name, 0, 0,
 739                                   XSTRING (name)->size,
 740                                   STRING_BYTES (XSTRING (name)), 1);
 741               insert_string ("\", which is not currently defined.\n");
 742               if (start[-1] == '<') keymap = Qnil;
 743             }
 744           else if (start[-1] == '<')
 745             keymap = tem;
 746           else
 747             describe_map_tree (tem, 1, Qnil, Qnil, (char *)0, 1, 0, 0);
 748           tem = Fbuffer_string ();
 749           Ferase_buffer ();
 750           set_buffer_internal (oldbuf);
 751
 752         subst_string:
 753           start = XSTRING (tem)->data;
 754           length = XSTRING (tem)->size;
 755           length_byte = STRING_BYTES (XSTRING (tem));
 756         subst:
 757           {
 758             int offset = bufp - buf;
 759             buf = (unsigned char *) xrealloc (buf, bsize += length_byte);
 760             bufp = buf + offset;
 761             bcopy (start, bufp, length_byte);
 762             bufp += length_byte;
 763             nchars += length;
 764             /* Check STRING again in case gc relocated it.  */
 765             strp = (unsigned char *) XSTRING (string)->data + idx;
 766           }
 767         }
 768       else if (! multibyte)             /* just copy other chars */
 769         *bufp++ = *strp++, nchars++;
 770       else
 771         {
 772           int len;
 773           int maxlen = XSTRING (string)->data + STRING_BYTES (XSTRING (string)) - strp;
 774
 775           STRING_CHAR_AND_LENGTH (strp, maxlen, len);
 776           if (len == 1)
 777             *bufp = *strp;
 778           else
 779             bcopy (strp, bufp, len);
 780           strp += len;
 781           bufp += len;
 782           nchars++;
 783         }
 784     }
 785
 786   if (changed)                  /* don't bother if nothing substituted */
 787     tem = make_string_from_bytes (buf, nchars, bufp - buf);
 788   else
 789     tem = string;
 790   xfree (buf);
 791   RETURN_UNGCPRO (tem);
 792 }
 793 \f
 794 void
 795 syms_of_doc ()
 796 {
 797   Qfunction_documentation = intern ("function-documentation");
 798   staticpro (&Qfunction_documentation);
 799
 800   DEFVAR_LISP ("internal-doc-file-name", &Vdoc_file_name,
 801     "Name of file containing documentation strings of built-in symbols.");
 802   Vdoc_file_name = Qnil;
 803   DEFVAR_LISP ("help-manyarg-func-alist", &Vhelp_manyarg_func_alist,
 804     "Alist of primitive functions and descriptions of their arg lists.\n\
 805 All special forms and primitives which effectively have &rest args\n\
 806 should have an entry here so that `documentation' can provide their\n\
 807 arg list.");
 808   Vhelp_manyarg_func_alist = Qnil;
 809
 810   defsubr (&Sdocumentation);
 811   defsubr (&Sdocumentation_property);
 812   defsubr (&Ssnarf_documentation);
 813   defsubr (&Ssubstitute_command_keys);
 814 }