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