; doc/emacs/misc.texi (Network Security): Fix typo.
[emacs.git] / src / doc.c
blob4264ed50640fe54a0b83cccd937fbf17bd76bab9
1 /* Record indices of function doc strings stored in a file. -*- coding: utf-8 -*-
3 Copyright (C) 1985-1986, 1993-1995, 1997-2018 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 (at
11 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 <https://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 "coding.h"
35 #include "buffer.h"
36 #include "disptab.h"
37 #include "intervals.h"
38 #include "keymap.h"
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 static char const sibling_etc[] = "../etc/";
48 /* `readchar' in lread.c calls back here to fetch the next byte.
49 If UNREADFLAG is 1, we unread a byte. */
51 int
52 read_bytecode_char (bool unreadflag)
54 if (unreadflag)
56 read_bytecode_pointer--;
57 return 0;
59 return *read_bytecode_pointer++;
62 /* Extract a doc string from a file. FILEPOS says where to get it.
63 If it is an integer, use that position in the standard DOC file.
64 If it is (FILE . INTEGER), use FILE as the file name
65 and INTEGER as the position in that file.
66 But if INTEGER is negative, make it positive.
67 (A negative integer is used for user variables, so we can distinguish
68 them without actually fetching the doc string.)
70 If the location does not point to the beginning of a docstring
71 (e.g. because the file has been modified and the location is stale),
72 return nil.
74 If UNIBYTE, always make a unibyte string.
76 If DEFINITION, assume this is for reading
77 a dynamic function definition; convert the bytestring
78 and the constants vector with appropriate byte handling,
79 and return a cons cell. */
81 Lisp_Object
82 get_doc_string (Lisp_Object filepos, bool unibyte, bool definition)
84 char *from, *to, *name, *p, *p1;
85 int fd;
86 int offset;
87 EMACS_INT position;
88 Lisp_Object file, tem, pos;
89 ptrdiff_t count;
90 USE_SAFE_ALLOCA;
92 if (INTEGERP (filepos))
94 file = Vdoc_file_name;
95 pos = filepos;
97 else if (CONSP (filepos))
99 file = XCAR (filepos);
100 pos = XCDR (filepos);
102 else
103 return Qnil;
105 position = eabs (XINT (pos));
107 if (!STRINGP (Vdoc_directory))
108 return Qnil;
110 if (!STRINGP (file))
111 return Qnil;
113 /* Put the file name in NAME as a C string.
114 If it is relative, combine it with Vdoc_directory. */
116 tem = Ffile_name_absolute_p (file);
117 file = ENCODE_FILE (file);
118 Lisp_Object docdir
119 = NILP (tem) ? ENCODE_FILE (Vdoc_directory) : empty_unibyte_string;
120 ptrdiff_t docdir_sizemax = SBYTES (docdir) + 1;
121 #ifndef CANNOT_DUMP
122 docdir_sizemax = max (docdir_sizemax, sizeof sibling_etc);
123 #endif
124 name = SAFE_ALLOCA (docdir_sizemax + SBYTES (file));
125 lispstpcpy (lispstpcpy (name, docdir), file);
127 fd = emacs_open (name, O_RDONLY, 0);
128 if (fd < 0)
130 #ifndef CANNOT_DUMP
131 if (!NILP (Vpurify_flag))
133 /* Preparing to dump; DOC file is probably not installed.
134 So check in ../etc. */
135 lispstpcpy (stpcpy (name, sibling_etc), file);
137 fd = emacs_open (name, O_RDONLY, 0);
139 #endif
140 if (fd < 0)
142 if (errno == EMFILE || errno == ENFILE)
143 report_file_error ("Read error on documentation file", file);
145 SAFE_FREE ();
146 AUTO_STRING (cannot_open, "Cannot open doc string file \"");
147 AUTO_STRING (quote_nl, "\"\n");
148 return concat3 (cannot_open, file, quote_nl);
151 count = SPECPDL_INDEX ();
152 record_unwind_protect_int (close_file_unwind, fd);
154 /* Seek only to beginning of disk block. */
155 /* Make sure we read at least 1024 bytes before `position'
156 so we can check the leading text for consistency. */
157 offset = min (position, max (1024, position % (8 * 1024)));
158 if (TYPE_MAXIMUM (off_t) < position
159 || lseek (fd, position - offset, 0) < 0)
160 error ("Position %"pI"d out of range in doc string file \"%s\"",
161 position, name);
163 /* Read the doc string into get_doc_string_buffer.
164 P points beyond the data just read. */
166 p = get_doc_string_buffer;
167 while (1)
169 ptrdiff_t space_left = (get_doc_string_buffer_size - 1
170 - (p - get_doc_string_buffer));
171 int nread;
173 /* Allocate or grow the buffer if we need to. */
174 if (space_left <= 0)
176 ptrdiff_t in_buffer = p - get_doc_string_buffer;
177 get_doc_string_buffer
178 = xpalloc (get_doc_string_buffer, &get_doc_string_buffer_size,
179 16 * 1024, -1, 1);
180 p = get_doc_string_buffer + in_buffer;
181 space_left = (get_doc_string_buffer_size - 1
182 - (p - get_doc_string_buffer));
185 /* Read a disk block at a time.
186 If we read the same block last time, maybe skip this? */
187 if (space_left > 1024 * 8)
188 space_left = 1024 * 8;
189 nread = emacs_read_quit (fd, p, space_left);
190 if (nread < 0)
191 report_file_error ("Read error on documentation file", file);
192 p[nread] = 0;
193 if (!nread)
194 break;
195 if (p == get_doc_string_buffer)
196 p1 = strchr (p + offset, '\037');
197 else
198 p1 = strchr (p, '\037');
199 if (p1)
201 *p1 = 0;
202 p = p1;
203 break;
205 p += nread;
207 unbind_to (count, Qnil);
208 SAFE_FREE ();
210 /* Sanity checking. */
211 if (CONSP (filepos))
213 int test = 1;
214 /* A dynamic docstring should be either at the very beginning of a "#@
215 comment" or right after a dynamic docstring delimiter (in case we
216 pack several such docstrings within the same comment). */
217 if (get_doc_string_buffer[offset - test] != '\037')
219 if (get_doc_string_buffer[offset - test++] != ' ')
220 return Qnil;
221 while (get_doc_string_buffer[offset - test] >= '0'
222 && get_doc_string_buffer[offset - test] <= '9')
223 test++;
224 if (get_doc_string_buffer[offset - test++] != '@'
225 || get_doc_string_buffer[offset - test] != '#')
226 return Qnil;
229 else
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;
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)
246 if (*from == 1)
248 int c;
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
260 unsigned char uc = c;
261 error ("\
262 Invalid data in documentation file -- %c followed by code %03o",
263 1, uc);
266 else
267 *to++ = *from++;
270 /* If DEFINITION, read from this buffer
271 the same way we would read bytes from a file. */
272 if (definition)
274 read_bytecode_pointer = (unsigned char *) get_doc_string_buffer + offset;
275 return Fread (Qlambda);
278 if (unibyte)
279 return make_unibyte_string (get_doc_string_buffer + offset,
280 to - (get_doc_string_buffer + offset));
281 else
283 /* The data determines whether the string is multibyte. */
284 ptrdiff_t nchars
285 = multibyte_chars_in_text (((unsigned char *) get_doc_string_buffer
286 + offset),
287 to - (get_doc_string_buffer + offset));
288 return make_string_from_bytes (get_doc_string_buffer + offset,
289 nchars,
290 to - (get_doc_string_buffer + offset));
294 /* Get a string from position FILEPOS and pass it through the Lisp reader.
295 We use this for fetching the bytecode string and constants vector
296 of a compiled function from the .elc file. */
298 Lisp_Object
299 read_doc_string (Lisp_Object filepos)
301 return get_doc_string (filepos, 0, 1);
304 static bool
305 reread_doc_file (Lisp_Object file)
307 if (NILP (file))
308 Fsnarf_documentation (Vdoc_file_name);
309 else
310 Fload (file, Qt, Qt, Qt, Qnil);
312 return 1;
315 DEFUN ("documentation", Fdocumentation, Sdocumentation, 1, 2, 0,
316 doc: /* Return the documentation string of FUNCTION.
317 Unless a non-nil second argument RAW is given, the
318 string is passed through `substitute-command-keys'. */)
319 (Lisp_Object function, Lisp_Object raw)
321 Lisp_Object fun;
322 Lisp_Object funcar;
323 Lisp_Object doc;
324 bool try_reload = 1;
326 documentation:
328 doc = Qnil;
330 if (SYMBOLP (function))
332 Lisp_Object tem = Fget (function, Qfunction_documentation);
333 if (!NILP (tem))
334 return Fdocumentation_property (function, Qfunction_documentation,
335 raw);
338 fun = Findirect_function (function, Qnil);
339 if (NILP (fun))
340 xsignal1 (Qvoid_function, function);
341 if (CONSP (fun) && EQ (XCAR (fun), Qmacro))
342 fun = XCDR (fun);
343 if (SUBRP (fun))
344 doc = make_number (XSUBR (fun)->doc);
345 else if (MODULE_FUNCTIONP (fun))
346 doc = XMODULE_FUNCTION (fun)->documentation;
347 else if (COMPILEDP (fun))
349 if (PVSIZE (fun) <= COMPILED_DOC_STRING)
350 return Qnil;
351 else
353 Lisp_Object tem = AREF (fun, COMPILED_DOC_STRING);
354 if (STRINGP (tem))
355 doc = tem;
356 else if (NATNUMP (tem) || CONSP (tem))
357 doc = tem;
358 else
359 return Qnil;
362 else if (STRINGP (fun) || VECTORP (fun))
364 return build_string ("Keyboard macro.");
366 else if (CONSP (fun))
368 funcar = XCAR (fun);
369 if (!SYMBOLP (funcar))
370 xsignal1 (Qinvalid_function, fun);
371 else if (EQ (funcar, Qkeymap))
372 return build_string ("Prefix command (definition is a keymap associating keystrokes with commands).");
373 else if (EQ (funcar, Qlambda)
374 || (EQ (funcar, Qclosure) && (fun = XCDR (fun), 1))
375 || EQ (funcar, Qautoload))
377 Lisp_Object tem1 = Fcdr (Fcdr (fun));
378 Lisp_Object tem = Fcar (tem1);
379 if (STRINGP (tem))
380 doc = tem;
381 /* Handle a doc reference--but these never come last
382 in the function body, so reject them if they are last. */
383 else if ((NATNUMP (tem) || (CONSP (tem) && INTEGERP (XCDR (tem))))
384 && !NILP (XCDR (tem1)))
385 doc = tem;
386 else
387 return Qnil;
389 else
390 goto oops;
392 else
394 oops:
395 xsignal1 (Qinvalid_function, fun);
398 /* If DOC is 0, it's typically because of a dumped file missing
399 from the DOC file (bug in src/Makefile.in). */
400 if (EQ (doc, make_number (0)))
401 doc = Qnil;
402 if (INTEGERP (doc) || CONSP (doc))
404 Lisp_Object tem;
405 tem = get_doc_string (doc, 0, 0);
406 if (NILP (tem) && try_reload)
408 /* The file is newer, we need to reset the pointers. */
409 try_reload = reread_doc_file (Fcar_safe (doc));
410 if (try_reload)
412 try_reload = 0;
413 goto documentation;
416 else
417 doc = tem;
420 if (NILP (raw))
421 doc = Fsubstitute_command_keys (doc);
422 return doc;
425 DEFUN ("documentation-property", Fdocumentation_property,
426 Sdocumentation_property, 2, 3, 0,
427 doc: /* Return the documentation string that is SYMBOL's PROP property.
428 Third argument RAW omitted or nil means pass the result through
429 `substitute-command-keys' if it is a string.
431 This differs from `get' in that it can refer to strings stored in the
432 `etc/DOC' file; and that it evaluates documentation properties that
433 aren't strings. */)
434 (Lisp_Object symbol, Lisp_Object prop, Lisp_Object raw)
436 bool try_reload = 1;
437 Lisp_Object tem;
439 documentation_property:
441 tem = Fget (symbol, prop);
442 if (EQ (tem, make_number (0)))
443 tem = Qnil;
444 if (INTEGERP (tem) || (CONSP (tem) && INTEGERP (XCDR (tem))))
446 Lisp_Object doc = tem;
447 tem = get_doc_string (tem, 0, 0);
448 if (NILP (tem) && try_reload)
450 /* The file is newer, we need to reset the pointers. */
451 try_reload = reread_doc_file (Fcar_safe (doc));
452 if (try_reload)
454 try_reload = 0;
455 goto documentation_property;
459 else if (!STRINGP (tem))
460 /* Feval protects its argument. */
461 tem = Feval (tem, Qnil);
463 if (NILP (raw) && STRINGP (tem))
464 tem = Fsubstitute_command_keys (tem);
465 return tem;
468 /* Scanning the DOC files and placing docstring offsets into functions. */
470 static void
471 store_function_docstring (Lisp_Object obj, EMACS_INT offset)
473 /* Don't use indirect_function here, or defaliases will apply their
474 docstrings to the base functions (Bug#2603). */
475 Lisp_Object fun = SYMBOLP (obj) ? XSYMBOL (obj)->u.s.function : obj;
477 /* The type determines where the docstring is stored. */
479 /* If it's a lisp form, stick it in the form. */
480 if (CONSP (fun) && EQ (XCAR (fun), Qmacro))
481 fun = XCDR (fun);
482 if (CONSP (fun))
484 Lisp_Object tem;
486 tem = XCAR (fun);
487 if (EQ (tem, Qlambda) || EQ (tem, Qautoload)
488 || (EQ (tem, Qclosure) && (fun = XCDR (fun), 1)))
490 tem = Fcdr (Fcdr (fun));
491 if (CONSP (tem) && INTEGERP (XCAR (tem)))
492 /* FIXME: This modifies typically pure hash-cons'd data, so its
493 correctness is quite delicate. */
494 XSETCAR (tem, make_number (offset));
498 /* Lisp_Subrs have a slot for it. */
499 else if (SUBRP (fun))
500 XSUBR (fun)->doc = offset;
502 /* Bytecode objects sometimes have slots for it. */
503 else if (COMPILEDP (fun))
505 /* This bytecode object must have a slot for the
506 docstring, since we've found a docstring for it. */
507 if (PVSIZE (fun) > COMPILED_DOC_STRING)
508 ASET (fun, COMPILED_DOC_STRING, make_number (offset));
509 else
511 AUTO_STRING (format, "No docstring slot for %s");
512 CALLN (Fmessage, format,
513 (SYMBOLP (obj)
514 ? SYMBOL_NAME (obj)
515 : build_string ("<anonymous>")));
521 DEFUN ("Snarf-documentation", Fsnarf_documentation, Ssnarf_documentation,
522 1, 1, 0,
523 doc: /* Used during Emacs initialization to scan the `etc/DOC...' file.
524 This searches the `etc/DOC...' file for doc strings and
525 records them in function and variable definitions.
526 The function takes one argument, FILENAME, a string;
527 it specifies the file name (without a directory) of the DOC file.
528 That file is found in `../etc' now; later, when the dumped Emacs is run,
529 the same file name is found in the `doc-directory'. */)
530 (Lisp_Object filename)
532 int fd;
533 char buf[1024 + 1];
534 int filled;
535 EMACS_INT pos;
536 Lisp_Object sym;
537 char *p, *name;
538 ptrdiff_t count;
539 char const *dirname;
540 ptrdiff_t dirlen;
541 /* Preloaded defcustoms using custom-initialize-delay are added to
542 this list, but kept unbound. See https://debbugs.gnu.org/11565 */
543 Lisp_Object delayed_init =
544 find_symbol_value (intern ("custom-delayed-init-variables"));
546 if (EQ (delayed_init, Qunbound)) delayed_init = Qnil;
548 CHECK_STRING (filename);
551 #ifndef CANNOT_DUMP
552 (!NILP (Vpurify_flag))
553 #else /* CANNOT_DUMP */
555 #endif /* CANNOT_DUMP */
557 dirname = sibling_etc;
558 dirlen = sizeof sibling_etc - 1;
560 else
562 CHECK_STRING (Vdoc_directory);
563 dirname = SSDATA (Vdoc_directory);
564 dirlen = SBYTES (Vdoc_directory);
567 count = SPECPDL_INDEX ();
568 USE_SAFE_ALLOCA;
569 name = SAFE_ALLOCA (dirlen + SBYTES (filename) + 1);
570 lispstpcpy (stpcpy (name, dirname), filename); /*** Add this line ***/
572 /* Vbuild_files is nil when temacs is run, and non-nil after that. */
573 if (NILP (Vbuild_files))
575 static char const *const buildobj[] =
577 #include "buildobj.h"
579 int i = ARRAYELTS (buildobj);
580 while (0 <= --i)
581 Vbuild_files = Fcons (build_string (buildobj[i]), Vbuild_files);
582 Vbuild_files = Fpurecopy (Vbuild_files);
585 fd = emacs_open (name, O_RDONLY, 0);
586 if (fd < 0)
588 int open_errno = errno;
589 report_file_errno ("Opening doc string file", build_string (name),
590 open_errno);
592 record_unwind_protect_int (close_file_unwind, fd);
593 Vdoc_file_name = filename;
594 filled = 0;
595 pos = 0;
596 while (true)
598 if (filled < 512)
599 filled += emacs_read_quit (fd, &buf[filled], sizeof buf - 1 - filled);
600 if (!filled)
601 break;
603 buf[filled] = 0;
604 char *end = buf + (filled < 512 ? filled : filled - 128);
605 p = memchr (buf, '\037', end - buf);
606 /* p points to ^_Ffunctionname\n or ^_Vvarname\n or ^_Sfilename\n. */
607 if (p)
609 end = strchr (p, '\n');
611 /* We used to skip files not in build_files, so that when a
612 function was defined several times in different files
613 (typically, once in xterm, once in w32term, ...), we only
614 paid attention to the relevant one.
616 But this meant the doc had to be kept and updated in
617 multiple files. Nowadays we keep the doc only in eg xterm.
618 The (f)boundp checks below ensure we don't report
619 docs for eg w32-specific items on X.
622 sym = oblookup (Vobarray, p + 2,
623 multibyte_chars_in_text ((unsigned char *) p + 2,
624 end - p - 2),
625 end - p - 2);
626 /* Ignore docs that start with SKIP. These mark
627 placeholders where the real doc is elsewhere. */
628 if (SYMBOLP (sym))
630 /* Attach a docstring to a variable? */
631 if (p[1] == 'V')
633 /* Install file-position as variable-documentation property
634 and make it negative for a user-variable
635 (doc starts with a `*'). */
636 if ((!NILP (Fboundp (sym))
637 || !NILP (Fmemq (sym, delayed_init)))
638 && strncmp (end, "\nSKIP", 5))
639 Fput (sym, Qvariable_documentation,
640 make_number ((pos + end + 1 - buf)
641 * (end[1] == '*' ? -1 : 1)));
644 /* Attach a docstring to a function? */
645 else if (p[1] == 'F')
647 if (!NILP (Ffboundp (sym)) && strncmp (end, "\nSKIP", 5))
648 store_function_docstring (sym, pos + end + 1 - buf);
650 else if (p[1] == 'S')
651 ; /* Just a source file name boundary marker. Ignore it. */
653 else
654 error ("DOC file invalid at position %"pI"d", pos);
657 pos += end - buf;
658 filled -= end - buf;
659 memmove (buf, end, filled);
662 SAFE_FREE ();
663 return unbind_to (count, Qnil);
666 /* Return true if text quoting style should default to quote `like this'. */
667 static bool
668 default_to_grave_quoting_style (void)
670 if (!text_quoting_flag)
671 return true;
672 if (! DISP_TABLE_P (Vstandard_display_table))
673 return false;
674 Lisp_Object dv = DISP_CHAR_VECTOR (XCHAR_TABLE (Vstandard_display_table),
675 LEFT_SINGLE_QUOTATION_MARK);
676 return (VECTORP (dv) && ASIZE (dv) == 1
677 && EQ (AREF (dv, 0), make_number ('`')));
680 /* Return the current effective text quoting style. */
681 enum text_quoting_style
682 text_quoting_style (void)
684 if (NILP (Vtext_quoting_style)
685 ? default_to_grave_quoting_style ()
686 : EQ (Vtext_quoting_style, Qgrave))
687 return GRAVE_QUOTING_STYLE;
688 else if (EQ (Vtext_quoting_style, Qstraight))
689 return STRAIGHT_QUOTING_STYLE;
690 else
691 return CURVE_QUOTING_STYLE;
694 DEFUN ("substitute-command-keys", Fsubstitute_command_keys,
695 Ssubstitute_command_keys, 1, 1, 0,
696 doc: /* Substitute key descriptions for command names in STRING.
697 Each substring of the form \\=\\[COMMAND] is replaced by either a
698 keystroke sequence that invokes COMMAND, or "M-x COMMAND" if COMMAND
699 is not on any keys.
701 Each substring of the form \\=\\{MAPVAR} is replaced by a summary of
702 the value of MAPVAR as a keymap. This summary is similar to the one
703 produced by `describe-bindings'. The summary ends in two newlines
704 \(used by the helper function `help-make-xrefs' to find the end of the
705 summary).
707 Each substring of the form \\=\\<MAPVAR> specifies the use of MAPVAR
708 as the keymap for future \\=\\[COMMAND] substrings.
710 Each grave accent \\=` is replaced by left quote, and each apostrophe \\='
711 is replaced by right quote. Left and right quote characters are
712 specified by `text-quoting-style'.
714 \\=\\= quotes the following character and is discarded; thus, \\=\\=\\=\\= puts \\=\\=
715 into the output, \\=\\=\\=\\[ puts \\=\\[ into the output, and \\=\\=\\=` puts \\=` into the
716 output.
718 Return the original STRING if no substitutions are made.
719 Otherwise, return a new string. */)
720 (Lisp_Object string)
722 char *buf;
723 bool changed = false;
724 bool nonquotes_changed = false;
725 unsigned char *strp;
726 char *bufp;
727 ptrdiff_t idx;
728 ptrdiff_t bsize;
729 Lisp_Object tem;
730 Lisp_Object keymap;
731 unsigned char const *start;
732 ptrdiff_t length, length_byte;
733 Lisp_Object name;
734 ptrdiff_t nchars;
736 if (NILP (string))
737 return Qnil;
739 /* If STRING contains non-ASCII unibyte data, process its
740 properly-encoded multibyte equivalent instead. This simplifies
741 the implementation and is OK since substitute-command-keys is
742 intended for use only on text strings. Keep STRING around, since
743 it will be returned if no changes occur. */
744 Lisp_Object str = Fstring_make_multibyte (string);
746 enum text_quoting_style quoting_style = text_quoting_style ();
748 nchars = 0;
750 /* KEYMAP is either nil (which means search all the active keymaps)
751 or a specified local map (which means search just that and the
752 global map). If non-nil, it might come from Voverriding_local_map,
753 or from a \\<mapname> construct in STRING itself.. */
754 keymap = Voverriding_local_map;
756 ptrdiff_t strbytes = SBYTES (str);
757 bsize = strbytes;
759 /* Fixed-size stack buffer. */
760 char sbuf[MAX_ALLOCA];
762 /* Heap-allocated buffer, if any. */
763 char *abuf;
765 /* Extra room for expansion due to replacing ‘\[]’ with ‘M-x ’. */
766 enum { EXTRA_ROOM = sizeof "M-x " - sizeof "\\[]" };
768 ptrdiff_t count = SPECPDL_INDEX ();
770 if (bsize <= sizeof sbuf - EXTRA_ROOM)
772 abuf = NULL;
773 buf = sbuf;
774 bsize = sizeof sbuf;
776 else
778 buf = abuf = xpalloc (NULL, &bsize, EXTRA_ROOM, STRING_BYTES_BOUND, 1);
779 record_unwind_protect_ptr (xfree, abuf);
781 bufp = buf;
783 strp = SDATA (str);
784 while (strp < SDATA (str) + strbytes)
786 unsigned char *close_bracket;
788 if (strp[0] == '\\' && strp[1] == '='
789 && strp + 2 < SDATA (str) + strbytes)
791 /* \= quotes the next character;
792 thus, to put in \[ without its special meaning, use \=\[. */
793 changed = nonquotes_changed = true;
794 strp += 2;
795 /* Fall through to copy one char. */
797 else if (strp[0] == '\\' && strp[1] == '['
798 && (close_bracket
799 = memchr (strp + 2, ']',
800 SDATA (str) + strbytes - (strp + 2))))
802 bool follow_remap = 1;
804 start = strp + 2;
805 length_byte = close_bracket - start;
806 idx = close_bracket + 1 - SDATA (str);
808 name = Fintern (make_string ((char *) start, length_byte), Qnil);
810 do_remap:
811 tem = Fwhere_is_internal (name, keymap, Qt, Qnil, Qnil);
813 if (VECTORP (tem) && ASIZE (tem) > 1
814 && EQ (AREF (tem, 0), Qremap) && SYMBOLP (AREF (tem, 1))
815 && follow_remap)
817 name = AREF (tem, 1);
818 follow_remap = 0;
819 goto do_remap;
822 /* Fwhere_is_internal can GC, so take relocation of string
823 contents into account. */
824 strp = SDATA (str) + idx;
825 start = strp - length_byte - 1;
827 if (NILP (tem)) /* but not on any keys */
829 memcpy (bufp, "M-x ", 4);
830 bufp += 4;
831 nchars += 4;
832 length = multibyte_chars_in_text (start, length_byte);
833 goto subst;
835 else
836 { /* function is on a key */
837 tem = Fkey_description (tem, Qnil);
838 goto subst_string;
841 /* \{foo} is replaced with a summary of the keymap (symbol-value foo).
842 \<foo> just sets the keymap used for \[cmd]. */
843 else if (strp[0] == '\\' && (strp[1] == '{' || strp[1] == '<')
844 && (close_bracket
845 = memchr (strp + 2, strp[1] == '{' ? '}' : '>',
846 SDATA (str) + strbytes - (strp + 2))))
849 bool generate_summary = strp[1] == '{';
850 /* This is for computing the SHADOWS arg for describe_map_tree. */
851 Lisp_Object active_maps = Fcurrent_active_maps (Qnil, Qnil);
852 ptrdiff_t count = SPECPDL_INDEX ();
854 start = strp + 2;
855 length_byte = close_bracket - start;
856 idx = close_bracket + 1 - SDATA (str);
858 /* Get the value of the keymap in TEM, or nil if undefined.
859 Do this while still in the user's current buffer
860 in case it is a local variable. */
861 name = Fintern (make_string ((char *) start, length_byte), Qnil);
862 tem = Fboundp (name);
863 if (! NILP (tem))
865 tem = Fsymbol_value (name);
866 if (! NILP (tem))
867 tem = get_keymap (tem, 0, 1);
870 /* Now switch to a temp buffer. */
871 struct buffer *oldbuf = current_buffer;
872 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer));
873 /* This is for an unusual case where some after-change
874 function uses 'format' or 'prin1' or something else that
875 will thrash Vprin1_to_string_buffer we are using. */
876 specbind (Qinhibit_modification_hooks, Qt);
878 if (NILP (tem))
880 name = Fsymbol_name (name);
881 AUTO_STRING (msg_prefix, "\nUses keymap `");
882 insert1 (Fsubstitute_command_keys (msg_prefix));
883 insert_from_string (name, 0, 0,
884 SCHARS (name),
885 SBYTES (name), 1);
886 AUTO_STRING (msg_suffix, "', which is not currently defined.\n");
887 insert1 (Fsubstitute_command_keys (msg_suffix));
888 if (!generate_summary)
889 keymap = Qnil;
891 else if (!generate_summary)
892 keymap = tem;
893 else
895 /* Get the list of active keymaps that precede this one.
896 If this one's not active, get nil. */
897 Lisp_Object earlier_maps
898 = Fcdr (Fmemq (tem, Freverse (active_maps)));
899 describe_map_tree (tem, 1, Fnreverse (earlier_maps),
900 Qnil, 0, 1, 0, 0, 1);
902 tem = Fbuffer_string ();
903 Ferase_buffer ();
904 set_buffer_internal (oldbuf);
905 unbind_to (count, Qnil);
908 subst_string:
909 /* Convert non-ASCII unibyte data to properly-encoded multibyte,
910 for the same reason STRING was converted to STR. */
911 tem = Fstring_make_multibyte (tem);
912 start = SDATA (tem);
913 length = SCHARS (tem);
914 length_byte = SBYTES (tem);
915 subst:
916 nonquotes_changed = true;
917 subst_quote:
918 changed = true;
920 ptrdiff_t offset = bufp - buf;
921 ptrdiff_t avail = bsize - offset;
922 ptrdiff_t need = strbytes - idx;
923 if (INT_ADD_WRAPV (need, length_byte + EXTRA_ROOM, &need))
924 string_overflow ();
925 if (avail < need)
927 abuf = xpalloc (abuf, &bsize, need - avail,
928 STRING_BYTES_BOUND, 1);
929 if (buf == sbuf)
931 record_unwind_protect_ptr (xfree, abuf);
932 memcpy (abuf, sbuf, offset);
934 else
935 set_unwind_protect_ptr (count, xfree, abuf);
936 buf = abuf;
937 bufp = buf + offset;
939 memcpy (bufp, start, length_byte);
940 bufp += length_byte;
941 nchars += length;
943 /* Some of the previous code can GC, so take relocation of
944 string contents into account. */
945 strp = SDATA (str) + idx;
947 continue;
950 else if ((strp[0] == '`' || strp[0] == '\'')
951 && quoting_style == CURVE_QUOTING_STYLE)
953 start = (unsigned char const *) (strp[0] == '`' ? uLSQM : uRSQM);
954 length = 1;
955 length_byte = sizeof uLSQM - 1;
956 idx = strp - SDATA (str) + 1;
957 goto subst_quote;
959 else if (strp[0] == '`' && quoting_style == STRAIGHT_QUOTING_STYLE)
961 *bufp++ = '\'';
962 strp++;
963 nchars++;
964 changed = true;
965 continue;
968 /* Copy one char. */
970 *bufp++ = *strp++;
971 while (! CHAR_HEAD_P (*strp));
972 nchars++;
975 if (changed) /* don't bother if nothing substituted */
977 tem = make_string_from_bytes (buf, nchars, bufp - buf);
978 if (!nonquotes_changed)
980 /* Nothing has changed other than quoting, so copy the string’s
981 text properties. FIXME: Text properties should survive other
982 changes too. */
983 INTERVAL interval_copy = copy_intervals (string_intervals (string),
984 0, SCHARS (string));
985 if (interval_copy)
987 set_interval_object (interval_copy, tem);
988 set_string_intervals (tem, interval_copy);
992 else
993 tem = string;
994 return unbind_to (count, tem);
997 void
998 syms_of_doc (void)
1000 DEFSYM (Qfunction_documentation, "function-documentation");
1001 DEFSYM (Qgrave, "grave");
1002 DEFSYM (Qstraight, "straight");
1004 DEFVAR_LISP ("internal-doc-file-name", Vdoc_file_name,
1005 doc: /* Name of file containing documentation strings of built-in symbols. */);
1006 Vdoc_file_name = Qnil;
1008 DEFVAR_LISP ("build-files", Vbuild_files,
1009 doc: /* A list of files used to build this Emacs binary. */);
1010 Vbuild_files = Qnil;
1012 DEFVAR_LISP ("text-quoting-style", Vtext_quoting_style,
1013 doc: /* Style to use for single quotes in help and messages.
1014 Its value should be a symbol. It works by substituting certain single
1015 quotes for grave accent and apostrophe. This is done in help output
1016 \(but not for display of Info manuals) and in functions like `message'
1017 and `format-message'. It is not done in `format'.
1019 `curve' means quote with curved single quotes ‘like this’.
1020 `straight' means quote with straight apostrophes \\='like this\\='.
1021 `grave' means quote with grave accent and apostrophe \\=`like this\\=';
1022 i.e., do not alter quote marks. The default value nil acts like
1023 `curve' if curved single quotes are displayable, and like `grave'
1024 otherwise. */);
1025 Vtext_quoting_style = Qnil;
1027 DEFVAR_BOOL ("internal--text-quoting-flag", text_quoting_flag,
1028 doc: /* If nil, a nil `text-quoting-style' is treated as `grave'. */);
1029 /* Initialized by ‘main’. */
1031 defsubr (&Sdocumentation);
1032 defsubr (&Sdocumentation_property);
1033 defsubr (&Ssnarf_documentation);
1034 defsubr (&Ssubstitute_command_keys);