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       /* Let the data determine whether the string is multibyte,
 290          even if Emacs is running in --unibyte mode.  */
 291       int nchars = multibyte_chars_in_text (get_doc_string_buffer + offset,
 292                                             to - (get_doc_string_buffer + offset));
 293       return make_string_from_bytes (get_doc_string_buffer + offset,
 294                                      nchars,
 295                                      to - (get_doc_string_buffer + offset));
 296     }
 297 }
 298
 299 /* Get a string from position FILEPOS and pass it through the Lisp reader.
 300    We use this for fetching the bytecode string and constants vector
 301    of a compiled function from the .elc file.  */
 302
 303 Lisp_Object
 304 read_doc_string (Lisp_Object filepos)
 305 {
 306   return get_doc_string (filepos, 0, 1);
 307 }
 308
 309 static int
 310 reread_doc_file (Lisp_Object file)
 311 {
 312 #if 0
 313   Lisp_Object reply, prompt[3];
 314   struct gcpro gcpro1;
 315   GCPRO1 (file);
 316   prompt[0] = build_string ("File ");
 317   prompt[1] = NILP (file) ? Vdoc_file_name : file;
 318   prompt[2] = build_string (" is out of sync.  Reload? ");
 319   reply = Fy_or_n_p (Fconcat (3, prompt));
 320   UNGCPRO;
 321   if (NILP (reply))
 322     return 0;
 323 #endif
 324
 325   if (NILP (file))
 326     Fsnarf_documentation (Vdoc_file_name);
 327   else
 328     Fload (file, Qt, Qt, Qt, Qnil);
 329
 330   return 1;
 331 }
 332
 333 DEFUN ("documentation", Fdocumentation, Sdocumentation, 1, 2, 0,
 334        doc: /* Return the documentation string of FUNCTION.
 335 Unless a non-nil second argument RAW is given, the
 336 string is passed through `substitute-command-keys'.  */)
 337   (Lisp_Object function, Lisp_Object raw)
 338 {
 339   Lisp_Object fun;
 340   Lisp_Object funcar;
 341   Lisp_Object tem, doc;
 342   int try_reload = 1;
 343
 344  documentation:
 345
 346   doc = Qnil;
 347
 348   if (SYMBOLP (function)
 349       && (tem = Fget (function, Qfunction_documentation),
 350           !NILP (tem)))
 351     return Fdocumentation_property (function, Qfunction_documentation, raw);
 352
 353   fun = Findirect_function (function, Qnil);
 354   if (SUBRP (fun))
 355     {
 356       if (XSUBR (fun)->doc == 0)
 357         return Qnil;
 358       else if ((EMACS_INT) XSUBR (fun)->doc >= 0)
 359         doc = build_string (XSUBR (fun)->doc);
 360       else
 361         doc = make_number ((EMACS_INT) XSUBR (fun)->doc);
 362     }
 363   else if (COMPILEDP (fun))
 364     {
 365       if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) <= COMPILED_DOC_STRING)
 366         return Qnil;
 367       tem = AREF (fun, COMPILED_DOC_STRING);
 368       if (STRINGP (tem))
 369         doc = tem;
 370       else if (NATNUMP (tem) || CONSP (tem))
 371         doc = tem;
 372       else
 373         return Qnil;
 374     }
 375   else if (FUNVECP (fun))
 376     {
 377       /* Unless otherwise handled, funvecs have no documentation.  */
 378       return Qnil;
 379     }
 380   else if (STRINGP (fun) || VECTORP (fun))
 381     {
 382       return build_string ("Keyboard macro.");
 383     }
 384   else if (CONSP (fun))
 385     {
 386       funcar = Fcar (fun);
 387       if (!SYMBOLP (funcar))
 388         xsignal1 (Qinvalid_function, fun);
 389       else if (EQ (funcar, Qkeymap))
 390         return build_string ("Prefix command (definition is a keymap associating keystrokes with commands).");
 391       else if (EQ (funcar, Qlambda)
 392                || EQ (funcar, Qautoload))
 393         {
 394           Lisp_Object tem1;
 395           tem1 = Fcdr (Fcdr (fun));
 396           tem = Fcar (tem1);
 397           if (STRINGP (tem))
 398             doc = tem;
 399           /* Handle a doc reference--but these never come last
 400              in the function body, so reject them if they are last.  */
 401           else if ((NATNUMP (tem) || (CONSP (tem) && INTEGERP (XCDR (tem))))
 402                    && !NILP (XCDR (tem1)))
 403             doc = tem;
 404           else
 405             return Qnil;
 406         }
 407       else if (EQ (funcar, Qclosure))
 408         return Fdocumentation (Fcdr (XCDR (fun)), raw);
 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       else if (EQ (tem, Qclosure))
 537         store_function_docstring (Fcdr (XCDR (fun)), offset);
 538     }
 539
 540   /* Bytecode objects sometimes have slots for it.  */
 541   else if (COMPILEDP (fun))
 542     {
 543       /* This bytecode object must have a slot for the
 544          docstring, since we've found a docstring for it.  */
 545       if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) > COMPILED_DOC_STRING)
 546         ASET (fun, COMPILED_DOC_STRING, make_number (offset));
 547     }
 548 }
 549
 550 static const char buildobj[] = BUILDOBJ;
 551
 552 DEFUN ("Snarf-documentation", Fsnarf_documentation, Ssnarf_documentation,
 553        1, 1, 0,
 554        doc: /* Used during Emacs initialization to scan the `etc/DOC...' file.
 555 This searches the `etc/DOC...' file for doc strings and
 556 records them in function and variable definitions.
 557 The function takes one argument, FILENAME, a string;
 558 it specifies the file name (without a directory) of the DOC file.
 559 That file is found in `../etc' now; later, when the dumped Emacs is run,
 560 the same file name is found in the `doc-directory'.  */)
 561   (Lisp_Object filename)
 562 {
 563   int fd;
 564   char buf[1024 + 1];
 565   register int filled;
 566   register int pos;
 567   register char *p, *end;
 568   Lisp_Object sym;
 569   char *name;
 570   int skip_file = 0;
 571
 572   CHECK_STRING (filename);
 573
 574   if
 575 #ifndef CANNOT_DUMP
 576     (!NILP (Vpurify_flag))
 577 #else /* CANNOT_DUMP */
 578       (0)
 579 #endif /* CANNOT_DUMP */
 580     {
 581       name = (char *) alloca (SCHARS (filename) + 14);
 582       strcpy (name, "../etc/");
 583     }
 584   else
 585     {
 586       CHECK_STRING (Vdoc_directory);
 587       name = (char *) alloca (SCHARS (filename)
 588                           + SCHARS (Vdoc_directory) + 1);
 589       strcpy (name, SDATA (Vdoc_directory));
 590     }
 591   strcat (name, SDATA (filename));      /*** Add this line ***/
 592
 593   /* Vbuild_files is nil when temacs is run, and non-nil after that.  */
 594   if (NILP (Vbuild_files))
 595   {
 596     const char *beg, *end;
 597
 598     for (beg = buildobj; *beg; beg = end)
 599       {
 600         int len;
 601
 602         while (*beg && isspace (*beg)) ++beg;
 603
 604         for (end = beg; *end && ! isspace (*end); ++end)
 605           if (*end == '/') beg = end+1;  /* skip directory part  */
 606
 607         len = end - beg;
 608         if (len > 4 && end[-4] == '.' && end[-3] == 'o')
 609           len -= 2;  /* Just take .o if it ends in .obj  */
 610
 611         if (len > 0)
 612           Vbuild_files = Fcons (make_string (beg, len), Vbuild_files);
 613       }
 614     Vbuild_files = Fpurecopy (Vbuild_files);
 615   }
 616
 617   fd = emacs_open (name, O_RDONLY, 0);
 618   if (fd < 0)
 619     report_file_error ("Opening doc string file",
 620                        Fcons (build_string (name), Qnil));
 621   Vdoc_file_name = filename;
 622   filled = 0;
 623   pos = 0;
 624   while (1)
 625     {
 626       if (filled < 512)
 627         filled += emacs_read (fd, &buf[filled], sizeof buf - 1 - filled);
 628       if (!filled)
 629         break;
 630
 631       buf[filled] = 0;
 632       p = buf;
 633       end = buf + (filled < 512 ? filled : filled - 128);
 634       while (p != end && *p != '\037') p++;
 635       /* p points to ^_Ffunctionname\n or ^_Vvarname\n.  */
 636       if (p != end)
 637         {
 638           end = strchr (p, '\n');
 639
 640           /* See if this is a file name, and if it is a file in build-files.  */
 641           if (p[1] == 'S' && end - p > 4 && end[-2] == '.'
 642               && (end[-1] == 'o' || end[-1] == 'c'))
 643             {
 644               int len = end - p - 2;
 645               char *fromfile = alloca (len + 1);
 646               strncpy (fromfile, &p[2], len);
 647               fromfile[len] = 0;
 648               if (fromfile[len-1] == 'c')
 649                 fromfile[len-1] = 'o';
 650
 651               skip_file = NILP (Fmember (build_string (fromfile),
 652                                          Vbuild_files));
 653             }
 654
 655           sym = oblookup (Vobarray, p + 2,
 656                           multibyte_chars_in_text (p + 2, end - p - 2),
 657                           end - p - 2);
 658           /* Check skip_file so that when a function is defined several
 659              times in different files (typically, once in xterm, once in
 660              w32term, ...), we only pay attention to the one that
 661              matters.  */
 662           if (! skip_file && SYMBOLP (sym))
 663             {
 664               /* Attach a docstring to a variable?  */
 665               if (p[1] == 'V')
 666                 {
 667                   /* Install file-position as variable-documentation property
 668                      and make it negative for a user-variable
 669                      (doc starts with a `*').  */
 670                   Fput (sym, Qvariable_documentation,
 671                         make_number ((pos + end + 1 - buf)
 672                                      * (end[1] == '*' ? -1 : 1)));
 673                 }
 674
 675               /* Attach a docstring to a function?  */
 676               else if (p[1] == 'F')
 677                 store_function_docstring (sym, pos + end + 1 - buf);
 678
 679               else if (p[1] == 'S')
 680                 ; /* Just a source file name boundary marker.  Ignore it.  */
 681
 682               else
 683                 error ("DOC file invalid at position %d", pos);
 684             }
 685         }
 686       pos += end - buf;
 687       filled -= end - buf;
 688       memcpy (buf, end, filled);
 689     }
 690   emacs_close (fd);
 691   return Qnil;
 692 }
 693 \f
 694 DEFUN ("substitute-command-keys", Fsubstitute_command_keys,
 695        Ssubstitute_command_keys, 1, 1, 0,
 696        doc: /* Substitute key descriptions for command names in STRING.
 697 Substrings of the form \\=\\[COMMAND] replaced by either: a keystroke
 698 sequence that will invoke COMMAND, or "M-x COMMAND" if COMMAND is not
 699 on any keys.
 700 Substrings of the form \\=\\{MAPVAR} are replaced by summaries
 701 \(made by `describe-bindings') of the value of MAPVAR, taken as a keymap.
 702 Substrings of the form \\=\\<MAPVAR> specify to use the value of MAPVAR
 703 as the keymap for future \\=\\[COMMAND] substrings.
 704 \\=\\= quotes the following character and is discarded;
 705 thus, \\=\\=\\=\\= puts \\=\\= into the output, and \\=\\=\\=\\[ puts \\=\\[ into the output.
 706
 707 Returns original STRING if no substitutions were made.  Otherwise,
 708 a new string, without any text properties, is returned.  */)
 709   (Lisp_Object string)
 710 {
 711   unsigned char *buf;
 712   int changed = 0;
 713   register unsigned char *strp;
 714   register unsigned char *bufp;
 715   int idx;
 716   int bsize;
 717   Lisp_Object tem;
 718   Lisp_Object keymap;
 719   unsigned char *start;
 720   int length, length_byte;
 721   Lisp_Object name;
 722   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
 723   int multibyte;
 724   int nchars;
 725
 726   if (NILP (string))
 727     return Qnil;
 728
 729   CHECK_STRING (string);
 730   tem = Qnil;
 731   keymap = Qnil;
 732   name = Qnil;
 733   GCPRO4 (string, tem, keymap, name);
 734
 735   multibyte = STRING_MULTIBYTE (string);
 736   nchars = 0;
 737
 738   /* KEYMAP is either nil (which means search all the active keymaps)
 739      or a specified local map (which means search just that and the
 740      global map).  If non-nil, it might come from Voverriding_local_map,
 741      or from a \\<mapname> construct in STRING itself..  */
 742   keymap = current_kboard->Voverriding_terminal_local_map;
 743   if (NILP (keymap))
 744     keymap = Voverriding_local_map;
 745
 746   bsize = SBYTES (string);
 747   bufp = buf = (unsigned char *) xmalloc (bsize);
 748
 749   strp = SDATA (string);
 750   while (strp < SDATA (string) + SBYTES (string))
 751     {
 752       if (strp[0] == '\\' && strp[1] == '=')
 753         {
 754           /* \= quotes the next character;
 755              thus, to put in \[ without its special meaning, use \=\[.  */
 756           changed = 1;
 757           strp += 2;
 758           if (multibyte)
 759             {
 760               int len;
 761
 762               STRING_CHAR_AND_LENGTH (strp, len);
 763               if (len == 1)
 764                 *bufp = *strp;
 765               else
 766                 memcpy (bufp, strp, len);
 767               strp += len;
 768               bufp += len;
 769               nchars++;
 770             }
 771           else
 772             *bufp++ = *strp++, nchars++;
 773         }
 774       else if (strp[0] == '\\' && strp[1] == '[')
 775         {
 776           int start_idx;
 777           int follow_remap = 1;
 778
 779           changed = 1;
 780           strp += 2;            /* skip \[ */
 781           start = strp;
 782           start_idx = start - SDATA (string);
 783
 784           while ((strp - SDATA (string)
 785                   < SBYTES (string))
 786                  && *strp != ']')
 787             strp++;
 788           length_byte = strp - start;
 789
 790           strp++;               /* skip ] */
 791
 792           /* Save STRP in IDX.  */
 793           idx = strp - SDATA (string);
 794           name = Fintern (make_string (start, length_byte), Qnil);
 795
 796         do_remap:
 797           tem = Fwhere_is_internal (name, keymap, Qt, Qnil, Qnil);
 798
 799           if (VECTORP (tem) && XVECTOR (tem)->size > 1
 800               && EQ (AREF (tem, 0), Qremap) && SYMBOLP (AREF (tem, 1))
 801               && follow_remap)
 802             {
 803               name = AREF (tem, 1);
 804               follow_remap = 0;
 805               goto do_remap;
 806             }
 807
 808           /* Note the Fwhere_is_internal can GC, so we have to take
 809              relocation of string contents into account.  */
 810           strp = SDATA (string) + idx;
 811           start = SDATA (string) + start_idx;
 812
 813           if (NILP (tem))       /* but not on any keys */
 814             {
 815               int offset = bufp - buf;
 816               buf = (unsigned char *) xrealloc (buf, bsize += 4);
 817               bufp = buf + offset;
 818               memcpy (bufp, "M-x ", 4);
 819               bufp += 4;
 820               nchars += 4;
 821               if (multibyte)
 822                 length = multibyte_chars_in_text (start, length_byte);
 823               else
 824                 length = length_byte;
 825               goto subst;
 826             }
 827           else
 828             {                   /* function is on a key */
 829               tem = Fkey_description (tem, Qnil);
 830               goto subst_string;
 831             }
 832         }
 833       /* \{foo} is replaced with a summary of the keymap (symbol-value foo).
 834          \<foo> just sets the keymap used for \[cmd].  */
 835       else if (strp[0] == '\\' && (strp[1] == '{' || strp[1] == '<'))
 836         {
 837           struct buffer *oldbuf;
 838           int start_idx;
 839           /* This is for computing the SHADOWS arg for describe_map_tree.  */
 840           Lisp_Object active_maps = Fcurrent_active_maps (Qnil, Qnil);
 841           Lisp_Object earlier_maps;
 842
 843           changed = 1;
 844           strp += 2;            /* skip \{ or \< */
 845           start = strp;
 846           start_idx = start - SDATA (string);
 847
 848           while ((strp - SDATA (string) < SBYTES (string))
 849                  && *strp != '}' && *strp != '>')
 850             strp++;
 851
 852           length_byte = strp - start;
 853           strp++;                       /* skip } or > */
 854
 855           /* Save STRP in IDX.  */
 856           idx = strp - SDATA (string);
 857
 858           /* Get the value of the keymap in TEM, or nil if undefined.
 859              Do this while still in the user's current buffer
 860              in case it is a local variable.  */
 861           name = Fintern (make_string (start, length_byte), Qnil);
 862           tem = Fboundp (name);
 863           if (! NILP (tem))
 864             {
 865               tem = Fsymbol_value (name);
 866               if (! NILP (tem))
 867                 {
 868                   tem = get_keymap (tem, 0, 1);
 869                   /* Note that get_keymap can GC.  */
 870                   strp = SDATA (string) + idx;
 871                   start = SDATA (string) + start_idx;
 872                 }
 873             }
 874
 875           /* Now switch to a temp buffer.  */
 876           oldbuf = current_buffer;
 877           set_buffer_internal (XBUFFER (Vprin1_to_string_buffer));
 878
 879           if (NILP (tem))
 880             {
 881               name = Fsymbol_name (name);
 882               insert_string ("\nUses keymap \"");
 883               insert_from_string (name, 0, 0,
 884                                   SCHARS (name),
 885                                   SBYTES (name), 1);
 886               insert_string ("\", which is not currently defined.\n");
 887               if (start[-1] == '<') keymap = Qnil;
 888             }
 889           else if (start[-1] == '<')
 890             keymap = tem;
 891           else
 892             {
 893               /* Get the list of active keymaps that precede this one.
 894                  If this one's not active, get nil.  */
 895               earlier_maps = Fcdr (Fmemq (tem, Freverse (active_maps)));
 896               describe_map_tree (tem, 1, Fnreverse (earlier_maps),
 897                                  Qnil, (char *)0, 1, 0, 0, 1);
 898             }
 899           tem = Fbuffer_string ();
 900           Ferase_buffer ();
 901           set_buffer_internal (oldbuf);
 902
 903         subst_string:
 904           start = SDATA (tem);
 905           length = SCHARS (tem);
 906           length_byte = SBYTES (tem);
 907         subst:
 908           {
 909             int offset = bufp - buf;
 910             buf = (unsigned char *) xrealloc (buf, bsize += length_byte);
 911             bufp = buf + offset;
 912             memcpy (bufp, start, length_byte);
 913             bufp += length_byte;
 914             nchars += length;
 915             /* Check STRING again in case gc relocated it.  */
 916             strp = (unsigned char *) SDATA (string) + idx;
 917           }
 918         }
 919       else if (! multibyte)             /* just copy other chars */
 920         *bufp++ = *strp++, nchars++;
 921       else
 922         {
 923           int len;
 924
 925           STRING_CHAR_AND_LENGTH (strp, len);
 926           if (len == 1)
 927             *bufp = *strp;
 928           else
 929             memcpy (bufp, strp, len);
 930           strp += len;
 931           bufp += len;
 932           nchars++;
 933         }
 934     }
 935
 936   if (changed)                  /* don't bother if nothing substituted */
 937     tem = make_string_from_bytes (buf, nchars, bufp - buf);
 938   else
 939     tem = string;
 940   xfree (buf);
 941   RETURN_UNGCPRO (tem);
 942 }
 943 \f
 944 void
 945 syms_of_doc (void)
 946 {
 947   Qfunction_documentation = intern_c_string ("function-documentation");
 948   staticpro (&Qfunction_documentation);
 949
 950   DEFVAR_LISP ("internal-doc-file-name", &Vdoc_file_name,
 951                doc: /* Name of file containing documentation strings of built-in symbols.  */);
 952   Vdoc_file_name = Qnil;
 953
 954   DEFVAR_LISP ("build-files", &Vbuild_files,
 955                doc: /* A list of files used to build this Emacs binary.  */);
 956   Vbuild_files = Qnil;
 957
 958   defsubr (&Sdocumentation);
 959   defsubr (&Sdocumentation_property);
 960   defsubr (&Ssnarf_documentation);
 961   defsubr (&Ssubstitute_command_keys);
 962 }
 963
 964 /* arch-tag: 56281d4d-6949-43e2-be2e-f6517de744ba
 965    (do not change this comment) */