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 int 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       EMACS_INT space_left = (get_doc_string_buffer_size
 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           EMACS_INT in_buffer = p - get_doc_string_buffer;
 177           get_doc_string_buffer_size += 16 * 1024;
 178           get_doc_string_buffer
 179             = (char *) xrealloc (get_doc_string_buffer,
 180                                  get_doc_string_buffer_size + 1);
 181           p = get_doc_string_buffer + in_buffer;
 182           space_left = (get_doc_string_buffer_size
 183                         - (p - get_doc_string_buffer));
 184         }
 185
 186       /* Read a disk block at a time.
 187          If we read the same block last time, maybe skip this?  */
 188       if (space_left > 1024 * 8)
 189         space_left = 1024 * 8;
 190       nread = emacs_read (fd, p, space_left);
 191       if (nread < 0)
 192         {
 193           emacs_close (fd);
 194           error ("Read error on documentation file");
 195         }
 196       p[nread] = 0;
 197       if (!nread)
 198         break;
 199       if (p == get_doc_string_buffer)
 200         p1 = strchr (p + offset, '\037');
 201       else
 202         p1 = strchr (p, '\037');
 203       if (p1)
 204         {
 205           *p1 = 0;
 206           p = p1;
 207           break;
 208         }
 209       p += nread;
 210     }
 211   emacs_close (fd);
 212
 213   /* Sanity checking.  */
 214   if (CONSP (filepos))
 215     {
 216       int test = 1;
 217       if (get_doc_string_buffer[offset - test++] != ' ')
 218         return Qnil;
 219       while (get_doc_string_buffer[offset - test] >= '0'
 220              && get_doc_string_buffer[offset - test] <= '9')
 221         test++;
 222       if (get_doc_string_buffer[offset - test++] != '@'
 223           || get_doc_string_buffer[offset - test] != '#')
 224         return Qnil;
 225     }
 226   else
 227     {
 228       int test = 1;
 229       if (get_doc_string_buffer[offset - test++] != '\n')
 230         return Qnil;
 231       while (get_doc_string_buffer[offset - test] > ' ')
 232         test++;
 233       if (get_doc_string_buffer[offset - test] != '\037')
 234         return Qnil;
 235     }
 236
 237   /* Scan the text and perform quoting with ^A (char code 1).
 238      ^A^A becomes ^A, ^A0 becomes a null char, and ^A_ becomes a ^_.  */
 239   from = get_doc_string_buffer + offset;
 240   to = get_doc_string_buffer + offset;
 241   while (from != p)
 242     {
 243       if (*from == 1)
 244         {
 245           int c;
 246
 247           from++;
 248           c = *from++;
 249           if (c == 1)
 250             *to++ = c;
 251           else if (c == '0')
 252             *to++ = 0;
 253           else if (c == '_')
 254             *to++ = 037;
 255           else
 256             error ("\
 257 Invalid data in documentation file -- %c followed by code %03o",
 258                    1, (unsigned)c);
 259         }
 260       else
 261         *to++ = *from++;
 262     }
 263
 264   /* If DEFINITION, read from this buffer
 265      the same way we would read bytes from a file.  */
 266   if (definition)
 267     {
 268       read_bytecode_pointer = (unsigned char *) get_doc_string_buffer + offset;
 269       return Fread (Qlambda);
 270     }
 271
 272   if (unibyte)
 273     return make_unibyte_string (get_doc_string_buffer + offset,
 274                                 to - (get_doc_string_buffer + offset));
 275   else
 276     {
 277       /* The data determines whether the string is multibyte.  */
 278       EMACS_INT nchars =
 279         multibyte_chars_in_text (((unsigned char *) get_doc_string_buffer
 280                                   + offset),
 281                                  to - (get_doc_string_buffer + offset));
 282       return make_string_from_bytes (get_doc_string_buffer + offset,
 283                                      nchars,
 284                                      to - (get_doc_string_buffer + offset));
 285     }
 286 }
 287
 288 /* Get a string from position FILEPOS and pass it through the Lisp reader.
 289    We use this for fetching the bytecode string and constants vector
 290    of a compiled function from the .elc file.  */
 291
 292 Lisp_Object
 293 read_doc_string (Lisp_Object filepos)
 294 {
 295   return get_doc_string (filepos, 0, 1);
 296 }
 297
 298 static int
 299 reread_doc_file (Lisp_Object file)
 300 {
 301 #if 0
 302   Lisp_Object reply, prompt[3];
 303   struct gcpro gcpro1;
 304   GCPRO1 (file);
 305   prompt[0] = build_string ("File ");
 306   prompt[1] = NILP (file) ? Vdoc_file_name : file;
 307   prompt[2] = build_string (" is out of sync.  Reload? ");
 308   reply = Fy_or_n_p (Fconcat (3, prompt));
 309   UNGCPRO;
 310   if (NILP (reply))
 311     return 0;
 312 #endif
 313
 314   if (NILP (file))
 315     Fsnarf_documentation (Vdoc_file_name);
 316   else
 317     Fload (file, Qt, Qt, Qt, Qnil);
 318
 319   return 1;
 320 }
 321
 322 DEFUN ("documentation", Fdocumentation, Sdocumentation, 1, 2, 0,
 323        doc: /* Return the documentation string of FUNCTION.
 324 Unless a non-nil second argument RAW is given, the
 325 string is passed through `substitute-command-keys'.  */)
 326   (Lisp_Object function, Lisp_Object raw)
 327 {
 328   Lisp_Object fun;
 329   Lisp_Object funcar;
 330   Lisp_Object doc;
 331   int try_reload = 1;
 332
 333  documentation:
 334
 335   doc = Qnil;
 336
 337   if (SYMBOLP (function))
 338     {
 339       Lisp_Object tem = Fget (function, Qfunction_documentation);
 340       if (!NILP (tem))
 341         return Fdocumentation_property (function, Qfunction_documentation,
 342                                         raw);
 343     }
 344
 345   fun = Findirect_function (function, Qnil);
 346   if (SUBRP (fun))
 347     {
 348       if (XSUBR (fun)->doc == 0)
 349         return Qnil;
 350       /* FIXME: This is not portable, as it assumes that string
 351          pointers have the top bit clear.  */
 352       else if ((intptr_t) XSUBR (fun)->doc >= 0)
 353         doc = build_string (XSUBR (fun)->doc);
 354       else
 355         doc = make_number ((intptr_t) XSUBR (fun)->doc);
 356     }
 357   else if (COMPILEDP (fun))
 358     {
 359       if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) <= COMPILED_DOC_STRING)
 360         return Qnil;
 361       else
 362         {
 363           Lisp_Object tem = AREF (fun, COMPILED_DOC_STRING);
 364           if (STRINGP (tem))
 365             doc = tem;
 366           else if (NATNUMP (tem) || CONSP (tem))
 367             doc = tem;
 368           else
 369             return Qnil;
 370         }
 371     }
 372   else if (STRINGP (fun) || VECTORP (fun))
 373     {
 374       return build_string ("Keyboard macro.");
 375     }
 376   else if (CONSP (fun))
 377     {
 378       funcar = Fcar (fun);
 379       if (!SYMBOLP (funcar))
 380         xsignal1 (Qinvalid_function, fun);
 381       else if (EQ (funcar, Qkeymap))
 382         return build_string ("Prefix command (definition is a keymap associating keystrokes with commands).");
 383       else if (EQ (funcar, Qlambda)
 384                || (EQ (funcar, Qclosure) && (fun = XCDR (fun), 1))
 385                || EQ (funcar, Qautoload))
 386         {
 387           Lisp_Object tem1 = Fcdr (Fcdr (fun));
 388           Lisp_Object tem = Fcar (tem1);
 389           if (STRINGP (tem))
 390             doc = tem;
 391           /* Handle a doc reference--but these never come last
 392              in the function body, so reject them if they are last.  */
 393           else if ((NATNUMP (tem) || (CONSP (tem) && INTEGERP (XCDR (tem))))
 394                    && !NILP (XCDR (tem1)))
 395             doc = tem;
 396           else
 397             return Qnil;
 398         }
 399       else if (EQ (funcar, Qmacro))
 400         return Fdocumentation (Fcdr (fun), raw);
 401       else
 402         goto oops;
 403     }
 404   else
 405     {
 406     oops:
 407       xsignal1 (Qinvalid_function, fun);
 408     }
 409
 410   /* Check for an advised function.  Its doc string
 411      has an `ad-advice-info' text property.  */
 412   if (STRINGP (doc))
 413     {
 414       Lisp_Object innerfunc;
 415       innerfunc = Fget_text_property (make_number (0),
 416                                       intern ("ad-advice-info"),
 417                                       doc);
 418       if (! NILP (innerfunc))
 419         doc = call1 (intern ("ad-make-advised-docstring"), innerfunc);
 420     }
 421
 422   /* If DOC is 0, it's typically because of a dumped file missing
 423      from the DOC file (bug in src/Makefile.in).  */
 424   if (EQ (doc, make_number (0)))
 425     doc = Qnil;
 426   if (INTEGERP (doc) || CONSP (doc))
 427     {
 428       Lisp_Object tem;
 429       tem = get_doc_string (doc, 0, 0);
 430       if (NILP (tem) && try_reload)
 431         {
 432           /* The file is newer, we need to reset the pointers.  */
 433           struct gcpro gcpro1, gcpro2;
 434           GCPRO2 (function, raw);
 435           try_reload = reread_doc_file (Fcar_safe (doc));
 436           UNGCPRO;
 437           if (try_reload)
 438             {
 439               try_reload = 0;
 440               goto documentation;
 441             }
 442         }
 443       else
 444         doc = tem;
 445     }
 446
 447   if (NILP (raw))
 448     doc = Fsubstitute_command_keys (doc);
 449   return doc;
 450 }
 451
 452 DEFUN ("documentation-property", Fdocumentation_property,
 453        Sdocumentation_property, 2, 3, 0,
 454        doc: /* Return the documentation string that is SYMBOL's PROP property.
 455 Third argument RAW omitted or nil means pass the result through
 456 `substitute-command-keys' if it is a string.
 457
 458 This differs from `get' in that it can refer to strings stored in the
 459 `etc/DOC' file; and that it evaluates documentation properties that
 460 aren't strings.  */)
 461   (Lisp_Object symbol, Lisp_Object prop, Lisp_Object raw)
 462 {
 463   int try_reload = 1;
 464   Lisp_Object tem;
 465
 466  documentation_property:
 467
 468   tem = Fget (symbol, prop);
 469   if (EQ (tem, make_number (0)))
 470     tem = Qnil;
 471   if (INTEGERP (tem) || (CONSP (tem) && INTEGERP (XCDR (tem))))
 472     {
 473       Lisp_Object doc = tem;
 474       tem = get_doc_string (tem, 0, 0);
 475       if (NILP (tem) && try_reload)
 476         {
 477           /* The file is newer, we need to reset the pointers.  */
 478           struct gcpro gcpro1, gcpro2, gcpro3;
 479           GCPRO3 (symbol, prop, raw);
 480           try_reload = reread_doc_file (Fcar_safe (doc));
 481           UNGCPRO;
 482           if (try_reload)
 483             {
 484               try_reload = 0;
 485               goto documentation_property;
 486             }
 487         }
 488     }
 489   else if (!STRINGP (tem))
 490     /* Feval protects its argument.  */
 491     tem = Feval (tem, Qnil);
 492
 493   if (NILP (raw) && STRINGP (tem))
 494     tem = Fsubstitute_command_keys (tem);
 495   return tem;
 496 }
 497 \f
 498 /* Scanning the DOC files and placing docstring offsets into functions.  */
 499
 500 static void
 501 store_function_docstring (Lisp_Object fun, EMACS_INT offset)
 502 /* Use EMACS_INT because we get offset from pointer subtraction.  */
 503 {
 504   fun = indirect_function (fun);
 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             XSETCAR (tem, make_number (offset));
 527         }
 528       else if (EQ (tem, Qmacro))
 529         store_function_docstring (XCDR (fun), offset);
 530     }
 531
 532   /* Bytecode objects sometimes have slots for it.  */
 533   else if (COMPILEDP (fun))
 534     {
 535       /* This bytecode object must have a slot for the
 536          docstring, since we've found a docstring for it.  */
 537       if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) > COMPILED_DOC_STRING)
 538         ASET (fun, COMPILED_DOC_STRING, make_number (offset));
 539     }
 540 }
 541
 542 static const char buildobj[] = BUILDOBJ;
 543
 544 DEFUN ("Snarf-documentation", Fsnarf_documentation, Ssnarf_documentation,
 545        1, 1, 0,
 546        doc: /* Used during Emacs initialization to scan the `etc/DOC...' file.
 547 This searches the `etc/DOC...' file for doc strings and
 548 records them in function and variable definitions.
 549 The function takes one argument, FILENAME, a string;
 550 it specifies the file name (without a directory) of the DOC file.
 551 That file is found in `../etc' now; later, when the dumped Emacs is run,
 552 the same file name is found in the `doc-directory'.  */)
 553   (Lisp_Object filename)
 554 {
 555   int fd;
 556   char buf[1024 + 1];
 557   register EMACS_INT filled;
 558   register EMACS_INT pos;
 559   register char *p;
 560   Lisp_Object sym;
 561   char *name;
 562   int skip_file = 0;
 563
 564   CHECK_STRING (filename);
 565
 566   if
 567 #ifndef CANNOT_DUMP
 568     (!NILP (Vpurify_flag))
 569 #else /* CANNOT_DUMP */
 570       (0)
 571 #endif /* CANNOT_DUMP */
 572     {
 573       name = (char *) alloca (SCHARS (filename) + 14);
 574       strcpy (name, "../etc/");
 575     }
 576   else
 577     {
 578       CHECK_STRING (Vdoc_directory);
 579       name = (char *) alloca (SCHARS (filename)
 580                           + 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         EMACS_INT len;
 593
 594         while (*beg && isspace (*beg)) ++beg;
 595
 596         for (end = beg; *end && ! 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                   EMACS_INT len = end - p - 2;
 641                   char *fromfile = alloca (len + 1);
 642                   strncpy (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                   Fput (sym, Qvariable_documentation,
 669                         make_number ((pos + end + 1 - buf)
 670                                      * (end[1] == '*' ? -1 : 1)));
 671                 }
 672
 673               /* Attach a docstring to a function?  */
 674               else if (p[1] == 'F')
 675                 store_function_docstring (sym, pos + end + 1 - buf);
 676
 677               else if (p[1] == 'S')
 678                 ; /* Just a source file name boundary marker.  Ignore it.  */
 679
 680               else
 681                 error ("DOC file invalid at position %"pI"d", pos);
 682             }
 683         }
 684       pos += end - buf;
 685       filled -= end - buf;
 686       memmove (buf, end, filled);
 687     }
 688   emacs_close (fd);
 689   return Qnil;
 690 }
 691 \f
 692 DEFUN ("substitute-command-keys", Fsubstitute_command_keys,
 693        Ssubstitute_command_keys, 1, 1, 0,
 694        doc: /* Substitute key descriptions for command names in STRING.
 695 Substrings of the form \\=\\[COMMAND] replaced by either: a keystroke
 696 sequence that will invoke COMMAND, or "M-x COMMAND" if COMMAND is not
 697 on any keys.
 698 Substrings of the form \\=\\{MAPVAR} are replaced by summaries
 699 \(made by `describe-bindings') of the value of MAPVAR, taken as a keymap.
 700 Substrings of the form \\=\\<MAPVAR> specify to use the value of MAPVAR
 701 as the keymap for future \\=\\[COMMAND] substrings.
 702 \\=\\= quotes the following character and is discarded;
 703 thus, \\=\\=\\=\\= puts \\=\\= into the output, and \\=\\=\\=\\[ puts \\=\\[ into the output.
 704
 705 Returns original STRING if no substitutions were made.  Otherwise,
 706 a new string, without any text properties, is returned.  */)
 707   (Lisp_Object string)
 708 {
 709   char *buf;
 710   int changed = 0;
 711   register unsigned char *strp;
 712   register char *bufp;
 713   EMACS_INT idx;
 714   EMACS_INT bsize;
 715   Lisp_Object tem;
 716   Lisp_Object keymap;
 717   unsigned char *start;
 718   EMACS_INT length, length_byte;
 719   Lisp_Object name;
 720   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
 721   int multibyte;
 722   EMACS_INT nchars;
 723
 724   if (NILP (string))
 725     return Qnil;
 726
 727   CHECK_STRING (string);
 728   tem = Qnil;
 729   keymap = Qnil;
 730   name = Qnil;
 731   GCPRO4 (string, tem, keymap, name);
 732
 733   multibyte = STRING_MULTIBYTE (string);
 734   nchars = 0;
 735
 736   /* KEYMAP is either nil (which means search all the active keymaps)
 737      or a specified local map (which means search just that and the
 738      global map).  If non-nil, it might come from Voverriding_local_map,
 739      or from a \\<mapname> construct in STRING itself..  */
 740   keymap = KVAR (current_kboard, Voverriding_terminal_local_map);
 741   if (NILP (keymap))
 742     keymap = Voverriding_local_map;
 743
 744   bsize = SBYTES (string);
 745   bufp = buf = (char *) xmalloc (bsize);
 746
 747   strp = SDATA (string);
 748   while (strp < SDATA (string) + SBYTES (string))
 749     {
 750       if (strp[0] == '\\' && strp[1] == '=')
 751         {
 752           /* \= quotes the next character;
 753              thus, to put in \[ without its special meaning, use \=\[.  */
 754           changed = 1;
 755           strp += 2;
 756           if (multibyte)
 757             {
 758               int len;
 759
 760               STRING_CHAR_AND_LENGTH (strp, len);
 761               if (len == 1)
 762                 *bufp = *strp;
 763               else
 764                 memcpy (bufp, strp, len);
 765               strp += len;
 766               bufp += len;
 767               nchars++;
 768             }
 769           else
 770             *bufp++ = *strp++, nchars++;
 771         }
 772       else if (strp[0] == '\\' && strp[1] == '[')
 773         {
 774           EMACS_INT start_idx;
 775           int follow_remap = 1;
 776
 777           changed = 1;
 778           strp += 2;            /* skip \[ */
 779           start = strp;
 780           start_idx = start - SDATA (string);
 781
 782           while ((strp - SDATA (string)
 783                   < SBYTES (string))
 784                  && *strp != ']')
 785             strp++;
 786           length_byte = strp - start;
 787
 788           strp++;               /* skip ] */
 789
 790           /* Save STRP in IDX.  */
 791           idx = strp - SDATA (string);
 792           name = Fintern (make_string ((char *) start, length_byte), Qnil);
 793
 794         do_remap:
 795           tem = Fwhere_is_internal (name, keymap, Qt, Qnil, Qnil);
 796
 797           if (VECTORP (tem) && ASIZE (tem) > 1
 798               && EQ (AREF (tem, 0), Qremap) && SYMBOLP (AREF (tem, 1))
 799               && follow_remap)
 800             {
 801               name = AREF (tem, 1);
 802               follow_remap = 0;
 803               goto do_remap;
 804             }
 805
 806           /* Note the Fwhere_is_internal can GC, so we have to take
 807              relocation of string contents into account.  */
 808           strp = SDATA (string) + idx;
 809           start = SDATA (string) + start_idx;
 810
 811           if (NILP (tem))       /* but not on any keys */
 812             {
 813               EMACS_INT offset = bufp - buf;
 814               buf = (char *) xrealloc (buf, bsize += 4);
 815               bufp = buf + offset;
 816               memcpy (bufp, "M-x ", 4);
 817               bufp += 4;
 818               nchars += 4;
 819               if (multibyte)
 820                 length = multibyte_chars_in_text (start, length_byte);
 821               else
 822                 length = length_byte;
 823               goto subst;
 824             }
 825           else
 826             {                   /* function is on a key */
 827               tem = Fkey_description (tem, Qnil);
 828               goto subst_string;
 829             }
 830         }
 831       /* \{foo} is replaced with a summary of the keymap (symbol-value foo).
 832          \<foo> just sets the keymap used for \[cmd].  */
 833       else if (strp[0] == '\\' && (strp[1] == '{' || strp[1] == '<'))
 834         {
 835           struct buffer *oldbuf;
 836           EMACS_INT start_idx;
 837           /* This is for computing the SHADOWS arg for describe_map_tree.  */
 838           Lisp_Object active_maps = Fcurrent_active_maps (Qnil, Qnil);
 839           Lisp_Object earlier_maps;
 840
 841           changed = 1;
 842           strp += 2;            /* skip \{ or \< */
 843           start = strp;
 844           start_idx = start - SDATA (string);
 845
 846           while ((strp - SDATA (string) < SBYTES (string))
 847                  && *strp != '}' && *strp != '>')
 848             strp++;
 849
 850           length_byte = strp - start;
 851           strp++;                       /* skip } or > */
 852
 853           /* Save STRP in IDX.  */
 854           idx = strp - SDATA (string);
 855
 856           /* Get the value of the keymap in TEM, or nil if undefined.
 857              Do this while still in the user's current buffer
 858              in case it is a local variable.  */
 859           name = Fintern (make_string ((char *) start, length_byte), Qnil);
 860           tem = Fboundp (name);
 861           if (! NILP (tem))
 862             {
 863               tem = Fsymbol_value (name);
 864               if (! NILP (tem))
 865                 {
 866                   tem = get_keymap (tem, 0, 1);
 867                   /* Note that get_keymap can GC.  */
 868                   strp = SDATA (string) + idx;
 869                   start = SDATA (string) + start_idx;
 870                 }
 871             }
 872
 873           /* Now switch to a temp buffer.  */
 874           oldbuf = current_buffer;
 875           set_buffer_internal (XBUFFER (Vprin1_to_string_buffer));
 876
 877           if (NILP (tem))
 878             {
 879               name = Fsymbol_name (name);
 880               insert_string ("\nUses keymap \"");
 881               insert_from_string (name, 0, 0,
 882                                   SCHARS (name),
 883                                   SBYTES (name), 1);
 884               insert_string ("\", which is not currently defined.\n");
 885               if (start[-1] == '<') keymap = Qnil;
 886             }
 887           else if (start[-1] == '<')
 888             keymap = tem;
 889           else
 890             {
 891               /* Get the list of active keymaps that precede this one.
 892                  If this one's not active, get nil.  */
 893               earlier_maps = Fcdr (Fmemq (tem, Freverse (active_maps)));
 894               describe_map_tree (tem, 1, Fnreverse (earlier_maps),
 895                                  Qnil, (char *)0, 1, 0, 0, 1);
 896             }
 897           tem = Fbuffer_string ();
 898           Ferase_buffer ();
 899           set_buffer_internal (oldbuf);
 900
 901         subst_string:
 902           start = SDATA (tem);
 903           length = SCHARS (tem);
 904           length_byte = SBYTES (tem);
 905         subst:
 906           {
 907             EMACS_INT offset = bufp - buf;
 908             buf = (char *) xrealloc (buf, bsize += length_byte);
 909             bufp = buf + offset;
 910             memcpy (bufp, start, length_byte);
 911             bufp += length_byte;
 912             nchars += length;
 913             /* Check STRING again in case gc relocated it.  */
 914             strp = SDATA (string) + idx;
 915           }
 916         }
 917       else if (! multibyte)             /* just copy other chars */
 918         *bufp++ = *strp++, nchars++;
 919       else
 920         {
 921           int len;
 922
 923           STRING_CHAR_AND_LENGTH (strp, len);
 924           if (len == 1)
 925             *bufp = *strp;
 926           else
 927             memcpy (bufp, strp, len);
 928           strp += len;
 929           bufp += len;
 930           nchars++;
 931         }
 932     }
 933
 934   if (changed)                  /* don't bother if nothing substituted */
 935     tem = make_string_from_bytes (buf, nchars, bufp - buf);
 936   else
 937     tem = string;
 938   xfree (buf);
 939   RETURN_UNGCPRO (tem);
 940 }
 941 \f
 942 void
 943 syms_of_doc (void)
 944 {
 945   Qfunction_documentation = intern_c_string ("function-documentation");
 946   staticpro (&Qfunction_documentation);
 947
 948   DEFVAR_LISP ("internal-doc-file-name", Vdoc_file_name,
 949                doc: /* Name of file containing documentation strings of built-in symbols.  */);
 950   Vdoc_file_name = Qnil;
 951
 952   DEFVAR_LISP ("build-files", Vbuild_files,
 953                doc: /* A list of files used to build this Emacs binary.  */);
 954   Vbuild_files = Qnil;
 955
 956   defsubr (&Sdocumentation);
 957   defsubr (&Sdocumentation_property);
 958   defsubr (&Ssnarf_documentation);
 959   defsubr (&Ssubstitute_command_keys);
 960 }