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, Vhelp_manyarg_func_alist;
  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       if (! NILP (tem = Fassq (function, Vhelp_manyarg_func_alist)))
 335         doc = concat3 (doc, build_string ("\n"), Fcdr (tem));
 336     }
 337   else if (COMPILEDP (fun))
 338     {
 339       if ((XVECTOR (fun)->size & PSEUDOVECTOR_SIZE_MASK) <= COMPILED_DOC_STRING)
 340         return Qnil;
 341       tem = XVECTOR (fun)->contents[COMPILED_DOC_STRING];
 342       if (STRINGP (tem))
 343         doc = tem;
 344       else if (NATNUMP (tem) || CONSP (tem))
 345         doc = get_doc_string (tem, 0, 0);
 346       else
 347         return Qnil;
 348     }
 349   else if (STRINGP (fun) || VECTORP (fun))
 350     {
 351       return build_string ("Keyboard macro.");
 352     }
 353   else if (CONSP (fun))
 354     {
 355       funcar = Fcar (fun);
 356       if (!SYMBOLP (funcar))
 357         return Fsignal (Qinvalid_function, Fcons (fun, Qnil));
 358       else if (EQ (funcar, Qkeymap))
 359         return build_string ("Prefix command (definition is a keymap associating keystrokes with commands).");
 360       else if (EQ (funcar, Qlambda)
 361                || EQ (funcar, Qautoload))
 362         {
 363           Lisp_Object tem1;
 364           tem1 = Fcdr (Fcdr (fun));
 365           tem = Fcar (tem1);
 366           if (STRINGP (tem))
 367             doc = tem;
 368           /* Handle a doc reference--but these never come last
 369              in the function body, so reject them if they are last.  */
 370           else if ((NATNUMP (tem) || CONSP (tem))
 371                    && ! NILP (XCDR (tem1)))
 372             doc = get_doc_string (tem, 0, 0);
 373           else
 374             return Qnil;
 375         }
 376       else if (EQ (funcar, Qmocklisp))
 377         return Qnil;
 378       else if (EQ (funcar, Qmacro))
 379         return Fdocumentation (Fcdr (fun), raw);
 380       else
 381         goto oops;
 382     }
 383   else
 384     {
 385     oops:
 386       Fsignal (Qinvalid_function, Fcons (fun, Qnil));
 387     }
 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   "Return the documentation string that is SYMBOL's PROP property.\n\
 397 Third argument RAW omitted or nil means pass the result through\n\
 398 `substitute-command-keys' if it is a string.\n\
 399 \n\
 400 This differs from `get' in that it can refer to strings stored in the\n\
 401 `etc/DOC' file; and that it evaluates documentation properties that\n\
 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))
 410     tem = get_doc_string (XINT (tem) > 0 ? tem : make_number (- XINT (tem)), 0, 0);
 411   else if (CONSP (tem) && INTEGERP (XCDR (tem)))
 412     tem = get_doc_string (tem, 0, 0);
 413   else if (!STRINGP (tem))
 414     /* Feval protects its argument.  */
 415     tem = Feval (tem);
 416
 417   if (NILP (raw) && STRINGP (tem))
 418     tem = Fsubstitute_command_keys (tem);
 419   return tem;
 420 }
 421 \f
 422 /* Scanning the DOC files and placing docstring offsets into functions.  */
 423
 424 static void
 425 store_function_docstring (fun, offset)
 426      Lisp_Object fun;
 427      /* Use EMACS_INT because we get this from pointer subtraction.  */
 428      EMACS_INT offset;
 429 {
 430   fun = indirect_function (fun);
 431
 432   /* The type determines where the docstring is stored.  */
 433
 434   /* Lisp_Subrs have a slot for it.  */
 435   if (SUBRP (fun))
 436     XSUBR (fun)->doc = (char *) - offset;
 437
 438   /* If it's a lisp form, stick it in the form.  */
 439   else if (CONSP (fun))
 440     {
 441       Lisp_Object tem;
 442
 443       tem = XCAR (fun);
 444       if (EQ (tem, Qlambda) || EQ (tem, Qautoload))
 445         {
 446           tem = Fcdr (Fcdr (fun));
 447           if (CONSP (tem) && INTEGERP (XCAR (tem)))
 448             XSETFASTINT (XCAR (tem), offset);
 449         }
 450       else if (EQ (tem, Qmacro))
 451         store_function_docstring (XCDR (fun), offset);
 452     }
 453
 454   /* Bytecode objects sometimes have slots for it.  */
 455   else if (COMPILEDP (fun))
 456     {
 457       /* This bytecode object must have a slot for the
 458          docstring, since we've found a docstring for it.  */
 459       if ((XVECTOR (fun)->size & PSEUDOVECTOR_SIZE_MASK) > COMPILED_DOC_STRING)
 460         XSETFASTINT (XVECTOR (fun)->contents[COMPILED_DOC_STRING], offset);
 461     }
 462 }
 463
 464
 465 DEFUN ("Snarf-documentation", Fsnarf_documentation, Ssnarf_documentation,
 466   1, 1, 0,
 467   "Used during Emacs initialization, before dumping runnable Emacs,\n\
 468 to find pointers to doc strings stored in `etc/DOC...' and\n\
 469 record them in function definitions.\n\
 470 One arg, FILENAME, a string which does not include a directory.\n\
 471 The file is found in `../etc' now; found in the `data-directory'\n\
 472 when doc strings are referred to later in the dumped Emacs.")
 473   (filename)
 474      Lisp_Object filename;
 475 {
 476   int fd;
 477   char buf[1024 + 1];
 478   register int filled;
 479   register int pos;
 480   register char *p, *end;
 481   Lisp_Object sym;
 482   char *name;
 483
 484 #ifndef CANNOT_DUMP
 485   if (NILP (Vpurify_flag))
 486     error ("Snarf-documentation can only be called in an undumped Emacs");
 487 #endif
 488
 489   CHECK_STRING (filename, 0);
 490
 491 #ifndef CANNOT_DUMP
 492   name = (char *) alloca (XSTRING (filename)->size + 14);
 493   strcpy (name, "../etc/");
 494 #else /* CANNOT_DUMP */
 495   CHECK_STRING (Vdoc_directory, 0);
 496   name = (char *) alloca (XSTRING (filename)->size +
 497                           XSTRING (Vdoc_directory)->size + 1);
 498   strcpy (name, XSTRING (Vdoc_directory)->data);
 499 #endif /* CANNOT_DUMP */
 500   strcat (name, XSTRING (filename)->data);      /*** Add this line ***/
 501 #ifdef VMS
 502 #ifndef VMS4_4
 503   /* For VMS versions with limited file name syntax,
 504      convert the name to something VMS will allow.  */
 505   p = name;
 506   while (*p)
 507     {
 508       if (*p == '-')
 509         *p = '_';
 510       p++;
 511     }
 512 #endif /* not VMS4_4 */
 513 #ifdef VMS4_4
 514   strcpy (name, sys_translate_unix (name));
 515 #endif /* VMS4_4 */
 516 #endif /* VMS */
 517
 518   fd = emacs_open (name, O_RDONLY, 0);
 519   if (fd < 0)
 520     report_file_error ("Opening doc string file",
 521                        Fcons (build_string (name), Qnil));
 522   Vdoc_file_name = filename;
 523   filled = 0;
 524   pos = 0;
 525   while (1)
 526     {
 527       if (filled < 512)
 528         filled += emacs_read (fd, &buf[filled], sizeof buf - 1 - filled);
 529       if (!filled)
 530         break;
 531
 532       buf[filled] = 0;
 533       p = buf;
 534       end = buf + (filled < 512 ? filled : filled - 128);
 535       while (p != end && *p != '\037') p++;
 536       /* p points to ^_Ffunctionname\n or ^_Vvarname\n.  */
 537       if (p != end)
 538         {
 539           end = (char *) index (p, '\n');
 540           sym = oblookup (Vobarray, p + 2,
 541                           multibyte_chars_in_text (p + 2, end - p - 2),
 542                           end - p - 2);
 543           if (SYMBOLP (sym))
 544             {
 545               /* Attach a docstring to a variable?  */
 546               if (p[1] == 'V')
 547                 {
 548                   /* Install file-position as variable-documentation property
 549                      and make it negative for a user-variable
 550                      (doc starts with a `*').  */
 551                   Fput (sym, Qvariable_documentation,
 552                         make_number ((pos + end + 1 - buf)
 553                                      * (end[1] == '*' ? -1 : 1)));
 554                 }
 555
 556               /* Attach a docstring to a function?  */
 557               else if (p[1] == 'F')
 558                 store_function_docstring (sym, pos + end + 1 - buf);
 559
 560               else
 561                 error ("DOC file invalid at position %d", pos);
 562             }
 563         }
 564       pos += end - buf;
 565       filled -= end - buf;
 566       bcopy (end, buf, filled);
 567     }
 568   emacs_close (fd);
 569   return Qnil;
 570 }
 571 \f
 572 DEFUN ("substitute-command-keys", Fsubstitute_command_keys,
 573   Ssubstitute_command_keys, 1, 1, 0,
 574   "Substitute key descriptions for command names in STRING.\n\
 575 Return a new string which is STRING with substrings of the form \\=\\[COMMAND]\n\
 576 replaced by either:  a keystroke sequence that will invoke COMMAND,\n\
 577 or \"M-x COMMAND\" if COMMAND is not on any keys.\n\
 578 Substrings of the form \\=\\{MAPVAR} are replaced by summaries\n\
 579 \(made by describe-bindings) of the value of MAPVAR, taken as a keymap.\n\
 580 Substrings of the form \\=\\<MAPVAR> specify to use the value of MAPVAR\n\
 581 as the keymap for future \\=\\[COMMAND] substrings.\n\
 582 \\=\\= quotes the following character and is discarded;\n\
 583 thus, \\=\\=\\=\\= puts \\=\\= into the output, and \\=\\=\\=\\[ puts \\=\\[ into the output.")
 584   (string)
 585      Lisp_Object string;
 586 {
 587   unsigned char *buf;
 588   int changed = 0;
 589   register unsigned char *strp;
 590   register unsigned char *bufp;
 591   int idx;
 592   int bsize;
 593   Lisp_Object tem;
 594   Lisp_Object keymap;
 595   unsigned char *start;
 596   int length, length_byte;
 597   Lisp_Object name;
 598   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
 599   int multibyte;
 600   int nchars;
 601
 602   if (NILP (string))
 603     return Qnil;
 604
 605   CHECK_STRING (string, 0);
 606   tem = Qnil;
 607   keymap = Qnil;
 608   name = Qnil;
 609   GCPRO4 (string, tem, keymap, name);
 610
 611   multibyte = STRING_MULTIBYTE (string);
 612   nchars = 0;
 613
 614   /* KEYMAP is either nil (which means search all the active keymaps)
 615      or a specified local map (which means search just that and the
 616      global map).  If non-nil, it might come from Voverriding_local_map,
 617      or from a \\<mapname> construct in STRING itself..  */
 618   keymap = current_kboard->Voverriding_terminal_local_map;
 619   if (NILP (keymap))
 620     keymap = Voverriding_local_map;
 621
 622   bsize = STRING_BYTES (XSTRING (string));
 623   bufp = buf = (unsigned char *) xmalloc (bsize);
 624
 625   strp = (unsigned char *) XSTRING (string)->data;
 626   while (strp < XSTRING (string)->data + STRING_BYTES (XSTRING (string)))
 627     {
 628       if (strp[0] == '\\' && strp[1] == '=')
 629         {
 630           /* \= quotes the next character;
 631              thus, to put in \[ without its special meaning, use \=\[.  */
 632           changed = 1;
 633           strp += 2;
 634           if (multibyte)
 635             {
 636               int len;
 637               int maxlen = XSTRING (string)->data + STRING_BYTES (XSTRING (string)) - strp;
 638
 639               STRING_CHAR_AND_LENGTH (strp, maxlen, len);
 640               if (len == 1)
 641                 *bufp = *strp;
 642               else
 643                 bcopy (strp, bufp, len);
 644               strp += len;
 645               bufp += len;
 646               nchars++;
 647             }
 648           else
 649             *bufp++ = *strp++, nchars++;
 650         }
 651       else if (strp[0] == '\\' && strp[1] == '[')
 652         {
 653           Lisp_Object firstkey;
 654           int start_idx;
 655
 656           changed = 1;
 657           strp += 2;            /* skip \[ */
 658           start = strp;
 659           start_idx = start - XSTRING (string)->data;
 660
 661           while ((strp - (unsigned char *) XSTRING (string)->data
 662                   < STRING_BYTES (XSTRING (string)))
 663                  && *strp != ']')
 664             strp++;
 665           length_byte = strp - start;
 666
 667           strp++;               /* skip ] */
 668
 669           /* Save STRP in IDX.  */
 670           idx = strp - (unsigned char *) XSTRING (string)->data;
 671           tem = Fintern (make_string (start, length_byte), Qnil);
 672
 673           /* Note the Fwhere_is_internal can GC, so we have to take
 674              relocation of string contents into account.  */
 675           tem = Fwhere_is_internal (tem, keymap, Qt, Qnil);
 676           strp = XSTRING (string)->data + idx;
 677           start = XSTRING (string)->data + start_idx;
 678
 679           /* Disregard menu bar bindings; it is positively annoying to
 680              mention them when there's no menu bar, and it isn't terribly
 681              useful even when there is a menu bar.  */
 682           if (!NILP (tem))
 683             {
 684               firstkey = Faref (tem, make_number (0));
 685               if (EQ (firstkey, Qmenu_bar))
 686                 tem = Qnil;
 687             }
 688
 689           if (NILP (tem))       /* but not on any keys */
 690             {
 691               int offset = bufp - buf;
 692               buf = (unsigned char *) xrealloc (buf, bsize += 4);
 693               bufp = buf + offset;
 694               bcopy ("M-x ", bufp, 4);
 695               bufp += 4;
 696               nchars += 4;
 697               if (multibyte)
 698                 length = multibyte_chars_in_text (start, length_byte);
 699               else
 700                 length = length_byte;
 701               goto subst;
 702             }
 703           else
 704             {                   /* function is on a key */
 705               tem = Fkey_description (tem);
 706               goto subst_string;
 707             }
 708         }
 709       /* \{foo} is replaced with a summary of the keymap (symbol-value foo).
 710          \<foo> just sets the keymap used for \[cmd].  */
 711       else if (strp[0] == '\\' && (strp[1] == '{' || strp[1] == '<'))
 712         {
 713           struct buffer *oldbuf;
 714           int start_idx;
 715
 716           changed = 1;
 717           strp += 2;            /* skip \{ or \< */
 718           start = strp;
 719           start_idx = start - XSTRING (string)->data;
 720
 721           while ((strp - (unsigned char *) XSTRING (string)->data
 722                   < XSTRING (string)->size)
 723                  && *strp != '}' && *strp != '>')
 724             strp++;
 725
 726           length_byte = strp - start;
 727           strp++;                       /* skip } or > */
 728
 729           /* Save STRP in IDX.  */
 730           idx = strp - (unsigned char *) XSTRING (string)->data;
 731
 732           /* Get the value of the keymap in TEM, or nil if undefined.
 733              Do this while still in the user's current buffer
 734              in case it is a local variable.  */
 735           name = Fintern (make_string (start, length_byte), Qnil);
 736           tem = Fboundp (name);
 737           if (! NILP (tem))
 738             {
 739               tem = Fsymbol_value (name);
 740               if (! NILP (tem))
 741                 {
 742                   tem = get_keymap (tem, 0, 1);
 743                   /* Note that get_keymap can GC.  */
 744                   strp = XSTRING (string)->data + idx;
 745                   start = XSTRING (string)->data + start_idx;
 746                 }
 747             }
 748
 749           /* Now switch to a temp buffer.  */
 750           oldbuf = current_buffer;
 751           set_buffer_internal (XBUFFER (Vprin1_to_string_buffer));
 752
 753           if (NILP (tem))
 754             {
 755               name = Fsymbol_name (name);
 756               insert_string ("\nUses keymap \"");
 757               insert_from_string (name, 0, 0,
 758                                   XSTRING (name)->size,
 759                                   STRING_BYTES (XSTRING (name)), 1);
 760               insert_string ("\", which is not currently defined.\n");
 761               if (start[-1] == '<') keymap = Qnil;
 762             }
 763           else if (start[-1] == '<')
 764             keymap = tem;
 765           else
 766             describe_map_tree (tem, 1, Qnil, Qnil, (char *)0, 1, 0, 0);
 767           tem = Fbuffer_string ();
 768           Ferase_buffer ();
 769           set_buffer_internal (oldbuf);
 770
 771         subst_string:
 772           start = XSTRING (tem)->data;
 773           length = XSTRING (tem)->size;
 774           length_byte = STRING_BYTES (XSTRING (tem));
 775         subst:
 776           {
 777             int offset = bufp - buf;
 778             buf = (unsigned char *) xrealloc (buf, bsize += length_byte);
 779             bufp = buf + offset;
 780             bcopy (start, bufp, length_byte);
 781             bufp += length_byte;
 782             nchars += length;
 783             /* Check STRING again in case gc relocated it.  */
 784             strp = (unsigned char *) XSTRING (string)->data + idx;
 785           }
 786         }
 787       else if (! multibyte)             /* just copy other chars */
 788         *bufp++ = *strp++, nchars++;
 789       else
 790         {
 791           int len;
 792           int maxlen = XSTRING (string)->data + STRING_BYTES (XSTRING (string)) - strp;
 793
 794           STRING_CHAR_AND_LENGTH (strp, maxlen, len);
 795           if (len == 1)
 796             *bufp = *strp;
 797           else
 798             bcopy (strp, bufp, len);
 799           strp += len;
 800           bufp += len;
 801           nchars++;
 802         }
 803     }
 804
 805   if (changed)                  /* don't bother if nothing substituted */
 806     tem = make_string_from_bytes (buf, nchars, bufp - buf);
 807   else
 808     tem = string;
 809   xfree (buf);
 810   RETURN_UNGCPRO (tem);
 811 }
 812 \f
 813 void
 814 syms_of_doc ()
 815 {
 816   Qfunction_documentation = intern ("function-documentation");
 817   staticpro (&Qfunction_documentation);
 818
 819   DEFVAR_LISP ("internal-doc-file-name", &Vdoc_file_name,
 820     "Name of file containing documentation strings of built-in symbols.");
 821   Vdoc_file_name = Qnil;
 822   DEFVAR_LISP ("help-manyarg-func-alist", &Vhelp_manyarg_func_alist,
 823     "Alist of primitive functions and descriptions of their arg lists.\n\
 824 All special forms and primitives which effectively have &rest args\n\
 825 should have an entry here so that `documentation' can provide their\n\
 826 arg list.");
 827   Vhelp_manyarg_func_alist = Qnil;
 828
 829   defsubr (&Sdocumentation);
 830   defsubr (&Sdocumentation_property);
 831   defsubr (&Ssnarf_documentation);
 832   defsubr (&Ssubstitute_command_keys);
 833 }