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