src/doc.c

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