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