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 VMS4_4
  62   /* For VMS versions with limited file name syntax,
  63      convert the name to something VMS will allow.  */
  64   p = name;
  65   while (*p)
  66     {
  67       if (*p == '-')
  68         *p = '_';
  69       p++;
  70     }
  71 #endif /* not VMS4_4 */
  72 #ifdef VMS4_4
  73   strcpy (name, sys_translate_unix (name));
  74 #endif /* VMS4_4 */
  75 #endif /* VMS */
  76 }
  77
  78 /* Buffer used for reading from documentation file.  */
  79 static char *get_doc_string_buffer;
  80 static int get_doc_string_buffer_size;
  81
  82 static unsigned char *read_bytecode_pointer;
  83
  84 /* readchar in lread.c calls back here to fetch the next byte.
  85    If UNREADFLAG is 1, we unread a byte.  */
  86
  87 int
  88 read_bytecode_char (unreadflag)
  89      int unreadflag;
  90 {
  91   if (unreadflag)
  92     {
  93       read_bytecode_pointer--;
  94       return 0;
  95     }
  96   return *read_bytecode_pointer++;
  97 }
  98
  99 /* Extract a doc string from a file.  FILEPOS says where to get it.
 100    If it is an integer, use that position in the standard DOC-... file.
 101    If it is (FILE . INTEGER), use FILE as the file name
 102    and INTEGER as the position in that file.
 103    But if INTEGER is negative, make it positive.
 104    (A negative integer is used for user variables, so we can distinguish
 105    them without actually fetching the doc string.)
 106
 107    If UNIBYTE is nonzero, always make a unibyte string.
 108
 109    If DEFINITION is nonzero, assume this is for reading
 110    a dynamic function definition; convert the bytestring
 111    and the constants vector with appropriate byte handling,
 112    and return a cons cell.  */
 113
 114 Lisp_Object
 115 get_doc_string (filepos, unibyte, definition)
 116      Lisp_Object filepos;
 117      int unibyte, definition;
 118 {
 119   char *from, *to;
 120   register int fd;
 121   register char *name;
 122   register char *p, *p1;
 123   int minsize;
 124   int offset, position;
 125   Lisp_Object file, tem;
 126
 127   if (INTEGERP (filepos))
 128     {
 129       file = Vdoc_file_name;
 130       position = XINT (filepos);
 131     }
 132   else if (CONSP (filepos))
 133     {
 134       file = XCAR (filepos);
 135       position = XINT (XCDR (filepos));
 136       if (position < 0)
 137         position = - position;
 138     }
 139   else
 140     return Qnil;
 141
 142   if (!STRINGP (Vdoc_directory))
 143     return Qnil;
 144
 145   if (!STRINGP (file))
 146     return Qnil;
 147
 148   /* Put the file name in NAME as a C string.
 149      If it is relative, combine it with Vdoc_directory.  */
 150
 151   tem = Ffile_name_absolute_p (file);
 152   if (NILP (tem))
 153     {
 154       minsize = XSTRING (Vdoc_directory)->size;
 155       /* sizeof ("../etc/") == 8 */
 156       if (minsize < 8)
 157         minsize = 8;
 158       name = (char *) alloca (minsize + XSTRING (file)->size + 8);
 159       strcpy (name, XSTRING (Vdoc_directory)->data);
 160       strcat (name, XSTRING (file)->data);
 161       munge_doc_file_name (name);
 162     }
 163   else
 164     {
 165       name = (char *) XSTRING (file)->data;
 166     }
 167
 168   fd = emacs_open (name, O_RDONLY, 0);
 169   if (fd < 0)
 170     {
 171 #ifndef CANNOT_DUMP
 172       if (!NILP (Vpurify_flag))
 173         {
 174           /* Preparing to dump; DOC file is probably not installed.
 175              So check in ../etc. */
 176           strcpy (name, "../etc/");
 177           strcat (name, XSTRING (file)->data);
 178           munge_doc_file_name (name);
 179
 180           fd = emacs_open (name, O_RDONLY, 0);
 181         }
 182 #endif
 183       if (fd < 0)
 184         error ("Cannot open doc string file \"%s\"", name);
 185     }
 186
 187   /* Seek only to beginning of disk block.  */
 188   offset = position % (8 * 1024);
 189   if (0 > lseek (fd, position - offset, 0))
 190     {
 191       emacs_close (fd);
 192       error ("Position %ld out of range in doc string file \"%s\"",
 193              position, name);
 194     }
 195
 196   /* Read the doc string into get_doc_string_buffer.
 197      P points beyond the data just read.  */
 198
 199   p = get_doc_string_buffer;
 200   while (1)
 201     {
 202       int space_left = (get_doc_string_buffer_size
 203                         - (p - get_doc_string_buffer));
 204       int nread;
 205
 206       /* Allocate or grow the buffer if we need to.  */
 207       if (space_left == 0)
 208         {
 209           int in_buffer = p - get_doc_string_buffer;
 210           get_doc_string_buffer_size += 16 * 1024;
 211           get_doc_string_buffer
 212             = (char *) xrealloc (get_doc_string_buffer,
 213                                  get_doc_string_buffer_size + 1);
 214           p = get_doc_string_buffer + in_buffer;
 215           space_left = (get_doc_string_buffer_size
 216                         - (p - get_doc_string_buffer));
 217         }
 218
 219       /* Read a disk block at a time.
 220          If we read the same block last time, maybe skip this?  */
 221       if (space_left > 1024 * 8)
 222         space_left = 1024 * 8;
 223       nread = emacs_read (fd, p, space_left);
 224       if (nread < 0)
 225         {
 226           emacs_close (fd);
 227           error ("Read error on documentation file");
 228         }
 229       p[nread] = 0;
 230       if (!nread)
 231         break;
 232       if (p == get_doc_string_buffer)
 233         p1 = (char *) index (p + offset, '\037');
 234       else
 235         p1 = (char *) index (p, '\037');
 236       if (p1)
 237         {
 238           *p1 = 0;
 239           p = p1;
 240           break;
 241         }
 242       p += nread;
 243     }
 244   emacs_close (fd);
 245
 246   /* Scan the text and perform quoting with ^A (char code 1).
 247      ^A^A becomes ^A, ^A0 becomes a null char, and ^A_ becomes a ^_.  */
 248   from = get_doc_string_buffer + offset;
 249   to = get_doc_string_buffer + offset;
 250   while (from != p)
 251     {
 252       if (*from == 1)
 253         {
 254           int c;
 255
 256           from++;
 257           c = *from++;
 258           if (c == 1)
 259             *to++ = c;
 260           else if (c == '0')
 261             *to++ = 0;
 262           else if (c == '_')
 263             *to++ = 037;
 264           else
 265             error ("Invalid data in documentation file -- ^A followed by code 0%o", c);
 266         }
 267       else
 268         *to++ = *from++;
 269     }
 270
 271   /* If DEFINITION, read from this buffer
 272      the same way we would read bytes from a file.  */
 273   if (definition)
 274     {
 275       read_bytecode_pointer = get_doc_string_buffer + offset;
 276       return Fread (Qlambda);
 277     }
 278
 279   if (unibyte)
 280     return make_unibyte_string (get_doc_string_buffer + offset,
 281                                 to - (get_doc_string_buffer + offset));
 282   else
 283     {
 284       /* Let the data determine whether the string is multibyte,
 285          even if Emacs is running in --unibyte mode.  */
 286       int nchars = multibyte_chars_in_text (get_doc_string_buffer + offset,
 287                                             to - (get_doc_string_buffer + offset));
 288       return make_string_from_bytes (get_doc_string_buffer + offset,
 289                                      nchars,
 290                                      to - (get_doc_string_buffer + offset));
 291     }
 292 }
 293
 294 /* Get a string from position FILEPOS and pass it through the Lisp reader.
 295    We use this for fetching the bytecode string and constants vector
 296    of a compiled function from the .elc file.  */
 297
 298 Lisp_Object
 299 read_doc_string (filepos)
 300      Lisp_Object filepos;
 301 {
 302   return get_doc_string (filepos, 0, 1);
 303 }
 304
 305 DEFUN ("documentation", Fdocumentation, Sdocumentation, 1, 2, 0,
 306   "Return the documentation string of FUNCTION.\n\
 307 Unless a non-nil second argument RAW is given, the\n\
 308 string is passed through `substitute-command-keys'.")
 309   (function, raw)
 310      Lisp_Object function, raw;
 311 {
 312   Lisp_Object fun;
 313   Lisp_Object funcar;
 314   Lisp_Object tem, doc;
 315
 316   if (SYMBOLP (function)
 317       && (tem = Fget (function, Qfunction_documentation),
 318           !NILP (tem)))
 319     return Fdocumentation_property (function, Qfunction_documentation, raw);
 320
 321   fun = Findirect_function (function);
 322   if (SUBRP (fun))
 323     {
 324       if (XSUBR (fun)->doc == 0)
 325         return Qnil;
 326       else if ((EMACS_INT) XSUBR (fun)->doc >= 0)
 327         doc = build_string (XSUBR (fun)->doc);
 328       else
 329         doc = get_doc_string (make_number (- (EMACS_INT) XSUBR (fun)->doc),
 330                               0, 0);
 331       if (! NILP (tem = Fassq (function, Vhelp_manyarg_func_alist)))
 332         doc = concat3 (doc, build_string ("\n"), Fcdr (tem));
 333     }
 334   else if (COMPILEDP (fun))
 335     {
 336       if ((XVECTOR (fun)->size & PSEUDOVECTOR_SIZE_MASK) <= COMPILED_DOC_STRING)
 337         return Qnil;
 338       tem = XVECTOR (fun)->contents[COMPILED_DOC_STRING];
 339       if (STRINGP (tem))
 340         doc = tem;
 341       else if (NATNUMP (tem) || CONSP (tem))
 342         doc = get_doc_string (tem, 0, 0);
 343       else
 344         return Qnil;
 345     }
 346   else if (STRINGP (fun) || VECTORP (fun))
 347     {
 348       return build_string ("Keyboard macro.");
 349     }
 350   else if (CONSP (fun))
 351     {
 352       funcar = Fcar (fun);
 353       if (!SYMBOLP (funcar))
 354         return Fsignal (Qinvalid_function, Fcons (fun, Qnil));
 355       else if (EQ (funcar, Qkeymap))
 356         return build_string ("Prefix command (definition is a keymap associating keystrokes with commands).");
 357       else if (EQ (funcar, Qlambda)
 358                || EQ (funcar, Qautoload))
 359         {
 360           Lisp_Object tem1;
 361           tem1 = Fcdr (Fcdr (fun));
 362           tem = Fcar (tem1);
 363           if (STRINGP (tem))
 364             doc = tem;
 365           /* Handle a doc reference--but these never come last
 366              in the function body, so reject them if they are last.  */
 367           else if ((NATNUMP (tem) || CONSP (tem))
 368                    && ! NILP (XCDR (tem1)))
 369             doc = get_doc_string (tem, 0, 0);
 370           else
 371             return Qnil;
 372         }
 373       else if (EQ (funcar, Qmocklisp))
 374         return Qnil;
 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 (NILP (raw))
 387     doc = Fsubstitute_command_keys (doc);
 388   return doc;
 389 }
 390
 391 DEFUN ("documentation-property", Fdocumentation_property,
 392        Sdocumentation_property, 2, 3, 0,
 393   "Return the documentation string that is SYMBOL's PROP property.\n\
 394 Third argument RAW omitted or nil means pass the result through\n\
 395 `substitute-command-keys' if it is a string.\n\
 396 \n\
 397 This is differs from `get' in that it can refer to strings stored in the\n\
 398 `etc/DOC' file; and that it evaluates documentation properties that\n\
 399 aren't strings.")
 400   (symbol, prop, raw)
 401      Lisp_Object symbol, prop, raw;
 402 {
 403   Lisp_Object tem;
 404
 405   tem = Fget (symbol, prop);
 406   if (INTEGERP (tem))
 407     tem = get_doc_string (XINT (tem) > 0 ? tem : make_number (- XINT (tem)), 0, 0);
 408   else if (CONSP (tem) && INTEGERP (XCDR (tem)))
 409     tem = get_doc_string (tem, 0, 0);
 410   else if (!STRINGP (tem))
 411     /* Feval protects its argument.  */
 412     tem = Feval (tem);
 413
 414   if (NILP (raw) && STRINGP (tem))
 415     tem = Fsubstitute_command_keys (tem);
 416   return tem;
 417 }
 418 \f
 419 /* Scanning the DOC files and placing docstring offsets into functions.  */
 420
 421 static void
 422 store_function_docstring (fun, offset)
 423      Lisp_Object fun;
 424      /* Use EMACS_INT because we get this from pointer subtraction.  */
 425      EMACS_INT offset;
 426 {
 427   fun = indirect_function (fun);
 428
 429   /* The type determines where the docstring is stored.  */
 430
 431   /* Lisp_Subrs have a slot for it.  */
 432   if (SUBRP (fun))
 433     XSUBR (fun)->doc = (char *) - offset;
 434
 435   /* If it's a lisp form, stick it in the form.  */
 436   else if (CONSP (fun))
 437     {
 438       Lisp_Object tem;
 439
 440       tem = XCAR (fun);
 441       if (EQ (tem, Qlambda) || EQ (tem, Qautoload))
 442         {
 443           tem = Fcdr (Fcdr (fun));
 444           if (CONSP (tem) && INTEGERP (XCAR (tem)))
 445             XSETFASTINT (XCAR (tem), offset);
 446         }
 447       else if (EQ (tem, Qmacro))
 448         store_function_docstring (XCDR (fun), offset);
 449     }
 450
 451   /* Bytecode objects sometimes have slots for it.  */
 452   else if (COMPILEDP (fun))
 453     {
 454       /* This bytecode object must have a slot for the
 455          docstring, since we've found a docstring for it.  */
 456       if ((XVECTOR (fun)->size & PSEUDOVECTOR_SIZE_MASK) > COMPILED_DOC_STRING)
 457         XSETFASTINT (XVECTOR (fun)->contents[COMPILED_DOC_STRING], offset);
 458     }
 459 }
 460
 461
 462 DEFUN ("Snarf-documentation", Fsnarf_documentation, Ssnarf_documentation,
 463   1, 1, 0,
 464   "Used during Emacs initialization, before dumping runnable Emacs,\n\
 465 to find pointers to doc strings stored in `etc/DOC...' and\n\
 466 record them in function definitions.\n\
 467 One arg, FILENAME, a string which does not include a directory.\n\
 468 The file is found in `../etc' now; found in the `data-directory'\n\
 469 when doc strings are referred to later in the dumped Emacs.")
 470   (filename)
 471      Lisp_Object filename;
 472 {
 473   int fd;
 474   char buf[1024 + 1];
 475   register int filled;
 476   register int pos;
 477   register char *p, *end;
 478   Lisp_Object sym, fun, tem;
 479   char *name;
 480
 481 #ifndef CANNOT_DUMP
 482   if (NILP (Vpurify_flag))
 483     error ("Snarf-documentation can only be called in an undumped Emacs");
 484 #endif
 485
 486   CHECK_STRING (filename, 0);
 487
 488 #ifndef CANNOT_DUMP
 489   name = (char *) alloca (XSTRING (filename)->size + 14);
 490   strcpy (name, "../etc/");
 491 #else /* CANNOT_DUMP */
 492   CHECK_STRING (Vdoc_directory, 0);
 493   name = (char *) alloca (XSTRING (filename)->size +
 494                           XSTRING (Vdoc_directory)->size + 1);
 495   strcpy (name, XSTRING (Vdoc_directory)->data);
 496 #endif /* CANNOT_DUMP */
 497   strcat (name, XSTRING (filename)->data);      /*** Add this line ***/
 498 #ifdef VMS
 499 #ifndef VMS4_4
 500   /* For VMS versions with limited file name syntax,
 501      convert the name to something VMS will allow.  */
 502   p = name;
 503   while (*p)
 504     {
 505       if (*p == '-')
 506         *p = '_';
 507       p++;
 508     }
 509 #endif /* not VMS4_4 */
 510 #ifdef VMS4_4
 511   strcpy (name, sys_translate_unix (name));
 512 #endif /* VMS4_4 */
 513 #endif /* VMS */
 514
 515   fd = emacs_open (name, O_RDONLY, 0);
 516   if (fd < 0)
 517     report_file_error ("Opening doc string file",
 518                        Fcons (build_string (name), Qnil));
 519   Vdoc_file_name = filename;
 520   filled = 0;
 521   pos = 0;
 522   while (1)
 523     {
 524       if (filled < 512)
 525         filled += emacs_read (fd, &buf[filled], sizeof buf - 1 - filled);
 526       if (!filled)
 527         break;
 528
 529       buf[filled] = 0;
 530       p = buf;
 531       end = buf + (filled < 512 ? filled : filled - 128);
 532       while (p != end && *p != '\037') p++;
 533       /* p points to ^_Ffunctionname\n or ^_Vvarname\n.  */
 534       if (p != end)
 535         {
 536           end = (char *) index (p, '\n');
 537           sym = oblookup (Vobarray, p + 2,
 538                           multibyte_chars_in_text (p + 2, end - p - 2),
 539                           end - p - 2);
 540           if (SYMBOLP (sym))
 541             {
 542               /* Attach a docstring to a variable?  */
 543               if (p[1] == 'V')
 544                 {
 545                   /* Install file-position as variable-documentation property
 546                      and make it negative for a user-variable
 547                      (doc starts with a `*').  */
 548                   Fput (sym, Qvariable_documentation,
 549                         make_number ((pos + end + 1 - buf)
 550                                      * (end[1] == '*' ? -1 : 1)));
 551                 }
 552
 553               /* Attach a docstring to a function?  */
 554               else if (p[1] == 'F')
 555                 store_function_docstring (sym, pos + end + 1 - buf);
 556
 557               else
 558                 error ("DOC file invalid at position %d", pos);
 559             }
 560         }
 561       pos += end - buf;
 562       filled -= end - buf;
 563       bcopy (end, buf, filled);
 564     }
 565   emacs_close (fd);
 566   return Qnil;
 567 }
 568 \f
 569 DEFUN ("substitute-command-keys", Fsubstitute_command_keys,
 570   Ssubstitute_command_keys, 1, 1, 0,
 571   "Substitute key descriptions for command names in STRING.\n\
 572 Return a new string which is STRING with substrings of the form \\=\\[COMMAND]\n\
 573 replaced by either:  a keystroke sequence that will invoke COMMAND,\n\
 574 or \"M-x COMMAND\" if COMMAND is not on any keys.\n\
 575 Substrings of the form \\=\\{MAPVAR} are replaced by summaries\n\
 576 \(made by describe-bindings) of the value of MAPVAR, taken as a keymap.\n\
 577 Substrings of the form \\=\\<MAPVAR> specify to use the value of MAPVAR\n\
 578 as the keymap for future \\=\\[COMMAND] substrings.\n\
 579 \\=\\= quotes the following character and is discarded;\n\
 580 thus, \\=\\=\\=\\= puts \\=\\= into the output, and \\=\\=\\=\\[ puts \\=\\[ into the output.")
 581   (string)
 582      Lisp_Object string;
 583 {
 584   unsigned char *buf;
 585   int changed = 0;
 586   register unsigned char *strp;
 587   register unsigned char *bufp;
 588   int idx;
 589   int bsize;
 590   unsigned char *new;
 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               new = (unsigned char *) xrealloc (buf, bsize += 4);
 690               bufp += new - buf;
 691               buf = new;
 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_1 (tem, 0, 1);
 741                   /* Note that get_keymap_1 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           new = (unsigned char *) xrealloc (buf, bsize += length_byte);
 775           bufp += new - buf;
 776           buf = new;
 777           bcopy (start, bufp, length_byte);
 778           bufp += length_byte;
 779           nchars += length;
 780           /* Check STRING again in case gc relocated it.  */
 781           strp = (unsigned char *) XSTRING (string)->data + idx;
 782         }
 783       else if (! multibyte)             /* just copy other chars */
 784         *bufp++ = *strp++, nchars++;
 785       else
 786         {
 787           int len;
 788           int maxlen = XSTRING (string)->data + STRING_BYTES (XSTRING (string)) - strp;
 789
 790           STRING_CHAR_AND_LENGTH (strp, maxlen, len);
 791           if (len == 1)
 792             *bufp = *strp;
 793           else
 794             bcopy (strp, bufp, len);
 795           strp += len;
 796           bufp += len;
 797           nchars++;
 798         }
 799     }
 800
 801   if (changed)                  /* don't bother if nothing substituted */
 802     tem = make_string_from_bytes (buf, nchars, bufp - buf);
 803   else
 804     tem = string;
 805   xfree (buf);
 806   RETURN_UNGCPRO (tem);
 807 }
 808 \f
 809 void
 810 syms_of_doc ()
 811 {
 812   Qfunction_documentation = intern ("function-documentation");
 813   staticpro (&Qfunction_documentation);
 814
 815   DEFVAR_LISP ("internal-doc-file-name", &Vdoc_file_name,
 816     "Name of file containing documentation strings of built-in symbols.");
 817   Vdoc_file_name = Qnil;
 818   DEFVAR_LISP ("help-manyarg-func-alist", &Vhelp_manyarg_func_alist,
 819     "Alist of primitive functions and descriptions of their arg lists.\n\
 820 All special forms and primitives which effectively have &rest args\n\
 821 should have an entry here so that `documentation' can provide their\n\
 822 arg list.");
 823   Vhelp_manyarg_func_alist = Qnil;
 824
 825   defsubr (&Sdocumentation);
 826   defsubr (&Sdocumentation_property);
 827   defsubr (&Ssnarf_documentation);
 828   defsubr (&Ssubstitute_command_keys);
 829 }