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