src/doc.c

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