merge trunk
[emacs.git] / src / doc.c
blobb6f1569c2d830c87a97df60c42b4b422ec9a504c
1 /* Record indices of function doc strings stored in a file.
3 Copyright (C) 1985-1986, 1993-1995, 1997-2013 Free Software Foundation,
4 Inc.
6 This file is part of GNU Emacs.
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.
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.
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/>. */
22 #include <config.h>
24 #include <errno.h>
25 #include <sys/types.h>
26 #include <sys/file.h> /* Must be after sys/types.h for USG. */
27 #include <fcntl.h>
28 #include <unistd.h>
30 #include <c-ctype.h>
32 #include "lisp.h"
33 #include "character.h"
34 #include "buffer.h"
35 #include "keyboard.h"
36 #include "keymap.h"
38 Lisp_Object Qfunction_documentation;
40 /* Buffer used for reading from documentation file. */
41 static char *get_doc_string_buffer;
42 static ptrdiff_t get_doc_string_buffer_size;
44 static unsigned char *read_bytecode_pointer;
46 /* `readchar' in lread.c calls back here to fetch the next byte.
47 If UNREADFLAG is 1, we unread a byte. */
49 int
50 read_bytecode_char (bool unreadflag)
52 if (unreadflag)
54 read_bytecode_pointer--;
55 return 0;
57 return *read_bytecode_pointer++;
60 /* Extract a doc string from a file. FILEPOS says where to get it.
61 If it is an integer, use that position in the standard DOC file.
62 If it is (FILE . INTEGER), use FILE as the file name
63 and INTEGER as the position in that file.
64 But if INTEGER is negative, make it positive.
65 (A negative integer is used for user variables, so we can distinguish
66 them without actually fetching the doc string.)
68 If the location does not point to the beginning of a docstring
69 (e.g. because the file has been modified and the location is stale),
70 return nil.
72 If UNIBYTE, always make a unibyte string.
74 If DEFINITION, assume this is for reading
75 a dynamic function definition; convert the bytestring
76 and the constants vector with appropriate byte handling,
77 and return a cons cell. */
79 Lisp_Object
80 get_doc_string (Lisp_Object filepos, bool unibyte, bool definition)
82 char *from, *to, *name, *p, *p1;
83 int fd;
84 ptrdiff_t minsize;
85 int offset;
86 EMACS_INT position;
87 Lisp_Object file, tem, pos;
88 ptrdiff_t count;
89 USE_SAFE_ALLOCA;
91 if (INTEGERP (filepos))
93 file = Vdoc_file_name;
94 pos = filepos;
96 else if (CONSP (filepos))
98 file = XCAR (filepos);
99 pos = XCDR (filepos);
101 else
102 return Qnil;
104 position = eabs (XINT (pos));
106 if (!STRINGP (Vdoc_directory))
107 return Qnil;
109 if (!STRINGP (file))
110 return Qnil;
112 /* Put the file name in NAME as a C string.
113 If it is relative, combine it with Vdoc_directory. */
115 tem = Ffile_name_absolute_p (file);
116 file = ENCODE_FILE (file);
117 if (NILP (tem))
119 Lisp_Object docdir = ENCODE_FILE (Vdoc_directory);
120 minsize = SCHARS (docdir);
121 /* sizeof ("../etc/") == 8 */
122 if (minsize < 8)
123 minsize = 8;
124 name = SAFE_ALLOCA (minsize + SCHARS (file) + 8);
125 strcpy (name, SSDATA (docdir));
126 strcat (name, SSDATA (file));
128 else
130 name = SSDATA (file);
133 fd = emacs_open (name, O_RDONLY, 0);
134 if (fd < 0)
136 #ifndef CANNOT_DUMP
137 if (!NILP (Vpurify_flag))
139 /* Preparing to dump; DOC file is probably not installed.
140 So check in ../etc. */
141 strcpy (name, "../etc/");
142 strcat (name, SSDATA (file));
144 fd = emacs_open (name, O_RDONLY, 0);
146 #endif
147 if (fd < 0)
149 SAFE_FREE ();
150 return concat3 (build_string ("Cannot open doc string file \""),
151 file, build_string ("\"\n"));
154 count = SPECPDL_INDEX ();
155 record_unwind_protect_int (close_file_unwind, fd);
157 /* Seek only to beginning of disk block. */
158 /* Make sure we read at least 1024 bytes before `position'
159 so we can check the leading text for consistency. */
160 offset = min (position, max (1024, position % (8 * 1024)));
161 if (TYPE_MAXIMUM (off_t) < position
162 || lseek (fd, position - offset, 0) < 0)
163 error ("Position %"pI"d out of range in doc string file \"%s\"",
164 position, name);
166 /* Read the doc string into get_doc_string_buffer.
167 P points beyond the data just read. */
169 p = get_doc_string_buffer;
170 while (1)
172 ptrdiff_t space_left = (get_doc_string_buffer_size - 1
173 - (p - get_doc_string_buffer));
174 int nread;
176 /* Allocate or grow the buffer if we need to. */
177 if (space_left <= 0)
179 ptrdiff_t in_buffer = p - get_doc_string_buffer;
180 get_doc_string_buffer
181 = xpalloc (get_doc_string_buffer, &get_doc_string_buffer_size,
182 16 * 1024, -1, 1);
183 p = get_doc_string_buffer + in_buffer;
184 space_left = (get_doc_string_buffer_size - 1
185 - (p - get_doc_string_buffer));
188 /* Read a disk block at a time.
189 If we read the same block last time, maybe skip this? */
190 if (space_left > 1024 * 8)
191 space_left = 1024 * 8;
192 nread = emacs_read (fd, p, space_left);
193 if (nread < 0)
194 report_file_error ("Read error on documentation file", file);
195 p[nread] = 0;
196 if (!nread)
197 break;
198 if (p == get_doc_string_buffer)
199 p1 = strchr (p + offset, '\037');
200 else
201 p1 = strchr (p, '\037');
202 if (p1)
204 *p1 = 0;
205 p = p1;
206 break;
208 p += nread;
210 unbind_to (count, Qnil);
211 SAFE_FREE ();
213 /* Sanity checking. */
214 if (CONSP (filepos))
216 int test = 1;
217 /* A dynamic docstring should be either at the very beginning of a "#@
218 comment" or right after a dynamic docstring delimiter (in case we
219 pack several such docstrings within the same comment). */
220 if (get_doc_string_buffer[offset - test] != '\037')
222 if (get_doc_string_buffer[offset - test++] != ' ')
223 return Qnil;
224 while (get_doc_string_buffer[offset - test] >= '0'
225 && get_doc_string_buffer[offset - test] <= '9')
226 test++;
227 if (get_doc_string_buffer[offset - test++] != '@'
228 || get_doc_string_buffer[offset - test] != '#')
229 return Qnil;
232 else
234 int test = 1;
235 if (get_doc_string_buffer[offset - test++] != '\n')
236 return Qnil;
237 while (get_doc_string_buffer[offset - test] > ' ')
238 test++;
239 if (get_doc_string_buffer[offset - test] != '\037')
240 return Qnil;
243 /* Scan the text and perform quoting with ^A (char code 1).
244 ^A^A becomes ^A, ^A0 becomes a null char, and ^A_ becomes a ^_. */
245 from = get_doc_string_buffer + offset;
246 to = get_doc_string_buffer + offset;
247 while (from != p)
249 if (*from == 1)
251 int c;
253 from++;
254 c = *from++;
255 if (c == 1)
256 *to++ = c;
257 else if (c == '0')
258 *to++ = 0;
259 else if (c == '_')
260 *to++ = 037;
261 else
263 unsigned char uc = c;
264 error ("\
265 Invalid data in documentation file -- %c followed by code %03o",
266 1, uc);
269 else
270 *to++ = *from++;
273 /* If DEFINITION, read from this buffer
274 the same way we would read bytes from a file. */
275 if (definition)
277 read_bytecode_pointer = (unsigned char *) get_doc_string_buffer + offset;
278 return Fread (Qlambda);
281 if (unibyte)
282 return make_unibyte_string (get_doc_string_buffer + offset,
283 to - (get_doc_string_buffer + offset));
284 else
286 /* The data determines whether the string is multibyte. */
287 ptrdiff_t nchars
288 = multibyte_chars_in_text (((unsigned char *) get_doc_string_buffer
289 + offset),
290 to - (get_doc_string_buffer + offset));
291 return make_string_from_bytes (get_doc_string_buffer + offset,
292 nchars,
293 to - (get_doc_string_buffer + offset));
297 /* Get a string from position FILEPOS and pass it through the Lisp reader.
298 We use this for fetching the bytecode string and constants vector
299 of a compiled function from the .elc file. */
301 Lisp_Object
302 read_doc_string (Lisp_Object filepos)
304 return get_doc_string (filepos, 0, 1);
307 static bool
308 reread_doc_file (Lisp_Object file)
310 #if 0
311 Lisp_Object reply, prompt[3];
312 struct gcpro gcpro1;
313 GCPRO1 (file);
314 prompt[0] = build_string ("File ");
315 prompt[1] = NILP (file) ? Vdoc_file_name : file;
316 prompt[2] = build_string (" is out of sync. Reload? ");
317 reply = Fy_or_n_p (Fconcat (3, prompt));
318 UNGCPRO;
319 if (NILP (reply))
320 return 0;
321 #endif
323 if (NILP (file))
324 Fsnarf_documentation (Vdoc_file_name);
325 else
326 Fload (file, Qt, Qt, Qt, Qnil);
328 return 1;
331 DEFUN ("documentation", Fdocumentation, Sdocumentation, 1, 2, 0,
332 doc: /* Return the documentation string of FUNCTION.
333 Unless a non-nil second argument RAW is given, the
334 string is passed through `substitute-command-keys'. */)
335 (Lisp_Object function, Lisp_Object raw)
337 Lisp_Object fun;
338 Lisp_Object funcar;
339 Lisp_Object doc;
340 bool try_reload = 1;
342 documentation:
344 doc = Qnil;
346 if (SYMBOLP (function))
348 Lisp_Object tem = Fget (function, Qfunction_documentation);
349 if (!NILP (tem))
350 return Fdocumentation_property (function, Qfunction_documentation,
351 raw);
354 fun = Findirect_function (function, Qnil);
355 if (CONSP (fun) && EQ (XCAR (fun), Qmacro))
356 fun = XCDR (fun);
357 if (SUBRP (fun))
359 if (XSUBR (fun)->doc == 0)
360 return Qnil;
361 /* FIXME: This is not portable, as it assumes that string
362 pointers have the top bit clear. */
363 else if ((intptr_t) XSUBR (fun)->doc >= 0)
364 doc = build_string (XSUBR (fun)->doc);
365 else
366 doc = make_number ((intptr_t) XSUBR (fun)->doc);
368 else if (COMPILEDP (fun))
370 if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) <= COMPILED_DOC_STRING)
371 return Qnil;
372 else
374 Lisp_Object tem = AREF (fun, COMPILED_DOC_STRING);
375 if (STRINGP (tem))
376 doc = tem;
377 else if (NATNUMP (tem) || CONSP (tem))
378 doc = tem;
379 else
380 return Qnil;
383 else if (STRINGP (fun) || VECTORP (fun))
385 return build_string ("Keyboard macro.");
387 else if (CONSP (fun))
389 funcar = XCAR (fun);
390 if (!SYMBOLP (funcar))
391 xsignal1 (Qinvalid_function, fun);
392 else if (EQ (funcar, Qkeymap))
393 return build_string ("Prefix command (definition is a keymap associating keystrokes with commands).");
394 else if (EQ (funcar, Qlambda)
395 || (EQ (funcar, Qclosure) && (fun = XCDR (fun), 1))
396 || EQ (funcar, Qautoload))
398 Lisp_Object tem1 = Fcdr (Fcdr (fun));
399 Lisp_Object tem = Fcar (tem1);
400 if (STRINGP (tem))
401 doc = tem;
402 /* Handle a doc reference--but these never come last
403 in the function body, so reject them if they are last. */
404 else if ((NATNUMP (tem) || (CONSP (tem) && INTEGERP (XCDR (tem))))
405 && !NILP (XCDR (tem1)))
406 doc = tem;
407 else
408 return Qnil;
410 else
411 goto oops;
413 else
415 oops:
416 xsignal1 (Qinvalid_function, fun);
419 /* Check for a dynamic docstring. These come with
420 a dynamic-docstring-function text property. */
421 if (STRINGP (doc))
423 Lisp_Object func
424 = Fget_text_property (make_number (0),
425 intern ("dynamic-docstring-function"),
426 doc);
427 if (!NILP (func))
428 /* Pass both `doc' and `function' since `function' can be needed, and
429 finding `doc' can be annoying: calling `documentation' is not an
430 option because it would infloop. */
431 doc = call2 (func, doc, function);
434 /* If DOC is 0, it's typically because of a dumped file missing
435 from the DOC file (bug in src/Makefile.in). */
436 if (EQ (doc, make_number (0)))
437 doc = Qnil;
438 if (INTEGERP (doc) || CONSP (doc))
440 Lisp_Object tem;
441 tem = get_doc_string (doc, 0, 0);
442 if (NILP (tem) && try_reload)
444 /* The file is newer, we need to reset the pointers. */
445 struct gcpro gcpro1, gcpro2;
446 GCPRO2 (function, raw);
447 try_reload = reread_doc_file (Fcar_safe (doc));
448 UNGCPRO;
449 if (try_reload)
451 try_reload = 0;
452 goto documentation;
455 else
456 doc = tem;
459 if (NILP (raw))
460 doc = Fsubstitute_command_keys (doc);
461 return doc;
464 DEFUN ("documentation-property", Fdocumentation_property,
465 Sdocumentation_property, 2, 3, 0,
466 doc: /* Return the documentation string that is SYMBOL's PROP property.
467 Third argument RAW omitted or nil means pass the result through
468 `substitute-command-keys' if it is a string.
470 This differs from `get' in that it can refer to strings stored in the
471 `etc/DOC' file; and that it evaluates documentation properties that
472 aren't strings. */)
473 (Lisp_Object symbol, Lisp_Object prop, Lisp_Object raw)
475 bool try_reload = 1;
476 Lisp_Object tem;
478 documentation_property:
480 tem = Fget (symbol, prop);
481 if (EQ (tem, make_number (0)))
482 tem = Qnil;
483 if (INTEGERP (tem) || (CONSP (tem) && INTEGERP (XCDR (tem))))
485 Lisp_Object doc = tem;
486 tem = get_doc_string (tem, 0, 0);
487 if (NILP (tem) && try_reload)
489 /* The file is newer, we need to reset the pointers. */
490 struct gcpro gcpro1, gcpro2, gcpro3;
491 GCPRO3 (symbol, prop, raw);
492 try_reload = reread_doc_file (Fcar_safe (doc));
493 UNGCPRO;
494 if (try_reload)
496 try_reload = 0;
497 goto documentation_property;
501 else if (!STRINGP (tem))
502 /* Feval protects its argument. */
503 tem = Feval (tem, Qnil);
505 if (NILP (raw) && STRINGP (tem))
506 tem = Fsubstitute_command_keys (tem);
507 return tem;
510 /* Scanning the DOC files and placing docstring offsets into functions. */
512 static void
513 store_function_docstring (Lisp_Object obj, ptrdiff_t offset)
515 /* Don't use indirect_function here, or defaliases will apply their
516 docstrings to the base functions (Bug#2603). */
517 Lisp_Object fun = SYMBOLP (obj) ? XSYMBOL (obj)->function : obj;
519 /* The type determines where the docstring is stored. */
521 /* Lisp_Subrs have a slot for it. */
522 if (SUBRP (fun))
524 intptr_t negative_offset = - offset;
525 XSUBR (fun)->doc = (char *) negative_offset;
528 /* If it's a lisp form, stick it in the form. */
529 else if (CONSP (fun))
531 Lisp_Object tem;
533 tem = XCAR (fun);
534 if (EQ (tem, Qlambda) || EQ (tem, Qautoload)
535 || (EQ (tem, Qclosure) && (fun = XCDR (fun), 1)))
537 tem = Fcdr (Fcdr (fun));
538 if (CONSP (tem) && INTEGERP (XCAR (tem)))
539 /* FIXME: This modifies typically pure hash-cons'd data, so its
540 correctness is quite delicate. */
541 XSETCAR (tem, make_number (offset));
543 else if (EQ (tem, Qmacro))
544 store_function_docstring (XCDR (fun), offset);
547 /* Bytecode objects sometimes have slots for it. */
548 else if (COMPILEDP (fun))
550 /* This bytecode object must have a slot for the
551 docstring, since we've found a docstring for it. */
552 if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) > COMPILED_DOC_STRING)
553 ASET (fun, COMPILED_DOC_STRING, make_number (offset));
558 DEFUN ("Snarf-documentation", Fsnarf_documentation, Ssnarf_documentation,
559 1, 1, 0,
560 doc: /* Used during Emacs initialization to scan the `etc/DOC...' file.
561 This searches the `etc/DOC...' file for doc strings and
562 records them in function and variable definitions.
563 The function takes one argument, FILENAME, a string;
564 it specifies the file name (without a directory) of the DOC file.
565 That file is found in `../etc' now; later, when the dumped Emacs is run,
566 the same file name is found in the `doc-directory'. */)
567 (Lisp_Object filename)
569 int fd;
570 char buf[1024 + 1];
571 int filled;
572 EMACS_INT pos;
573 Lisp_Object sym;
574 char *p, *name;
575 bool skip_file = 0;
576 ptrdiff_t count;
578 CHECK_STRING (filename);
581 #ifndef CANNOT_DUMP
582 (!NILP (Vpurify_flag))
583 #else /* CANNOT_DUMP */
585 #endif /* CANNOT_DUMP */
587 name = alloca (SCHARS (filename) + 14);
588 strcpy (name, "../etc/");
590 else
592 CHECK_STRING (Vdoc_directory);
593 name = alloca (SCHARS (filename) + SCHARS (Vdoc_directory) + 1);
594 strcpy (name, SSDATA (Vdoc_directory));
596 strcat (name, SSDATA (filename)); /*** Add this line ***/
598 /* Vbuild_files is nil when temacs is run, and non-nil after that. */
599 if (NILP (Vbuild_files))
601 static char const *const buildobj[] =
603 #include "buildobj.h"
605 int i = sizeof buildobj / sizeof *buildobj;
606 while (0 <= --i)
607 Vbuild_files = Fcons (build_string (buildobj[i]), Vbuild_files);
608 Vbuild_files = Fpurecopy (Vbuild_files);
611 fd = emacs_open (name, O_RDONLY, 0);
612 if (fd < 0)
614 int open_errno = errno;
615 report_file_errno ("Opening doc string file", build_string (name),
616 open_errno);
618 count = SPECPDL_INDEX ();
619 record_unwind_protect_int (close_file_unwind, fd);
620 Vdoc_file_name = filename;
621 filled = 0;
622 pos = 0;
623 while (1)
625 register char *end;
626 if (filled < 512)
627 filled += emacs_read (fd, &buf[filled], sizeof buf - 1 - filled);
628 if (!filled)
629 break;
631 buf[filled] = 0;
632 end = buf + (filled < 512 ? filled : filled - 128);
633 p = memchr (buf, '\037', end - buf);
634 /* p points to ^_Ffunctionname\n or ^_Vvarname\n or ^_Sfilename\n. */
635 if (p)
637 end = strchr (p, '\n');
639 /* See if this is a file name, and if it is a file in build-files. */
640 if (p[1] == 'S')
642 skip_file = 0;
643 if (end - p > 4 && end[-2] == '.'
644 && (end[-1] == 'o' || end[-1] == 'c'))
646 ptrdiff_t len = end - p - 2;
647 char *fromfile = alloca (len + 1);
648 memcpy (fromfile, &p[2], len);
649 fromfile[len] = 0;
650 if (fromfile[len-1] == 'c')
651 fromfile[len-1] = 'o';
653 skip_file = NILP (Fmember (build_string (fromfile),
654 Vbuild_files));
658 sym = oblookup (Vobarray, p + 2,
659 multibyte_chars_in_text ((unsigned char *) p + 2,
660 end - p - 2),
661 end - p - 2);
662 /* Check skip_file so that when a function is defined several
663 times in different files (typically, once in xterm, once in
664 w32term, ...), we only pay attention to the one that
665 matters. */
666 if (! skip_file && SYMBOLP (sym))
668 /* Attach a docstring to a variable? */
669 if (p[1] == 'V')
671 /* Install file-position as variable-documentation property
672 and make it negative for a user-variable
673 (doc starts with a `*'). */
674 if (!NILP (Fboundp (sym)))
675 Fput (sym, Qvariable_documentation,
676 make_number ((pos + end + 1 - buf)
677 * (end[1] == '*' ? -1 : 1)));
680 /* Attach a docstring to a function? */
681 else if (p[1] == 'F')
683 if (!NILP (Ffboundp (sym)))
684 store_function_docstring (sym, pos + end + 1 - buf);
686 else if (p[1] == 'S')
687 ; /* Just a source file name boundary marker. Ignore it. */
689 else
690 error ("DOC file invalid at position %"pI"d", pos);
693 pos += end - buf;
694 filled -= end - buf;
695 memmove (buf, end, filled);
697 return unbind_to (count, Qnil);
700 DEFUN ("substitute-command-keys", Fsubstitute_command_keys,
701 Ssubstitute_command_keys, 1, 1, 0,
702 doc: /* Substitute key descriptions for command names in STRING.
703 Each substring of the form \\=\\[COMMAND] is replaced by either a
704 keystroke sequence that invokes COMMAND, or "M-x COMMAND" if COMMAND
705 is not on any keys.
707 Each substring of the form \\=\\{MAPVAR} is replaced by a summary of
708 the value of MAPVAR as a keymap. This summary is similar to the one
709 produced by `describe-bindings'. The summary ends in two newlines
710 \(used by the helper function `help-make-xrefs' to find the end of the
711 summary).
713 Each substring of the form \\=\\<MAPVAR> specifies the use of MAPVAR
714 as the keymap for future \\=\\[COMMAND] substrings.
715 \\=\\= quotes the following character and is discarded;
716 thus, \\=\\=\\=\\= puts \\=\\= into the output, and \\=\\=\\=\\[ puts \\=\\[ into the output.
718 Return the original STRING if no substitutions are made.
719 Otherwise, return a new string, without any text properties. */)
720 (Lisp_Object string)
722 char *buf;
723 bool changed = 0;
724 unsigned char *strp;
725 char *bufp;
726 ptrdiff_t idx;
727 ptrdiff_t bsize;
728 Lisp_Object tem;
729 Lisp_Object keymap;
730 unsigned char *start;
731 ptrdiff_t length, length_byte;
732 Lisp_Object name;
733 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
734 bool multibyte;
735 ptrdiff_t nchars;
737 if (NILP (string))
738 return Qnil;
740 CHECK_STRING (string);
741 tem = Qnil;
742 keymap = Qnil;
743 name = Qnil;
744 GCPRO4 (string, tem, keymap, name);
746 multibyte = STRING_MULTIBYTE (string);
747 nchars = 0;
749 /* KEYMAP is either nil (which means search all the active keymaps)
750 or a specified local map (which means search just that and the
751 global map). If non-nil, it might come from Voverriding_local_map,
752 or from a \\<mapname> construct in STRING itself.. */
753 keymap = Voverriding_local_map;
755 bsize = SBYTES (string);
756 bufp = buf = xmalloc (bsize);
758 strp = SDATA (string);
759 while (strp < SDATA (string) + SBYTES (string))
761 if (strp[0] == '\\' && strp[1] == '=')
763 /* \= quotes the next character;
764 thus, to put in \[ without its special meaning, use \=\[. */
765 changed = 1;
766 strp += 2;
767 if (multibyte)
769 int len;
771 STRING_CHAR_AND_LENGTH (strp, len);
772 if (len == 1)
773 *bufp = *strp;
774 else
775 memcpy (bufp, strp, len);
776 strp += len;
777 bufp += len;
778 nchars++;
780 else
781 *bufp++ = *strp++, nchars++;
783 else if (strp[0] == '\\' && strp[1] == '[')
785 ptrdiff_t start_idx;
786 bool follow_remap = 1;
788 changed = 1;
789 strp += 2; /* skip \[ */
790 start = strp;
791 start_idx = start - SDATA (string);
793 while ((strp - SDATA (string)
794 < SBYTES (string))
795 && *strp != ']')
796 strp++;
797 length_byte = strp - start;
799 strp++; /* skip ] */
801 /* Save STRP in IDX. */
802 idx = strp - SDATA (string);
803 name = Fintern (make_string ((char *) start, length_byte), Qnil);
805 do_remap:
806 tem = Fwhere_is_internal (name, keymap, Qt, Qnil, Qnil);
808 if (VECTORP (tem) && ASIZE (tem) > 1
809 && EQ (AREF (tem, 0), Qremap) && SYMBOLP (AREF (tem, 1))
810 && follow_remap)
812 name = AREF (tem, 1);
813 follow_remap = 0;
814 goto do_remap;
817 /* Note the Fwhere_is_internal can GC, so we have to take
818 relocation of string contents into account. */
819 strp = SDATA (string) + idx;
820 start = SDATA (string) + start_idx;
822 if (NILP (tem)) /* but not on any keys */
824 ptrdiff_t offset = bufp - buf;
825 if (STRING_BYTES_BOUND - 4 < bsize)
826 string_overflow ();
827 buf = xrealloc (buf, bsize += 4);
828 bufp = buf + offset;
829 memcpy (bufp, "M-x ", 4);
830 bufp += 4;
831 nchars += 4;
832 if (multibyte)
833 length = multibyte_chars_in_text (start, length_byte);
834 else
835 length = length_byte;
836 goto subst;
838 else
839 { /* function is on a key */
840 tem = Fkey_description (tem, Qnil);
841 goto subst_string;
844 /* \{foo} is replaced with a summary of the keymap (symbol-value foo).
845 \<foo> just sets the keymap used for \[cmd]. */
846 else if (strp[0] == '\\' && (strp[1] == '{' || strp[1] == '<'))
848 struct buffer *oldbuf;
849 ptrdiff_t start_idx;
850 /* This is for computing the SHADOWS arg for describe_map_tree. */
851 Lisp_Object active_maps = Fcurrent_active_maps (Qnil, Qnil);
852 Lisp_Object earlier_maps;
853 ptrdiff_t count = SPECPDL_INDEX ();
855 changed = 1;
856 strp += 2; /* skip \{ or \< */
857 start = strp;
858 start_idx = start - SDATA (string);
860 while ((strp - SDATA (string) < SBYTES (string))
861 && *strp != '}' && *strp != '>')
862 strp++;
864 length_byte = strp - start;
865 strp++; /* skip } or > */
867 /* Save STRP in IDX. */
868 idx = strp - SDATA (string);
870 /* Get the value of the keymap in TEM, or nil if undefined.
871 Do this while still in the user's current buffer
872 in case it is a local variable. */
873 name = Fintern (make_string ((char *) start, length_byte), Qnil);
874 tem = Fboundp (name);
875 if (! NILP (tem))
877 tem = Fsymbol_value (name);
878 if (! NILP (tem))
880 tem = get_keymap (tem, 0, 1);
881 /* Note that get_keymap can GC. */
882 strp = SDATA (string) + idx;
883 start = SDATA (string) + start_idx;
887 /* Now switch to a temp buffer. */
888 oldbuf = current_buffer;
889 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer));
890 /* This is for an unusual case where some after-change
891 function uses 'format' or 'prin1' or something else that
892 will thrash Vprin1_to_string_buffer we are using. */
893 specbind (Qinhibit_modification_hooks, Qt);
895 if (NILP (tem))
897 name = Fsymbol_name (name);
898 insert_string ("\nUses keymap `");
899 insert_from_string (name, 0, 0,
900 SCHARS (name),
901 SBYTES (name), 1);
902 insert_string ("', which is not currently defined.\n");
903 if (start[-1] == '<') keymap = Qnil;
905 else if (start[-1] == '<')
906 keymap = tem;
907 else
909 /* Get the list of active keymaps that precede this one.
910 If this one's not active, get nil. */
911 earlier_maps = Fcdr (Fmemq (tem, Freverse (active_maps)));
912 describe_map_tree (tem, 1, Fnreverse (earlier_maps),
913 Qnil, 0, 1, 0, 0, 1);
915 tem = Fbuffer_string ();
916 Ferase_buffer ();
917 set_buffer_internal (oldbuf);
918 unbind_to (count, Qnil);
920 subst_string:
921 start = SDATA (tem);
922 length = SCHARS (tem);
923 length_byte = SBYTES (tem);
924 subst:
926 ptrdiff_t offset = bufp - buf;
927 if (STRING_BYTES_BOUND - length_byte < bsize)
928 string_overflow ();
929 buf = xrealloc (buf, bsize += length_byte);
930 bufp = buf + offset;
931 memcpy (bufp, start, length_byte);
932 bufp += length_byte;
933 nchars += length;
934 /* Check STRING again in case gc relocated it. */
935 strp = SDATA (string) + idx;
938 else if (! multibyte) /* just copy other chars */
939 *bufp++ = *strp++, nchars++;
940 else
942 int len;
944 STRING_CHAR_AND_LENGTH (strp, len);
945 if (len == 1)
946 *bufp = *strp;
947 else
948 memcpy (bufp, strp, len);
949 strp += len;
950 bufp += len;
951 nchars++;
955 if (changed) /* don't bother if nothing substituted */
956 tem = make_string_from_bytes (buf, nchars, bufp - buf);
957 else
958 tem = string;
959 xfree (buf);
960 RETURN_UNGCPRO (tem);
963 void
964 syms_of_doc (void)
966 DEFSYM (Qfunction_documentation, "function-documentation");
968 DEFVAR_LISP ("internal-doc-file-name", Vdoc_file_name,
969 doc: /* Name of file containing documentation strings of built-in symbols. */);
970 Vdoc_file_name = Qnil;
972 DEFVAR_LISP ("build-files", Vbuild_files,
973 doc: /* A list of files used to build this Emacs binary. */);
974 Vbuild_files = Qnil;
976 defsubr (&Sdocumentation);
977 defsubr (&Sdocumentation_property);
978 defsubr (&Ssnarf_documentation);
979 defsubr (&Ssubstitute_command_keys);