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