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