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