src/doc.c

   1 /* Record indices of function doc strings stored in a file.
   2    Copyright (C) 1985, 1986, 1993, 1994, 1995, 1997, 1998, 1999, 2000, 2001,
   3                  2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
   4                  Free Software Foundation, Inc.
   5
   6 This file is part of GNU Emacs.
   7
   8 GNU Emacs is free software: you can redistribute it and/or modify
   9 it under the terms of the GNU General Public License as published by
  10 the Free Software Foundation, either version 3 of the License, or
  11 (at your option) any later version.
  12
  13 GNU Emacs is distributed in the hope that it will be useful,
  14 but WITHOUT ANY WARRANTY; without even the implied warranty of
  15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16 GNU General Public License for more details.
  17
  18 You should have received a copy of the GNU General Public License
  19 along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
  20
  21
  22 #include <config.h>
  23
  24 #include <sys/types.h>
  25 #include <sys/file.h>   /* Must be after sys/types.h for USG*/
  26 #include <ctype.h>
  27 #include <setjmp.h>
  28
  29 #ifdef HAVE_FCNTL_H
  30 #include <fcntl.h>
  31 #endif
  32
  33 #ifdef HAVE_UNISTD_H
  34 #include <unistd.h>
  35 #endif
  36
  37 #ifndef O_RDONLY
  38 #define O_RDONLY 0
  39 #endif
  40
  41 #include "lisp.h"
  42 #include "buffer.h"
  43 #include "keyboard.h"
  44 #include "character.h"
  45 #include "keymap.h"
  46 #include "buildobj.h"
  47
  48 Lisp_Object Vdoc_file_name;
  49
  50 Lisp_Object Qfunction_documentation;
  51
  52 /* A list of files used to build this Emacs binary.  */
  53 static Lisp_Object Vbuild_files;
  54
  55 extern Lisp_Object Qclosure;
  56 /* Buffer used for reading from documentation file.  */
  57 static char *get_doc_string_buffer;
  58 static int get_doc_string_buffer_size;
  59
  60 static unsigned char *read_bytecode_pointer;
  61 Lisp_Object Fsnarf_documentation (Lisp_Object);
  62
  63 /* readchar in lread.c calls back here to fetch the next byte.
  64    If UNREADFLAG is 1, we unread a byte.  */
  65
  66 int
  67 read_bytecode_char (int unreadflag)
  68 {
  69   if (unreadflag)
  70     {
  71       read_bytecode_pointer--;
  72       return 0;
  73     }
  74   return *read_bytecode_pointer++;
  75 }
  76
  77 /* Extract a doc string from a file.  FILEPOS says where to get it.
  78    If it is an integer, use that position in the standard DOC-... file.
  79    If it is (FILE . INTEGER), use FILE as the file name
  80    and INTEGER as the position in that file.
  81    But if INTEGER is negative, make it positive.
  82    (A negative integer is used for user variables, so we can distinguish
  83    them without actually fetching the doc string.)
  84
  85    If the location does not point to the beginning of a docstring
  86    (e.g. because the file has been modified and the location is stale),
  87    return nil.
  88
  89    If UNIBYTE is nonzero, always make a unibyte string.
  90
  91    If DEFINITION is nonzero, assume this is for reading
  92    a dynamic function definition; convert the bytestring
  93    and the constants vector with appropriate byte handling,
  94    and return a cons cell.  */
  95
  96 Lisp_Object
  97 get_doc_string (Lisp_Object filepos, int unibyte, int definition)
  98 {
  99   char *from, *to;
 100   register int fd;
 101   register char *name;
 102   register char *p, *p1;
 103   int minsize;
 104   int offset, position;
 105   Lisp_Object file, tem;
 106
 107   if (INTEGERP (filepos))
 108     {
 109       file = Vdoc_file_name;
 110       position = XINT (filepos);
 111     }
 112   else if (CONSP (filepos))
 113     {
 114       file = XCAR (filepos);
 115       position = XINT (XCDR (filepos));
 116     }
 117   else
 118     return Qnil;
 119
 120   if (position < 0)
 121     position = - position;
 122
 123   if (!STRINGP (Vdoc_directory))
 124     return Qnil;
 125
 126   if (!STRINGP (file))
 127     return Qnil;
 128
 129   /* Put the file name in NAME as a C string.
 130      If it is relative, combine it with Vdoc_directory.  */
 131
 132   tem = Ffile_name_absolute_p (file);
 133   if (NILP (tem))
 134     {
 135       minsize = SCHARS (Vdoc_directory);
 136       /* sizeof ("../etc/") == 8 */
 137       if (minsize < 8)
 138         minsize = 8;
 139       name = (char *) alloca (minsize + SCHARS (file) + 8);
 140       strcpy (name, SDATA (Vdoc_directory));
 141       strcat (name, SDATA (file));
 142     }
 143   else
 144     {
 145       name = (char *) SDATA (file);
 146     }
 147
 148   fd = emacs_open (name, O_RDONLY, 0);
 149   if (fd < 0)
 150     {
 151 #ifndef CANNOT_DUMP
 152       if (!NILP (Vpurify_flag))
 153         {
 154           /* Preparing to dump; DOC file is probably not installed.
 155              So check in ../etc. */
 156           strcpy (name, "../etc/");
 157           strcat (name, SDATA (file));
 158
 159           fd = emacs_open (name, O_RDONLY, 0);
 160         }
 161 #endif
 162       if (fd < 0)
 163         error ("Cannot open doc string file \"%s\"", name);
 164     }
 165
 166   /* Seek only to beginning of disk block.  */
 167   /* Make sure we read at least 1024 bytes before `position'
 168      so we can check the leading text for consistency.  */
 169   offset = min (position, max (1024, position % (8 * 1024)));
 170   if (0 > lseek (fd, position - offset, 0))
 171     {
 172       emacs_close (fd);
 173       error ("Position %ld out of range in doc string file \"%s\"",
 174              position, name);
 175     }
 176
 177   /* Read the doc string into get_doc_string_buffer.
 178      P points beyond the data just read.  */
 179
 180   p = get_doc_string_buffer;
 181   while (1)
 182     {
 183       int space_left = (get_doc_string_buffer_size
 184                         - (p - get_doc_string_buffer));
 185       int nread;
 186
 187       /* Allocate or grow the buffer if we need to.  */
 188       if (space_left == 0)
 189         {
 190           int in_buffer = p - get_doc_string_buffer;
 191           get_doc_string_buffer_size += 16 * 1024;
 192           get_doc_string_buffer
 193             = (char *) xrealloc (get_doc_string_buffer,
 194                                  get_doc_string_buffer_size + 1);
 195           p = get_doc_string_buffer + in_buffer;
 196           space_left = (get_doc_string_buffer_size
 197                         - (p - get_doc_string_buffer));
 198         }
 199
 200       /* Read a disk block at a time.
 201          If we read the same block last time, maybe skip this?  */
 202       if (space_left > 1024 * 8)
 203         space_left = 1024 * 8;
 204       nread = emacs_read (fd, p, space_left);
 205       if (nread < 0)
 206         {
 207           emacs_close (fd);
 208           error ("Read error on documentation file");
 209         }
 210       p[nread] = 0;
 211       if (!nread)
 212         break;
 213       if (p == get_doc_string_buffer)
 214         p1 = strchr (p + offset, '\037');
 215       else
 216         p1 = strchr (p, '\037');
 217       if (p1)
 218         {
 219           *p1 = 0;
 220           p = p1;
 221           break;
 222         }
 223       p += nread;
 224     }
 225   emacs_close (fd);
 226
 227   /* Sanity checking.  */
 228   if (CONSP (filepos))
 229     {
 230       int test = 1;
 231       if (get_doc_string_buffer[offset - test++] != ' ')
 232         return Qnil;
 233       while (get_doc_string_buffer[offset - test] >= '0'
 234              && get_doc_string_buffer[offset - test] <= '9')
 235         test++;
 236       if (get_doc_string_buffer[offset - test++] != '@'
 237           || get_doc_string_buffer[offset - test] != '#')
 238         return Qnil;
 239     }
 240   else
 241     {
 242       int test = 1;
 243       if (get_doc_string_buffer[offset - test++] != '\n')
 244         return Qnil;
 245       while (get_doc_string_buffer[offset - test] > ' ')
 246         test++;
 247       if (get_doc_string_buffer[offset - test] != '\037')
 248         return Qnil;
 249     }
 250
 251   /* Scan the text and perform quoting with ^A (char code 1).
 252      ^A^A becomes ^A, ^A0 becomes a null char, and ^A_ becomes a ^_.  */
 253   from = get_doc_string_buffer + offset;
 254   to = get_doc_string_buffer + offset;
 255   while (from != p)
 256     {
 257       if (*from == 1)
 258         {
 259           int c;
 260
 261           from++;
 262           c = *from++;
 263           if (c == 1)
 264             *to++ = c;
 265           else if (c == '0')
 266             *to++ = 0;
 267           else if (c == '_')
 268             *to++ = 037;
 269           else
 270             error ("Invalid data in documentation file -- ^A followed by code 0%o", c);
 271         }
 272       else
 273         *to++ = *from++;
 274     }
 275
 276   /* If DEFINITION, read from this buffer
 277      the same way we would read bytes from a file.  */
 278   if (definition)
 279     {
 280       read_bytecode_pointer = get_doc_string_buffer + offset;
 281       return Fread (Qlambda);
 282     }
 283
 284   if (unibyte)
 285     return make_unibyte_string (get_doc_string_buffer + offset,
 286                                 to - (get_doc_string_buffer + offset));
 287   else
 288     {
 289       /* The data determines whether the string is multibyte.  */
 290       int nchars = multibyte_chars_in_text (get_doc_string_buffer + offset,
 291                                             to - (get_doc_string_buffer + offset));
 292       return make_string_from_bytes (get_doc_string_buffer + offset,
 293                                      nchars,
 294                                      to - (get_doc_string_buffer + offset));
 295     }
 296 }
 297
 298 /* Get a string from position FILEPOS and pass it through the Lisp reader.
 299    We use this for fetching the bytecode string and constants vector
 300    of a compiled function from the .elc file.  */
 301
 302 Lisp_Object
 303 read_doc_string (Lisp_Object filepos)
 304 {
 305   return get_doc_string (filepos, 0, 1);
 306 }
 307
 308 static int
 309 reread_doc_file (Lisp_Object file)
 310 {
 311 #if 0
 312   Lisp_Object reply, prompt[3];
 313   struct gcpro gcpro1;
 314   GCPRO1 (file);
 315   prompt[0] = build_string ("File ");
 316   prompt[1] = NILP (file) ? Vdoc_file_name : file;
 317   prompt[2] = build_string (" is out of sync.  Reload? ");
 318   reply = Fy_or_n_p (Fconcat (3, prompt));
 319   UNGCPRO;
 320   if (NILP (reply))
 321     return 0;
 322 #endif
 323
 324   if (NILP (file))
 325     Fsnarf_documentation (Vdoc_file_name);
 326   else
 327     Fload (file, Qt, Qt, Qt, Qnil);
 328
 329   return 1;
 330 }
 331
 332 DEFUN ("documentation", Fdocumentation, Sdocumentation, 1, 2, 0,
 333        doc: /* Return the documentation string of FUNCTION.
 334 Unless a non-nil second argument RAW is given, the
 335 string is passed through `substitute-command-keys'.  */)
 336   (Lisp_Object function, Lisp_Object raw)
 337 {
 338   Lisp_Object fun;
 339   Lisp_Object funcar;
 340   Lisp_Object tem, doc;
 341   int try_reload = 1;
 342
 343  documentation:
 344
 345   doc = Qnil;
 346
 347   if (SYMBOLP (function)
 348       && (tem = Fget (function, Qfunction_documentation),
 349           !NILP (tem)))
 350     return Fdocumentation_property (function, Qfunction_documentation, raw);
 351
 352   fun = Findirect_function (function, Qnil);
 353   if (SUBRP (fun))
 354     {
 355       if (XSUBR (fun)->doc == 0)
 356         return Qnil;
 357       else if ((EMACS_INT) XSUBR (fun)->doc >= 0)
 358         doc = build_string (XSUBR (fun)->doc);
 359       else
 360         doc = make_number ((EMACS_INT) XSUBR (fun)->doc);
 361     }
 362   else if (COMPILEDP (fun))
 363     {
 364       if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) <= COMPILED_DOC_STRING)
 365         return Qnil;
 366       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   else if (FUNVECP (fun))
 375     {
 376       /* Unless otherwise handled, funvecs have no documentation.  */
 377       return Qnil;
 378     }
 379   else if (STRINGP (fun) || VECTORP (fun))
 380     {
 381       return build_string ("Keyboard macro.");
 382     }
 383   else if (CONSP (fun))
 384     {
 385       funcar = Fcar (fun);
 386       if (!SYMBOLP (funcar))
 387         xsignal1 (Qinvalid_function, fun);
 388       else if (EQ (funcar, Qkeymap))
 389         return build_string ("Prefix command (definition is a keymap associating keystrokes with commands).");
 390       else if (EQ (funcar, Qlambda)
 391                || EQ (funcar, Qautoload))
 392         {
 393           Lisp_Object tem1;
 394           tem1 = Fcdr (Fcdr (fun));
 395           tem = Fcar (tem1);
 396           if (STRINGP (tem))
 397             doc = tem;
 398           /* Handle a doc reference--but these never come last
 399              in the function body, so reject them if they are last.  */
 400           else if ((NATNUMP (tem) || (CONSP (tem) && INTEGERP (XCDR (tem))))
 401                    && !NILP (XCDR (tem1)))
 402             doc = tem;
 403           else
 404             return Qnil;
 405         }
 406       else if (EQ (funcar, Qclosure))
 407         return Fdocumentation (Fcdr (XCDR (fun)), raw);
 408       else if (EQ (funcar, Qmacro))
 409         return Fdocumentation (Fcdr (fun), raw);
 410       else
 411         goto oops;
 412     }
 413   else
 414     {
 415     oops:
 416       xsignal1 (Qinvalid_function, fun);
 417     }
 418
 419   /* Check for an advised function.  Its doc string
 420      has an `ad-advice-info' text property.  */
 421   if (STRINGP (doc))
 422     {
 423       Lisp_Object innerfunc;
 424       innerfunc = Fget_text_property (make_number (0),
 425                                       intern ("ad-advice-info"),
 426                                       doc);
 427       if (! NILP (innerfunc))
 428         doc = call1 (intern ("ad-make-advised-docstring"), innerfunc);
 429     }
 430
 431   /* If DOC is 0, it's typically because of a dumped file missing
 432      from the DOC file (bug in src/Makefile.in).  */
 433   if (EQ (doc, make_number (0)))
 434     doc = Qnil;
 435   if (INTEGERP (doc) || CONSP (doc))
 436     {
 437       Lisp_Object tem;
 438       tem = get_doc_string (doc, 0, 0);
 439       if (NILP (tem) && try_reload)
 440         {
 441           /* The file is newer, we need to reset the pointers.  */
 442           struct gcpro gcpro1, gcpro2;
 443           GCPRO2 (function, raw);
 444           try_reload = reread_doc_file (Fcar_safe (doc));
 445           UNGCPRO;
 446           if (try_reload)
 447             {
 448               try_reload = 0;
 449               goto documentation;
 450             }
 451         }
 452       else
 453         doc = tem;
 454     }
 455
 456   if (NILP (raw))
 457     doc = Fsubstitute_command_keys (doc);
 458   return doc;
 459 }
 460
 461 DEFUN ("documentation-property", Fdocumentation_property,
 462        Sdocumentation_property, 2, 3, 0,
 463        doc: /* Return the documentation string that is SYMBOL's PROP property.
 464 Third argument RAW omitted or nil means pass the result through
 465 `substitute-command-keys' if it is a string.
 466
 467 This differs from `get' in that it can refer to strings stored in the
 468 `etc/DOC' file; and that it evaluates documentation properties that
 469 aren't strings.  */)
 470   (Lisp_Object symbol, Lisp_Object prop, Lisp_Object raw)
 471 {
 472   int try_reload = 1;
 473   Lisp_Object tem;
 474
 475  documentation_property:
 476
 477   tem = Fget (symbol, prop);
 478   if (EQ (tem, make_number (0)))
 479     tem = Qnil;
 480   if (INTEGERP (tem) || (CONSP (tem) && INTEGERP (XCDR (tem))))
 481     {
 482       Lisp_Object doc = tem;
 483       tem = get_doc_string (tem, 0, 0);
 484       if (NILP (tem) && try_reload)
 485         {
 486           /* The file is newer, we need to reset the pointers.  */
 487           struct gcpro gcpro1, gcpro2, gcpro3;
 488           GCPRO3 (symbol, prop, raw);
 489           try_reload = reread_doc_file (Fcar_safe (doc));
 490           UNGCPRO;
 491           if (try_reload)
 492             {
 493               try_reload = 0;
 494               goto documentation_property;
 495             }
 496         }
 497     }
 498   else if (!STRINGP (tem))
 499     /* Feval protects its argument.  */
 500     tem = Feval (tem);
 501
 502   if (NILP (raw) && STRINGP (tem))
 503     tem = Fsubstitute_command_keys (tem);
 504   return tem;
 505 }
 506 \f
 507 /* Scanning the DOC files and placing docstring offsets into functions.  */
 508
 509 static void
 510 store_function_docstring (Lisp_Object fun, EMACS_INT offset)
 511 /* Use EMACS_INT because we get offset from pointer subtraction.  */
 512 {
 513   fun = indirect_function (fun);
 514
 515   /* The type determines where the docstring is stored.  */
 516
 517   /* Lisp_Subrs have a slot for it.  */
 518   if (SUBRP (fun))
 519     XSUBR (fun)->doc = (char *) - offset;
 520
 521   /* If it's a lisp form, stick it in the form.  */
 522   else if (CONSP (fun))
 523     {
 524       Lisp_Object tem;
 525
 526       tem = XCAR (fun);
 527       if (EQ (tem, Qlambda) || EQ (tem, Qautoload))
 528         {
 529           tem = Fcdr (Fcdr (fun));
 530           if (CONSP (tem) && INTEGERP (XCAR (tem)))
 531             XSETCAR (tem, make_number (offset));
 532         }
 533       else if (EQ (tem, Qmacro))
 534         store_function_docstring (XCDR (fun), offset);
 535       else if (EQ (tem, Qclosure))
 536         store_function_docstring (Fcdr (XCDR (fun)), offset);
 537     }
 538
 539   /* Bytecode objects sometimes have slots for it.  */
 540   else if (COMPILEDP (fun))
 541     {
 542       /* This bytecode object must have a slot for the
 543          docstring, since we've found a docstring for it.  */
 544       if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) > COMPILED_DOC_STRING)
 545         ASET (fun, COMPILED_DOC_STRING, make_number (offset));
 546     }
 547 }
 548
 549 static const char buildobj[] = BUILDOBJ;
 550
 551 DEFUN ("Snarf-documentation", Fsnarf_documentation, Ssnarf_documentation,
 552        1, 1, 0,
 553        doc: /* Used during Emacs initialization to scan the `etc/DOC...' file.
 554 This searches the `etc/DOC...' file for doc strings and
 555 records them in function and variable definitions.
 556 The function takes one argument, FILENAME, a string;
 557 it specifies the file name (without a directory) of the DOC file.
 558 That file is found in `../etc' now; later, when the dumped Emacs is run,
 559 the same file name is found in the `doc-directory'.  */)
 560   (Lisp_Object filename)
 561 {
 562   int fd;
 563   char buf[1024 + 1];
 564   register int filled;
 565   register int pos;
 566   register char *p, *end;
 567   Lisp_Object sym;
 568   char *name;
 569   int skip_file = 0;
 570
 571   CHECK_STRING (filename);
 572
 573   if
 574 #ifndef CANNOT_DUMP
 575     (!NILP (Vpurify_flag))
 576 #else /* CANNOT_DUMP */
 577       (0)
 578 #endif /* CANNOT_DUMP */
 579     {
 580       name = (char *) alloca (SCHARS (filename) + 14);
 581       strcpy (name, "../etc/");
 582     }
 583   else
 584     {
 585       CHECK_STRING (Vdoc_directory);
 586       name = (char *) alloca (SCHARS (filename)
 587                           + SCHARS (Vdoc_directory) + 1);
 588       strcpy (name, SDATA (Vdoc_directory));
 589     }
 590   strcat (name, SDATA (filename));      /*** Add this line ***/
 591
 592   /* Vbuild_files is nil when temacs is run, and non-nil after that.  */
 593   if (NILP (Vbuild_files))
 594   {
 595     const char *beg, *end;
 596
 597     for (beg = buildobj; *beg; beg = end)
 598       {
 599         int len;
 600
 601         while (*beg && isspace (*beg)) ++beg;
 602
 603         for (end = beg; *end && ! isspace (*end); ++end)
 604           if (*end == '/') beg = end+1;  /* skip directory part  */
 605
 606         len = end - beg;
 607         if (len > 4 && end[-4] == '.' && end[-3] == 'o')
 608           len -= 2;  /* Just take .o if it ends in .obj  */
 609
 610         if (len > 0)
 611           Vbuild_files = Fcons (make_string (beg, len), Vbuild_files);
 612       }
 613     Vbuild_files = Fpurecopy (Vbuild_files);
 614   }
 615
 616   fd = emacs_open (name, O_RDONLY, 0);
 617   if (fd < 0)
 618     report_file_error ("Opening doc string file",
 619                        Fcons (build_string (name), Qnil));
 620   Vdoc_file_name = filename;
 621   filled = 0;
 622   pos = 0;
 623   while (1)
 624     {
 625       if (filled < 512)
 626         filled += emacs_read (fd, &buf[filled], sizeof buf - 1 - filled);
 627       if (!filled)
 628         break;
 629
 630       buf[filled] = 0;
 631       p = buf;
 632       end = buf + (filled < 512 ? filled : filled - 128);
 633       while (p != end && *p != '\037') p++;
 634       /* p points to ^_Ffunctionname\n or ^_Vvarname\n or ^_Sfilename\n.  */
 635       if (p != end)
 636         {
 637           end = strchr (p, '\n');
 638
 639           /* See if this is a file name, and if it is a file in build-files.  */
 640           if (p[1] == 'S')
 641             {
 642               skip_file = 0;
 643               if (end - p > 4 && end[-2] == '.'
 644                   && (end[-1] == 'o' || end[-1] == 'c'))
 645                 {
 646                   int len = end - p - 2;
 647                   char *fromfile = alloca (len + 1);
 648                   strncpy (fromfile, &p[2], len);
 649                   fromfile[len] = 0;
 650                   if (fromfile[len-1] == 'c')
 651                     fromfile[len-1] = 'o';
 652
 653                   skip_file = NILP (Fmember (build_string (fromfile),
 654                                              Vbuild_files));
 655                 }
 656             }
 657
 658           sym = oblookup (Vobarray, p + 2,
 659                           multibyte_chars_in_text (p + 2, end - p - 2),
 660                           end - p - 2);
 661           /* Check skip_file so that when a function is defined several
 662              times in different files (typically, once in xterm, once in
 663              w32term, ...), we only pay attention to the one that
 664              matters.  */
 665           if (! skip_file && SYMBOLP (sym))
 666             {
 667               /* Attach a docstring to a variable?  */
 668               if (p[1] == 'V')
 669                 {
 670                   /* Install file-position as variable-documentation property
 671                      and make it negative for a user-variable
 672                      (doc starts with a `*').  */
 673                   Fput (sym, Qvariable_documentation,
 674                         make_number ((pos + end + 1 - buf)
 675                                      * (end[1] == '*' ? -1 : 1)));
 676                 }
 677
 678               /* Attach a docstring to a function?  */
 679               else if (p[1] == 'F')
 680                 store_function_docstring (sym, pos + end + 1 - buf);
 681
 682               else if (p[1] == 'S')
 683                 ; /* Just a source file name boundary marker.  Ignore it.  */
 684
 685               else
 686                 error ("DOC file invalid at position %d", pos);
 687             }
 688         }
 689       pos += end - buf;
 690       filled -= end - buf;
 691       memcpy (buf, end, filled);
 692     }
 693   emacs_close (fd);
 694   return Qnil;
 695 }
 696 \f
 697 DEFUN ("substitute-command-keys", Fsubstitute_command_keys,
 698        Ssubstitute_command_keys, 1, 1, 0,
 699        doc: /* Substitute key descriptions for command names in STRING.
 700 Substrings of the form \\=\\[COMMAND] replaced by either: a keystroke
 701 sequence that will invoke COMMAND, or "M-x COMMAND" if COMMAND is not
 702 on any keys.
 703 Substrings of the form \\=\\{MAPVAR} are replaced by summaries
 704 \(made by `describe-bindings') of the value of MAPVAR, taken as a keymap.
 705 Substrings of the form \\=\\<MAPVAR> specify to use the value of MAPVAR
 706 as the keymap for future \\=\\[COMMAND] substrings.
 707 \\=\\= quotes the following character and is discarded;
 708 thus, \\=\\=\\=\\= puts \\=\\= into the output, and \\=\\=\\=\\[ puts \\=\\[ into the output.
 709
 710 Returns original STRING if no substitutions were made.  Otherwise,
 711 a new string, without any text properties, is returned.  */)
 712   (Lisp_Object string)
 713 {
 714   unsigned char *buf;
 715   int changed = 0;
 716   register unsigned char *strp;
 717   register unsigned char *bufp;
 718   int idx;
 719   int bsize;
 720   Lisp_Object tem;
 721   Lisp_Object keymap;
 722   unsigned char *start;
 723   int length, length_byte;
 724   Lisp_Object name;
 725   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
 726   int multibyte;
 727   int nchars;
 728
 729   if (NILP (string))
 730     return Qnil;
 731
 732   CHECK_STRING (string);
 733   tem = Qnil;
 734   keymap = Qnil;
 735   name = Qnil;
 736   GCPRO4 (string, tem, keymap, name);
 737
 738   multibyte = STRING_MULTIBYTE (string);
 739   nchars = 0;
 740
 741   /* KEYMAP is either nil (which means search all the active keymaps)
 742      or a specified local map (which means search just that and the
 743      global map).  If non-nil, it might come from Voverriding_local_map,
 744      or from a \\<mapname> construct in STRING itself..  */
 745   keymap = current_kboard->Voverriding_terminal_local_map;
 746   if (NILP (keymap))
 747     keymap = Voverriding_local_map;
 748
 749   bsize = SBYTES (string);
 750   bufp = buf = (unsigned char *) xmalloc (bsize);
 751
 752   strp = SDATA (string);
 753   while (strp < SDATA (string) + SBYTES (string))
 754     {
 755       if (strp[0] == '\\' && strp[1] == '=')
 756         {
 757           /* \= quotes the next character;
 758              thus, to put in \[ without its special meaning, use \=\[.  */
 759           changed = 1;
 760           strp += 2;
 761           if (multibyte)
 762             {
 763               int len;
 764
 765               STRING_CHAR_AND_LENGTH (strp, len);
 766               if (len == 1)
 767                 *bufp = *strp;
 768               else
 769                 memcpy (bufp, strp, len);
 770               strp += len;
 771               bufp += len;
 772               nchars++;
 773             }
 774           else
 775             *bufp++ = *strp++, nchars++;
 776         }
 777       else if (strp[0] == '\\' && strp[1] == '[')
 778         {
 779           int start_idx;
 780           int follow_remap = 1;
 781
 782           changed = 1;
 783           strp += 2;            /* skip \[ */
 784           start = strp;
 785           start_idx = start - SDATA (string);
 786
 787           while ((strp - SDATA (string)
 788                   < SBYTES (string))
 789                  && *strp != ']')
 790             strp++;
 791           length_byte = strp - start;
 792
 793           strp++;               /* skip ] */
 794
 795           /* Save STRP in IDX.  */
 796           idx = strp - SDATA (string);
 797           name = Fintern (make_string (start, length_byte), Qnil);
 798
 799         do_remap:
 800           tem = Fwhere_is_internal (name, keymap, Qt, Qnil, Qnil);
 801
 802           if (VECTORP (tem) && XVECTOR (tem)->size > 1
 803               && EQ (AREF (tem, 0), Qremap) && SYMBOLP (AREF (tem, 1))
 804               && follow_remap)
 805             {
 806               name = AREF (tem, 1);
 807               follow_remap = 0;
 808               goto do_remap;
 809             }
 810
 811           /* Note the Fwhere_is_internal can GC, so we have to take
 812              relocation of string contents into account.  */
 813           strp = SDATA (string) + idx;
 814           start = SDATA (string) + start_idx;
 815
 816           if (NILP (tem))       /* but not on any keys */
 817             {
 818               int offset = bufp - buf;
 819               buf = (unsigned char *) xrealloc (buf, bsize += 4);
 820               bufp = buf + offset;
 821               memcpy (bufp, "M-x ", 4);
 822               bufp += 4;
 823               nchars += 4;
 824               if (multibyte)
 825                 length = multibyte_chars_in_text (start, length_byte);
 826               else
 827                 length = length_byte;
 828               goto subst;
 829             }
 830           else
 831             {                   /* function is on a key */
 832               tem = Fkey_description (tem, Qnil);
 833               goto subst_string;
 834             }
 835         }
 836       /* \{foo} is replaced with a summary of the keymap (symbol-value foo).
 837          \<foo> just sets the keymap used for \[cmd].  */
 838       else if (strp[0] == '\\' && (strp[1] == '{' || strp[1] == '<'))
 839         {
 840           struct buffer *oldbuf;
 841           int start_idx;
 842           /* This is for computing the SHADOWS arg for describe_map_tree.  */
 843           Lisp_Object active_maps = Fcurrent_active_maps (Qnil, Qnil);
 844           Lisp_Object earlier_maps;
 845
 846           changed = 1;
 847           strp += 2;            /* skip \{ or \< */
 848           start = strp;
 849           start_idx = start - SDATA (string);
 850
 851           while ((strp - SDATA (string) < SBYTES (string))
 852                  && *strp != '}' && *strp != '>')
 853             strp++;
 854
 855           length_byte = strp - start;
 856           strp++;                       /* skip } or > */
 857
 858           /* Save STRP in IDX.  */
 859           idx = strp - SDATA (string);
 860
 861           /* Get the value of the keymap in TEM, or nil if undefined.
 862              Do this while still in the user's current buffer
 863              in case it is a local variable.  */
 864           name = Fintern (make_string (start, length_byte), Qnil);
 865           tem = Fboundp (name);
 866           if (! NILP (tem))
 867             {
 868               tem = Fsymbol_value (name);
 869               if (! NILP (tem))
 870                 {
 871                   tem = get_keymap (tem, 0, 1);
 872                   /* Note that get_keymap can GC.  */
 873                   strp = SDATA (string) + idx;
 874                   start = SDATA (string) + start_idx;
 875                 }
 876             }
 877
 878           /* Now switch to a temp buffer.  */
 879           oldbuf = current_buffer;
 880           set_buffer_internal (XBUFFER (Vprin1_to_string_buffer));
 881
 882           if (NILP (tem))
 883             {
 884               name = Fsymbol_name (name);
 885               insert_string ("\nUses keymap \"");
 886               insert_from_string (name, 0, 0,
 887                                   SCHARS (name),
 888                                   SBYTES (name), 1);
 889               insert_string ("\", which is not currently defined.\n");
 890               if (start[-1] == '<') keymap = Qnil;
 891             }
 892           else if (start[-1] == '<')
 893             keymap = tem;
 894           else
 895             {
 896               /* Get the list of active keymaps that precede this one.
 897                  If this one's not active, get nil.  */
 898               earlier_maps = Fcdr (Fmemq (tem, Freverse (active_maps)));
 899               describe_map_tree (tem, 1, Fnreverse (earlier_maps),
 900                                  Qnil, (char *)0, 1, 0, 0, 1);
 901             }
 902           tem = Fbuffer_string ();
 903           Ferase_buffer ();
 904           set_buffer_internal (oldbuf);
 905
 906         subst_string:
 907           start = SDATA (tem);
 908           length = SCHARS (tem);
 909           length_byte = SBYTES (tem);
 910         subst:
 911           {
 912             int offset = bufp - buf;
 913             buf = (unsigned char *) xrealloc (buf, bsize += length_byte);
 914             bufp = buf + offset;
 915             memcpy (bufp, start, length_byte);
 916             bufp += length_byte;
 917             nchars += length;
 918             /* Check STRING again in case gc relocated it.  */
 919             strp = (unsigned char *) SDATA (string) + idx;
 920           }
 921         }
 922       else if (! multibyte)             /* just copy other chars */
 923         *bufp++ = *strp++, nchars++;
 924       else
 925         {
 926           int len;
 927
 928           STRING_CHAR_AND_LENGTH (strp, len);
 929           if (len == 1)
 930             *bufp = *strp;
 931           else
 932             memcpy (bufp, strp, len);
 933           strp += len;
 934           bufp += len;
 935           nchars++;
 936         }
 937     }
 938
 939   if (changed)                  /* don't bother if nothing substituted */
 940     tem = make_string_from_bytes (buf, nchars, bufp - buf);
 941   else
 942     tem = string;
 943   xfree (buf);
 944   RETURN_UNGCPRO (tem);
 945 }
 946 \f
 947 void
 948 syms_of_doc (void)
 949 {
 950   Qfunction_documentation = intern_c_string ("function-documentation");
 951   staticpro (&Qfunction_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 }
 966
 967 /* arch-tag: 56281d4d-6949-43e2-be2e-f6517de744ba
 968    (do not change this comment) */