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