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