src/doc.c

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