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 Substrings of the form \\=\\[COMMAND] replaced by either: a keystroke
 709 sequence that will invoke COMMAND, or "M-x COMMAND" if COMMAND is not
 710 on any keys.
 711 Substrings of the form \\=\\{MAPVAR} are replaced by summaries
 712 \(made by `describe-bindings') of the value of MAPVAR, taken as a keymap.
 713 Substrings of the form \\=\\<MAPVAR> specify to use the value of MAPVAR
 714 as the keymap for future \\=\\[COMMAND] substrings.
 715 \\=\\= quotes the following character and is discarded;
 716 thus, \\=\\=\\=\\= puts \\=\\= into the output, and \\=\\=\\=\\[ puts \\=\\[ into the output.
 717
 718 Returns original STRING if no substitutions were made.  Otherwise,
 719 a new string, without any text properties, is returned.  */)
 720   (Lisp_Object string)
 721 {
 722   char *buf;
 723   int changed = 0;
 724   register unsigned char *strp;
 725   register char *bufp;
 726   ptrdiff_t idx;
 727   ptrdiff_t bsize;
 728   Lisp_Object tem;
 729   Lisp_Object keymap;
 730   unsigned char *start;
 731   ptrdiff_t length, length_byte;
 732   Lisp_Object name;
 733   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
 734   int multibyte;
 735   ptrdiff_t nchars;
 736
 737   if (NILP (string))
 738     return Qnil;
 739
 740   CHECK_STRING (string);
 741   tem = Qnil;
 742   keymap = Qnil;
 743   name = Qnil;
 744   GCPRO4 (string, tem, keymap, name);
 745
 746   multibyte = STRING_MULTIBYTE (string);
 747   nchars = 0;
 748
 749   /* KEYMAP is either nil (which means search all the active keymaps)
 750      or a specified local map (which means search just that and the
 751      global map).  If non-nil, it might come from Voverriding_local_map,
 752      or from a \\<mapname> construct in STRING itself..  */
 753   keymap = KVAR (current_kboard, Voverriding_terminal_local_map);
 754   if (NILP (keymap))
 755     keymap = Voverriding_local_map;
 756
 757   bsize = SBYTES (string);
 758   bufp = buf = (char *) xmalloc (bsize);
 759
 760   strp = SDATA (string);
 761   while (strp < SDATA (string) + SBYTES (string))
 762     {
 763       if (strp[0] == '\\' && strp[1] == '=')
 764         {
 765           /* \= quotes the next character;
 766              thus, to put in \[ without its special meaning, use \=\[.  */
 767           changed = 1;
 768           strp += 2;
 769           if (multibyte)
 770             {
 771               int len;
 772
 773               STRING_CHAR_AND_LENGTH (strp, len);
 774               if (len == 1)
 775                 *bufp = *strp;
 776               else
 777                 memcpy (bufp, strp, len);
 778               strp += len;
 779               bufp += len;
 780               nchars++;
 781             }
 782           else
 783             *bufp++ = *strp++, nchars++;
 784         }
 785       else if (strp[0] == '\\' && strp[1] == '[')
 786         {
 787           ptrdiff_t start_idx;
 788           int follow_remap = 1;
 789
 790           changed = 1;
 791           strp += 2;            /* skip \[ */
 792           start = strp;
 793           start_idx = start - SDATA (string);
 794
 795           while ((strp - SDATA (string)
 796                   < SBYTES (string))
 797                  && *strp != ']')
 798             strp++;
 799           length_byte = strp - start;
 800
 801           strp++;               /* skip ] */
 802
 803           /* Save STRP in IDX.  */
 804           idx = strp - SDATA (string);
 805           name = Fintern (make_string ((char *) start, length_byte), Qnil);
 806
 807         do_remap:
 808           tem = Fwhere_is_internal (name, keymap, Qt, Qnil, Qnil);
 809
 810           if (VECTORP (tem) && ASIZE (tem) > 1
 811               && EQ (AREF (tem, 0), Qremap) && SYMBOLP (AREF (tem, 1))
 812               && follow_remap)
 813             {
 814               name = AREF (tem, 1);
 815               follow_remap = 0;
 816               goto do_remap;
 817             }
 818
 819           /* Note the Fwhere_is_internal can GC, so we have to take
 820              relocation of string contents into account.  */
 821           strp = SDATA (string) + idx;
 822           start = SDATA (string) + start_idx;
 823
 824           if (NILP (tem))       /* but not on any keys */
 825             {
 826               ptrdiff_t offset = bufp - buf;
 827               if (STRING_BYTES_BOUND - 4 < bsize)
 828                 string_overflow ();
 829               buf = (char *) xrealloc (buf, bsize += 4);
 830               bufp = buf + offset;
 831               memcpy (bufp, "M-x ", 4);
 832               bufp += 4;
 833               nchars += 4;
 834               if (multibyte)
 835                 length = multibyte_chars_in_text (start, length_byte);
 836               else
 837                 length = length_byte;
 838               goto subst;
 839             }
 840           else
 841             {                   /* function is on a key */
 842               tem = Fkey_description (tem, Qnil);
 843               goto subst_string;
 844             }
 845         }
 846       /* \{foo} is replaced with a summary of the keymap (symbol-value foo).
 847          \<foo> just sets the keymap used for \[cmd].  */
 848       else if (strp[0] == '\\' && (strp[1] == '{' || strp[1] == '<'))
 849         {
 850           struct buffer *oldbuf;
 851           ptrdiff_t start_idx;
 852           /* This is for computing the SHADOWS arg for describe_map_tree.  */
 853           Lisp_Object active_maps = Fcurrent_active_maps (Qnil, Qnil);
 854           Lisp_Object earlier_maps;
 855
 856           changed = 1;
 857           strp += 2;            /* skip \{ or \< */
 858           start = strp;
 859           start_idx = start - SDATA (string);
 860
 861           while ((strp - SDATA (string) < SBYTES (string))
 862                  && *strp != '}' && *strp != '>')
 863             strp++;
 864
 865           length_byte = strp - start;
 866           strp++;                       /* skip } or > */
 867
 868           /* Save STRP in IDX.  */
 869           idx = strp - SDATA (string);
 870
 871           /* Get the value of the keymap in TEM, or nil if undefined.
 872              Do this while still in the user's current buffer
 873              in case it is a local variable.  */
 874           name = Fintern (make_string ((char *) start, length_byte), Qnil);
 875           tem = Fboundp (name);
 876           if (! NILP (tem))
 877             {
 878               tem = Fsymbol_value (name);
 879               if (! NILP (tem))
 880                 {
 881                   tem = get_keymap (tem, 0, 1);
 882                   /* Note that get_keymap can GC.  */
 883                   strp = SDATA (string) + idx;
 884                   start = SDATA (string) + start_idx;
 885                 }
 886             }
 887
 888           /* Now switch to a temp buffer.  */
 889           oldbuf = current_buffer;
 890           set_buffer_internal (XBUFFER (Vprin1_to_string_buffer));
 891
 892           if (NILP (tem))
 893             {
 894               name = Fsymbol_name (name);
 895               insert_string ("\nUses keymap \"");
 896               insert_from_string (name, 0, 0,
 897                                   SCHARS (name),
 898                                   SBYTES (name), 1);
 899               insert_string ("\", which is not currently defined.\n");
 900               if (start[-1] == '<') keymap = Qnil;
 901             }
 902           else if (start[-1] == '<')
 903             keymap = tem;
 904           else
 905             {
 906               /* Get the list of active keymaps that precede this one.
 907                  If this one's not active, get nil.  */
 908               earlier_maps = Fcdr (Fmemq (tem, Freverse (active_maps)));
 909               describe_map_tree (tem, 1, Fnreverse (earlier_maps),
 910                                  Qnil, (char *)0, 1, 0, 0, 1);
 911             }
 912           tem = Fbuffer_string ();
 913           Ferase_buffer ();
 914           set_buffer_internal (oldbuf);
 915
 916         subst_string:
 917           start = SDATA (tem);
 918           length = SCHARS (tem);
 919           length_byte = SBYTES (tem);
 920         subst:
 921           {
 922             ptrdiff_t offset = bufp - buf;
 923             if (STRING_BYTES_BOUND - length_byte < bsize)
 924               string_overflow ();
 925             buf = (char *) xrealloc (buf, bsize += length_byte);
 926             bufp = buf + offset;
 927             memcpy (bufp, start, length_byte);
 928             bufp += length_byte;
 929             nchars += length;
 930             /* Check STRING again in case gc relocated it.  */
 931             strp = SDATA (string) + idx;
 932           }
 933         }
 934       else if (! multibyte)             /* just copy other chars */
 935         *bufp++ = *strp++, nchars++;
 936       else
 937         {
 938           int len;
 939
 940           STRING_CHAR_AND_LENGTH (strp, len);
 941           if (len == 1)
 942             *bufp = *strp;
 943           else
 944             memcpy (bufp, strp, len);
 945           strp += len;
 946           bufp += len;
 947           nchars++;
 948         }
 949     }
 950
 951   if (changed)                  /* don't bother if nothing substituted */
 952     tem = make_string_from_bytes (buf, nchars, bufp - buf);
 953   else
 954     tem = string;
 955   xfree (buf);
 956   RETURN_UNGCPRO (tem);
 957 }
 958 \f
 959 void
 960 syms_of_doc (void)
 961 {
 962   DEFSYM (Qfunction_documentation, "function-documentation");
 963
 964   DEFVAR_LISP ("internal-doc-file-name", Vdoc_file_name,
 965                doc: /* Name of file containing documentation strings of built-in symbols.  */);
 966   Vdoc_file_name = Qnil;
 967
 968   DEFVAR_LISP ("build-files", Vbuild_files,
 969                doc: /* A list of files used to build this Emacs binary.  */);
 970   Vbuild_files = Qnil;
 971
 972   defsubr (&Sdocumentation);
 973   defsubr (&Sdocumentation_property);
 974   defsubr (&Ssnarf_documentation);
 975   defsubr (&Ssubstitute_command_keys);
 976 }