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