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 #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
  85 /* readchar in lread.c calls back here to fetch the next byte.
  86    If UNREADFLAG is 1, we unread a byte.  */
  87
  88 int
  89 read_bytecode_char (unreadflag)
  90      int unreadflag;
  91 {
  92   if (unreadflag)
  93     {
  94       read_bytecode_pointer--;
  95       return 0;
  96     }
  97   return *read_bytecode_pointer++;
  98 }
  99
 100 /* Extract a doc string from a file.  FILEPOS says where to get it.
 101    If it is an integer, use that position in the standard DOC-... file.
 102    If it is (FILE . INTEGER), use FILE as the file name
 103    and INTEGER as the position in that file.
 104    But if INTEGER is negative, make it positive.
 105    (A negative integer is used for user variables, so we can distinguish
 106    them without actually fetching the doc string.)
 107
 108    If UNIBYTE is nonzero, always make a unibyte string.
 109
 110    If DEFINITION is nonzero, assume this is for reading
 111    a dynamic function definition; convert the bytestring
 112    and the constants vector with appropriate byte handling,
 113    and return a cons cell.  */
 114
 115 Lisp_Object
 116 get_doc_string (filepos, unibyte, definition)
 117      Lisp_Object filepos;
 118      int unibyte, definition;
 119 {
 120   char *from, *to;
 121   register int fd;
 122   register char *name;
 123   register char *p, *p1;
 124   int minsize;
 125   int offset, position;
 126   Lisp_Object file, tem;
 127
 128   if (INTEGERP (filepos))
 129     {
 130       file = Vdoc_file_name;
 131       position = XINT (filepos);
 132     }
 133   else if (CONSP (filepos))
 134     {
 135       file = XCAR (filepos);
 136       position = XINT (XCDR (filepos));
 137       if (position < 0)
 138         position = - position;
 139     }
 140   else
 141     return Qnil;
 142
 143   if (!STRINGP (Vdoc_directory))
 144     return Qnil;
 145
 146   if (!STRINGP (file))
 147     return Qnil;
 148
 149   /* Put the file name in NAME as a C string.
 150      If it is relative, combine it with Vdoc_directory.  */
 151
 152   tem = Ffile_name_absolute_p (file);
 153   if (NILP (tem))
 154     {
 155       minsize = XSTRING (Vdoc_directory)->size;
 156       /* sizeof ("../etc/") == 8 */
 157       if (minsize < 8)
 158         minsize = 8;
 159       name = (char *) alloca (minsize + XSTRING (file)->size + 8);
 160       strcpy (name, XSTRING (Vdoc_directory)->data);
 161       strcat (name, XSTRING (file)->data);
 162       munge_doc_file_name (name);
 163     }
 164   else
 165     {
 166       name = (char *) XSTRING (file)->data;
 167     }
 168
 169   fd = emacs_open (name, O_RDONLY, 0);
 170   if (fd < 0)
 171     {
 172 #ifndef CANNOT_DUMP
 173       if (!NILP (Vpurify_flag))
 174         {
 175           /* Preparing to dump; DOC file is probably not installed.
 176              So check in ../etc. */
 177           strcpy (name, "../etc/");
 178           strcat (name, XSTRING (file)->data);
 179           munge_doc_file_name (name);
 180
 181           fd = emacs_open (name, O_RDONLY, 0);
 182         }
 183 #endif
 184       if (fd < 0)
 185         error ("Cannot open doc string file \"%s\"", name);
 186     }
 187
 188   /* Seek only to beginning of disk block.  */
 189   offset = position % (8 * 1024);
 190   if (0 > lseek (fd, position - offset, 0))
 191     {
 192       emacs_close (fd);
 193       error ("Position %ld out of range in doc string file \"%s\"",
 194              position, name);
 195     }
 196
 197   /* Read the doc string into get_doc_string_buffer.
 198      P points beyond the data just read.  */
 199
 200   p = get_doc_string_buffer;
 201   while (1)
 202     {
 203       int space_left = (get_doc_string_buffer_size
 204                         - (p - get_doc_string_buffer));
 205       int nread;
 206
 207       /* Allocate or grow the buffer if we need to.  */
 208       if (space_left == 0)
 209         {
 210           int in_buffer = p - get_doc_string_buffer;
 211           get_doc_string_buffer_size += 16 * 1024;
 212           get_doc_string_buffer
 213             = (char *) xrealloc (get_doc_string_buffer,
 214                                  get_doc_string_buffer_size + 1);
 215           p = get_doc_string_buffer + in_buffer;
 216           space_left = (get_doc_string_buffer_size
 217                         - (p - get_doc_string_buffer));
 218         }
 219
 220       /* Read a disk block at a time.
 221          If we read the same block last time, maybe skip this?  */
 222       if (space_left > 1024 * 8)
 223         space_left = 1024 * 8;
 224       nread = emacs_read (fd, p, space_left);
 225       if (nread < 0)
 226         {
 227           emacs_close (fd);
 228           error ("Read error on documentation file");
 229         }
 230       p[nread] = 0;
 231       if (!nread)
 232         break;
 233       if (p == get_doc_string_buffer)
 234         p1 = (char *) index (p + offset, '\037');
 235       else
 236         p1 = (char *) index (p, '\037');
 237       if (p1)
 238         {
 239           *p1 = 0;
 240           p = p1;
 241           break;
 242         }
 243       p += nread;
 244     }
 245   emacs_close (fd);
 246
 247   /* Scan the text and perform quoting with ^A (char code 1).
 248      ^A^A becomes ^A, ^A0 becomes a null char, and ^A_ becomes a ^_.  */
 249   from = get_doc_string_buffer + offset;
 250   to = get_doc_string_buffer + offset;
 251   while (from != p)
 252     {
 253       if (*from == 1)
 254         {
 255           int c;
 256
 257           from++;
 258           c = *from++;
 259           if (c == 1)
 260             *to++ = c;
 261           else if (c == '0')
 262             *to++ = 0;
 263           else if (c == '_')
 264             *to++ = 037;
 265           else
 266             error ("Invalid data in documentation file -- ^A followed by code 0%o", c);
 267         }
 268       else
 269         *to++ = *from++;
 270     }
 271
 272   /* If DEFINITION, read from this buffer
 273      the same way we would read bytes from a file.  */
 274   if (definition)
 275     {
 276       read_bytecode_pointer = get_doc_string_buffer + offset;
 277       return Fread (Qlambda);
 278     }
 279
 280   if (unibyte)
 281     return make_unibyte_string (get_doc_string_buffer + offset,
 282                                 to - (get_doc_string_buffer + offset));
 283   else
 284     {
 285       /* Let the data determine whether the string is multibyte,
 286          even if Emacs is running in --unibyte mode.  */
 287       int nchars = multibyte_chars_in_text (get_doc_string_buffer + offset,
 288                                             to - (get_doc_string_buffer + offset));
 289       return make_string_from_bytes (get_doc_string_buffer + offset,
 290                                      nchars,
 291                                      to - (get_doc_string_buffer + offset));
 292     }
 293 }
 294
 295 /* Get a string from position FILEPOS and pass it through the Lisp reader.
 296    We use this for fetching the bytecode string and constants vector
 297    of a compiled function from the .elc file.  */
 298
 299 Lisp_Object
 300 read_doc_string (filepos)
 301      Lisp_Object filepos;
 302 {
 303   return get_doc_string (filepos, 0, 1);
 304 }
 305
 306 DEFUN ("documentation", Fdocumentation, Sdocumentation, 1, 2, 0,
 307   "Return the documentation string of FUNCTION.\n\
 308 Unless a non-nil second argument RAW is given, the\n\
 309 string is passed through `substitute-command-keys'.")
 310   (function, raw)
 311      Lisp_Object function, raw;
 312 {
 313   Lisp_Object fun;
 314   Lisp_Object funcar;
 315   Lisp_Object tem, doc;
 316
 317   doc = Qnil;
 318
 319   if (SYMBOLP (function)
 320       && (tem = Fget (function, Qfunction_documentation),
 321           !NILP (tem)))
 322     return Fdocumentation_property (function, Qfunction_documentation, raw);
 323
 324   fun = Findirect_function (function);
 325   if (SUBRP (fun))
 326     {
 327       if (XSUBR (fun)->doc == 0)
 328         return Qnil;
 329       else if ((EMACS_INT) XSUBR (fun)->doc >= 0)
 330         doc = build_string (XSUBR (fun)->doc);
 331       else
 332         doc = get_doc_string (make_number (- (EMACS_INT) XSUBR (fun)->doc),
 333                               0, 0);
 334     }
 335   else if (COMPILEDP (fun))
 336     {
 337       if ((XVECTOR (fun)->size & PSEUDOVECTOR_SIZE_MASK) <= COMPILED_DOC_STRING)
 338         return Qnil;
 339       tem = XVECTOR (fun)->contents[COMPILED_DOC_STRING];
 340       if (STRINGP (tem))
 341         doc = tem;
 342       else if (NATNUMP (tem) || CONSP (tem))
 343         doc = get_doc_string (tem, 0, 0);
 344       else
 345         return Qnil;
 346     }
 347   else if (STRINGP (fun) || VECTORP (fun))
 348     {
 349       return build_string ("Keyboard macro.");
 350     }
 351   else if (CONSP (fun))
 352     {
 353       funcar = Fcar (fun);
 354       if (!SYMBOLP (funcar))
 355         return Fsignal (Qinvalid_function, Fcons (fun, Qnil));
 356       else if (EQ (funcar, Qkeymap))
 357         return build_string ("Prefix command (definition is a keymap associating keystrokes with commands).");
 358       else if (EQ (funcar, Qlambda)
 359                || EQ (funcar, Qautoload))
 360         {
 361           Lisp_Object tem1;
 362           tem1 = Fcdr (Fcdr (fun));
 363           tem = Fcar (tem1);
 364           if (STRINGP (tem))
 365             doc = tem;
 366           /* Handle a doc reference--but these never come last
 367              in the function body, so reject them if they are last.  */
 368           else if ((NATNUMP (tem) || CONSP (tem))
 369                    && ! NILP (XCDR (tem1)))
 370             doc = get_doc_string (tem, 0, 0);
 371           else
 372             return Qnil;
 373         }
 374       else if (EQ (funcar, Qmocklisp))
 375         return Qnil;
 376       else if (EQ (funcar, Qmacro))
 377         return Fdocumentation (Fcdr (fun), raw);
 378       else
 379         goto oops;
 380     }
 381   else
 382     {
 383     oops:
 384       Fsignal (Qinvalid_function, Fcons (fun, Qnil));
 385     }
 386
 387   if (NILP (raw))
 388     doc = Fsubstitute_command_keys (doc);
 389   return doc;
 390 }
 391
 392 DEFUN ("documentation-property", Fdocumentation_property,
 393        Sdocumentation_property, 2, 3, 0,
 394   "Return the documentation string that is SYMBOL's PROP property.\n\
 395 Third argument RAW omitted or nil means pass the result through\n\
 396 `substitute-command-keys' if it is a string.\n\
 397 \n\
 398 This differs from `get' in that it can refer to strings stored in the\n\
 399 `etc/DOC' file; and that it evaluates documentation properties that\n\
 400 aren't strings.")
 401   (symbol, prop, raw)
 402      Lisp_Object symbol, prop, raw;
 403 {
 404   Lisp_Object tem;
 405
 406   tem = Fget (symbol, prop);
 407   if (INTEGERP (tem))
 408     tem = get_doc_string (XINT (tem) > 0 ? tem : make_number (- XINT (tem)), 0, 0);
 409   else if (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 ((XVECTOR (fun)->size & PSEUDOVECTOR_SIZE_MASK) > COMPILED_DOC_STRING)
 458         XSETFASTINT (XVECTOR (fun)->contents[COMPILED_DOC_STRING], offset);
 459     }
 460 }
 461
 462
 463 DEFUN ("Snarf-documentation", Fsnarf_documentation, Ssnarf_documentation,
 464   1, 1, 0,
 465   "Used during Emacs initialization, before dumping runnable Emacs,\n\
 466 to find pointers to doc strings stored in `etc/DOC...' and\n\
 467 record them in function definitions.\n\
 468 One arg, FILENAME, a string which does not include a directory.\n\
 469 The file is found in `../etc' now; found in the `data-directory'\n\
 470 when doc strings are referred to later in the dumped Emacs.")
 471   (filename)
 472      Lisp_Object filename;
 473 {
 474   int fd;
 475   char buf[1024 + 1];
 476   register int filled;
 477   register int pos;
 478   register char *p, *end;
 479   Lisp_Object sym;
 480   char *name;
 481
 482 #ifndef CANNOT_DUMP
 483   if (NILP (Vpurify_flag))
 484     error ("Snarf-documentation can only be called in an undumped Emacs");
 485 #endif
 486
 487   CHECK_STRING (filename, 0);
 488
 489 #ifndef CANNOT_DUMP
 490   name = (char *) alloca (XSTRING (filename)->size + 14);
 491   strcpy (name, "../etc/");
 492 #else /* CANNOT_DUMP */
 493   CHECK_STRING (Vdoc_directory, 0);
 494   name = (char *) alloca (XSTRING (filename)->size +
 495                           XSTRING (Vdoc_directory)->size + 1);
 496   strcpy (name, XSTRING (Vdoc_directory)->data);
 497 #endif /* CANNOT_DUMP */
 498   strcat (name, XSTRING (filename)->data);      /*** Add this line ***/
 499 #ifdef VMS
 500 #ifndef VMS4_4
 501   /* For VMS versions with limited file name syntax,
 502      convert the name to something VMS will allow.  */
 503   p = name;
 504   while (*p)
 505     {
 506       if (*p == '-')
 507         *p = '_';
 508       p++;
 509     }
 510 #endif /* not VMS4_4 */
 511 #ifdef VMS4_4
 512   strcpy (name, sys_translate_unix (name));
 513 #endif /* VMS4_4 */
 514 #endif /* VMS */
 515
 516   fd = emacs_open (name, O_RDONLY, 0);
 517   if (fd < 0)
 518     report_file_error ("Opening doc string file",
 519                        Fcons (build_string (name), Qnil));
 520   Vdoc_file_name = filename;
 521   filled = 0;
 522   pos = 0;
 523   while (1)
 524     {
 525       if (filled < 512)
 526         filled += emacs_read (fd, &buf[filled], sizeof buf - 1 - filled);
 527       if (!filled)
 528         break;
 529
 530       buf[filled] = 0;
 531       p = buf;
 532       end = buf + (filled < 512 ? filled : filled - 128);
 533       while (p != end && *p != '\037') p++;
 534       /* p points to ^_Ffunctionname\n or ^_Vvarname\n.  */
 535       if (p != end)
 536         {
 537           end = (char *) index (p, '\n');
 538           sym = oblookup (Vobarray, p + 2,
 539                           multibyte_chars_in_text (p + 2, end - p - 2),
 540                           end - p - 2);
 541           if (SYMBOLP (sym))
 542             {
 543               /* Attach a docstring to a variable?  */
 544               if (p[1] == 'V')
 545                 {
 546                   /* Install file-position as variable-documentation property
 547                      and make it negative for a user-variable
 548                      (doc starts with a `*').  */
 549                   Fput (sym, Qvariable_documentation,
 550                         make_number ((pos + end + 1 - buf)
 551                                      * (end[1] == '*' ? -1 : 1)));
 552                 }
 553
 554               /* Attach a docstring to a function?  */
 555               else if (p[1] == 'F')
 556                 store_function_docstring (sym, pos + end + 1 - buf);
 557
 558               else
 559                 error ("DOC file invalid at position %d", pos);
 560             }
 561         }
 562       pos += end - buf;
 563       filled -= end - buf;
 564       bcopy (end, buf, filled);
 565     }
 566   emacs_close (fd);
 567   return Qnil;
 568 }
 569 \f
 570 DEFUN ("substitute-command-keys", Fsubstitute_command_keys,
 571   Ssubstitute_command_keys, 1, 1, 0,
 572   "Substitute key descriptions for command names in STRING.\n\
 573 Return a new string which is STRING with substrings of the form \\=\\[COMMAND]\n\
 574 replaced by either:  a keystroke sequence that will invoke COMMAND,\n\
 575 or \"M-x COMMAND\" if COMMAND is not on any keys.\n\
 576 Substrings of the form \\=\\{MAPVAR} are replaced by summaries\n\
 577 \(made by describe-bindings) of the value of MAPVAR, taken as a keymap.\n\
 578 Substrings of the form \\=\\<MAPVAR> specify to use the value of MAPVAR\n\
 579 as the keymap for future \\=\\[COMMAND] substrings.\n\
 580 \\=\\= quotes the following character and is discarded;\n\
 581 thus, \\=\\=\\=\\= puts \\=\\= into the output, and \\=\\=\\=\\[ puts \\=\\[ into the output.")
 582   (string)
 583      Lisp_Object string;
 584 {
 585   unsigned char *buf;
 586   int changed = 0;
 587   register unsigned char *strp;
 588   register unsigned char *bufp;
 589   int idx;
 590   int bsize;
 591   Lisp_Object tem;
 592   Lisp_Object keymap;
 593   unsigned char *start;
 594   int length, length_byte;
 595   Lisp_Object name;
 596   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
 597   int multibyte;
 598   int nchars;
 599
 600   if (NILP (string))
 601     return Qnil;
 602
 603   CHECK_STRING (string, 0);
 604   tem = Qnil;
 605   keymap = Qnil;
 606   name = Qnil;
 607   GCPRO4 (string, tem, keymap, name);
 608
 609   multibyte = STRING_MULTIBYTE (string);
 610   nchars = 0;
 611
 612   /* KEYMAP is either nil (which means search all the active keymaps)
 613      or a specified local map (which means search just that and the
 614      global map).  If non-nil, it might come from Voverriding_local_map,
 615      or from a \\<mapname> construct in STRING itself..  */
 616   keymap = current_kboard->Voverriding_terminal_local_map;
 617   if (NILP (keymap))
 618     keymap = Voverriding_local_map;
 619
 620   bsize = STRING_BYTES (XSTRING (string));
 621   bufp = buf = (unsigned char *) xmalloc (bsize);
 622
 623   strp = (unsigned char *) XSTRING (string)->data;
 624   while (strp < XSTRING (string)->data + STRING_BYTES (XSTRING (string)))
 625     {
 626       if (strp[0] == '\\' && strp[1] == '=')
 627         {
 628           /* \= quotes the next character;
 629              thus, to put in \[ without its special meaning, use \=\[.  */
 630           changed = 1;
 631           strp += 2;
 632           if (multibyte)
 633             {
 634               int len;
 635               int maxlen = XSTRING (string)->data + STRING_BYTES (XSTRING (string)) - strp;
 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);
 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           int maxlen = XSTRING (string)->data + STRING_BYTES (XSTRING (string)) - strp;
 791
 792           STRING_CHAR_AND_LENGTH (strp, maxlen, len);
 793           if (len == 1)
 794             *bufp = *strp;
 795           else
 796             bcopy (strp, bufp, len);
 797           strp += len;
 798           bufp += len;
 799           nchars++;
 800         }
 801     }
 802
 803   if (changed)                  /* don't bother if nothing substituted */
 804     tem = make_string_from_bytes (buf, nchars, bufp - buf);
 805   else
 806     tem = string;
 807   xfree (buf);
 808   RETURN_UNGCPRO (tem);
 809 }
 810 \f
 811 void
 812 syms_of_doc ()
 813 {
 814   Qfunction_documentation = intern ("function-documentation");
 815   staticpro (&Qfunction_documentation);
 816
 817   DEFVAR_LISP ("internal-doc-file-name", &Vdoc_file_name,
 818     "Name of file containing documentation strings of built-in symbols.");
 819   Vdoc_file_name = Qnil;
 820
 821   defsubr (&Sdocumentation);
 822   defsubr (&Sdocumentation_property);
 823   defsubr (&Ssnarf_documentation);
 824   defsubr (&Ssubstitute_command_keys);
 825 }