1 /* Record indices of function doc strings stored in a file. -*- coding: utf-8 -*-
3 Copyright (C) 1985-1986, 1993-1995, 1997-2017 Free Software Foundation,
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 <http://www.gnu.org/licenses/>. */
25 #include <sys/types.h>
26 #include <sys/file.h> /* Must be after sys/types.h for USG. */
33 #include "character.h"
37 #include "intervals.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. */
52 read_bytecode_char (bool unreadflag
)
56 read_bytecode_pointer
--;
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),
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. */
82 get_doc_string (Lisp_Object filepos
, bool unibyte
, bool definition
)
84 char *from
, *to
, *name
, *p
, *p1
;
88 Lisp_Object file
, tem
, pos
;
92 if (INTEGERP (filepos
))
94 file
= Vdoc_file_name
;
97 else if (CONSP (filepos
))
99 file
= XCAR (filepos
);
100 pos
= XCDR (filepos
);
105 position
= eabs (XINT (pos
));
107 if (!STRINGP (Vdoc_directory
))
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
);
119 = NILP (tem
) ? ENCODE_FILE (Vdoc_directory
) : empty_unibyte_string
;
120 ptrdiff_t docdir_sizemax
= SBYTES (docdir
) + 1;
122 docdir_sizemax
= max (docdir_sizemax
, sizeof sibling_etc
);
124 name
= SAFE_ALLOCA (docdir_sizemax
+ SBYTES (file
));
125 lispstpcpy (lispstpcpy (name
, docdir
), file
);
127 fd
= emacs_open (name
, O_RDONLY
, 0);
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);
142 if (errno
== EMFILE
|| errno
== ENFILE
)
143 report_file_error ("Read error on documentation file", file
);
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\"",
163 /* Read the doc string into get_doc_string_buffer.
164 P points beyond the data just read. */
166 p
= get_doc_string_buffer
;
169 ptrdiff_t space_left
= (get_doc_string_buffer_size
- 1
170 - (p
- get_doc_string_buffer
));
173 /* Allocate or grow the buffer if we need to. */
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
,
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 (fd
, p
, space_left
);
191 report_file_error ("Read error on documentation file", file
);
195 if (p
== get_doc_string_buffer
)
196 p1
= strchr (p
+ offset
, '\037');
198 p1
= strchr (p
, '\037');
207 unbind_to (count
, Qnil
);
210 /* Sanity checking. */
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
++] != ' ')
221 while (get_doc_string_buffer
[offset
- test
] >= '0'
222 && get_doc_string_buffer
[offset
- test
] <= '9')
224 if (get_doc_string_buffer
[offset
- test
++] != '@'
225 || get_doc_string_buffer
[offset
- test
] != '#')
232 if (get_doc_string_buffer
[offset
- test
++] != '\n')
234 while (get_doc_string_buffer
[offset
- test
] > ' ')
236 if (get_doc_string_buffer
[offset
- test
] != '\037')
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
;
260 unsigned char uc
= c
;
262 Invalid data in documentation file -- %c followed by code %03o",
270 /* If DEFINITION, read from this buffer
271 the same way we would read bytes from a file. */
274 read_bytecode_pointer
= (unsigned char *) get_doc_string_buffer
+ offset
;
275 return Fread (Qlambda
);
279 return make_unibyte_string (get_doc_string_buffer
+ offset
,
280 to
- (get_doc_string_buffer
+ offset
));
283 /* The data determines whether the string is multibyte. */
285 = multibyte_chars_in_text (((unsigned char *) get_doc_string_buffer
287 to
- (get_doc_string_buffer
+ offset
));
288 return make_string_from_bytes (get_doc_string_buffer
+ offset
,
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. */
299 read_doc_string (Lisp_Object filepos
)
301 return get_doc_string (filepos
, 0, 1);
305 reread_doc_file (Lisp_Object file
)
308 Fsnarf_documentation (Vdoc_file_name
);
310 Fload (file
, Qt
, Qt
, Qt
, Qnil
);
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
)
330 if (SYMBOLP (function
))
332 Lisp_Object tem
= Fget (function
, Qfunction_documentation
);
334 return Fdocumentation_property (function
, Qfunction_documentation
,
338 fun
= Findirect_function (function
, Qnil
);
339 if (CONSP (fun
) && EQ (XCAR (fun
), Qmacro
))
343 if (XSUBR (fun
)->doc
== 0)
345 /* FIXME: This is not portable, as it assumes that string
346 pointers have the top bit clear. */
347 else if ((intptr_t) XSUBR (fun
)->doc
>= 0)
348 doc
= build_string (XSUBR (fun
)->doc
);
350 doc
= make_number ((intptr_t) XSUBR (fun
)->doc
);
352 else if (COMPILEDP (fun
))
354 if ((ASIZE (fun
) & PSEUDOVECTOR_SIZE_MASK
) <= COMPILED_DOC_STRING
)
358 Lisp_Object tem
= AREF (fun
, COMPILED_DOC_STRING
);
361 else if (NATNUMP (tem
) || CONSP (tem
))
367 else if (STRINGP (fun
) || VECTORP (fun
))
369 return build_string ("Keyboard macro.");
371 else if (CONSP (fun
))
374 if (!SYMBOLP (funcar
))
375 xsignal1 (Qinvalid_function
, fun
);
376 else if (EQ (funcar
, Qkeymap
))
377 return build_string ("Prefix command (definition is a keymap associating keystrokes with commands).");
378 else if (EQ (funcar
, Qlambda
)
379 || (EQ (funcar
, Qclosure
) && (fun
= XCDR (fun
), 1))
380 || EQ (funcar
, Qautoload
))
382 Lisp_Object tem1
= Fcdr (Fcdr (fun
));
383 Lisp_Object tem
= Fcar (tem1
);
386 /* Handle a doc reference--but these never come last
387 in the function body, so reject them if they are last. */
388 else if ((NATNUMP (tem
) || (CONSP (tem
) && INTEGERP (XCDR (tem
))))
389 && !NILP (XCDR (tem1
)))
400 xsignal1 (Qinvalid_function
, fun
);
403 /* If DOC is 0, it's typically because of a dumped file missing
404 from the DOC file (bug in src/Makefile.in). */
405 if (EQ (doc
, make_number (0)))
407 if (INTEGERP (doc
) || CONSP (doc
))
410 tem
= get_doc_string (doc
, 0, 0);
411 if (NILP (tem
) && try_reload
)
413 /* The file is newer, we need to reset the pointers. */
414 try_reload
= reread_doc_file (Fcar_safe (doc
));
426 doc
= Fsubstitute_command_keys (doc
);
430 DEFUN ("documentation-property", Fdocumentation_property
,
431 Sdocumentation_property
, 2, 3, 0,
432 doc
: /* Return the documentation string that is SYMBOL's PROP property.
433 Third argument RAW omitted or nil means pass the result through
434 `substitute-command-keys' if it is a string.
436 This differs from `get' in that it can refer to strings stored in the
437 `etc/DOC' file; and that it evaluates documentation properties that
439 (Lisp_Object symbol
, Lisp_Object prop
, Lisp_Object raw
)
444 documentation_property
:
446 tem
= Fget (symbol
, prop
);
447 if (EQ (tem
, make_number (0)))
449 if (INTEGERP (tem
) || (CONSP (tem
) && INTEGERP (XCDR (tem
))))
451 Lisp_Object doc
= tem
;
452 tem
= get_doc_string (tem
, 0, 0);
453 if (NILP (tem
) && try_reload
)
455 /* The file is newer, we need to reset the pointers. */
456 try_reload
= reread_doc_file (Fcar_safe (doc
));
460 goto documentation_property
;
464 else if (!STRINGP (tem
))
465 /* Feval protects its argument. */
466 tem
= Feval (tem
, Qnil
);
468 if (NILP (raw
) && STRINGP (tem
))
469 tem
= Fsubstitute_command_keys (tem
);
473 /* Scanning the DOC files and placing docstring offsets into functions. */
476 store_function_docstring (Lisp_Object obj
, ptrdiff_t offset
)
478 /* Don't use indirect_function here, or defaliases will apply their
479 docstrings to the base functions (Bug#2603). */
480 Lisp_Object fun
= SYMBOLP (obj
) ? XSYMBOL (obj
)->function
: obj
;
482 /* The type determines where the docstring is stored. */
484 /* Lisp_Subrs have a slot for it. */
487 intptr_t negative_offset
= - offset
;
488 XSUBR (fun
)->doc
= (char *) negative_offset
;
491 /* If it's a lisp form, stick it in the form. */
492 else if (CONSP (fun
))
497 if (EQ (tem
, Qlambda
) || EQ (tem
, Qautoload
)
498 || (EQ (tem
, Qclosure
) && (fun
= XCDR (fun
), 1)))
500 tem
= Fcdr (Fcdr (fun
));
501 if (CONSP (tem
) && INTEGERP (XCAR (tem
)))
502 /* FIXME: This modifies typically pure hash-cons'd data, so its
503 correctness is quite delicate. */
504 XSETCAR (tem
, make_number (offset
));
506 else if (EQ (tem
, Qmacro
))
507 store_function_docstring (XCDR (fun
), offset
);
510 /* Bytecode objects sometimes have slots for it. */
511 else if (COMPILEDP (fun
))
513 /* This bytecode object must have a slot for the
514 docstring, since we've found a docstring for it. */
515 if ((ASIZE (fun
) & PSEUDOVECTOR_SIZE_MASK
) > COMPILED_DOC_STRING
)
516 ASET (fun
, COMPILED_DOC_STRING
, make_number (offset
));
519 AUTO_STRING (format
, "No docstring slot for %s");
520 CALLN (Fmessage
, format
,
523 : build_string ("<anonymous>")));
529 DEFUN ("Snarf-documentation", Fsnarf_documentation
, Ssnarf_documentation
,
531 doc
: /* Used during Emacs initialization to scan the `etc/DOC...' file.
532 This searches the `etc/DOC...' file for doc strings and
533 records them in function and variable definitions.
534 The function takes one argument, FILENAME, a string;
535 it specifies the file name (without a directory) of the DOC file.
536 That file is found in `../etc' now; later, when the dumped Emacs is run,
537 the same file name is found in the `doc-directory'. */)
538 (Lisp_Object filename
)
550 /* Preloaded defcustoms using custom-initialize-delay are added to
551 this list, but kept unbound. See http://debbugs.gnu.org/11565 */
552 Lisp_Object delayed_init
=
553 find_symbol_value (intern ("custom-delayed-init-variables"));
555 if (EQ (delayed_init
, Qunbound
)) delayed_init
= Qnil
;
557 CHECK_STRING (filename
);
561 (!NILP (Vpurify_flag
))
562 #else /* CANNOT_DUMP */
564 #endif /* CANNOT_DUMP */
566 dirname
= sibling_etc
;
567 dirlen
= sizeof sibling_etc
- 1;
571 CHECK_STRING (Vdoc_directory
);
572 dirname
= SSDATA (Vdoc_directory
);
573 dirlen
= SBYTES (Vdoc_directory
);
576 count
= SPECPDL_INDEX ();
578 name
= SAFE_ALLOCA (dirlen
+ SBYTES (filename
) + 1);
579 lispstpcpy (stpcpy (name
, dirname
), filename
); /*** Add this line ***/
581 /* Vbuild_files is nil when temacs is run, and non-nil after that. */
582 if (NILP (Vbuild_files
))
584 static char const *const buildobj
[] =
586 #include "buildobj.h"
588 int i
= ARRAYELTS (buildobj
);
590 Vbuild_files
= Fcons (build_string (buildobj
[i
]), Vbuild_files
);
591 Vbuild_files
= Fpurecopy (Vbuild_files
);
594 fd
= emacs_open (name
, O_RDONLY
, 0);
597 int open_errno
= errno
;
598 report_file_errno ("Opening doc string file", build_string (name
),
601 record_unwind_protect_int (close_file_unwind
, fd
);
602 Vdoc_file_name
= filename
;
609 filled
+= emacs_read (fd
, &buf
[filled
], sizeof buf
- 1 - filled
);
614 end
= buf
+ (filled
< 512 ? filled
: filled
- 128);
615 p
= memchr (buf
, '\037', end
- buf
);
616 /* p points to ^_Ffunctionname\n or ^_Vvarname\n or ^_Sfilename\n. */
619 end
= strchr (p
, '\n');
621 /* See if this is a file name, and if it is a file in build-files. */
625 if (end
- p
> 4 && end
[-2] == '.'
626 && (end
[-1] == 'o' || end
[-1] == 'c'))
628 ptrdiff_t len
= end
- p
- 2;
629 char *fromfile
= SAFE_ALLOCA (len
+ 1);
630 memcpy (fromfile
, &p
[2], len
);
632 if (fromfile
[len
-1] == 'c')
633 fromfile
[len
-1] = 'o';
635 skip_file
= NILP (Fmember (build_string (fromfile
),
640 sym
= oblookup (Vobarray
, p
+ 2,
641 multibyte_chars_in_text ((unsigned char *) p
+ 2,
644 /* Check skip_file so that when a function is defined several
645 times in different files (typically, once in xterm, once in
646 w32term, ...), we only pay attention to the one that
648 if (! skip_file
&& SYMBOLP (sym
))
650 /* Attach a docstring to a variable? */
653 /* Install file-position as variable-documentation property
654 and make it negative for a user-variable
655 (doc starts with a `*'). */
656 if (!NILP (Fboundp (sym
))
657 || !NILP (Fmemq (sym
, delayed_init
)))
658 Fput (sym
, Qvariable_documentation
,
659 make_number ((pos
+ end
+ 1 - buf
)
660 * (end
[1] == '*' ? -1 : 1)));
663 /* Attach a docstring to a function? */
664 else if (p
[1] == 'F')
666 if (!NILP (Ffboundp (sym
)))
667 store_function_docstring (sym
, pos
+ end
+ 1 - buf
);
669 else if (p
[1] == 'S')
670 ; /* Just a source file name boundary marker. Ignore it. */
673 error ("DOC file invalid at position %"pI
"d", pos
);
678 memmove (buf
, end
, filled
);
682 return unbind_to (count
, Qnil
);
685 /* Return true if text quoting style should default to quote `like this'. */
687 default_to_grave_quoting_style (void)
689 if (!text_quoting_flag
)
691 if (! DISP_TABLE_P (Vstandard_display_table
))
693 Lisp_Object dv
= DISP_CHAR_VECTOR (XCHAR_TABLE (Vstandard_display_table
),
694 LEFT_SINGLE_QUOTATION_MARK
);
695 return (VECTORP (dv
) && ASIZE (dv
) == 1
696 && EQ (AREF (dv
, 0), make_number ('`')));
699 /* Return the current effective text quoting style. */
700 enum text_quoting_style
701 text_quoting_style (void)
703 if (NILP (Vtext_quoting_style
)
704 ? default_to_grave_quoting_style ()
705 : EQ (Vtext_quoting_style
, Qgrave
))
706 return GRAVE_QUOTING_STYLE
;
707 else if (EQ (Vtext_quoting_style
, Qstraight
))
708 return STRAIGHT_QUOTING_STYLE
;
710 return CURVE_QUOTING_STYLE
;
713 DEFUN ("substitute-command-keys", Fsubstitute_command_keys
,
714 Ssubstitute_command_keys
, 1, 1, 0,
715 doc
: /* Substitute key descriptions for command names in STRING.
716 Each substring of the form \\=\\[COMMAND] is replaced by either a
717 keystroke sequence that invokes COMMAND, or "M-x COMMAND" if COMMAND
720 Each substring of the form \\=\\{MAPVAR} is replaced by a summary of
721 the value of MAPVAR as a keymap. This summary is similar to the one
722 produced by `describe-bindings'. The summary ends in two newlines
723 \(used by the helper function `help-make-xrefs' to find the end of the
726 Each substring of the form \\=\\<MAPVAR> specifies the use of MAPVAR
727 as the keymap for future \\=\\[COMMAND] substrings.
729 Each \\=‘ and \\=` is replaced by left quote, and each \\=’ and \\='
730 is replaced by right quote. Left and right quote characters are
731 specified by `text-quoting-style'.
733 \\=\\= quotes the following character and is discarded; thus,
734 \\=\\=\\=\\= puts \\=\\= into the output, \\=\\=\\=\\[ puts \\=\\[ into the output, and
735 \\=\\=\\=` puts \\=` into the output.
737 Return the original STRING if no substitutions are made.
738 Otherwise, return a new string. */)
742 bool changed
= false;
743 bool nonquotes_changed
= false;
750 unsigned char const *start
;
751 ptrdiff_t length
, length_byte
;
753 bool multibyte
, pure_ascii
;
759 CHECK_STRING (string
);
764 enum text_quoting_style quoting_style
= text_quoting_style ();
766 multibyte
= STRING_MULTIBYTE (string
);
767 /* Pure-ASCII unibyte input strings should produce unibyte strings
768 if substitution doesn't yield non-ASCII bytes, otherwise they
769 should produce multibyte strings. */
770 pure_ascii
= SBYTES (string
) == count_size_as_multibyte (SDATA (string
),
774 /* KEYMAP is either nil (which means search all the active keymaps)
775 or a specified local map (which means search just that and the
776 global map). If non-nil, it might come from Voverriding_local_map,
777 or from a \\<mapname> construct in STRING itself.. */
778 keymap
= Voverriding_local_map
;
780 bsize
= SBYTES (string
);
782 /* Add some room for expansion due to quote replacement. */
783 enum { EXTRA_ROOM
= 20 };
784 if (bsize
<= STRING_BYTES_BOUND
- EXTRA_ROOM
)
787 bufp
= buf
= xmalloc (bsize
);
789 strp
= SDATA (string
);
790 while (strp
< SDATA (string
) + SBYTES (string
))
792 if (strp
[0] == '\\' && strp
[1] == '=')
794 /* \= quotes the next character;
795 thus, to put in \[ without its special meaning, use \=\[. */
796 changed
= nonquotes_changed
= true;
802 STRING_CHAR_AND_LENGTH (strp
, len
);
806 memcpy (bufp
, strp
, len
);
812 *bufp
++ = *strp
++, nchars
++;
814 else if (strp
[0] == '\\' && strp
[1] == '[')
817 bool follow_remap
= 1;
819 strp
+= 2; /* skip \[ */
821 start_idx
= start
- SDATA (string
);
823 while ((strp
- SDATA (string
)
827 length_byte
= strp
- start
;
831 /* Save STRP in IDX. */
832 idx
= strp
- SDATA (string
);
833 name
= Fintern (make_string ((char *) start
, length_byte
), Qnil
);
836 tem
= Fwhere_is_internal (name
, keymap
, Qt
, Qnil
, Qnil
);
838 if (VECTORP (tem
) && ASIZE (tem
) > 1
839 && EQ (AREF (tem
, 0), Qremap
) && SYMBOLP (AREF (tem
, 1))
842 name
= AREF (tem
, 1);
847 /* Note the Fwhere_is_internal can GC, so we have to take
848 relocation of string contents into account. */
849 strp
= SDATA (string
) + idx
;
850 start
= SDATA (string
) + start_idx
;
852 if (NILP (tem
)) /* but not on any keys */
854 ptrdiff_t offset
= bufp
- buf
;
855 if (STRING_BYTES_BOUND
- 4 < bsize
)
857 buf
= xrealloc (buf
, bsize
+= 4);
859 memcpy (bufp
, "M-x ", 4);
863 length
= multibyte_chars_in_text (start
, length_byte
);
865 length
= length_byte
;
869 { /* function is on a key */
870 tem
= Fkey_description (tem
, Qnil
);
874 /* \{foo} is replaced with a summary of the keymap (symbol-value foo).
875 \<foo> just sets the keymap used for \[cmd]. */
876 else if (strp
[0] == '\\' && (strp
[1] == '{' || strp
[1] == '<'))
878 struct buffer
*oldbuf
;
880 /* This is for computing the SHADOWS arg for describe_map_tree. */
881 Lisp_Object active_maps
= Fcurrent_active_maps (Qnil
, Qnil
);
882 Lisp_Object earlier_maps
;
883 ptrdiff_t count
= SPECPDL_INDEX ();
885 strp
+= 2; /* skip \{ or \< */
887 start_idx
= start
- SDATA (string
);
889 while ((strp
- SDATA (string
) < SBYTES (string
))
890 && *strp
!= '}' && *strp
!= '>')
893 length_byte
= strp
- start
;
894 strp
++; /* skip } or > */
896 /* Save STRP in IDX. */
897 idx
= strp
- SDATA (string
);
899 /* Get the value of the keymap in TEM, or nil if undefined.
900 Do this while still in the user's current buffer
901 in case it is a local variable. */
902 name
= Fintern (make_string ((char *) start
, length_byte
), Qnil
);
903 tem
= Fboundp (name
);
906 tem
= Fsymbol_value (name
);
909 tem
= get_keymap (tem
, 0, 1);
910 /* Note that get_keymap can GC. */
911 strp
= SDATA (string
) + idx
;
912 start
= SDATA (string
) + start_idx
;
916 /* Now switch to a temp buffer. */
917 oldbuf
= current_buffer
;
918 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer
));
919 /* This is for an unusual case where some after-change
920 function uses 'format' or 'prin1' or something else that
921 will thrash Vprin1_to_string_buffer we are using. */
922 specbind (Qinhibit_modification_hooks
, Qt
);
926 name
= Fsymbol_name (name
);
927 AUTO_STRING (msg_prefix
, "\nUses keymap `");
928 insert1 (Fsubstitute_command_keys (msg_prefix
));
929 insert_from_string (name
, 0, 0,
932 AUTO_STRING (msg_suffix
, "', which is not currently defined.\n");
933 insert1 (Fsubstitute_command_keys (msg_suffix
));
934 if (start
[-1] == '<') keymap
= Qnil
;
936 else if (start
[-1] == '<')
940 /* Get the list of active keymaps that precede this one.
941 If this one's not active, get nil. */
942 earlier_maps
= Fcdr (Fmemq (tem
, Freverse (active_maps
)));
943 describe_map_tree (tem
, 1, Fnreverse (earlier_maps
),
944 Qnil
, 0, 1, 0, 0, 1);
946 tem
= Fbuffer_string ();
948 set_buffer_internal (oldbuf
);
949 unbind_to (count
, Qnil
);
953 length_byte
= SBYTES (tem
);
954 if (multibyte
|| pure_ascii
)
955 length
= SCHARS (tem
);
957 length
= length_byte
;
959 nonquotes_changed
= true;
963 ptrdiff_t offset
= bufp
- buf
;
964 if (STRING_BYTES_BOUND
- length_byte
< bsize
)
966 buf
= xrealloc (buf
, bsize
+= length_byte
);
968 memcpy (bufp
, start
, length_byte
);
971 /* Check STRING again in case gc relocated it. */
972 strp
= SDATA (string
) + idx
;
975 else if ((strp
[0] == '`' || strp
[0] == '\'')
976 && quoting_style
== CURVE_QUOTING_STYLE
977 && (multibyte
|| pure_ascii
))
979 start
= (unsigned char const *) (strp
[0] == '`' ? uLSQM
: uRSQM
);
980 length_byte
= sizeof uLSQM
- 1;
981 if (multibyte
|| pure_ascii
)
984 length
= length_byte
;
985 idx
= strp
- SDATA (string
) + 1;
988 else if (strp
[0] == '`' && quoting_style
== STRAIGHT_QUOTING_STYLE
)
995 else if (! multibyte
)
996 *bufp
++ = *strp
++, nchars
++;
1000 int ch
= STRING_CHAR_AND_LENGTH (strp
, len
);
1001 if ((ch
== LEFT_SINGLE_QUOTATION_MARK
1002 || ch
== RIGHT_SINGLE_QUOTATION_MARK
)
1003 && quoting_style
!= CURVE_QUOTING_STYLE
)
1005 *bufp
++ = ((ch
== LEFT_SINGLE_QUOTATION_MARK
1006 && quoting_style
== GRAVE_QUOTING_STYLE
)
1021 if (changed
) /* don't bother if nothing substituted */
1023 tem
= make_string_from_bytes (buf
, nchars
, bufp
- buf
);
1024 if (!nonquotes_changed
)
1026 /* Nothing has changed other than quoting, so copy the string’s
1027 text properties. FIXME: Text properties should survive other
1029 INTERVAL interval_copy
= copy_intervals (string_intervals (string
),
1030 0, SCHARS (string
));
1033 set_interval_object (interval_copy
, tem
);
1034 set_string_intervals (tem
, interval_copy
);
1047 DEFSYM (Qfunction_documentation
, "function-documentation");
1048 DEFSYM (Qgrave
, "grave");
1049 DEFSYM (Qstraight
, "straight");
1051 DEFVAR_LISP ("internal-doc-file-name", Vdoc_file_name
,
1052 doc
: /* Name of file containing documentation strings of built-in symbols. */);
1053 Vdoc_file_name
= Qnil
;
1055 DEFVAR_LISP ("build-files", Vbuild_files
,
1056 doc
: /* A list of files used to build this Emacs binary. */);
1057 Vbuild_files
= Qnil
;
1059 DEFVAR_LISP ("text-quoting-style", Vtext_quoting_style
,
1060 doc
: /* Style to use for single quotes in help and messages.
1061 Its value should be a symbol.
1062 `curve' means quote with curved single quotes \\=‘like this\\=’.
1063 `straight' means quote with straight apostrophes \\='like this\\='.
1064 `grave' means quote with grave accent and apostrophe \\=`like this\\='.
1065 The default value nil acts like `curve' if curved single quotes are
1066 displayable, and like `grave' otherwise. */);
1067 Vtext_quoting_style
= Qnil
;
1069 DEFVAR_BOOL ("internal--text-quoting-flag", text_quoting_flag
,
1070 doc
: /* If nil, a nil `text-quoting-style' is treated as `grave'. */);
1071 /* Initialized by ‘main’. */
1073 defsubr (&Sdocumentation
);
1074 defsubr (&Sdocumentation_property
);
1075 defsubr (&Ssnarf_documentation
);
1076 defsubr (&Ssubstitute_command_keys
);