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