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