1 /* Record indices of function doc strings stored in a file. -*- coding: utf-8 -*-
3 Copyright (C) 1985-1986, 1993-1995, 1997-2015 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
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/>. */
25 #include <sys/types.h>
26 #include <sys/file.h> /* Must be after sys/types.h for USG. */
33 #include "character.h"
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 static char const sibling_etc
[] = "../etc/";
47 /* `readchar' in lread.c calls back here to fetch the next byte.
48 If UNREADFLAG is 1, we unread a byte. */
51 read_bytecode_char (bool unreadflag
)
55 read_bytecode_pointer
--;
58 return *read_bytecode_pointer
++;
61 /* Extract a doc string from a file. FILEPOS says where to get it.
62 If it is an integer, use that position in the standard DOC file.
63 If it is (FILE . INTEGER), use FILE as the file name
64 and INTEGER as the position in that file.
65 But if INTEGER is negative, make it positive.
66 (A negative integer is used for user variables, so we can distinguish
67 them without actually fetching the doc string.)
69 If the location does not point to the beginning of a docstring
70 (e.g. because the file has been modified and the location is stale),
73 If UNIBYTE, always make a unibyte string.
75 If DEFINITION, assume this is for reading
76 a dynamic function definition; convert the bytestring
77 and the constants vector with appropriate byte handling,
78 and return a cons cell. */
81 get_doc_string (Lisp_Object filepos
, bool unibyte
, bool definition
)
83 char *from
, *to
, *name
, *p
, *p1
;
87 Lisp_Object file
, tem
, pos
;
91 if (INTEGERP (filepos
))
93 file
= Vdoc_file_name
;
96 else if (CONSP (filepos
))
98 file
= XCAR (filepos
);
104 position
= eabs (XINT (pos
));
106 if (!STRINGP (Vdoc_directory
))
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
);
118 = NILP (tem
) ? ENCODE_FILE (Vdoc_directory
) : empty_unibyte_string
;
119 ptrdiff_t docdir_sizemax
= SBYTES (docdir
) + 1;
121 docdir_sizemax
= max (docdir_sizemax
, sizeof sibling_etc
);
123 name
= SAFE_ALLOCA (docdir_sizemax
+ SBYTES (file
));
124 lispstpcpy (lispstpcpy (name
, docdir
), file
);
126 fd
= emacs_open (name
, O_RDONLY
, 0);
130 if (!NILP (Vpurify_flag
))
132 /* Preparing to dump; DOC file is probably not installed.
133 So check in ../etc. */
134 lispstpcpy (stpcpy (name
, sibling_etc
), file
);
136 fd
= emacs_open (name
, O_RDONLY
, 0);
142 AUTO_STRING (cannot_open
, "Cannot open doc string file \"");
143 AUTO_STRING (quote_nl
, "\"\n");
144 return concat3 (cannot_open
, file
, quote_nl
);
147 count
= SPECPDL_INDEX ();
148 record_unwind_protect_int (close_file_unwind
, fd
);
150 /* Seek only to beginning of disk block. */
151 /* Make sure we read at least 1024 bytes before `position'
152 so we can check the leading text for consistency. */
153 offset
= min (position
, max (1024, position
% (8 * 1024)));
154 if (TYPE_MAXIMUM (off_t
) < position
155 || lseek (fd
, position
- offset
, 0) < 0)
156 error ("Position %"pI
"d out of range in doc string file \"%s\"",
159 /* Read the doc string into get_doc_string_buffer.
160 P points beyond the data just read. */
162 p
= get_doc_string_buffer
;
165 ptrdiff_t space_left
= (get_doc_string_buffer_size
- 1
166 - (p
- get_doc_string_buffer
));
169 /* Allocate or grow the buffer if we need to. */
172 ptrdiff_t in_buffer
= p
- get_doc_string_buffer
;
173 get_doc_string_buffer
174 = xpalloc (get_doc_string_buffer
, &get_doc_string_buffer_size
,
176 p
= get_doc_string_buffer
+ in_buffer
;
177 space_left
= (get_doc_string_buffer_size
- 1
178 - (p
- get_doc_string_buffer
));
181 /* Read a disk block at a time.
182 If we read the same block last time, maybe skip this? */
183 if (space_left
> 1024 * 8)
184 space_left
= 1024 * 8;
185 nread
= emacs_read (fd
, p
, space_left
);
187 report_file_error ("Read error on documentation file", file
);
191 if (p
== get_doc_string_buffer
)
192 p1
= strchr (p
+ offset
, '\037');
194 p1
= strchr (p
, '\037');
203 unbind_to (count
, Qnil
);
206 /* Sanity checking. */
210 /* A dynamic docstring should be either at the very beginning of a "#@
211 comment" or right after a dynamic docstring delimiter (in case we
212 pack several such docstrings within the same comment). */
213 if (get_doc_string_buffer
[offset
- test
] != '\037')
215 if (get_doc_string_buffer
[offset
- test
++] != ' ')
217 while (get_doc_string_buffer
[offset
- test
] >= '0'
218 && get_doc_string_buffer
[offset
- test
] <= '9')
220 if (get_doc_string_buffer
[offset
- test
++] != '@'
221 || get_doc_string_buffer
[offset
- test
] != '#')
228 if (get_doc_string_buffer
[offset
- test
++] != '\n')
230 while (get_doc_string_buffer
[offset
- test
] > ' ')
232 if (get_doc_string_buffer
[offset
- test
] != '\037')
236 /* Scan the text and perform quoting with ^A (char code 1).
237 ^A^A becomes ^A, ^A0 becomes a null char, and ^A_ becomes a ^_. */
238 from
= get_doc_string_buffer
+ offset
;
239 to
= get_doc_string_buffer
+ offset
;
256 unsigned char uc
= c
;
258 Invalid data in documentation file -- %c followed by code %03o",
266 /* If DEFINITION, read from this buffer
267 the same way we would read bytes from a file. */
270 read_bytecode_pointer
= (unsigned char *) get_doc_string_buffer
+ offset
;
271 return Fread (Qlambda
);
275 return make_unibyte_string (get_doc_string_buffer
+ offset
,
276 to
- (get_doc_string_buffer
+ offset
));
279 /* The data determines whether the string is multibyte. */
281 = multibyte_chars_in_text (((unsigned char *) get_doc_string_buffer
283 to
- (get_doc_string_buffer
+ offset
));
284 return make_string_from_bytes (get_doc_string_buffer
+ offset
,
286 to
- (get_doc_string_buffer
+ offset
));
290 /* Get a string from position FILEPOS and pass it through the Lisp reader.
291 We use this for fetching the bytecode string and constants vector
292 of a compiled function from the .elc file. */
295 read_doc_string (Lisp_Object filepos
)
297 return get_doc_string (filepos
, 0, 1);
301 reread_doc_file (Lisp_Object file
)
304 Fsnarf_documentation (Vdoc_file_name
);
306 Fload (file
, Qt
, Qt
, Qt
, Qnil
);
311 DEFUN ("documentation", Fdocumentation
, Sdocumentation
, 1, 2, 0,
312 doc
: /* Return the documentation string of FUNCTION.
313 Unless a non-nil second argument RAW is given, the
314 string is passed through `substitute-command-keys'. */)
315 (Lisp_Object function
, Lisp_Object raw
)
326 if (SYMBOLP (function
))
328 Lisp_Object tem
= Fget (function
, Qfunction_documentation
);
330 return Fdocumentation_property (function
, Qfunction_documentation
,
334 fun
= Findirect_function (function
, Qnil
);
335 if (CONSP (fun
) && EQ (XCAR (fun
), Qmacro
))
339 if (XSUBR (fun
)->doc
== 0)
341 /* FIXME: This is not portable, as it assumes that string
342 pointers have the top bit clear. */
343 else if ((intptr_t) XSUBR (fun
)->doc
>= 0)
344 doc
= build_string (XSUBR (fun
)->doc
);
346 doc
= make_number ((intptr_t) XSUBR (fun
)->doc
);
348 else if (COMPILEDP (fun
))
350 if ((ASIZE (fun
) & PSEUDOVECTOR_SIZE_MASK
) <= COMPILED_DOC_STRING
)
354 Lisp_Object tem
= AREF (fun
, COMPILED_DOC_STRING
);
357 else if (NATNUMP (tem
) || CONSP (tem
))
363 else if (STRINGP (fun
) || VECTORP (fun
))
365 return build_string ("Keyboard macro.");
367 else if (CONSP (fun
))
370 if (!SYMBOLP (funcar
))
371 xsignal1 (Qinvalid_function
, fun
);
372 else if (EQ (funcar
, Qkeymap
))
373 return build_string ("Prefix command (definition is a keymap associating keystrokes with commands).");
374 else if (EQ (funcar
, Qlambda
)
375 || (EQ (funcar
, Qclosure
) && (fun
= XCDR (fun
), 1))
376 || EQ (funcar
, Qautoload
))
378 Lisp_Object tem1
= Fcdr (Fcdr (fun
));
379 Lisp_Object tem
= Fcar (tem1
);
382 /* Handle a doc reference--but these never come last
383 in the function body, so reject them if they are last. */
384 else if ((NATNUMP (tem
) || (CONSP (tem
) && INTEGERP (XCDR (tem
))))
385 && !NILP (XCDR (tem1
)))
396 xsignal1 (Qinvalid_function
, fun
);
399 /* If DOC is 0, it's typically because of a dumped file missing
400 from the DOC file (bug in src/Makefile.in). */
401 if (EQ (doc
, make_number (0)))
403 if (INTEGERP (doc
) || CONSP (doc
))
406 tem
= get_doc_string (doc
, 0, 0);
407 if (NILP (tem
) && try_reload
)
409 /* The file is newer, we need to reset the pointers. */
410 struct gcpro gcpro1
, gcpro2
;
411 GCPRO2 (function
, raw
);
412 try_reload
= reread_doc_file (Fcar_safe (doc
));
425 doc
= Fsubstitute_command_keys (doc
);
429 DEFUN ("documentation-property", Fdocumentation_property
,
430 Sdocumentation_property
, 2, 3, 0,
431 doc
: /* Return the documentation string that is SYMBOL's PROP property.
432 Third argument RAW omitted or nil means pass the result through
433 `substitute-command-keys' if it is a string.
435 This differs from `get' in that it can refer to strings stored in the
436 `etc/DOC' file; and that it evaluates documentation properties that
438 (Lisp_Object symbol
, Lisp_Object prop
, Lisp_Object raw
)
443 documentation_property
:
445 tem
= Fget (symbol
, prop
);
446 if (EQ (tem
, make_number (0)))
448 if (INTEGERP (tem
) || (CONSP (tem
) && INTEGERP (XCDR (tem
))))
450 Lisp_Object doc
= tem
;
451 tem
= get_doc_string (tem
, 0, 0);
452 if (NILP (tem
) && try_reload
)
454 /* The file is newer, we need to reset the pointers. */
455 struct gcpro gcpro1
, gcpro2
, gcpro3
;
456 GCPRO3 (symbol
, prop
, raw
);
457 try_reload
= reread_doc_file (Fcar_safe (doc
));
462 goto documentation_property
;
466 else if (!STRINGP (tem
))
467 /* Feval protects its argument. */
468 tem
= Feval (tem
, Qnil
);
470 if (NILP (raw
) && STRINGP (tem
))
471 tem
= Fsubstitute_command_keys (tem
);
475 /* Scanning the DOC files and placing docstring offsets into functions. */
478 store_function_docstring (Lisp_Object obj
, ptrdiff_t offset
)
480 /* Don't use indirect_function here, or defaliases will apply their
481 docstrings to the base functions (Bug#2603). */
482 Lisp_Object fun
= SYMBOLP (obj
) ? XSYMBOL (obj
)->function
: obj
;
484 /* The type determines where the docstring is stored. */
486 /* Lisp_Subrs have a slot for it. */
489 intptr_t negative_offset
= - offset
;
490 XSUBR (fun
)->doc
= (char *) negative_offset
;
493 /* If it's a lisp form, stick it in the form. */
494 else if (CONSP (fun
))
499 if (EQ (tem
, Qlambda
) || EQ (tem
, Qautoload
)
500 || (EQ (tem
, Qclosure
) && (fun
= XCDR (fun
), 1)))
502 tem
= Fcdr (Fcdr (fun
));
503 if (CONSP (tem
) && INTEGERP (XCAR (tem
)))
504 /* FIXME: This modifies typically pure hash-cons'd data, so its
505 correctness is quite delicate. */
506 XSETCAR (tem
, make_number (offset
));
508 else if (EQ (tem
, Qmacro
))
509 store_function_docstring (XCDR (fun
), offset
);
512 /* Bytecode objects sometimes have slots for it. */
513 else if (COMPILEDP (fun
))
515 /* This bytecode object must have a slot for the
516 docstring, since we've found a docstring for it. */
517 if ((ASIZE (fun
) & PSEUDOVECTOR_SIZE_MASK
) > COMPILED_DOC_STRING
)
518 ASET (fun
, COMPILED_DOC_STRING
, make_number (offset
));
521 AUTO_STRING (format
, "No docstring slot for %s");
522 CALLN (Fmessage
, format
,
525 : build_string ("<anonymous>")));
531 DEFUN ("Snarf-documentation", Fsnarf_documentation
, Ssnarf_documentation
,
533 doc
: /* Used during Emacs initialization to scan the `etc/DOC...' file.
534 This searches the `etc/DOC...' file for doc strings and
535 records them in function and variable definitions.
536 The function takes one argument, FILENAME, a string;
537 it specifies the file name (without a directory) of the DOC file.
538 That file is found in `../etc' now; later, when the dumped Emacs is run,
539 the same file name is found in the `doc-directory'. */)
540 (Lisp_Object filename
)
552 /* Preloaded defcustoms using custom-initialize-delay are added to
553 this list, but kept unbound. See http://debbugs.gnu.org/11565 */
554 Lisp_Object delayed_init
=
555 find_symbol_value (intern ("custom-delayed-init-variables"));
557 if (EQ (delayed_init
, Qunbound
)) delayed_init
= Qnil
;
559 CHECK_STRING (filename
);
563 (!NILP (Vpurify_flag
))
564 #else /* CANNOT_DUMP */
566 #endif /* CANNOT_DUMP */
568 dirname
= sibling_etc
;
569 dirlen
= sizeof sibling_etc
- 1;
573 CHECK_STRING (Vdoc_directory
);
574 dirname
= SSDATA (Vdoc_directory
);
575 dirlen
= SBYTES (Vdoc_directory
);
578 count
= SPECPDL_INDEX ();
580 name
= SAFE_ALLOCA (dirlen
+ SBYTES (filename
) + 1);
581 lispstpcpy (stpcpy (name
, dirname
), filename
); /*** Add this line ***/
583 /* Vbuild_files is nil when temacs is run, and non-nil after that. */
584 if (NILP (Vbuild_files
))
586 static char const *const buildobj
[] =
588 #include "buildobj.h"
590 int i
= ARRAYELTS (buildobj
);
592 Vbuild_files
= Fcons (build_string (buildobj
[i
]), Vbuild_files
);
593 Vbuild_files
= Fpurecopy (Vbuild_files
);
596 fd
= emacs_open (name
, O_RDONLY
, 0);
599 int open_errno
= errno
;
600 report_file_errno ("Opening doc string file", build_string (name
),
603 record_unwind_protect_int (close_file_unwind
, fd
);
604 Vdoc_file_name
= filename
;
611 filled
+= emacs_read (fd
, &buf
[filled
], sizeof buf
- 1 - filled
);
616 end
= buf
+ (filled
< 512 ? filled
: filled
- 128);
617 p
= memchr (buf
, '\037', end
- buf
);
618 /* p points to ^_Ffunctionname\n or ^_Vvarname\n or ^_Sfilename\n. */
621 end
= strchr (p
, '\n');
623 /* See if this is a file name, and if it is a file in build-files. */
627 if (end
- p
> 4 && end
[-2] == '.'
628 && (end
[-1] == 'o' || end
[-1] == 'c'))
630 ptrdiff_t len
= end
- p
- 2;
631 char *fromfile
= SAFE_ALLOCA (len
+ 1);
632 memcpy (fromfile
, &p
[2], len
);
634 if (fromfile
[len
-1] == 'c')
635 fromfile
[len
-1] = 'o';
637 skip_file
= NILP (Fmember (build_string (fromfile
),
642 sym
= oblookup (Vobarray
, p
+ 2,
643 multibyte_chars_in_text ((unsigned char *) p
+ 2,
646 /* Check skip_file so that when a function is defined several
647 times in different files (typically, once in xterm, once in
648 w32term, ...), we only pay attention to the one that
650 if (! skip_file
&& SYMBOLP (sym
))
652 /* Attach a docstring to a variable? */
655 /* Install file-position as variable-documentation property
656 and make it negative for a user-variable
657 (doc starts with a `*'). */
658 if (!NILP (Fboundp (sym
))
659 || !NILP (Fmemq (sym
, delayed_init
)))
660 Fput (sym
, Qvariable_documentation
,
661 make_number ((pos
+ end
+ 1 - buf
)
662 * (end
[1] == '*' ? -1 : 1)));
665 /* Attach a docstring to a function? */
666 else if (p
[1] == 'F')
668 if (!NILP (Ffboundp (sym
)))
669 store_function_docstring (sym
, pos
+ end
+ 1 - buf
);
671 else if (p
[1] == 'S')
672 ; /* Just a source file name boundary marker. Ignore it. */
675 error ("DOC file invalid at position %"pI
"d", pos
);
680 memmove (buf
, end
, filled
);
684 return unbind_to (count
, Qnil
);
687 /* Curved quotation marks. */
688 static unsigned char const LSQM
[] = { uLSQM0
, uLSQM1
, uLSQM2
};
689 static unsigned char const RSQM
[] = { uRSQM0
, uRSQM1
, uRSQM2
};
692 default_to_grave_quoting_style (void)
694 if (!text_quoting_flag
)
696 if (! DISP_TABLE_P (Vstandard_display_table
))
698 Lisp_Object dv
= DISP_CHAR_VECTOR (XCHAR_TABLE (Vstandard_display_table
),
699 LEFT_SINGLE_QUOTATION_MARK
);
700 return (VECTORP (dv
) && ASIZE (dv
) == 1
701 && EQ (AREF (dv
, 0), make_number ('`')));
704 /* Return the current effective text quoting style. */
705 enum text_quoting_style
706 text_quoting_style (void)
708 if (NILP (Vtext_quoting_style
)
709 ? default_to_grave_quoting_style ()
710 : EQ (Vtext_quoting_style
, Qgrave
))
711 return GRAVE_QUOTING_STYLE
;
712 else if (EQ (Vtext_quoting_style
, Qstraight
))
713 return STRAIGHT_QUOTING_STYLE
;
715 return CURVE_QUOTING_STYLE
;
718 DEFUN ("substitute-command-keys", Fsubstitute_command_keys
,
719 Ssubstitute_command_keys
, 1, 1, 0,
720 doc
: /* Substitute key descriptions for command names in STRING.
721 Each substring of the form \\=\\[COMMAND] is replaced by either a
722 keystroke sequence that invokes COMMAND, or "M-x COMMAND" if COMMAND
725 Each substring of the form \\=\\{MAPVAR} is replaced by a summary of
726 the value of MAPVAR as a keymap. This summary is similar to the one
727 produced by `describe-bindings'. The summary ends in two newlines
728 \(used by the helper function `help-make-xrefs' to find the end of the
731 Each substring of the form \\=\\<MAPVAR> specifies the use of MAPVAR
732 as the keymap for future \\=\\[COMMAND] substrings.
734 Each \\=‘ and \\=’ are replaced by left and right quote. Each \\=` is
735 replaced by left quote, and each ' preceded by \\=` and without
736 intervening ' is replaced by right quote. Left and right quote
737 characters are specified by ‘text-quoting-style’.
739 \\=\\= quotes the following character and is discarded; thus,
740 \\=\\=\\=\\= puts \\=\\= into the output, \\=\\=\\=\\[ puts \\=\\[ into the output, and
741 \\=\\=\\=` puts \\=` into the output.
743 Return the original STRING if no substitutions are made.
744 Otherwise, return a new string. */)
748 bool changed
= false;
749 bool in_quote
= false;
756 unsigned char const *start
;
757 ptrdiff_t length
, length_byte
;
759 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
766 CHECK_STRING (string
);
770 GCPRO4 (string
, tem
, keymap
, name
);
772 enum text_quoting_style quoting_style
= text_quoting_style ();
774 multibyte
= STRING_MULTIBYTE (string
);
777 /* KEYMAP is either nil (which means search all the active keymaps)
778 or a specified local map (which means search just that and the
779 global map). If non-nil, it might come from Voverriding_local_map,
780 or from a \\<mapname> construct in STRING itself.. */
781 keymap
= Voverriding_local_map
;
783 bsize
= SBYTES (string
);
785 /* Add some room for expansion due to quote replacement. */
786 enum { EXTRA_ROOM
= 20 };
787 if (bsize
<= STRING_BYTES_BOUND
- EXTRA_ROOM
)
790 bufp
= buf
= xmalloc (bsize
);
792 strp
= SDATA (string
);
793 while (strp
< SDATA (string
) + SBYTES (string
))
795 if (strp
[0] == '\\' && strp
[1] == '=')
797 /* \= quotes the next character;
798 thus, to put in \[ without its special meaning, use \=\[. */
805 STRING_CHAR_AND_LENGTH (strp
, len
);
809 memcpy (bufp
, strp
, len
);
815 *bufp
++ = *strp
++, nchars
++;
817 else if (strp
[0] == '\\' && strp
[1] == '[')
820 bool follow_remap
= 1;
822 strp
+= 2; /* skip \[ */
824 start_idx
= start
- SDATA (string
);
826 while ((strp
- SDATA (string
)
830 length_byte
= strp
- start
;
834 /* Save STRP in IDX. */
835 idx
= strp
- SDATA (string
);
836 name
= Fintern (make_string ((char *) start
, length_byte
), Qnil
);
839 tem
= Fwhere_is_internal (name
, keymap
, Qt
, Qnil
, Qnil
);
841 if (VECTORP (tem
) && ASIZE (tem
) > 1
842 && EQ (AREF (tem
, 0), Qremap
) && SYMBOLP (AREF (tem
, 1))
845 name
= AREF (tem
, 1);
850 /* Note the Fwhere_is_internal can GC, so we have to take
851 relocation of string contents into account. */
852 strp
= SDATA (string
) + idx
;
853 start
= SDATA (string
) + start_idx
;
855 if (NILP (tem
)) /* but not on any keys */
857 ptrdiff_t offset
= bufp
- buf
;
858 if (STRING_BYTES_BOUND
- 4 < bsize
)
860 buf
= xrealloc (buf
, bsize
+= 4);
862 memcpy (bufp
, "M-x ", 4);
866 length
= multibyte_chars_in_text (start
, length_byte
);
868 length
= length_byte
;
872 { /* function is on a key */
873 tem
= Fkey_description (tem
, Qnil
);
877 /* \{foo} is replaced with a summary of the keymap (symbol-value foo).
878 \<foo> just sets the keymap used for \[cmd]. */
879 else if (strp
[0] == '\\' && (strp
[1] == '{' || strp
[1] == '<'))
881 struct buffer
*oldbuf
;
883 /* This is for computing the SHADOWS arg for describe_map_tree. */
884 Lisp_Object active_maps
= Fcurrent_active_maps (Qnil
, Qnil
);
885 Lisp_Object earlier_maps
;
886 ptrdiff_t count
= SPECPDL_INDEX ();
888 strp
+= 2; /* skip \{ or \< */
890 start_idx
= start
- SDATA (string
);
892 while ((strp
- SDATA (string
) < SBYTES (string
))
893 && *strp
!= '}' && *strp
!= '>')
896 length_byte
= strp
- start
;
897 strp
++; /* skip } or > */
899 /* Save STRP in IDX. */
900 idx
= strp
- SDATA (string
);
902 /* Get the value of the keymap in TEM, or nil if undefined.
903 Do this while still in the user's current buffer
904 in case it is a local variable. */
905 name
= Fintern (make_string ((char *) start
, length_byte
), Qnil
);
906 tem
= Fboundp (name
);
909 tem
= Fsymbol_value (name
);
912 tem
= get_keymap (tem
, 0, 1);
913 /* Note that get_keymap can GC. */
914 strp
= SDATA (string
) + idx
;
915 start
= SDATA (string
) + start_idx
;
919 /* Now switch to a temp buffer. */
920 oldbuf
= current_buffer
;
921 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer
));
922 /* This is for an unusual case where some after-change
923 function uses 'format' or 'prin1' or something else that
924 will thrash Vprin1_to_string_buffer we are using. */
925 specbind (Qinhibit_modification_hooks
, Qt
);
929 name
= Fsymbol_name (name
);
930 insert1 (Fsubstitute_command_keys
931 (build_string ("\nUses keymap "uLSQM
)));
932 insert_from_string (name
, 0, 0,
935 insert1 (Fsubstitute_command_keys
937 (uRSQM
", which is not currently defined.\n")));
938 if (start
[-1] == '<') keymap
= Qnil
;
940 else if (start
[-1] == '<')
944 /* Get the list of active keymaps that precede this one.
945 If this one's not active, get nil. */
946 earlier_maps
= Fcdr (Fmemq (tem
, Freverse (active_maps
)));
947 describe_map_tree (tem
, 1, Fnreverse (earlier_maps
),
948 Qnil
, 0, 1, 0, 0, 1);
950 tem
= Fbuffer_string ();
952 set_buffer_internal (oldbuf
);
953 unbind_to (count
, Qnil
);
957 length
= SCHARS (tem
);
958 length_byte
= SBYTES (tem
);
962 ptrdiff_t offset
= bufp
- buf
;
963 if (STRING_BYTES_BOUND
- length_byte
< bsize
)
965 buf
= xrealloc (buf
, bsize
+= length_byte
);
967 memcpy (bufp
, start
, length_byte
);
970 /* Check STRING again in case gc relocated it. */
971 strp
= SDATA (string
) + idx
;
974 else if (strp
[0] == '`' && quoting_style
== CURVE_QUOTING_STYLE
)
981 idx
= strp
- SDATA (string
) + 1;
984 else if (strp
[0] == '`' && quoting_style
== STRAIGHT_QUOTING_STYLE
)
991 else if (strp
[0] == '\'' && in_quote
)
997 else if (strp
[0] == uLSQM0
&& strp
[1] == uLSQM1
998 && (strp
[2] == uLSQM2
|| strp
[2] == uRSQM2
)
999 && quoting_style
!= CURVE_QUOTING_STYLE
)
1001 *bufp
++ = (strp
[2] == uLSQM2
&& quoting_style
== GRAVE_QUOTING_STYLE
1007 else if (! multibyte
) /* just copy other chars */
1008 *bufp
++ = *strp
++, nchars
++;
1013 STRING_CHAR_AND_LENGTH (strp
, len
);
1017 memcpy (bufp
, strp
, len
);
1024 if (changed
) /* don't bother if nothing substituted */
1025 tem
= make_string_from_bytes (buf
, nchars
, bufp
- buf
);
1029 RETURN_UNGCPRO (tem
);
1032 DEFUN ("internal--text-restyle", Finternal__text_restyle
,
1033 Sinternal__text_restyle
, 1, 1, 0,
1034 doc
: /* Return STRING, possibly substituting quote characters.
1036 In the result, replace each curved single quote (\\=‘ and \\=’) by
1037 left and right quote characters as specified by ‘text-quoting-style’.
1039 Return the original STRING in the common case where no changes are needed.
1040 Otherwise, return a new string. */)
1041 (Lisp_Object string
)
1043 bool changed
= false;
1045 CHECK_STRING (string
);
1046 if (! STRING_MULTIBYTE (string
))
1049 enum text_quoting_style quoting_style
= text_quoting_style ();
1050 if (quoting_style
== CURVE_QUOTING_STYLE
)
1053 ptrdiff_t bsize
= SBYTES (string
);
1054 unsigned char const *strp
= SDATA (string
);
1055 unsigned char const *strlim
= strp
+ bsize
;
1057 char *buf
= SAFE_ALLOCA (bsize
);
1059 ptrdiff_t nchars
= 0;
1061 while (strp
< strlim
)
1063 unsigned char const *cp
= strp
;
1064 switch (STRING_CHAR_ADVANCE (strp
))
1066 case LEFT_SINGLE_QUOTATION_MARK
:
1067 *bufp
++ = quoting_style
== GRAVE_QUOTING_STYLE
? '`': '\'';
1071 case RIGHT_SINGLE_QUOTATION_MARK
:
1088 = changed
? make_string_from_bytes (buf
, nchars
, bufp
- buf
) : string
;
1096 DEFSYM (Qfunction_documentation
, "function-documentation");
1097 DEFSYM (Qgrave
, "grave");
1098 DEFSYM (Qstraight
, "straight");
1100 DEFVAR_LISP ("internal-doc-file-name", Vdoc_file_name
,
1101 doc
: /* Name of file containing documentation strings of built-in symbols. */);
1102 Vdoc_file_name
= Qnil
;
1104 DEFVAR_LISP ("build-files", Vbuild_files
,
1105 doc
: /* A list of files used to build this Emacs binary. */);
1106 Vbuild_files
= Qnil
;
1108 DEFVAR_LISP ("text-quoting-style", Vtext_quoting_style
,
1109 doc
: /* Style to use for single quotes when generating text.
1110 ‘curve’ means quote with curved single quotes \\=‘like this\\=’.
1111 ‘straight’ means quote with straight apostrophes 'like this'.
1112 ‘grave’ means quote with grave accent and apostrophe \\=`like this'.
1113 The default value nil acts like ‘curve’ if curved single quotes are
1114 displayable, and like ‘grave’ otherwise. */);
1115 Vtext_quoting_style
= Qnil
;
1117 DEFVAR_BOOL ("internal--text-quoting-flag", text_quoting_flag
,
1118 doc
: /* If nil, a nil ‘text-quoting-style’ is treated as ‘grave’. */);
1119 /* Initialized by ‘main’. */
1121 defsubr (&Sdocumentation
);
1122 defsubr (&Sdocumentation_property
);
1123 defsubr (&Ssnarf_documentation
);
1124 defsubr (&Ssubstitute_command_keys
);
1125 defsubr (&Sinternal__text_restyle
);