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