src/doc.c

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