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