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