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   EMACS_INT minsize;
  90   EMACS_INT offset, position;
  91   Lisp_Object file, tem;
  92
  93   if (INTEGERP (filepos))
  94     {
  95       file = Vdoc_file_name;
  96       position = XINT (filepos);
  97     }
  98   else if (CONSP (filepos))
  99     {
 100       file = XCAR (filepos);
 101       position = XINT (XCDR (filepos));
 102     }
 103   else
 104     return Qnil;
 105
 106   if (position < 0)
 107     position = - position;
 108
 109   if (!STRINGP (Vdoc_directory))
 110     return Qnil;
 111
 112   if (!STRINGP (file))
 113     return Qnil;
 114
 115   /* Put the file name in NAME as a C string.
 116      If it is relative, combine it with Vdoc_directory.  */
 117
 118   tem = Ffile_name_absolute_p (file);
 119   file = ENCODE_FILE (file);
 120   if (NILP (tem))
 121     {
 122       Lisp_Object docdir = ENCODE_FILE (Vdoc_directory);
 123       minsize = SCHARS (docdir);
 124       /* sizeof ("../etc/") == 8 */
 125       if (minsize < 8)
 126         minsize = 8;
 127       name = (char *) alloca (minsize + SCHARS (file) + 8);
 128       strcpy (name, SSDATA (docdir));
 129       strcat (name, SSDATA (file));
 130     }
 131   else
 132     {
 133       name = SSDATA (file);
 134     }
 135
 136   fd = emacs_open (name, O_RDONLY, 0);
 137   if (fd < 0)
 138     {
 139 #ifndef CANNOT_DUMP
 140       if (!NILP (Vpurify_flag))
 141         {
 142           /* Preparing to dump; DOC file is probably not installed.
 143              So check in ../etc.  */
 144           strcpy (name, "../etc/");
 145           strcat (name, SSDATA (file));
 146
 147           fd = emacs_open (name, O_RDONLY, 0);
 148         }
 149 #endif
 150       if (fd < 0)
 151         error ("Cannot open doc string file \"%s\"", name);
 152     }
 153
 154   /* Seek only to beginning of disk block.  */
 155   /* Make sure we read at least 1024 bytes before `position'
 156      so we can check the leading text for consistency.  */
 157   offset = min (position, max (1024, position % (8 * 1024)));
 158   if (0 > lseek (fd, position - offset, 0))
 159     {
 160       emacs_close (fd);
 161       error ("Position %"pI"d out of range in doc string file \"%s\"",
 162              position, name);
 163     }
 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       EMACS_INT 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 int
 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   int 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 (SUBRP (fun))
 351     {
 352       if (XSUBR (fun)->doc == 0)
 353         return Qnil;
 354       /* FIXME: This is not portable, as it assumes that string
 355          pointers have the top bit clear.  */
 356       else if ((intptr_t) XSUBR (fun)->doc >= 0)
 357         doc = build_string (XSUBR (fun)->doc);
 358       else
 359         doc = make_number ((intptr_t) XSUBR (fun)->doc);
 360     }
 361   else if (COMPILEDP (fun))
 362     {
 363       if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) <= COMPILED_DOC_STRING)
 364         return Qnil;
 365       else
 366         {
 367           Lisp_Object tem = AREF (fun, COMPILED_DOC_STRING);
 368           if (STRINGP (tem))
 369             doc = tem;
 370           else if (NATNUMP (tem) || CONSP (tem))
 371             doc = tem;
 372           else
 373             return Qnil;
 374         }
 375     }
 376   else if (STRINGP (fun) || VECTORP (fun))
 377     {
 378       return build_string ("Keyboard macro.");
 379     }
 380   else if (CONSP (fun))
 381     {
 382       funcar = Fcar (fun);
 383       if (!SYMBOLP (funcar))
 384         xsignal1 (Qinvalid_function, fun);
 385       else if (EQ (funcar, Qkeymap))
 386         return build_string ("Prefix command (definition is a keymap associating keystrokes with commands).");
 387       else if (EQ (funcar, Qlambda)
 388                || (EQ (funcar, Qclosure) && (fun = XCDR (fun), 1))
 389                || EQ (funcar, Qautoload))
 390         {
 391           Lisp_Object tem1 = Fcdr (Fcdr (fun));
 392           Lisp_Object tem = Fcar (tem1);
 393           if (STRINGP (tem))
 394             doc = tem;
 395           /* Handle a doc reference--but these never come last
 396              in the function body, so reject them if they are last.  */
 397           else if ((NATNUMP (tem) || (CONSP (tem) && INTEGERP (XCDR (tem))))
 398                    && !NILP (XCDR (tem1)))
 399             doc = tem;
 400           else
 401             return Qnil;
 402         }
 403       else if (EQ (funcar, Qmacro))
 404         return Fdocumentation (Fcdr (fun), raw);
 405       else
 406         goto oops;
 407     }
 408   else
 409     {
 410     oops:
 411       xsignal1 (Qinvalid_function, fun);
 412     }
 413
 414   /* Check for an advised function.  Its doc string
 415      has an `ad-advice-info' text property.  */
 416   if (STRINGP (doc))
 417     {
 418       Lisp_Object innerfunc;
 419       innerfunc = Fget_text_property (make_number (0),
 420                                       intern ("ad-advice-info"),
 421                                       doc);
 422       if (! NILP (innerfunc))
 423         doc = call1 (intern ("ad-make-advised-docstring"), innerfunc);
 424     }
 425
 426   /* If DOC is 0, it's typically because of a dumped file missing
 427      from the DOC file (bug in src/Makefile.in).  */
 428   if (EQ (doc, make_number (0)))
 429     doc = Qnil;
 430   if (INTEGERP (doc) || CONSP (doc))
 431     {
 432       Lisp_Object tem;
 433       tem = get_doc_string (doc, 0, 0);
 434       if (NILP (tem) && try_reload)
 435         {
 436           /* The file is newer, we need to reset the pointers.  */
 437           struct gcpro gcpro1, gcpro2;
 438           GCPRO2 (function, raw);
 439           try_reload = reread_doc_file (Fcar_safe (doc));
 440           UNGCPRO;
 441           if (try_reload)
 442             {
 443               try_reload = 0;
 444               goto documentation;
 445             }
 446         }
 447       else
 448         doc = tem;
 449     }
 450
 451   if (NILP (raw))
 452     doc = Fsubstitute_command_keys (doc);
 453   return doc;
 454 }
 455
 456 DEFUN ("documentation-property", Fdocumentation_property,
 457        Sdocumentation_property, 2, 3, 0,
 458        doc: /* Return the documentation string that is SYMBOL's PROP property.
 459 Third argument RAW omitted or nil means pass the result through
 460 `substitute-command-keys' if it is a string.
 461
 462 This differs from `get' in that it can refer to strings stored in the
 463 `etc/DOC' file; and that it evaluates documentation properties that
 464 aren't strings.  */)
 465   (Lisp_Object symbol, Lisp_Object prop, Lisp_Object raw)
 466 {
 467   int try_reload = 1;
 468   Lisp_Object tem;
 469
 470  documentation_property:
 471
 472   tem = Fget (symbol, prop);
 473   if (EQ (tem, make_number (0)))
 474     tem = Qnil;
 475   if (INTEGERP (tem) || (CONSP (tem) && INTEGERP (XCDR (tem))))
 476     {
 477       Lisp_Object doc = tem;
 478       tem = get_doc_string (tem, 0, 0);
 479       if (NILP (tem) && try_reload)
 480         {
 481           /* The file is newer, we need to reset the pointers.  */
 482           struct gcpro gcpro1, gcpro2, gcpro3;
 483           GCPRO3 (symbol, prop, raw);
 484           try_reload = reread_doc_file (Fcar_safe (doc));
 485           UNGCPRO;
 486           if (try_reload)
 487             {
 488               try_reload = 0;
 489               goto documentation_property;
 490             }
 491         }
 492     }
 493   else if (!STRINGP (tem))
 494     /* Feval protects its argument.  */
 495     tem = Feval (tem, Qnil);
 496
 497   if (NILP (raw) && STRINGP (tem))
 498     tem = Fsubstitute_command_keys (tem);
 499   return tem;
 500 }
 501 \f
 502 /* Scanning the DOC files and placing docstring offsets into functions.  */
 503
 504 static void
 505 store_function_docstring (Lisp_Object obj, EMACS_INT offset)
 506 /* Use EMACS_INT because we get offset from pointer subtraction.  */
 507 {
 508   /* Don't use indirect_function here, or defaliases will apply their
 509      docstrings to the base functions (Bug#2603).  */
 510   Lisp_Object fun = SYMBOLP (obj) ? XSYMBOL (obj)->function : obj;
 511
 512   /* The type determines where the docstring is stored.  */
 513
 514   /* Lisp_Subrs have a slot for it.  */
 515   if (SUBRP (fun))
 516     {
 517       intptr_t negative_offset = - offset;
 518       XSUBR (fun)->doc = (char *) negative_offset;
 519     }
 520
 521   /* If it's a lisp form, stick it in the form.  */
 522   else if (CONSP (fun))
 523     {
 524       Lisp_Object tem;
 525
 526       tem = XCAR (fun);
 527       if (EQ (tem, Qlambda) || EQ (tem, Qautoload)
 528           || (EQ (tem, Qclosure) && (fun = XCDR (fun), 1)))
 529         {
 530           tem = Fcdr (Fcdr (fun));
 531           if (CONSP (tem) && INTEGERP (XCAR (tem)))
 532             XSETCAR (tem, make_number (offset));
 533         }
 534       else if (EQ (tem, Qmacro))
 535         store_function_docstring (XCDR (fun), offset);
 536     }
 537
 538   /* Bytecode objects sometimes have slots for it.  */
 539   else if (COMPILEDP (fun))
 540     {
 541       /* This bytecode object must have a slot for the
 542          docstring, since we've found a docstring for it.  */
 543       if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) > COMPILED_DOC_STRING)
 544         ASET (fun, COMPILED_DOC_STRING, make_number (offset));
 545     }
 546 }
 547
 548 static const char buildobj[] = BUILDOBJ;
 549
 550 DEFUN ("Snarf-documentation", Fsnarf_documentation, Ssnarf_documentation,
 551        1, 1, 0,
 552        doc: /* Used during Emacs initialization to scan the `etc/DOC...' file.
 553 This searches the `etc/DOC...' file for doc strings and
 554 records them in function and variable definitions.
 555 The function takes one argument, FILENAME, a string;
 556 it specifies the file name (without a directory) of the DOC file.
 557 That file is found in `../etc' now; later, when the dumped Emacs is run,
 558 the same file name is found in the `doc-directory'.  */)
 559   (Lisp_Object filename)
 560 {
 561   int fd;
 562   char buf[1024 + 1];
 563   register EMACS_INT filled;
 564   register EMACS_INT pos;
 565   register char *p;
 566   Lisp_Object sym;
 567   char *name;
 568   int skip_file = 0;
 569
 570   CHECK_STRING (filename);
 571
 572   if
 573 #ifndef CANNOT_DUMP
 574     (!NILP (Vpurify_flag))
 575 #else /* CANNOT_DUMP */
 576       (0)
 577 #endif /* CANNOT_DUMP */
 578     {
 579       name = (char *) alloca (SCHARS (filename) + 14);
 580       strcpy (name, "../etc/");
 581     }
 582   else
 583     {
 584       CHECK_STRING (Vdoc_directory);
 585       name = (char *) alloca (SCHARS (filename)
 586                           + SCHARS (Vdoc_directory) + 1);
 587       strcpy (name, SSDATA (Vdoc_directory));
 588     }
 589   strcat (name, SSDATA (filename));     /*** Add this line ***/
 590
 591   /* Vbuild_files is nil when temacs is run, and non-nil after that.  */
 592   if (NILP (Vbuild_files))
 593   {
 594     const char *beg, *end;
 595
 596     for (beg = buildobj; *beg; beg = end)
 597       {
 598         EMACS_INT len;
 599
 600         while (*beg && isspace (*beg)) ++beg;
 601
 602         for (end = beg; *end && ! isspace (*end); ++end)
 603           if (*end == '/') beg = end+1;  /* skip directory part  */
 604
 605         len = end - beg;
 606         if (len > 4 && end[-4] == '.' && end[-3] == 'o')
 607           len -= 2;  /* Just take .o if it ends in .obj  */
 608
 609         if (len > 0)
 610           Vbuild_files = Fcons (make_string (beg, len), Vbuild_files);
 611       }
 612     Vbuild_files = Fpurecopy (Vbuild_files);
 613   }
 614
 615   fd = emacs_open (name, O_RDONLY, 0);
 616   if (fd < 0)
 617     report_file_error ("Opening doc string file",
 618                        Fcons (build_string (name), Qnil));
 619   Vdoc_file_name = filename;
 620   filled = 0;
 621   pos = 0;
 622   while (1)
 623     {
 624       register char *end;
 625       if (filled < 512)
 626         filled += emacs_read (fd, &buf[filled], sizeof buf - 1 - filled);
 627       if (!filled)
 628         break;
 629
 630       buf[filled] = 0;
 631       p = buf;
 632       end = buf + (filled < 512 ? filled : filled - 128);
 633       while (p != end && *p != '\037') p++;
 634       /* p points to ^_Ffunctionname\n or ^_Vvarname\n or ^_Sfilename\n.  */
 635       if (p != end)
 636         {
 637           end = strchr (p, '\n');
 638
 639           /* See if this is a file name, and if it is a file in build-files.  */
 640           if (p[1] == 'S')
 641             {
 642               skip_file = 0;
 643               if (end - p > 4 && end[-2] == '.'
 644                   && (end[-1] == 'o' || end[-1] == 'c'))
 645                 {
 646                   EMACS_INT len = end - p - 2;
 647                   char *fromfile = alloca (len + 1);
 648                   strncpy (fromfile, &p[2], len);
 649                   fromfile[len] = 0;
 650                   if (fromfile[len-1] == 'c')
 651                     fromfile[len-1] = 'o';
 652
 653                   skip_file = NILP (Fmember (build_string (fromfile),
 654                                              Vbuild_files));
 655                 }
 656             }
 657
 658           sym = oblookup (Vobarray, p + 2,
 659                           multibyte_chars_in_text ((unsigned char *) p + 2,
 660                                                    end - p - 2),
 661                           end - p - 2);
 662           /* Check skip_file so that when a function is defined several
 663              times in different files (typically, once in xterm, once in
 664              w32term, ...), we only pay attention to the one that
 665              matters.  */
 666           if (! skip_file && SYMBOLP (sym))
 667             {
 668               /* Attach a docstring to a variable?  */
 669               if (p[1] == 'V')
 670                 {
 671                   /* Install file-position as variable-documentation property
 672                      and make it negative for a user-variable
 673                      (doc starts with a `*').  */
 674                   if (!NILP (Fboundp (sym)))
 675                     Fput (sym, Qvariable_documentation,
 676                           make_number ((pos + end + 1 - buf)
 677                                        * (end[1] == '*' ? -1 : 1)));
 678                 }
 679
 680               /* Attach a docstring to a function?  */
 681               else if (p[1] == 'F')
 682                 {
 683                   if (!NILP (Ffboundp (sym)))
 684                     store_function_docstring (sym, pos + end + 1 - buf);
 685                 }
 686               else if (p[1] == 'S')
 687                 ; /* Just a source file name boundary marker.  Ignore it.  */
 688
 689               else
 690                 error ("DOC file invalid at position %"pI"d", pos);
 691             }
 692         }
 693       pos += end - buf;
 694       filled -= end - buf;
 695       memmove (buf, end, filled);
 696     }
 697   emacs_close (fd);
 698   return Qnil;
 699 }
 700 \f
 701 DEFUN ("substitute-command-keys", Fsubstitute_command_keys,
 702        Ssubstitute_command_keys, 1, 1, 0,
 703        doc: /* Substitute key descriptions for command names in STRING.
 704 Substrings of the form \\=\\[COMMAND] replaced by either: a keystroke
 705 sequence that will invoke COMMAND, or "M-x COMMAND" if COMMAND is not
 706 on any keys.
 707 Substrings of the form \\=\\{MAPVAR} are replaced by summaries
 708 \(made by `describe-bindings') of the value of MAPVAR, taken as a keymap.
 709 Substrings of the form \\=\\<MAPVAR> specify to use the value of MAPVAR
 710 as the keymap for future \\=\\[COMMAND] substrings.
 711 \\=\\= quotes the following character and is discarded;
 712 thus, \\=\\=\\=\\= puts \\=\\= into the output, and \\=\\=\\=\\[ puts \\=\\[ into the output.
 713
 714 Returns original STRING if no substitutions were made.  Otherwise,
 715 a new string, without any text properties, is returned.  */)
 716   (Lisp_Object string)
 717 {
 718   char *buf;
 719   int changed = 0;
 720   register unsigned char *strp;
 721   register char *bufp;
 722   ptrdiff_t idx;
 723   ptrdiff_t bsize;
 724   Lisp_Object tem;
 725   Lisp_Object keymap;
 726   unsigned char *start;
 727   ptrdiff_t length, length_byte;
 728   Lisp_Object name;
 729   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
 730   int multibyte;
 731   ptrdiff_t nchars;
 732
 733   if (NILP (string))
 734     return Qnil;
 735
 736   CHECK_STRING (string);
 737   tem = Qnil;
 738   keymap = Qnil;
 739   name = Qnil;
 740   GCPRO4 (string, tem, keymap, name);
 741
 742   multibyte = STRING_MULTIBYTE (string);
 743   nchars = 0;
 744
 745   /* KEYMAP is either nil (which means search all the active keymaps)
 746      or a specified local map (which means search just that and the
 747      global map).  If non-nil, it might come from Voverriding_local_map,
 748      or from a \\<mapname> construct in STRING itself..  */
 749   keymap = KVAR (current_kboard, Voverriding_terminal_local_map);
 750   if (NILP (keymap))
 751     keymap = Voverriding_local_map;
 752
 753   bsize = SBYTES (string);
 754   bufp = buf = (char *) xmalloc (bsize);
 755
 756   strp = SDATA (string);
 757   while (strp < SDATA (string) + SBYTES (string))
 758     {
 759       if (strp[0] == '\\' && strp[1] == '=')
 760         {
 761           /* \= quotes the next character;
 762              thus, to put in \[ without its special meaning, use \=\[.  */
 763           changed = 1;
 764           strp += 2;
 765           if (multibyte)
 766             {
 767               int len;
 768
 769               STRING_CHAR_AND_LENGTH (strp, len);
 770               if (len == 1)
 771                 *bufp = *strp;
 772               else
 773                 memcpy (bufp, strp, len);
 774               strp += len;
 775               bufp += len;
 776               nchars++;
 777             }
 778           else
 779             *bufp++ = *strp++, nchars++;
 780         }
 781       else if (strp[0] == '\\' && strp[1] == '[')
 782         {
 783           ptrdiff_t start_idx;
 784           int follow_remap = 1;
 785
 786           changed = 1;
 787           strp += 2;            /* skip \[ */
 788           start = strp;
 789           start_idx = start - SDATA (string);
 790
 791           while ((strp - SDATA (string)
 792                   < SBYTES (string))
 793                  && *strp != ']')
 794             strp++;
 795           length_byte = strp - start;
 796
 797           strp++;               /* skip ] */
 798
 799           /* Save STRP in IDX.  */
 800           idx = strp - SDATA (string);
 801           name = Fintern (make_string ((char *) start, length_byte), Qnil);
 802
 803         do_remap:
 804           tem = Fwhere_is_internal (name, keymap, Qt, Qnil, Qnil);
 805
 806           if (VECTORP (tem) && ASIZE (tem) > 1
 807               && EQ (AREF (tem, 0), Qremap) && SYMBOLP (AREF (tem, 1))
 808               && follow_remap)
 809             {
 810               name = AREF (tem, 1);
 811               follow_remap = 0;
 812               goto do_remap;
 813             }
 814
 815           /* Note the Fwhere_is_internal can GC, so we have to take
 816              relocation of string contents into account.  */
 817           strp = SDATA (string) + idx;
 818           start = SDATA (string) + start_idx;
 819
 820           if (NILP (tem))       /* but not on any keys */
 821             {
 822               ptrdiff_t offset = bufp - buf;
 823               if (STRING_BYTES_BOUND - 4 < bsize)
 824                 string_overflow ();
 825               buf = (char *) xrealloc (buf, bsize += 4);
 826               bufp = buf + offset;
 827               memcpy (bufp, "M-x ", 4);
 828               bufp += 4;
 829               nchars += 4;
 830               if (multibyte)
 831                 length = multibyte_chars_in_text (start, length_byte);
 832               else
 833                 length = length_byte;
 834               goto subst;
 835             }
 836           else
 837             {                   /* function is on a key */
 838               tem = Fkey_description (tem, Qnil);
 839               goto subst_string;
 840             }
 841         }
 842       /* \{foo} is replaced with a summary of the keymap (symbol-value foo).
 843          \<foo> just sets the keymap used for \[cmd].  */
 844       else if (strp[0] == '\\' && (strp[1] == '{' || strp[1] == '<'))
 845         {
 846           struct buffer *oldbuf;
 847           ptrdiff_t start_idx;
 848           /* This is for computing the SHADOWS arg for describe_map_tree.  */
 849           Lisp_Object active_maps = Fcurrent_active_maps (Qnil, Qnil);
 850           Lisp_Object earlier_maps;
 851
 852           changed = 1;
 853           strp += 2;            /* skip \{ or \< */
 854           start = strp;
 855           start_idx = start - SDATA (string);
 856
 857           while ((strp - SDATA (string) < SBYTES (string))
 858                  && *strp != '}' && *strp != '>')
 859             strp++;
 860
 861           length_byte = strp - start;
 862           strp++;                       /* skip } or > */
 863
 864           /* Save STRP in IDX.  */
 865           idx = strp - SDATA (string);
 866
 867           /* Get the value of the keymap in TEM, or nil if undefined.
 868              Do this while still in the user's current buffer
 869              in case it is a local variable.  */
 870           name = Fintern (make_string ((char *) start, length_byte), Qnil);
 871           tem = Fboundp (name);
 872           if (! NILP (tem))
 873             {
 874               tem = Fsymbol_value (name);
 875               if (! NILP (tem))
 876                 {
 877                   tem = get_keymap (tem, 0, 1);
 878                   /* Note that get_keymap can GC.  */
 879                   strp = SDATA (string) + idx;
 880                   start = SDATA (string) + start_idx;
 881                 }
 882             }
 883
 884           /* Now switch to a temp buffer.  */
 885           oldbuf = current_buffer;
 886           set_buffer_internal (XBUFFER (Vprin1_to_string_buffer));
 887
 888           if (NILP (tem))
 889             {
 890               name = Fsymbol_name (name);
 891               insert_string ("\nUses keymap \"");
 892               insert_from_string (name, 0, 0,
 893                                   SCHARS (name),
 894                                   SBYTES (name), 1);
 895               insert_string ("\", which is not currently defined.\n");
 896               if (start[-1] == '<') keymap = Qnil;
 897             }
 898           else if (start[-1] == '<')
 899             keymap = tem;
 900           else
 901             {
 902               /* Get the list of active keymaps that precede this one.
 903                  If this one's not active, get nil.  */
 904               earlier_maps = Fcdr (Fmemq (tem, Freverse (active_maps)));
 905               describe_map_tree (tem, 1, Fnreverse (earlier_maps),
 906                                  Qnil, (char *)0, 1, 0, 0, 1);
 907             }
 908           tem = Fbuffer_string ();
 909           Ferase_buffer ();
 910           set_buffer_internal (oldbuf);
 911
 912         subst_string:
 913           start = SDATA (tem);
 914           length = SCHARS (tem);
 915           length_byte = SBYTES (tem);
 916         subst:
 917           {
 918             ptrdiff_t offset = bufp - buf;
 919             if (STRING_BYTES_BOUND - length_byte < bsize)
 920               string_overflow ();
 921             buf = (char *) xrealloc (buf, bsize += length_byte);
 922             bufp = buf + offset;
 923             memcpy (bufp, start, length_byte);
 924             bufp += length_byte;
 925             nchars += length;
 926             /* Check STRING again in case gc relocated it.  */
 927             strp = SDATA (string) + idx;
 928           }
 929         }
 930       else if (! multibyte)             /* just copy other chars */
 931         *bufp++ = *strp++, nchars++;
 932       else
 933         {
 934           int len;
 935
 936           STRING_CHAR_AND_LENGTH (strp, len);
 937           if (len == 1)
 938             *bufp = *strp;
 939           else
 940             memcpy (bufp, strp, len);
 941           strp += len;
 942           bufp += len;
 943           nchars++;
 944         }
 945     }
 946
 947   if (changed)                  /* don't bother if nothing substituted */
 948     tem = make_string_from_bytes (buf, nchars, bufp - buf);
 949   else
 950     tem = string;
 951   xfree (buf);
 952   RETURN_UNGCPRO (tem);
 953 }
 954 \f
 955 void
 956 syms_of_doc (void)
 957 {
 958   DEFSYM (Qfunction_documentation, "function-documentation");
 959
 960   DEFVAR_LISP ("internal-doc-file-name", Vdoc_file_name,
 961                doc: /* Name of file containing documentation strings of built-in symbols.  */);
 962   Vdoc_file_name = Qnil;
 963
 964   DEFVAR_LISP ("build-files", Vbuild_files,
 965                doc: /* A list of files used to build this Emacs binary.  */);
 966   Vbuild_files = Qnil;
 967
 968   defsubr (&Sdocumentation);
 969   defsubr (&Sdocumentation_property);
 970   defsubr (&Ssnarf_documentation);
 971   defsubr (&Ssubstitute_command_keys);
 972 }