src/doc.c

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