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 int
 339 reread_doc_file (file)
 340      Lisp_Object file;
 341 {
 342   Lisp_Object reply, prompt[3];
 343   struct gcpro gcpro1;
 344   GCPRO1 (file);
 345   prompt[0] = build_string ("File ");
 346   prompt[1] = NILP (file) ? Vdoc_file_name : file;
 347   prompt[2] = build_string (" is out-of-sync.  Reload? ");
 348   reply = Fy_or_n_p (Fconcat (3, prompt));
 349   UNGCPRO;
 350   if (NILP (reply))
 351     return 0;
 352
 353   if (NILP (file))
 354     Fsnarf_documentation (Vdoc_file_name);
 355   else
 356     Fload (file, Qt, Qt, Qt, Qnil);
 357
 358   return 1;
 359 }
 360
 361 DEFUN ("documentation", Fdocumentation, Sdocumentation, 1, 2, 0,
 362        doc: /* Return the documentation string of FUNCTION.
 363 Unless a non-nil second argument RAW is given, the
 364 string is passed through `substitute-command-keys'.  */)
 365      (function, raw)
 366      Lisp_Object function, raw;
 367 {
 368   Lisp_Object fun;
 369   Lisp_Object funcar;
 370   Lisp_Object tem, doc;
 371   int try_reload = 1;
 372
 373  documentation:
 374
 375   doc = Qnil;
 376
 377   if (SYMBOLP (function)
 378       && (tem = Fget (function, Qfunction_documentation),
 379           !NILP (tem)))
 380     return Fdocumentation_property (function, Qfunction_documentation, raw);
 381
 382   fun = Findirect_function (function);
 383   if (SUBRP (fun))
 384     {
 385       if (XSUBR (fun)->doc == 0)
 386         return Qnil;
 387       else if ((EMACS_INT) XSUBR (fun)->doc >= 0)
 388         doc = build_string (XSUBR (fun)->doc);
 389       else
 390         doc = make_number ((EMACS_INT) XSUBR (fun)->doc);
 391     }
 392   else if (COMPILEDP (fun))
 393     {
 394       if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) <= COMPILED_DOC_STRING)
 395         return Qnil;
 396       tem = AREF (fun, COMPILED_DOC_STRING);
 397       if (STRINGP (tem))
 398         doc = tem;
 399       else if (NATNUMP (tem) || CONSP (tem))
 400         doc = tem;
 401       else
 402         return Qnil;
 403     }
 404   else if (STRINGP (fun) || VECTORP (fun))
 405     {
 406       return build_string ("Keyboard macro.");
 407     }
 408   else if (CONSP (fun))
 409     {
 410       funcar = Fcar (fun);
 411       if (!SYMBOLP (funcar))
 412         return Fsignal (Qinvalid_function, Fcons (fun, Qnil));
 413       else if (EQ (funcar, Qkeymap))
 414         return build_string ("Prefix command (definition is a keymap associating keystrokes with commands).");
 415       else if (EQ (funcar, Qlambda)
 416                || EQ (funcar, Qautoload))
 417         {
 418           Lisp_Object tem1;
 419           tem1 = Fcdr (Fcdr (fun));
 420           tem = Fcar (tem1);
 421           if (STRINGP (tem))
 422             doc = tem;
 423           /* Handle a doc reference--but these never come last
 424              in the function body, so reject them if they are last.  */
 425           else if ((NATNUMP (tem) || (CONSP (tem) && INTEGERP (XCDR (tem))))
 426                    && !NILP (XCDR (tem1)))
 427             doc = tem;
 428           else
 429             return Qnil;
 430         }
 431       else if (EQ (funcar, Qmacro))
 432         return Fdocumentation (Fcdr (fun), raw);
 433       else
 434         goto oops;
 435     }
 436   else
 437     {
 438     oops:
 439       Fsignal (Qinvalid_function, Fcons (fun, Qnil));
 440     }
 441
 442   /* If DOC is 0, it's typically because of a dumped file missing
 443      from the DOC file (bug in src/Makefile.in).  */
 444   if (EQ (doc, make_number (0)))
 445     doc = Qnil;
 446   if (INTEGERP (doc) || CONSP (doc))
 447     {
 448       Lisp_Object tem;
 449       tem = get_doc_string (doc, 0, 0);
 450       if (NILP (tem) && try_reload)
 451         {
 452           /* The file is newer, we need to reset the pointers.  */
 453           struct gcpro gcpro1, gcpro2;
 454           GCPRO2 (function, raw);
 455           try_reload = reread_doc_file (Fcar_safe (doc));
 456           UNGCPRO;
 457           if (try_reload)
 458             {
 459               try_reload = 0;
 460               goto documentation;
 461             }
 462         }
 463       else
 464         doc = tem;
 465     }
 466
 467   if (NILP (raw))
 468     doc = Fsubstitute_command_keys (doc);
 469   return doc;
 470 }
 471
 472 DEFUN ("documentation-property", Fdocumentation_property,
 473        Sdocumentation_property, 2, 3, 0,
 474        doc: /* Return the documentation string that is SYMBOL's PROP property.
 475 Third argument RAW omitted or nil means pass the result through
 476 `substitute-command-keys' if it is a string.
 477
 478 This differs from `get' in that it can refer to strings stored in the
 479 `etc/DOC' file; and that it evaluates documentation properties that
 480 aren't strings.  */)
 481   (symbol, prop, raw)
 482      Lisp_Object symbol, prop, raw;
 483 {
 484   int try_reload = 1;
 485   Lisp_Object tem;
 486
 487  documentation_property:
 488
 489   tem = Fget (symbol, prop);
 490   if (EQ (tem, make_number (0)))
 491     tem = Qnil;
 492   if (INTEGERP (tem) || (CONSP (tem) && INTEGERP (XCDR (tem))))
 493     {
 494       Lisp_Object doc = tem;
 495       tem = get_doc_string (tem, 0, 0);
 496       if (NILP (tem) && try_reload)
 497         {
 498           /* The file is newer, we need to reset the pointers.  */
 499           struct gcpro gcpro1, gcpro2, gcpro3;
 500           GCPRO3 (symbol, prop, raw);
 501           try_reload = reread_doc_file (Fcar_safe (doc));
 502           UNGCPRO;
 503           if (try_reload)
 504             {
 505               try_reload = 0;
 506               goto documentation_property;
 507             }
 508         }
 509     }
 510   else if (!STRINGP (tem))
 511     /* Feval protects its argument.  */
 512     tem = Feval (tem);
 513
 514   if (NILP (raw) && STRINGP (tem))
 515     tem = Fsubstitute_command_keys (tem);
 516   return tem;
 517 }
 518 \f
 519 /* Scanning the DOC files and placing docstring offsets into functions.  */
 520
 521 static void
 522 store_function_docstring (fun, offset)
 523      Lisp_Object fun;
 524      /* Use EMACS_INT because we get this from pointer subtraction.  */
 525      EMACS_INT offset;
 526 {
 527   fun = indirect_function (fun);
 528
 529   /* The type determines where the docstring is stored.  */
 530
 531   /* Lisp_Subrs have a slot for it.  */
 532   if (SUBRP (fun))
 533     XSUBR (fun)->doc = (char *) - offset;
 534
 535   /* If it's a lisp form, stick it in the form.  */
 536   else if (CONSP (fun))
 537     {
 538       Lisp_Object tem;
 539
 540       tem = XCAR (fun);
 541       if (EQ (tem, Qlambda) || EQ (tem, Qautoload))
 542         {
 543           tem = Fcdr (Fcdr (fun));
 544           if (CONSP (tem) && INTEGERP (XCAR (tem)))
 545             XSETCARFASTINT (tem, offset);
 546         }
 547       else if (EQ (tem, Qmacro))
 548         store_function_docstring (XCDR (fun), offset);
 549     }
 550
 551   /* Bytecode objects sometimes have slots for it.  */
 552   else if (COMPILEDP (fun))
 553     {
 554       /* This bytecode object must have a slot for the
 555          docstring, since we've found a docstring for it.  */
 556       if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) > COMPILED_DOC_STRING)
 557         XSETFASTINT (AREF (fun, COMPILED_DOC_STRING), offset);
 558     }
 559 }
 560
 561
 562 DEFUN ("Snarf-documentation", Fsnarf_documentation, Ssnarf_documentation,
 563        1, 1, 0,
 564        doc: /* Used during Emacs initialization to scan the `etc/DOC...' file.
 565 This searches the `etc/DOC...' file for doc strings and
 566 records them in function and variable definitions.
 567 The function takes one argument, FILENAME, a string;
 568 it specifies the file name (without a directory) of the DOC file.
 569 That file is found in `../etc' now; later, when the dumped Emacs is run,
 570 the same file name is found in the `data-directory'.  */)
 571      (filename)
 572      Lisp_Object filename;
 573 {
 574   int fd;
 575   char buf[1024 + 1];
 576   register int filled;
 577   register int pos;
 578   register char *p, *end;
 579   Lisp_Object sym;
 580   char *name;
 581
 582   CHECK_STRING (filename);
 583
 584   if
 585 #ifndef CANNOT_DUMP
 586     (!NILP (Vpurify_flag))
 587 #else /* CANNOT_DUMP */
 588       (0)
 589 #endif /* CANNOT_DUMP */
 590     {
 591       name = (char *) alloca (XSTRING (filename)->size + 14);
 592       strcpy (name, "../etc/");
 593     }
 594   else
 595     {
 596       CHECK_STRING (Vdoc_directory);
 597       name = (char *) alloca (XSTRING (filename)->size
 598                           + XSTRING (Vdoc_directory)->size + 1);
 599       strcpy (name, XSTRING (Vdoc_directory)->data);
 600     }
 601   strcat (name, XSTRING (filename)->data);      /*** Add this line ***/
 602 #ifdef VMS
 603 #ifndef VMS4_4
 604   /* For VMS versions with limited file name syntax,
 605      convert the name to something VMS will allow.  */
 606   p = name;
 607   while (*p)
 608     {
 609       if (*p == '-')
 610         *p = '_';
 611       p++;
 612     }
 613 #endif /* not VMS4_4 */
 614 #ifdef VMS4_4
 615   strcpy (name, sys_translate_unix (name));
 616 #endif /* VMS4_4 */
 617 #endif /* VMS */
 618
 619   fd = emacs_open (name, O_RDONLY, 0);
 620   if (fd < 0)
 621     report_file_error ("Opening doc string file",
 622                        Fcons (build_string (name), Qnil));
 623   Vdoc_file_name = filename;
 624   filled = 0;
 625   pos = 0;
 626   while (1)
 627     {
 628       if (filled < 512)
 629         filled += emacs_read (fd, &buf[filled], sizeof buf - 1 - filled);
 630       if (!filled)
 631         break;
 632
 633       buf[filled] = 0;
 634       p = buf;
 635       end = buf + (filled < 512 ? filled : filled - 128);
 636       while (p != end && *p != '\037') p++;
 637       /* p points to ^_Ffunctionname\n or ^_Vvarname\n.  */
 638       if (p != end)
 639         {
 640           end = (char *) index (p, '\n');
 641           sym = oblookup (Vobarray, p + 2,
 642                           multibyte_chars_in_text (p + 2, end - p - 2),
 643                           end - p - 2);
 644           if (SYMBOLP (sym))
 645             {
 646               /* Attach a docstring to a variable?  */
 647               if (p[1] == 'V')
 648                 {
 649                   /* Install file-position as variable-documentation property
 650                      and make it negative for a user-variable
 651                      (doc starts with a `*').  */
 652                   Fput (sym, Qvariable_documentation,
 653                         make_number ((pos + end + 1 - buf)
 654                                      * (end[1] == '*' ? -1 : 1)));
 655                 }
 656
 657               /* Attach a docstring to a function?  */
 658               else if (p[1] == 'F')
 659                 store_function_docstring (sym, pos + end + 1 - buf);
 660
 661               else
 662                 error ("DOC file invalid at position %d", pos);
 663             }
 664         }
 665       pos += end - buf;
 666       filled -= end - buf;
 667       bcopy (end, buf, filled);
 668     }
 669   emacs_close (fd);
 670   return Qnil;
 671 }
 672 \f
 673 DEFUN ("substitute-command-keys", Fsubstitute_command_keys,
 674        Ssubstitute_command_keys, 1, 1, 0,
 675        doc: /* Substitute key descriptions for command names in STRING.
 676 Return a new string which is STRING with substrings of the form \\=\\[COMMAND]
 677 replaced by either:  a keystroke sequence that will invoke COMMAND,
 678 or "M-x COMMAND" if COMMAND is not on any keys.
 679 Substrings of the form \\=\\{MAPVAR} are replaced by summaries
 680 \(made by describe-bindings) of the value of MAPVAR, taken as a keymap.
 681 Substrings of the form \\=\\<MAPVAR> specify to use the value of MAPVAR
 682 as the keymap for future \\=\\[COMMAND] substrings.
 683 \\=\\= quotes the following character and is discarded;
 684 thus, \\=\\=\\=\\= puts \\=\\= into the output, and \\=\\=\\=\\[ puts \\=\\[ into the output.  */)
 685      (string)
 686      Lisp_Object string;
 687 {
 688   unsigned char *buf;
 689   int changed = 0;
 690   register unsigned char *strp;
 691   register unsigned char *bufp;
 692   int idx;
 693   int bsize;
 694   Lisp_Object tem;
 695   Lisp_Object keymap;
 696   unsigned char *start;
 697   int length, length_byte;
 698   Lisp_Object name;
 699   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
 700   int multibyte;
 701   int nchars;
 702
 703   if (NILP (string))
 704     return Qnil;
 705
 706   CHECK_STRING (string);
 707   tem = Qnil;
 708   keymap = Qnil;
 709   name = Qnil;
 710   GCPRO4 (string, tem, keymap, name);
 711
 712   multibyte = STRING_MULTIBYTE (string);
 713   nchars = 0;
 714
 715   /* KEYMAP is either nil (which means search all the active keymaps)
 716      or a specified local map (which means search just that and the
 717      global map).  If non-nil, it might come from Voverriding_local_map,
 718      or from a \\<mapname> construct in STRING itself..  */
 719   keymap = current_kboard->Voverriding_terminal_local_map;
 720   if (NILP (keymap))
 721     keymap = Voverriding_local_map;
 722
 723   bsize = STRING_BYTES (XSTRING (string));
 724   bufp = buf = (unsigned char *) xmalloc (bsize);
 725
 726   strp = (unsigned char *) XSTRING (string)->data;
 727   while (strp < XSTRING (string)->data + STRING_BYTES (XSTRING (string)))
 728     {
 729       if (strp[0] == '\\' && strp[1] == '=')
 730         {
 731           /* \= quotes the next character;
 732              thus, to put in \[ without its special meaning, use \=\[.  */
 733           changed = 1;
 734           strp += 2;
 735           if (multibyte)
 736             {
 737               int len;
 738               int maxlen = XSTRING (string)->data + STRING_BYTES (XSTRING (string)) - strp;
 739
 740               STRING_CHAR_AND_LENGTH (strp, maxlen, len);
 741               if (len == 1)
 742                 *bufp = *strp;
 743               else
 744                 bcopy (strp, bufp, len);
 745               strp += len;
 746               bufp += len;
 747               nchars++;
 748             }
 749           else
 750             *bufp++ = *strp++, nchars++;
 751         }
 752       else if (strp[0] == '\\' && strp[1] == '[')
 753         {
 754           Lisp_Object firstkey;
 755           int start_idx;
 756
 757           changed = 1;
 758           strp += 2;            /* skip \[ */
 759           start = strp;
 760           start_idx = start - XSTRING (string)->data;
 761
 762           while ((strp - (unsigned char *) XSTRING (string)->data
 763                   < STRING_BYTES (XSTRING (string)))
 764                  && *strp != ']')
 765             strp++;
 766           length_byte = strp - start;
 767
 768           strp++;               /* skip ] */
 769
 770           /* Save STRP in IDX.  */
 771           idx = strp - (unsigned char *) XSTRING (string)->data;
 772           tem = Fintern (make_string (start, length_byte), Qnil);
 773
 774           /* Note the Fwhere_is_internal can GC, so we have to take
 775              relocation of string contents into account.  */
 776           tem = Fwhere_is_internal (tem, keymap, Qt, Qnil, Qnil);
 777           strp = XSTRING (string)->data + idx;
 778           start = XSTRING (string)->data + start_idx;
 779
 780           /* Disregard menu bar bindings; it is positively annoying to
 781              mention them when there's no menu bar, and it isn't terribly
 782              useful even when there is a menu bar.  */
 783           if (!NILP (tem))
 784             {
 785               firstkey = Faref (tem, make_number (0));
 786               if (EQ (firstkey, Qmenu_bar))
 787                 tem = Qnil;
 788             }
 789
 790           if (NILP (tem))       /* but not on any keys */
 791             {
 792               int offset = bufp - buf;
 793               buf = (unsigned char *) xrealloc (buf, bsize += 4);
 794               bufp = buf + offset;
 795               bcopy ("M-x ", bufp, 4);
 796               bufp += 4;
 797               nchars += 4;
 798               if (multibyte)
 799                 length = multibyte_chars_in_text (start, length_byte);
 800               else
 801                 length = length_byte;
 802               goto subst;
 803             }
 804           else
 805             {                   /* function is on a key */
 806               tem = Fkey_description (tem);
 807               goto subst_string;
 808             }
 809         }
 810       /* \{foo} is replaced with a summary of the keymap (symbol-value foo).
 811          \<foo> just sets the keymap used for \[cmd].  */
 812       else if (strp[0] == '\\' && (strp[1] == '{' || strp[1] == '<'))
 813         {
 814           struct buffer *oldbuf;
 815           int start_idx;
 816
 817           changed = 1;
 818           strp += 2;            /* skip \{ or \< */
 819           start = strp;
 820           start_idx = start - XSTRING (string)->data;
 821
 822           while ((strp - (unsigned char *) XSTRING (string)->data
 823                   < XSTRING (string)->size)
 824                  && *strp != '}' && *strp != '>')
 825             strp++;
 826
 827           length_byte = strp - start;
 828           strp++;                       /* skip } or > */
 829
 830           /* Save STRP in IDX.  */
 831           idx = strp - (unsigned char *) XSTRING (string)->data;
 832
 833           /* Get the value of the keymap in TEM, or nil if undefined.
 834              Do this while still in the user's current buffer
 835              in case it is a local variable.  */
 836           name = Fintern (make_string (start, length_byte), Qnil);
 837           tem = Fboundp (name);
 838           if (! NILP (tem))
 839             {
 840               tem = Fsymbol_value (name);
 841               if (! NILP (tem))
 842                 {
 843                   tem = get_keymap (tem, 0, 1);
 844                   /* Note that get_keymap can GC.  */
 845                   strp = XSTRING (string)->data + idx;
 846                   start = XSTRING (string)->data + start_idx;
 847                 }
 848             }
 849
 850           /* Now switch to a temp buffer.  */
 851           oldbuf = current_buffer;
 852           set_buffer_internal (XBUFFER (Vprin1_to_string_buffer));
 853
 854           if (NILP (tem))
 855             {
 856               name = Fsymbol_name (name);
 857               insert_string ("\nUses keymap \"");
 858               insert_from_string (name, 0, 0,
 859                                   XSTRING (name)->size,
 860                                   STRING_BYTES (XSTRING (name)), 1);
 861               insert_string ("\", which is not currently defined.\n");
 862               if (start[-1] == '<') keymap = Qnil;
 863             }
 864           else if (start[-1] == '<')
 865             keymap = tem;
 866           else
 867             describe_map_tree (tem, 1, Qnil, Qnil, (char *)0, 1, 0, 0);
 868           tem = Fbuffer_string ();
 869           Ferase_buffer ();
 870           set_buffer_internal (oldbuf);
 871
 872         subst_string:
 873           start = XSTRING (tem)->data;
 874           length = XSTRING (tem)->size;
 875           length_byte = STRING_BYTES (XSTRING (tem));
 876         subst:
 877           {
 878             int offset = bufp - buf;
 879             buf = (unsigned char *) xrealloc (buf, bsize += length_byte);
 880             bufp = buf + offset;
 881             bcopy (start, bufp, length_byte);
 882             bufp += length_byte;
 883             nchars += length;
 884             /* Check STRING again in case gc relocated it.  */
 885             strp = (unsigned char *) XSTRING (string)->data + idx;
 886           }
 887         }
 888       else if (! multibyte)             /* just copy other chars */
 889         *bufp++ = *strp++, nchars++;
 890       else
 891         {
 892           int len;
 893           int maxlen = XSTRING (string)->data + STRING_BYTES (XSTRING (string)) - strp;
 894
 895           STRING_CHAR_AND_LENGTH (strp, maxlen, len);
 896           if (len == 1)
 897             *bufp = *strp;
 898           else
 899             bcopy (strp, bufp, len);
 900           strp += len;
 901           bufp += len;
 902           nchars++;
 903         }
 904     }
 905
 906   if (changed)                  /* don't bother if nothing substituted */
 907     tem = make_string_from_bytes (buf, nchars, bufp - buf);
 908   else
 909     tem = string;
 910   xfree (buf);
 911   RETURN_UNGCPRO (tem);
 912 }
 913 \f
 914 void
 915 syms_of_doc ()
 916 {
 917   Qfunction_documentation = intern ("function-documentation");
 918   staticpro (&Qfunction_documentation);
 919
 920   DEFVAR_LISP ("internal-doc-file-name", &Vdoc_file_name,
 921                doc: /* Name of file containing documentation strings of built-in symbols.  */);
 922   Vdoc_file_name = Qnil;
 923
 924   defsubr (&Sdocumentation);
 925   defsubr (&Sdocumentation_property);
 926   defsubr (&Ssnarf_documentation);
 927   defsubr (&Ssubstitute_command_keys);
 928 }