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