Detect remote uid and gid in tramp-gvfs.el
[emacs.git] / src / doc.c
blob6ffdad10f030221f1ee54943bce482f04de4bcc0
1 /* Record indices of function doc strings stored in a file. -*- coding: utf-8 -*-
3 Copyright (C) 1985-1986, 1993-1995, 1997-2016 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 <http://www.gnu.org/licenses/>. */
22 #include <config.h>
24 #include <errno.h>
25 #include <sys/types.h>
26 #include <sys/file.h> /* Must be after sys/types.h for USG. */
27 #include <fcntl.h>
28 #include <unistd.h>
30 #include <c-ctype.h>
32 #include "lisp.h"
33 #include "character.h"
34 #include "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 (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 (CONSP (fun) && EQ (XCAR (fun), Qmacro))
340 fun = XCDR (fun);
341 if (SUBRP (fun))
342 doc = make_number (XSUBR (fun)->doc);
343 else if (COMPILEDP (fun))
345 if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) <= COMPILED_DOC_STRING)
346 return Qnil;
347 else
349 Lisp_Object tem = AREF (fun, COMPILED_DOC_STRING);
350 if (STRINGP (tem))
351 doc = tem;
352 else if (NATNUMP (tem) || CONSP (tem))
353 doc = tem;
354 else
355 return Qnil;
358 else if (STRINGP (fun) || VECTORP (fun))
360 return build_string ("Keyboard macro.");
362 else if (CONSP (fun))
364 funcar = XCAR (fun);
365 if (!SYMBOLP (funcar))
366 xsignal1 (Qinvalid_function, fun);
367 else if (EQ (funcar, Qkeymap))
368 return build_string ("Prefix command (definition is a keymap associating keystrokes with commands).");
369 else if (EQ (funcar, Qlambda)
370 || (EQ (funcar, Qclosure) && (fun = XCDR (fun), 1))
371 || EQ (funcar, Qautoload))
373 Lisp_Object tem1 = Fcdr (Fcdr (fun));
374 Lisp_Object tem = Fcar (tem1);
375 if (STRINGP (tem))
376 doc = tem;
377 /* Handle a doc reference--but these never come last
378 in the function body, so reject them if they are last. */
379 else if ((NATNUMP (tem) || (CONSP (tem) && INTEGERP (XCDR (tem))))
380 && !NILP (XCDR (tem1)))
381 doc = tem;
382 else
383 return Qnil;
385 else
386 goto oops;
388 else
390 oops:
391 xsignal1 (Qinvalid_function, fun);
394 /* If DOC is 0, it's typically because of a dumped file missing
395 from the DOC file (bug in src/Makefile.in). */
396 if (EQ (doc, make_number (0)))
397 doc = Qnil;
398 if (INTEGERP (doc) || CONSP (doc))
400 Lisp_Object tem;
401 tem = get_doc_string (doc, 0, 0);
402 if (NILP (tem) && try_reload)
404 /* The file is newer, we need to reset the pointers. */
405 try_reload = reread_doc_file (Fcar_safe (doc));
406 if (try_reload)
408 try_reload = 0;
409 goto documentation;
412 else
413 doc = tem;
416 if (NILP (raw))
417 doc = Fsubstitute_command_keys (doc);
418 return doc;
421 DEFUN ("documentation-property", Fdocumentation_property,
422 Sdocumentation_property, 2, 3, 0,
423 doc: /* Return the documentation string that is SYMBOL's PROP property.
424 Third argument RAW omitted or nil means pass the result through
425 `substitute-command-keys' if it is a string.
427 This differs from `get' in that it can refer to strings stored in the
428 `etc/DOC' file; and that it evaluates documentation properties that
429 aren't strings. */)
430 (Lisp_Object symbol, Lisp_Object prop, Lisp_Object raw)
432 bool try_reload = 1;
433 Lisp_Object tem;
435 documentation_property:
437 tem = Fget (symbol, prop);
438 if (EQ (tem, make_number (0)))
439 tem = Qnil;
440 if (INTEGERP (tem) || (CONSP (tem) && INTEGERP (XCDR (tem))))
442 Lisp_Object doc = tem;
443 tem = get_doc_string (tem, 0, 0);
444 if (NILP (tem) && try_reload)
446 /* The file is newer, we need to reset the pointers. */
447 try_reload = reread_doc_file (Fcar_safe (doc));
448 if (try_reload)
450 try_reload = 0;
451 goto documentation_property;
455 else if (!STRINGP (tem))
456 /* Feval protects its argument. */
457 tem = Feval (tem, Qnil);
459 if (NILP (raw) && STRINGP (tem))
460 tem = Fsubstitute_command_keys (tem);
461 return tem;
464 /* Scanning the DOC files and placing docstring offsets into functions. */
466 static void
467 store_function_docstring (Lisp_Object obj, EMACS_INT offset)
469 /* Don't use indirect_function here, or defaliases will apply their
470 docstrings to the base functions (Bug#2603). */
471 Lisp_Object fun = SYMBOLP (obj) ? XSYMBOL (obj)->function : obj;
473 /* The type determines where the docstring is stored. */
475 /* If it's a lisp form, stick it in the form. */
476 if (CONSP (fun) && EQ (XCAR (fun), Qmacro))
477 fun = XCDR (fun);
478 if (CONSP (fun))
480 Lisp_Object tem;
482 tem = XCAR (fun);
483 if (EQ (tem, Qlambda) || EQ (tem, Qautoload)
484 || (EQ (tem, Qclosure) && (fun = XCDR (fun), 1)))
486 tem = Fcdr (Fcdr (fun));
487 if (CONSP (tem) && INTEGERP (XCAR (tem)))
488 /* FIXME: This modifies typically pure hash-cons'd data, so its
489 correctness is quite delicate. */
490 XSETCAR (tem, make_number (offset));
494 /* Lisp_Subrs have a slot for it. */
495 else if (SUBRP (fun))
496 XSUBR (fun)->doc = offset;
498 /* Bytecode objects sometimes have slots for it. */
499 else if (COMPILEDP (fun))
501 /* This bytecode object must have a slot for the
502 docstring, since we've found a docstring for it. */
503 if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) > COMPILED_DOC_STRING)
504 ASET (fun, COMPILED_DOC_STRING, make_number (offset));
505 else
507 AUTO_STRING (format, "No docstring slot for %s");
508 CALLN (Fmessage, format,
509 (SYMBOLP (obj)
510 ? SYMBOL_NAME (obj)
511 : build_string ("<anonymous>")));
517 DEFUN ("Snarf-documentation", Fsnarf_documentation, Ssnarf_documentation,
518 1, 1, 0,
519 doc: /* Used during Emacs initialization to scan the `etc/DOC...' file.
520 This searches the `etc/DOC...' file for doc strings and
521 records them in function and variable definitions.
522 The function takes one argument, FILENAME, a string;
523 it specifies the file name (without a directory) of the DOC file.
524 That file is found in `../etc' now; later, when the dumped Emacs is run,
525 the same file name is found in the `doc-directory'. */)
526 (Lisp_Object filename)
528 int fd;
529 char buf[1024 + 1];
530 int filled;
531 EMACS_INT pos;
532 Lisp_Object sym;
533 char *p, *name;
534 bool skip_file = 0;
535 ptrdiff_t count;
536 char const *dirname;
537 ptrdiff_t dirlen;
538 /* Preloaded defcustoms using custom-initialize-delay are added to
539 this list, but kept unbound. See http://debbugs.gnu.org/11565 */
540 Lisp_Object delayed_init =
541 find_symbol_value (intern ("custom-delayed-init-variables"));
543 if (EQ (delayed_init, Qunbound)) delayed_init = Qnil;
545 CHECK_STRING (filename);
548 #ifndef CANNOT_DUMP
549 (!NILP (Vpurify_flag))
550 #else /* CANNOT_DUMP */
552 #endif /* CANNOT_DUMP */
554 dirname = sibling_etc;
555 dirlen = sizeof sibling_etc - 1;
557 else
559 CHECK_STRING (Vdoc_directory);
560 dirname = SSDATA (Vdoc_directory);
561 dirlen = SBYTES (Vdoc_directory);
564 count = SPECPDL_INDEX ();
565 USE_SAFE_ALLOCA;
566 name = SAFE_ALLOCA (dirlen + SBYTES (filename) + 1);
567 lispstpcpy (stpcpy (name, dirname), filename); /*** Add this line ***/
569 /* Vbuild_files is nil when temacs is run, and non-nil after that. */
570 if (NILP (Vbuild_files))
572 static char const *const buildobj[] =
574 #include "buildobj.h"
576 int i = ARRAYELTS (buildobj);
577 while (0 <= --i)
578 Vbuild_files = Fcons (build_string (buildobj[i]), Vbuild_files);
579 Vbuild_files = Fpurecopy (Vbuild_files);
582 fd = emacs_open (name, O_RDONLY, 0);
583 if (fd < 0)
585 int open_errno = errno;
586 report_file_errno ("Opening doc string file", build_string (name),
587 open_errno);
589 record_unwind_protect_int (close_file_unwind, fd);
590 Vdoc_file_name = filename;
591 filled = 0;
592 pos = 0;
593 while (1)
595 register char *end;
596 if (filled < 512)
597 filled += emacs_read (fd, &buf[filled], sizeof buf - 1 - filled);
598 if (!filled)
599 break;
601 buf[filled] = 0;
602 end = buf + (filled < 512 ? filled : filled - 128);
603 p = memchr (buf, '\037', end - buf);
604 /* p points to ^_Ffunctionname\n or ^_Vvarname\n or ^_Sfilename\n. */
605 if (p)
607 end = strchr (p, '\n');
609 /* See if this is a file name, and if it is a file in build-files. */
610 if (p[1] == 'S')
612 skip_file = 0;
613 if (end - p > 4 && end[-2] == '.'
614 && (end[-1] == 'o' || end[-1] == 'c'))
616 ptrdiff_t len = end - p - 2;
617 char *fromfile = SAFE_ALLOCA (len + 1);
618 memcpy (fromfile, &p[2], len);
619 fromfile[len] = 0;
620 if (fromfile[len-1] == 'c')
621 fromfile[len-1] = 'o';
623 skip_file = NILP (Fmember (build_string (fromfile),
624 Vbuild_files));
628 sym = oblookup (Vobarray, p + 2,
629 multibyte_chars_in_text ((unsigned char *) p + 2,
630 end - p - 2),
631 end - p - 2);
632 /* Check skip_file so that when a function is defined several
633 times in different files (typically, once in xterm, once in
634 w32term, ...), we only pay attention to the one that
635 matters. */
636 if (! skip_file && SYMBOLP (sym))
638 /* Attach a docstring to a variable? */
639 if (p[1] == 'V')
641 /* Install file-position as variable-documentation property
642 and make it negative for a user-variable
643 (doc starts with a `*'). */
644 if (!NILP (Fboundp (sym))
645 || !NILP (Fmemq (sym, delayed_init)))
646 Fput (sym, Qvariable_documentation,
647 make_number ((pos + end + 1 - buf)
648 * (end[1] == '*' ? -1 : 1)));
651 /* Attach a docstring to a function? */
652 else if (p[1] == 'F')
654 if (!NILP (Ffboundp (sym)))
655 store_function_docstring (sym, pos + end + 1 - buf);
657 else if (p[1] == 'S')
658 ; /* Just a source file name boundary marker. Ignore it. */
660 else
661 error ("DOC file invalid at position %"pI"d", pos);
664 pos += end - buf;
665 filled -= end - buf;
666 memmove (buf, end, filled);
669 SAFE_FREE ();
670 return unbind_to (count, Qnil);
673 /* Return true if text quoting style should default to quote `like this'. */
674 static bool
675 default_to_grave_quoting_style (void)
677 if (!text_quoting_flag)
678 return true;
679 if (! DISP_TABLE_P (Vstandard_display_table))
680 return false;
681 Lisp_Object dv = DISP_CHAR_VECTOR (XCHAR_TABLE (Vstandard_display_table),
682 LEFT_SINGLE_QUOTATION_MARK);
683 return (VECTORP (dv) && ASIZE (dv) == 1
684 && EQ (AREF (dv, 0), make_number ('`')));
687 /* Return the current effective text quoting style. */
688 enum text_quoting_style
689 text_quoting_style (void)
691 if (NILP (Vtext_quoting_style)
692 ? default_to_grave_quoting_style ()
693 : EQ (Vtext_quoting_style, Qgrave))
694 return GRAVE_QUOTING_STYLE;
695 else if (EQ (Vtext_quoting_style, Qstraight))
696 return STRAIGHT_QUOTING_STYLE;
697 else
698 return CURVE_QUOTING_STYLE;
701 DEFUN ("substitute-command-keys", Fsubstitute_command_keys,
702 Ssubstitute_command_keys, 1, 1, 0,
703 doc: /* Substitute key descriptions for command names in STRING.
704 Each substring of the form \\=\\[COMMAND] is replaced by either a
705 keystroke sequence that invokes COMMAND, or "M-x COMMAND" if COMMAND
706 is not on any keys.
708 Each substring of the form \\=\\{MAPVAR} is replaced by a summary of
709 the value of MAPVAR as a keymap. This summary is similar to the one
710 produced by `describe-bindings'. The summary ends in two newlines
711 \(used by the helper function `help-make-xrefs' to find the end of the
712 summary).
714 Each substring of the form \\=\\<MAPVAR> specifies the use of MAPVAR
715 as the keymap for future \\=\\[COMMAND] substrings.
717 Each \\=‘ and \\=` is replaced by left quote, and each \\=’ and \\='
718 is replaced by right quote. Left and right quote characters are
719 specified by `text-quoting-style'.
721 \\=\\= quotes the following character and is discarded; thus,
722 \\=\\=\\=\\= puts \\=\\= into the output, \\=\\=\\=\\[ puts \\=\\[ into the output, and
723 \\=\\=\\=` puts \\=` into the output.
725 Return the original STRING if no substitutions are made.
726 Otherwise, return a new string. */)
727 (Lisp_Object string)
729 char *buf;
730 bool changed = false;
731 bool nonquotes_changed = false;
732 unsigned char *strp;
733 char *bufp;
734 ptrdiff_t idx;
735 ptrdiff_t bsize;
736 Lisp_Object tem;
737 Lisp_Object keymap;
738 unsigned char const *start;
739 ptrdiff_t length, length_byte;
740 Lisp_Object name;
741 bool multibyte;
742 ptrdiff_t nchars;
744 if (NILP (string))
745 return Qnil;
747 CHECK_STRING (string);
748 tem = Qnil;
749 keymap = Qnil;
750 name = Qnil;
752 enum text_quoting_style quoting_style = text_quoting_style ();
754 multibyte = STRING_MULTIBYTE (string);
755 nchars = 0;
757 /* KEYMAP is either nil (which means search all the active keymaps)
758 or a specified local map (which means search just that and the
759 global map). If non-nil, it might come from Voverriding_local_map,
760 or from a \\<mapname> construct in STRING itself.. */
761 keymap = Voverriding_local_map;
763 bsize = SBYTES (string);
765 /* Add some room for expansion due to quote replacement. */
766 enum { EXTRA_ROOM = 20 };
767 if (bsize <= STRING_BYTES_BOUND - EXTRA_ROOM)
768 bsize += EXTRA_ROOM;
770 bufp = buf = xmalloc (bsize);
772 strp = SDATA (string);
773 while (strp < SDATA (string) + SBYTES (string))
775 if (strp[0] == '\\' && strp[1] == '=')
777 /* \= quotes the next character;
778 thus, to put in \[ without its special meaning, use \=\[. */
779 changed = nonquotes_changed = true;
780 strp += 2;
781 if (multibyte)
783 int len;
785 STRING_CHAR_AND_LENGTH (strp, len);
786 if (len == 1)
787 *bufp = *strp;
788 else
789 memcpy (bufp, strp, len);
790 strp += len;
791 bufp += len;
792 nchars++;
794 else
795 *bufp++ = *strp++, nchars++;
797 else if (strp[0] == '\\' && strp[1] == '[')
799 ptrdiff_t start_idx;
800 bool follow_remap = 1;
802 strp += 2; /* skip \[ */
803 start = strp;
804 start_idx = start - SDATA (string);
806 while ((strp - SDATA (string)
807 < SBYTES (string))
808 && *strp != ']')
809 strp++;
810 length_byte = strp - start;
812 strp++; /* skip ] */
814 /* Save STRP in IDX. */
815 idx = strp - SDATA (string);
816 name = Fintern (make_string ((char *) start, length_byte), Qnil);
818 do_remap:
819 tem = Fwhere_is_internal (name, keymap, Qt, Qnil, Qnil);
821 if (VECTORP (tem) && ASIZE (tem) > 1
822 && EQ (AREF (tem, 0), Qremap) && SYMBOLP (AREF (tem, 1))
823 && follow_remap)
825 name = AREF (tem, 1);
826 follow_remap = 0;
827 goto do_remap;
830 /* Note the Fwhere_is_internal can GC, so we have to take
831 relocation of string contents into account. */
832 strp = SDATA (string) + idx;
833 start = SDATA (string) + start_idx;
835 if (NILP (tem)) /* but not on any keys */
837 ptrdiff_t offset = bufp - buf;
838 if (STRING_BYTES_BOUND - 4 < bsize)
839 string_overflow ();
840 buf = xrealloc (buf, bsize += 4);
841 bufp = buf + offset;
842 memcpy (bufp, "M-x ", 4);
843 bufp += 4;
844 nchars += 4;
845 if (multibyte)
846 length = multibyte_chars_in_text (start, length_byte);
847 else
848 length = length_byte;
849 goto subst;
851 else
852 { /* function is on a key */
853 tem = Fkey_description (tem, Qnil);
854 goto subst_string;
857 /* \{foo} is replaced with a summary of the keymap (symbol-value foo).
858 \<foo> just sets the keymap used for \[cmd]. */
859 else if (strp[0] == '\\' && (strp[1] == '{' || strp[1] == '<'))
862 /* This is for computing the SHADOWS arg for describe_map_tree. */
863 Lisp_Object active_maps = Fcurrent_active_maps (Qnil, Qnil);
864 ptrdiff_t count = SPECPDL_INDEX ();
866 strp += 2; /* skip \{ or \< */
867 start = strp;
868 ptrdiff_t start_idx = start - SDATA (string);
870 while ((strp - SDATA (string) < SBYTES (string))
871 && *strp != '}' && *strp != '>')
872 strp++;
874 length_byte = strp - start;
875 strp++; /* skip } or > */
877 /* Save STRP in IDX. */
878 idx = strp - SDATA (string);
880 /* Get the value of the keymap in TEM, or nil if undefined.
881 Do this while still in the user's current buffer
882 in case it is a local variable. */
883 name = Fintern (make_string ((char *) start, length_byte), Qnil);
884 tem = Fboundp (name);
885 if (! NILP (tem))
887 tem = Fsymbol_value (name);
888 if (! NILP (tem))
890 tem = get_keymap (tem, 0, 1);
891 /* Note that get_keymap can GC. */
892 strp = SDATA (string) + idx;
893 start = SDATA (string) + start_idx;
897 /* Now switch to a temp buffer. */
898 struct buffer *oldbuf = current_buffer;
899 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer));
900 /* This is for an unusual case where some after-change
901 function uses 'format' or 'prin1' or something else that
902 will thrash Vprin1_to_string_buffer we are using. */
903 specbind (Qinhibit_modification_hooks, Qt);
905 if (NILP (tem))
907 name = Fsymbol_name (name);
908 AUTO_STRING (msg_prefix, "\nUses keymap `");
909 insert1 (Fsubstitute_command_keys (msg_prefix));
910 insert_from_string (name, 0, 0,
911 SCHARS (name),
912 SBYTES (name), 1);
913 AUTO_STRING (msg_suffix, "', which is not currently defined.\n");
914 insert1 (Fsubstitute_command_keys (msg_suffix));
915 if (start[-1] == '<') keymap = Qnil;
917 else if (start[-1] == '<')
918 keymap = tem;
919 else
921 /* Get the list of active keymaps that precede this one.
922 If this one's not active, get nil. */
923 Lisp_Object earlier_maps
924 = Fcdr (Fmemq (tem, Freverse (active_maps)));
925 describe_map_tree (tem, 1, Fnreverse (earlier_maps),
926 Qnil, 0, 1, 0, 0, 1);
928 tem = Fbuffer_string ();
929 Ferase_buffer ();
930 set_buffer_internal (oldbuf);
931 unbind_to (count, Qnil);
934 subst_string:
935 start = SDATA (tem);
936 length = SCHARS (tem);
937 length_byte = SBYTES (tem);
938 subst:
939 nonquotes_changed = true;
940 subst_quote:
941 changed = true;
943 ptrdiff_t offset = bufp - buf;
944 if (STRING_BYTES_BOUND - length_byte < bsize)
945 string_overflow ();
946 buf = xrealloc (buf, bsize += length_byte);
947 bufp = buf + offset;
948 memcpy (bufp, start, length_byte);
949 bufp += length_byte;
950 nchars += length;
951 /* Check STRING again in case gc relocated it. */
952 strp = SDATA (string) + idx;
955 else if ((strp[0] == '`' || strp[0] == '\'')
956 && quoting_style == CURVE_QUOTING_STYLE)
958 start = (unsigned char const *) (strp[0] == '`' ? uLSQM : uRSQM);
959 length = 1;
960 length_byte = sizeof uLSQM - 1;
961 idx = strp - SDATA (string) + 1;
962 goto subst_quote;
964 else if (strp[0] == '`' && quoting_style == STRAIGHT_QUOTING_STYLE)
966 *bufp++ = '\'';
967 strp++;
968 nchars++;
969 changed = true;
971 else
973 *bufp++ = *strp++;
974 if (multibyte)
975 while (! CHAR_HEAD_P (*strp))
976 *bufp++ = *strp++;
977 nchars++;
981 if (changed) /* don't bother if nothing substituted */
983 tem = make_string_from_bytes (buf, nchars, bufp - buf);
984 if (!nonquotes_changed)
986 /* Nothing has changed other than quoting, so copy the string’s
987 text properties. FIXME: Text properties should survive other
988 changes too. */
989 INTERVAL interval_copy = copy_intervals (string_intervals (string),
990 0, SCHARS (string));
991 if (interval_copy)
993 set_interval_object (interval_copy, tem);
994 set_string_intervals (tem, interval_copy);
998 else
999 tem = string;
1000 xfree (buf);
1001 return tem;
1004 void
1005 syms_of_doc (void)
1007 DEFSYM (Qfunction_documentation, "function-documentation");
1008 DEFSYM (Qgrave, "grave");
1009 DEFSYM (Qstraight, "straight");
1011 DEFVAR_LISP ("internal-doc-file-name", Vdoc_file_name,
1012 doc: /* Name of file containing documentation strings of built-in symbols. */);
1013 Vdoc_file_name = Qnil;
1015 DEFVAR_LISP ("build-files", Vbuild_files,
1016 doc: /* A list of files used to build this Emacs binary. */);
1017 Vbuild_files = Qnil;
1019 DEFVAR_LISP ("text-quoting-style", Vtext_quoting_style,
1020 doc: /* Style to use for single quotes in help and messages.
1021 Its value should be a symbol. It works by substituting certain single
1022 quotes for grave accent and apostrophe. This is done in help output
1023 and in functions like `message' and `format-message'. It is not done
1024 in `format'.
1026 `curve' means quote with curved single quotes \\=‘like this\\=’.
1027 `straight' means quote with straight apostrophes \\='like this\\='.
1028 `grave' means quote with grave accent and apostrophe \\=`like this\\=';
1029 i.e., do not alter quote marks. The default value nil acts like
1030 `curve' if curved single quotes are displayable, and like `grave'
1031 otherwise. */);
1032 Vtext_quoting_style = Qnil;
1034 DEFVAR_BOOL ("internal--text-quoting-flag", text_quoting_flag,
1035 doc: /* If nil, a nil `text-quoting-style' is treated as `grave'. */);
1036 /* Initialized by ‘main’. */
1038 defsubr (&Sdocumentation);
1039 defsubr (&Sdocumentation_property);
1040 defsubr (&Ssnarf_documentation);
1041 defsubr (&Ssubstitute_command_keys);