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