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