Fixes: debbugs:19133
[emacs.git] / src / doc.c
blob1b87c23e9498088976b69b1792cdd145f35e759c
1 /* Record indices of function doc strings stored in a file.
3 Copyright (C) 1985-1986, 1993-1995, 1997-2014 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software: you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation, either version 3 of the License, or
10 (at your option) any later version.
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
21 #include <config.h>
23 #include <errno.h>
24 #include <sys/types.h>
25 #include <sys/file.h> /* Must be after sys/types.h for USG. */
26 #include <fcntl.h>
27 #include <unistd.h>
29 #include <c-ctype.h>
31 #include "lisp.h"
32 #include "character.h"
33 #include "buffer.h"
34 #include "keyboard.h"
35 #include "keymap.h"
37 Lisp_Object Qfunction_documentation;
39 /* Buffer used for reading from documentation file. */
40 static char *get_doc_string_buffer;
41 static ptrdiff_t get_doc_string_buffer_size;
43 static unsigned char *read_bytecode_pointer;
45 /* `readchar' in lread.c calls back here to fetch the next byte.
46 If UNREADFLAG is 1, we unread a byte. */
48 int
49 read_bytecode_char (bool unreadflag)
51 if (unreadflag)
53 read_bytecode_pointer--;
54 return 0;
56 return *read_bytecode_pointer++;
59 /* Extract a doc string from a file. FILEPOS says where to get it.
60 If it is an integer, use that position in the standard DOC file.
61 If it is (FILE . INTEGER), use FILE as the file name
62 and INTEGER as the position in that file.
63 But if INTEGER is negative, make it positive.
64 (A negative integer is used for user variables, so we can distinguish
65 them without actually fetching the doc string.)
67 If the location does not point to the beginning of a docstring
68 (e.g. because the file has been modified and the location is stale),
69 return nil.
71 If UNIBYTE, always make a unibyte string.
73 If DEFINITION, assume this is for reading
74 a dynamic function definition; convert the bytestring
75 and the constants vector with appropriate byte handling,
76 and return a cons cell. */
78 Lisp_Object
79 get_doc_string (Lisp_Object filepos, bool unibyte, bool definition)
81 char *from, *to, *name, *p, *p1;
82 int fd;
83 ptrdiff_t minsize;
84 int offset;
85 EMACS_INT position;
86 Lisp_Object file, tem, pos;
87 ptrdiff_t count;
88 USE_SAFE_ALLOCA;
90 if (INTEGERP (filepos))
92 file = Vdoc_file_name;
93 pos = filepos;
95 else if (CONSP (filepos))
97 file = XCAR (filepos);
98 pos = XCDR (filepos);
100 else
101 return Qnil;
103 position = eabs (XINT (pos));
105 if (!STRINGP (Vdoc_directory))
106 return Qnil;
108 if (!STRINGP (file))
109 return Qnil;
111 /* Put the file name in NAME as a C string.
112 If it is relative, combine it with Vdoc_directory. */
114 tem = Ffile_name_absolute_p (file);
115 file = ENCODE_FILE (file);
116 if (NILP (tem))
118 Lisp_Object docdir = ENCODE_FILE (Vdoc_directory);
119 minsize = SCHARS (docdir);
120 /* sizeof ("../etc/") == 8 */
121 if (minsize < 8)
122 minsize = 8;
123 name = SAFE_ALLOCA (minsize + SCHARS (file) + 8);
124 char *z = lispstpcpy (name, docdir);
125 strcpy (z, SSDATA (file));
127 else
129 name = SSDATA (file);
132 fd = emacs_open (name, O_RDONLY, 0);
133 if (fd < 0)
135 #ifndef CANNOT_DUMP
136 if (!NILP (Vpurify_flag))
138 /* Preparing to dump; DOC file is probably not installed.
139 So check in ../etc. */
140 strcpy (name, "../etc/");
141 strcat (name, SSDATA (file));
143 fd = emacs_open (name, O_RDONLY, 0);
145 #endif
146 if (fd < 0)
148 SAFE_FREE ();
149 AUTO_STRING (cannot_open, "Cannot open doc string file \"");
150 AUTO_STRING (quote_nl, "\"\n");
151 return concat3 (cannot_open, file, quote_nl);
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 /* If DOC is 0, it's typically because of a dumped file missing
420 from the DOC file (bug in src/Makefile.in). */
421 if (EQ (doc, make_number (0)))
422 doc = Qnil;
423 if (INTEGERP (doc) || CONSP (doc))
425 Lisp_Object tem;
426 tem = get_doc_string (doc, 0, 0);
427 if (NILP (tem) && try_reload)
429 /* The file is newer, we need to reset the pointers. */
430 struct gcpro gcpro1, gcpro2;
431 GCPRO2 (function, raw);
432 try_reload = reread_doc_file (Fcar_safe (doc));
433 UNGCPRO;
434 if (try_reload)
436 try_reload = 0;
437 goto documentation;
440 else
441 doc = tem;
444 if (NILP (raw))
445 doc = Fsubstitute_command_keys (doc);
446 return doc;
449 DEFUN ("documentation-property", Fdocumentation_property,
450 Sdocumentation_property, 2, 3, 0,
451 doc: /* Return the documentation string that is SYMBOL's PROP property.
452 Third argument RAW omitted or nil means pass the result through
453 `substitute-command-keys' if it is a string.
455 This differs from `get' in that it can refer to strings stored in the
456 `etc/DOC' file; and that it evaluates documentation properties that
457 aren't strings. */)
458 (Lisp_Object symbol, Lisp_Object prop, Lisp_Object raw)
460 bool try_reload = 1;
461 Lisp_Object tem;
463 documentation_property:
465 tem = Fget (symbol, prop);
466 if (EQ (tem, make_number (0)))
467 tem = Qnil;
468 if (INTEGERP (tem) || (CONSP (tem) && INTEGERP (XCDR (tem))))
470 Lisp_Object doc = tem;
471 tem = get_doc_string (tem, 0, 0);
472 if (NILP (tem) && try_reload)
474 /* The file is newer, we need to reset the pointers. */
475 struct gcpro gcpro1, gcpro2, gcpro3;
476 GCPRO3 (symbol, prop, raw);
477 try_reload = reread_doc_file (Fcar_safe (doc));
478 UNGCPRO;
479 if (try_reload)
481 try_reload = 0;
482 goto documentation_property;
486 else if (!STRINGP (tem))
487 /* Feval protects its argument. */
488 tem = Feval (tem, Qnil);
490 if (NILP (raw) && STRINGP (tem))
491 tem = Fsubstitute_command_keys (tem);
492 return tem;
495 /* Scanning the DOC files and placing docstring offsets into functions. */
497 static void
498 store_function_docstring (Lisp_Object obj, ptrdiff_t offset)
500 /* Don't use indirect_function here, or defaliases will apply their
501 docstrings to the base functions (Bug#2603). */
502 Lisp_Object fun = SYMBOLP (obj) ? XSYMBOL (obj)->function : obj;
504 /* The type determines where the docstring is stored. */
506 /* Lisp_Subrs have a slot for it. */
507 if (SUBRP (fun))
509 intptr_t negative_offset = - offset;
510 XSUBR (fun)->doc = (char *) negative_offset;
513 /* If it's a lisp form, stick it in the form. */
514 else if (CONSP (fun))
516 Lisp_Object tem;
518 tem = XCAR (fun);
519 if (EQ (tem, Qlambda) || EQ (tem, Qautoload)
520 || (EQ (tem, Qclosure) && (fun = XCDR (fun), 1)))
522 tem = Fcdr (Fcdr (fun));
523 if (CONSP (tem) && INTEGERP (XCAR (tem)))
524 /* FIXME: This modifies typically pure hash-cons'd data, so its
525 correctness is quite delicate. */
526 XSETCAR (tem, make_number (offset));
528 else if (EQ (tem, Qmacro))
529 store_function_docstring (XCDR (fun), offset);
532 /* Bytecode objects sometimes have slots for it. */
533 else if (COMPILEDP (fun))
535 /* This bytecode object must have a slot for the
536 docstring, since we've found a docstring for it. */
537 if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) > COMPILED_DOC_STRING)
538 ASET (fun, COMPILED_DOC_STRING, make_number (offset));
539 else
540 message ("No docstring slot for %s",
541 SYMBOLP (obj) ? SSDATA (SYMBOL_NAME (obj)) : "<anonymous>");
546 DEFUN ("Snarf-documentation", Fsnarf_documentation, Ssnarf_documentation,
547 1, 1, 0,
548 doc: /* Used during Emacs initialization to scan the `etc/DOC...' file.
549 This searches the `etc/DOC...' file for doc strings and
550 records them in function and variable definitions.
551 The function takes one argument, FILENAME, a string;
552 it specifies the file name (without a directory) of the DOC file.
553 That file is found in `../etc' now; later, when the dumped Emacs is run,
554 the same file name is found in the `doc-directory'. */)
555 (Lisp_Object filename)
557 int fd;
558 char buf[1024 + 1];
559 int filled;
560 EMACS_INT pos;
561 Lisp_Object sym;
562 char *p, *name;
563 bool skip_file = 0;
564 ptrdiff_t count;
565 char const *dirname;
566 ptrdiff_t dirlen;
567 /* Preloaded defcustoms using custom-initialize-delay are added to
568 this list, but kept unbound. See http://debbugs.gnu.org/11565 */
569 Lisp_Object delayed_init =
570 find_symbol_value (intern ("custom-delayed-init-variables"));
572 if (EQ (delayed_init, Qunbound)) delayed_init = Qnil;
574 CHECK_STRING (filename);
577 #ifndef CANNOT_DUMP
578 (!NILP (Vpurify_flag))
579 #else /* CANNOT_DUMP */
581 #endif /* CANNOT_DUMP */
583 static char const sibling_etc[] = "../etc/";
584 dirname = sibling_etc;
585 dirlen = sizeof sibling_etc - 1;
587 else
589 CHECK_STRING (Vdoc_directory);
590 dirname = SSDATA (Vdoc_directory);
591 dirlen = SBYTES (Vdoc_directory);
594 count = SPECPDL_INDEX ();
595 USE_SAFE_ALLOCA;
596 name = SAFE_ALLOCA (dirlen + SBYTES (filename) + 1);
597 strcpy (name, dirname);
598 strcat (name, SSDATA (filename)); /*** Add this line ***/
600 /* Vbuild_files is nil when temacs is run, and non-nil after that. */
601 if (NILP (Vbuild_files))
603 static char const *const buildobj[] =
605 #include "buildobj.h"
607 int i = ARRAYELTS (buildobj);
608 while (0 <= --i)
609 Vbuild_files = Fcons (build_string (buildobj[i]), Vbuild_files);
610 Vbuild_files = Fpurecopy (Vbuild_files);
613 fd = emacs_open (name, O_RDONLY, 0);
614 if (fd < 0)
616 int open_errno = errno;
617 report_file_errno ("Opening doc string file", build_string (name),
618 open_errno);
620 record_unwind_protect_int (close_file_unwind, fd);
621 Vdoc_file_name = filename;
622 filled = 0;
623 pos = 0;
624 while (1)
626 register char *end;
627 if (filled < 512)
628 filled += emacs_read (fd, &buf[filled], sizeof buf - 1 - filled);
629 if (!filled)
630 break;
632 buf[filled] = 0;
633 end = buf + (filled < 512 ? filled : filled - 128);
634 p = memchr (buf, '\037', end - buf);
635 /* p points to ^_Ffunctionname\n or ^_Vvarname\n or ^_Sfilename\n. */
636 if (p)
638 end = strchr (p, '\n');
640 /* See if this is a file name, and if it is a file in build-files. */
641 if (p[1] == 'S')
643 skip_file = 0;
644 if (end - p > 4 && end[-2] == '.'
645 && (end[-1] == 'o' || end[-1] == 'c'))
647 ptrdiff_t len = end - p - 2;
648 char *fromfile = SAFE_ALLOCA (len + 1);
649 memcpy (fromfile, &p[2], len);
650 fromfile[len] = 0;
651 if (fromfile[len-1] == 'c')
652 fromfile[len-1] = 'o';
654 skip_file = NILP (Fmember (build_string (fromfile),
655 Vbuild_files));
659 sym = oblookup (Vobarray, p + 2,
660 multibyte_chars_in_text ((unsigned char *) p + 2,
661 end - p - 2),
662 end - p - 2);
663 /* Check skip_file so that when a function is defined several
664 times in different files (typically, once in xterm, once in
665 w32term, ...), we only pay attention to the one that
666 matters. */
667 if (! skip_file && SYMBOLP (sym))
669 /* Attach a docstring to a variable? */
670 if (p[1] == 'V')
672 /* Install file-position as variable-documentation property
673 and make it negative for a user-variable
674 (doc starts with a `*'). */
675 if (!NILP (Fboundp (sym))
676 || !NILP (Fmemq (sym, delayed_init)))
677 Fput (sym, Qvariable_documentation,
678 make_number ((pos + end + 1 - buf)
679 * (end[1] == '*' ? -1 : 1)));
682 /* Attach a docstring to a function? */
683 else if (p[1] == 'F')
685 if (!NILP (Ffboundp (sym)))
686 store_function_docstring (sym, pos + end + 1 - buf);
688 else if (p[1] == 'S')
689 ; /* Just a source file name boundary marker. Ignore it. */
691 else
692 error ("DOC file invalid at position %"pI"d", pos);
695 pos += end - buf;
696 filled -= end - buf;
697 memmove (buf, end, filled);
700 SAFE_FREE ();
701 return unbind_to (count, Qnil);
704 DEFUN ("substitute-command-keys", Fsubstitute_command_keys,
705 Ssubstitute_command_keys, 1, 1, 0,
706 doc: /* Substitute key descriptions for command names in STRING.
707 Each substring of the form \\=\\[COMMAND] is replaced by either a
708 keystroke sequence that invokes COMMAND, or "M-x COMMAND" if COMMAND
709 is not on any keys.
711 Each substring of the form \\=\\{MAPVAR} is replaced by a summary of
712 the value of MAPVAR as a keymap. This summary is similar to the one
713 produced by `describe-bindings'. The summary ends in two newlines
714 \(used by the helper function `help-make-xrefs' to find the end of the
715 summary).
717 Each substring of the form \\=\\<MAPVAR> specifies the use of MAPVAR
718 as the keymap for future \\=\\[COMMAND] substrings.
719 \\=\\= quotes the following character and is discarded;
720 thus, \\=\\=\\=\\= puts \\=\\= into the output, and \\=\\=\\=\\[ puts \\=\\[ into the output.
722 Return the original STRING if no substitutions are made.
723 Otherwise, return a new string. */)
724 (Lisp_Object string)
726 char *buf;
727 bool changed = 0;
728 unsigned char *strp;
729 char *bufp;
730 ptrdiff_t idx;
731 ptrdiff_t bsize;
732 Lisp_Object tem;
733 Lisp_Object keymap;
734 unsigned char *start;
735 ptrdiff_t length, length_byte;
736 Lisp_Object name;
737 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
738 bool multibyte;
739 ptrdiff_t nchars;
741 if (NILP (string))
742 return Qnil;
744 CHECK_STRING (string);
745 tem = Qnil;
746 keymap = Qnil;
747 name = Qnil;
748 GCPRO4 (string, tem, keymap, name);
750 multibyte = STRING_MULTIBYTE (string);
751 nchars = 0;
753 /* KEYMAP is either nil (which means search all the active keymaps)
754 or a specified local map (which means search just that and the
755 global map). If non-nil, it might come from Voverriding_local_map,
756 or from a \\<mapname> construct in STRING itself.. */
757 keymap = Voverriding_local_map;
759 bsize = SBYTES (string);
760 bufp = buf = xmalloc (bsize);
762 strp = SDATA (string);
763 while (strp < SDATA (string) + SBYTES (string))
765 if (strp[0] == '\\' && strp[1] == '=')
767 /* \= quotes the next character;
768 thus, to put in \[ without its special meaning, use \=\[. */
769 changed = 1;
770 strp += 2;
771 if (multibyte)
773 int len;
775 STRING_CHAR_AND_LENGTH (strp, len);
776 if (len == 1)
777 *bufp = *strp;
778 else
779 memcpy (bufp, strp, len);
780 strp += len;
781 bufp += len;
782 nchars++;
784 else
785 *bufp++ = *strp++, nchars++;
787 else if (strp[0] == '\\' && strp[1] == '[')
789 ptrdiff_t start_idx;
790 bool follow_remap = 1;
792 changed = 1;
793 strp += 2; /* skip \[ */
794 start = strp;
795 start_idx = start - SDATA (string);
797 while ((strp - SDATA (string)
798 < SBYTES (string))
799 && *strp != ']')
800 strp++;
801 length_byte = strp - start;
803 strp++; /* skip ] */
805 /* Save STRP in IDX. */
806 idx = strp - SDATA (string);
807 name = Fintern (make_string ((char *) start, length_byte), Qnil);
809 do_remap:
810 tem = Fwhere_is_internal (name, keymap, Qt, Qnil, Qnil);
812 if (VECTORP (tem) && ASIZE (tem) > 1
813 && EQ (AREF (tem, 0), Qremap) && SYMBOLP (AREF (tem, 1))
814 && follow_remap)
816 name = AREF (tem, 1);
817 follow_remap = 0;
818 goto do_remap;
821 /* Note the Fwhere_is_internal can GC, so we have to take
822 relocation of string contents into account. */
823 strp = SDATA (string) + idx;
824 start = SDATA (string) + start_idx;
826 if (NILP (tem)) /* but not on any keys */
828 ptrdiff_t offset = bufp - buf;
829 if (STRING_BYTES_BOUND - 4 < bsize)
830 string_overflow ();
831 buf = xrealloc (buf, bsize += 4);
832 bufp = buf + offset;
833 memcpy (bufp, "M-x ", 4);
834 bufp += 4;
835 nchars += 4;
836 if (multibyte)
837 length = multibyte_chars_in_text (start, length_byte);
838 else
839 length = length_byte;
840 goto subst;
842 else
843 { /* function is on a key */
844 tem = Fkey_description (tem, Qnil);
845 goto subst_string;
848 /* \{foo} is replaced with a summary of the keymap (symbol-value foo).
849 \<foo> just sets the keymap used for \[cmd]. */
850 else if (strp[0] == '\\' && (strp[1] == '{' || strp[1] == '<'))
852 struct buffer *oldbuf;
853 ptrdiff_t start_idx;
854 /* This is for computing the SHADOWS arg for describe_map_tree. */
855 Lisp_Object active_maps = Fcurrent_active_maps (Qnil, Qnil);
856 Lisp_Object earlier_maps;
857 ptrdiff_t count = SPECPDL_INDEX ();
859 changed = 1;
860 strp += 2; /* skip \{ or \< */
861 start = strp;
862 start_idx = start - SDATA (string);
864 while ((strp - SDATA (string) < SBYTES (string))
865 && *strp != '}' && *strp != '>')
866 strp++;
868 length_byte = strp - start;
869 strp++; /* skip } or > */
871 /* Save STRP in IDX. */
872 idx = strp - SDATA (string);
874 /* Get the value of the keymap in TEM, or nil if undefined.
875 Do this while still in the user's current buffer
876 in case it is a local variable. */
877 name = Fintern (make_string ((char *) start, length_byte), Qnil);
878 tem = Fboundp (name);
879 if (! NILP (tem))
881 tem = Fsymbol_value (name);
882 if (! NILP (tem))
884 tem = get_keymap (tem, 0, 1);
885 /* Note that get_keymap can GC. */
886 strp = SDATA (string) + idx;
887 start = SDATA (string) + start_idx;
891 /* Now switch to a temp buffer. */
892 oldbuf = current_buffer;
893 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer));
894 /* This is for an unusual case where some after-change
895 function uses 'format' or 'prin1' or something else that
896 will thrash Vprin1_to_string_buffer we are using. */
897 specbind (Qinhibit_modification_hooks, Qt);
899 if (NILP (tem))
901 name = Fsymbol_name (name);
902 insert_string ("\nUses keymap `");
903 insert_from_string (name, 0, 0,
904 SCHARS (name),
905 SBYTES (name), 1);
906 insert_string ("', which is not currently defined.\n");
907 if (start[-1] == '<') keymap = Qnil;
909 else if (start[-1] == '<')
910 keymap = tem;
911 else
913 /* Get the list of active keymaps that precede this one.
914 If this one's not active, get nil. */
915 earlier_maps = Fcdr (Fmemq (tem, Freverse (active_maps)));
916 describe_map_tree (tem, 1, Fnreverse (earlier_maps),
917 Qnil, 0, 1, 0, 0, 1);
919 tem = Fbuffer_string ();
920 Ferase_buffer ();
921 set_buffer_internal (oldbuf);
922 unbind_to (count, Qnil);
924 subst_string:
925 start = SDATA (tem);
926 length = SCHARS (tem);
927 length_byte = SBYTES (tem);
928 subst:
930 ptrdiff_t offset = bufp - buf;
931 if (STRING_BYTES_BOUND - length_byte < bsize)
932 string_overflow ();
933 buf = xrealloc (buf, bsize += length_byte);
934 bufp = buf + offset;
935 memcpy (bufp, start, length_byte);
936 bufp += length_byte;
937 nchars += length;
938 /* Check STRING again in case gc relocated it. */
939 strp = SDATA (string) + idx;
942 else if (! multibyte) /* just copy other chars */
943 *bufp++ = *strp++, nchars++;
944 else
946 int len;
948 STRING_CHAR_AND_LENGTH (strp, len);
949 if (len == 1)
950 *bufp = *strp;
951 else
952 memcpy (bufp, strp, len);
953 strp += len;
954 bufp += len;
955 nchars++;
959 if (changed) /* don't bother if nothing substituted */
960 tem = make_string_from_bytes (buf, nchars, bufp - buf);
961 else
962 tem = string;
963 xfree (buf);
964 RETURN_UNGCPRO (tem);
967 void
968 syms_of_doc (void)
970 DEFSYM (Qfunction_documentation, "function-documentation");
972 DEFVAR_LISP ("internal-doc-file-name", Vdoc_file_name,
973 doc: /* Name of file containing documentation strings of built-in symbols. */);
974 Vdoc_file_name = Qnil;
976 DEFVAR_LISP ("build-files", Vbuild_files,
977 doc: /* A list of files used to build this Emacs binary. */);
978 Vbuild_files = Qnil;
980 defsubr (&Sdocumentation);
981 defsubr (&Sdocumentation_property);
982 defsubr (&Ssnarf_documentation);
983 defsubr (&Ssubstitute_command_keys);