src/doc.c

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