]> code.delx.au - gnu-emacs/blob - src/doc.c
Fix some minor quoting issues with grave accent
[gnu-emacs] / src / doc.c
1 /* Record indices of function doc strings stored in a file. -*- coding: utf-8 -*-
2
3 Copyright (C) 1985-1986, 1993-1995, 1997-2015 Free Software Foundation,
4 Inc.
5
6 This file is part of GNU Emacs.
7
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.
12
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.
17
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/>. */
20
21
22 #include <config.h>
23
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>
29
30 #include <c-ctype.h>
31
32 #include "lisp.h"
33 #include "character.h"
34 #include "buffer.h"
35 #include "disptab.h"
36 #include "keyboard.h"
37 #include "keymap.h"
38
39 /* Buffer used for reading from documentation file. */
40 static char *get_doc_string_buffer;
41 static ptrdiff_t get_doc_string_buffer_size;
42
43 static unsigned char *read_bytecode_pointer;
44
45 static char const sibling_etc[] = "../etc/";
46
47 /* `readchar' in lread.c calls back here to fetch the next byte.
48 If UNREADFLAG is 1, we unread a byte. */
49
50 int
51 read_bytecode_char (bool unreadflag)
52 {
53 if (unreadflag)
54 {
55 read_bytecode_pointer--;
56 return 0;
57 }
58 return *read_bytecode_pointer++;
59 }
60
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.)
68
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),
71 return nil.
72
73 If UNIBYTE, always make a unibyte string.
74
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. */
79
80 Lisp_Object
81 get_doc_string (Lisp_Object filepos, bool unibyte, bool definition)
82 {
83 char *from, *to, *name, *p, *p1;
84 int fd;
85 int offset;
86 EMACS_INT position;
87 Lisp_Object file, tem, pos;
88 ptrdiff_t count;
89 USE_SAFE_ALLOCA;
90
91 if (INTEGERP (filepos))
92 {
93 file = Vdoc_file_name;
94 pos = filepos;
95 }
96 else if (CONSP (filepos))
97 {
98 file = XCAR (filepos);
99 pos = XCDR (filepos);
100 }
101 else
102 return Qnil;
103
104 position = eabs (XINT (pos));
105
106 if (!STRINGP (Vdoc_directory))
107 return Qnil;
108
109 if (!STRINGP (file))
110 return Qnil;
111
112 /* Put the file name in NAME as a C string.
113 If it is relative, combine it with Vdoc_directory. */
114
115 tem = Ffile_name_absolute_p (file);
116 file = ENCODE_FILE (file);
117 Lisp_Object docdir
118 = NILP (tem) ? ENCODE_FILE (Vdoc_directory) : empty_unibyte_string;
119 ptrdiff_t docdir_sizemax = SBYTES (docdir) + 1;
120 #ifndef CANNOT_DUMP
121 docdir_sizemax = max (docdir_sizemax, sizeof sibling_etc);
122 #endif
123 name = SAFE_ALLOCA (docdir_sizemax + SBYTES (file));
124 lispstpcpy (lispstpcpy (name, docdir), file);
125
126 fd = emacs_open (name, O_RDONLY, 0);
127 if (fd < 0)
128 {
129 #ifndef CANNOT_DUMP
130 if (!NILP (Vpurify_flag))
131 {
132 /* Preparing to dump; DOC file is probably not installed.
133 So check in ../etc. */
134 lispstpcpy (stpcpy (name, sibling_etc), file);
135
136 fd = emacs_open (name, O_RDONLY, 0);
137 }
138 #endif
139 if (fd < 0)
140 {
141 SAFE_FREE ();
142 AUTO_STRING (cannot_open, "Cannot open doc string file \"");
143 AUTO_STRING (quote_nl, "\"\n");
144 return concat3 (cannot_open, file, quote_nl);
145 }
146 }
147 count = SPECPDL_INDEX ();
148 record_unwind_protect_int (close_file_unwind, fd);
149
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\"",
157 position, name);
158
159 /* Read the doc string into get_doc_string_buffer.
160 P points beyond the data just read. */
161
162 p = get_doc_string_buffer;
163 while (1)
164 {
165 ptrdiff_t space_left = (get_doc_string_buffer_size - 1
166 - (p - get_doc_string_buffer));
167 int nread;
168
169 /* Allocate or grow the buffer if we need to. */
170 if (space_left <= 0)
171 {
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,
175 16 * 1024, -1, 1);
176 p = get_doc_string_buffer + in_buffer;
177 space_left = (get_doc_string_buffer_size - 1
178 - (p - get_doc_string_buffer));
179 }
180
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);
186 if (nread < 0)
187 report_file_error ("Read error on documentation file", file);
188 p[nread] = 0;
189 if (!nread)
190 break;
191 if (p == get_doc_string_buffer)
192 p1 = strchr (p + offset, '\037');
193 else
194 p1 = strchr (p, '\037');
195 if (p1)
196 {
197 *p1 = 0;
198 p = p1;
199 break;
200 }
201 p += nread;
202 }
203 unbind_to (count, Qnil);
204 SAFE_FREE ();
205
206 /* Sanity checking. */
207 if (CONSP (filepos))
208 {
209 int test = 1;
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')
214 {
215 if (get_doc_string_buffer[offset - test++] != ' ')
216 return Qnil;
217 while (get_doc_string_buffer[offset - test] >= '0'
218 && get_doc_string_buffer[offset - test] <= '9')
219 test++;
220 if (get_doc_string_buffer[offset - test++] != '@'
221 || get_doc_string_buffer[offset - test] != '#')
222 return Qnil;
223 }
224 }
225 else
226 {
227 int test = 1;
228 if (get_doc_string_buffer[offset - test++] != '\n')
229 return Qnil;
230 while (get_doc_string_buffer[offset - test] > ' ')
231 test++;
232 if (get_doc_string_buffer[offset - test] != '\037')
233 return Qnil;
234 }
235
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;
240 while (from != p)
241 {
242 if (*from == 1)
243 {
244 int c;
245
246 from++;
247 c = *from++;
248 if (c == 1)
249 *to++ = c;
250 else if (c == '0')
251 *to++ = 0;
252 else if (c == '_')
253 *to++ = 037;
254 else
255 {
256 unsigned char uc = c;
257 error ("\
258 Invalid data in documentation file -- %c followed by code %03o",
259 1, uc);
260 }
261 }
262 else
263 *to++ = *from++;
264 }
265
266 /* If DEFINITION, read from this buffer
267 the same way we would read bytes from a file. */
268 if (definition)
269 {
270 read_bytecode_pointer = (unsigned char *) get_doc_string_buffer + offset;
271 return Fread (Qlambda);
272 }
273
274 if (unibyte)
275 return make_unibyte_string (get_doc_string_buffer + offset,
276 to - (get_doc_string_buffer + offset));
277 else
278 {
279 /* The data determines whether the string is multibyte. */
280 ptrdiff_t nchars
281 = multibyte_chars_in_text (((unsigned char *) get_doc_string_buffer
282 + offset),
283 to - (get_doc_string_buffer + offset));
284 return make_string_from_bytes (get_doc_string_buffer + offset,
285 nchars,
286 to - (get_doc_string_buffer + offset));
287 }
288 }
289
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. */
293
294 Lisp_Object
295 read_doc_string (Lisp_Object filepos)
296 {
297 return get_doc_string (filepos, 0, 1);
298 }
299
300 static bool
301 reread_doc_file (Lisp_Object file)
302 {
303 if (NILP (file))
304 Fsnarf_documentation (Vdoc_file_name);
305 else
306 Fload (file, Qt, Qt, Qt, Qnil);
307
308 return 1;
309 }
310
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)
316 {
317 Lisp_Object fun;
318 Lisp_Object funcar;
319 Lisp_Object doc;
320 bool try_reload = 1;
321
322 documentation:
323
324 doc = Qnil;
325
326 if (SYMBOLP (function))
327 {
328 Lisp_Object tem = Fget (function, Qfunction_documentation);
329 if (!NILP (tem))
330 return Fdocumentation_property (function, Qfunction_documentation,
331 raw);
332 }
333
334 fun = Findirect_function (function, Qnil);
335 if (CONSP (fun) && EQ (XCAR (fun), Qmacro))
336 fun = XCDR (fun);
337 if (SUBRP (fun))
338 {
339 if (XSUBR (fun)->doc == 0)
340 return Qnil;
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);
345 else
346 doc = make_number ((intptr_t) XSUBR (fun)->doc);
347 }
348 else if (COMPILEDP (fun))
349 {
350 if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) <= COMPILED_DOC_STRING)
351 return Qnil;
352 else
353 {
354 Lisp_Object tem = AREF (fun, COMPILED_DOC_STRING);
355 if (STRINGP (tem))
356 doc = tem;
357 else if (NATNUMP (tem) || CONSP (tem))
358 doc = tem;
359 else
360 return Qnil;
361 }
362 }
363 else if (STRINGP (fun) || VECTORP (fun))
364 {
365 return build_string ("Keyboard macro.");
366 }
367 else if (CONSP (fun))
368 {
369 funcar = XCAR (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))
377 {
378 Lisp_Object tem1 = Fcdr (Fcdr (fun));
379 Lisp_Object tem = Fcar (tem1);
380 if (STRINGP (tem))
381 doc = tem;
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)))
386 doc = tem;
387 else
388 return Qnil;
389 }
390 else
391 goto oops;
392 }
393 else
394 {
395 oops:
396 xsignal1 (Qinvalid_function, fun);
397 }
398
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)))
402 doc = Qnil;
403 if (INTEGERP (doc) || CONSP (doc))
404 {
405 Lisp_Object tem;
406 tem = get_doc_string (doc, 0, 0);
407 if (NILP (tem) && try_reload)
408 {
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));
413 UNGCPRO;
414 if (try_reload)
415 {
416 try_reload = 0;
417 goto documentation;
418 }
419 }
420 else
421 doc = tem;
422 }
423
424 if (NILP (raw))
425 doc = Fsubstitute_command_keys (doc);
426 return doc;
427 }
428
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.
434
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
437 aren't strings. */)
438 (Lisp_Object symbol, Lisp_Object prop, Lisp_Object raw)
439 {
440 bool try_reload = 1;
441 Lisp_Object tem;
442
443 documentation_property:
444
445 tem = Fget (symbol, prop);
446 if (EQ (tem, make_number (0)))
447 tem = Qnil;
448 if (INTEGERP (tem) || (CONSP (tem) && INTEGERP (XCDR (tem))))
449 {
450 Lisp_Object doc = tem;
451 tem = get_doc_string (tem, 0, 0);
452 if (NILP (tem) && try_reload)
453 {
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));
458 UNGCPRO;
459 if (try_reload)
460 {
461 try_reload = 0;
462 goto documentation_property;
463 }
464 }
465 }
466 else if (!STRINGP (tem))
467 /* Feval protects its argument. */
468 tem = Feval (tem, Qnil);
469
470 if (NILP (raw) && STRINGP (tem))
471 tem = Fsubstitute_command_keys (tem);
472 return tem;
473 }
474 \f
475 /* Scanning the DOC files and placing docstring offsets into functions. */
476
477 static void
478 store_function_docstring (Lisp_Object obj, ptrdiff_t offset)
479 {
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;
483
484 /* The type determines where the docstring is stored. */
485
486 /* Lisp_Subrs have a slot for it. */
487 if (SUBRP (fun))
488 {
489 intptr_t negative_offset = - offset;
490 XSUBR (fun)->doc = (char *) negative_offset;
491 }
492
493 /* If it's a lisp form, stick it in the form. */
494 else if (CONSP (fun))
495 {
496 Lisp_Object tem;
497
498 tem = XCAR (fun);
499 if (EQ (tem, Qlambda) || EQ (tem, Qautoload)
500 || (EQ (tem, Qclosure) && (fun = XCDR (fun), 1)))
501 {
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));
507 }
508 else if (EQ (tem, Qmacro))
509 store_function_docstring (XCDR (fun), offset);
510 }
511
512 /* Bytecode objects sometimes have slots for it. */
513 else if (COMPILEDP (fun))
514 {
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));
519 else
520 {
521 AUTO_STRING (format, "No docstring slot for %s");
522 CALLN (Fmessage, format,
523 (SYMBOLP (obj)
524 ? SYMBOL_NAME (obj)
525 : build_string ("<anonymous>")));
526 }
527 }
528 }
529
530
531 DEFUN ("Snarf-documentation", Fsnarf_documentation, Ssnarf_documentation,
532 1, 1, 0,
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)
541 {
542 int fd;
543 char buf[1024 + 1];
544 int filled;
545 EMACS_INT pos;
546 Lisp_Object sym;
547 char *p, *name;
548 bool skip_file = 0;
549 ptrdiff_t count;
550 char const *dirname;
551 ptrdiff_t dirlen;
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"));
556
557 if (EQ (delayed_init, Qunbound)) delayed_init = Qnil;
558
559 CHECK_STRING (filename);
560
561 if
562 #ifndef CANNOT_DUMP
563 (!NILP (Vpurify_flag))
564 #else /* CANNOT_DUMP */
565 (0)
566 #endif /* CANNOT_DUMP */
567 {
568 dirname = sibling_etc;
569 dirlen = sizeof sibling_etc - 1;
570 }
571 else
572 {
573 CHECK_STRING (Vdoc_directory);
574 dirname = SSDATA (Vdoc_directory);
575 dirlen = SBYTES (Vdoc_directory);
576 }
577
578 count = SPECPDL_INDEX ();
579 USE_SAFE_ALLOCA;
580 name = SAFE_ALLOCA (dirlen + SBYTES (filename) + 1);
581 lispstpcpy (stpcpy (name, dirname), filename); /*** Add this line ***/
582
583 /* Vbuild_files is nil when temacs is run, and non-nil after that. */
584 if (NILP (Vbuild_files))
585 {
586 static char const *const buildobj[] =
587 {
588 #include "buildobj.h"
589 };
590 int i = ARRAYELTS (buildobj);
591 while (0 <= --i)
592 Vbuild_files = Fcons (build_string (buildobj[i]), Vbuild_files);
593 Vbuild_files = Fpurecopy (Vbuild_files);
594 }
595
596 fd = emacs_open (name, O_RDONLY, 0);
597 if (fd < 0)
598 {
599 int open_errno = errno;
600 report_file_errno ("Opening doc string file", build_string (name),
601 open_errno);
602 }
603 record_unwind_protect_int (close_file_unwind, fd);
604 Vdoc_file_name = filename;
605 filled = 0;
606 pos = 0;
607 while (1)
608 {
609 register char *end;
610 if (filled < 512)
611 filled += emacs_read (fd, &buf[filled], sizeof buf - 1 - filled);
612 if (!filled)
613 break;
614
615 buf[filled] = 0;
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. */
619 if (p)
620 {
621 end = strchr (p, '\n');
622
623 /* See if this is a file name, and if it is a file in build-files. */
624 if (p[1] == 'S')
625 {
626 skip_file = 0;
627 if (end - p > 4 && end[-2] == '.'
628 && (end[-1] == 'o' || end[-1] == 'c'))
629 {
630 ptrdiff_t len = end - p - 2;
631 char *fromfile = SAFE_ALLOCA (len + 1);
632 memcpy (fromfile, &p[2], len);
633 fromfile[len] = 0;
634 if (fromfile[len-1] == 'c')
635 fromfile[len-1] = 'o';
636
637 skip_file = NILP (Fmember (build_string (fromfile),
638 Vbuild_files));
639 }
640 }
641
642 sym = oblookup (Vobarray, p + 2,
643 multibyte_chars_in_text ((unsigned char *) p + 2,
644 end - p - 2),
645 end - 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
649 matters. */
650 if (! skip_file && SYMBOLP (sym))
651 {
652 /* Attach a docstring to a variable? */
653 if (p[1] == 'V')
654 {
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)));
663 }
664
665 /* Attach a docstring to a function? */
666 else if (p[1] == 'F')
667 {
668 if (!NILP (Ffboundp (sym)))
669 store_function_docstring (sym, pos + end + 1 - buf);
670 }
671 else if (p[1] == 'S')
672 ; /* Just a source file name boundary marker. Ignore it. */
673
674 else
675 error ("DOC file invalid at position %"pI"d", pos);
676 }
677 }
678 pos += end - buf;
679 filled -= end - buf;
680 memmove (buf, end, filled);
681 }
682
683 SAFE_FREE ();
684 return unbind_to (count, Qnil);
685 }
686 \f
687 /* Declare named constants for U+2018 LEFT SINGLE QUOTATION MARK and
688 U+2019 RIGHT SINGLE QUOTATION MARK, which have UTF-8 encodings
689 "\xE2\x80\x98" and "\xE2\x80\x99", respectively. */
690 enum
691 {
692 LEFT_SINGLE_QUOTATION_MARK = 0x2018,
693 uLSQM0 = 0xE2, uLSQM1 = 0x80, uLSQM2 = 0x98,
694 uRSQM0 = 0xE2, uRSQM1 = 0x80, uRSQM2 = 0x99,
695 };
696 static unsigned char const LSQM[] = { uLSQM0, uLSQM1, uLSQM2 };
697 static unsigned char const RSQM[] = { uRSQM0, uRSQM1, uRSQM2 };
698 #define uLSQM "\xE2\x80\x98"
699 #define uRSQM "\xE2\x80\x99"
700
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.
707
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).
713
714 Each substring of the form \\=\\<MAPVAR> specifies the use of MAPVAR
715 as the keymap for future \\=\\[COMMAND] substrings.
716
717 Each \\=‘ and \\=’ are replaced by left and right quote. Each \\=` is
718 replaced by left quote, and each ' preceded by \\=` and without
719 intervening ' is replaced by right quote. Left and right quote
720 characters are specified by ‘text-quoting-style’.
721
722 \\=\\= quotes the following character and is discarded; thus,
723 \\=\\=\\=\\= puts \\=\\= into the output, \\=\\=\\=\\[ puts \\=\\[ into the output, and
724 \\=\\=\\=` puts \\=` into the output.
725
726 Return the original STRING if no substitutions are made.
727 Otherwise, return a new string. */)
728 (Lisp_Object string)
729 {
730 char *buf;
731 bool changed = false;
732 bool in_quote = false;
733 unsigned char *strp;
734 char *bufp;
735 ptrdiff_t idx;
736 ptrdiff_t bsize;
737 Lisp_Object tem;
738 Lisp_Object keymap;
739 unsigned char const *start;
740 ptrdiff_t length, length_byte;
741 Lisp_Object name;
742 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
743 bool multibyte;
744 ptrdiff_t nchars;
745
746 if (NILP (string))
747 return Qnil;
748
749 CHECK_STRING (string);
750 tem = Qnil;
751 keymap = Qnil;
752 name = Qnil;
753 GCPRO4 (string, tem, keymap, name);
754
755 enum { unicode, grave_accent, apostrophe } quote_translation = unicode;
756 if (EQ (Vtext_quoting_style, Qgrave))
757 quote_translation = grave_accent;
758 else if (EQ (Vtext_quoting_style, Qstraight))
759 quote_translation = apostrophe;
760 else if (NILP (Vtext_quoting_style)
761 && DISP_TABLE_P (Vstandard_display_table))
762 {
763 Lisp_Object dv = DISP_CHAR_VECTOR (XCHAR_TABLE (Vstandard_display_table),
764 LEFT_SINGLE_QUOTATION_MARK);
765 if (VECTORP (dv) && ASIZE (dv) == 1
766 && EQ (AREF (dv, 0), make_number ('`')))
767 quote_translation = grave_accent;
768 }
769
770 multibyte = STRING_MULTIBYTE (string);
771 nchars = 0;
772
773 /* KEYMAP is either nil (which means search all the active keymaps)
774 or a specified local map (which means search just that and the
775 global map). If non-nil, it might come from Voverriding_local_map,
776 or from a \\<mapname> construct in STRING itself.. */
777 keymap = Voverriding_local_map;
778
779 bsize = SBYTES (string);
780
781 /* Add some room for expansion due to quote replacement. */
782 enum { EXTRA_ROOM = 20 };
783 if (bsize <= STRING_BYTES_BOUND - EXTRA_ROOM)
784 bsize += EXTRA_ROOM;
785
786 bufp = buf = xmalloc (bsize);
787
788 strp = SDATA (string);
789 while (strp < SDATA (string) + SBYTES (string))
790 {
791 if (strp[0] == '\\' && strp[1] == '=')
792 {
793 /* \= quotes the next character;
794 thus, to put in \[ without its special meaning, use \=\[. */
795 changed = true;
796 strp += 2;
797 if (multibyte)
798 {
799 int len;
800
801 STRING_CHAR_AND_LENGTH (strp, len);
802 if (len == 1)
803 *bufp = *strp;
804 else
805 memcpy (bufp, strp, len);
806 strp += len;
807 bufp += len;
808 nchars++;
809 }
810 else
811 *bufp++ = *strp++, nchars++;
812 }
813 else if (strp[0] == '\\' && strp[1] == '[')
814 {
815 ptrdiff_t start_idx;
816 bool follow_remap = 1;
817
818 strp += 2; /* skip \[ */
819 start = strp;
820 start_idx = start - SDATA (string);
821
822 while ((strp - SDATA (string)
823 < SBYTES (string))
824 && *strp != ']')
825 strp++;
826 length_byte = strp - start;
827
828 strp++; /* skip ] */
829
830 /* Save STRP in IDX. */
831 idx = strp - SDATA (string);
832 name = Fintern (make_string ((char *) start, length_byte), Qnil);
833
834 do_remap:
835 tem = Fwhere_is_internal (name, keymap, Qt, Qnil, Qnil);
836
837 if (VECTORP (tem) && ASIZE (tem) > 1
838 && EQ (AREF (tem, 0), Qremap) && SYMBOLP (AREF (tem, 1))
839 && follow_remap)
840 {
841 name = AREF (tem, 1);
842 follow_remap = 0;
843 goto do_remap;
844 }
845
846 /* Note the Fwhere_is_internal can GC, so we have to take
847 relocation of string contents into account. */
848 strp = SDATA (string) + idx;
849 start = SDATA (string) + start_idx;
850
851 if (NILP (tem)) /* but not on any keys */
852 {
853 ptrdiff_t offset = bufp - buf;
854 if (STRING_BYTES_BOUND - 4 < bsize)
855 string_overflow ();
856 buf = xrealloc (buf, bsize += 4);
857 bufp = buf + offset;
858 memcpy (bufp, "M-x ", 4);
859 bufp += 4;
860 nchars += 4;
861 if (multibyte)
862 length = multibyte_chars_in_text (start, length_byte);
863 else
864 length = length_byte;
865 goto subst;
866 }
867 else
868 { /* function is on a key */
869 tem = Fkey_description (tem, Qnil);
870 goto subst_string;
871 }
872 }
873 /* \{foo} is replaced with a summary of the keymap (symbol-value foo).
874 \<foo> just sets the keymap used for \[cmd]. */
875 else if (strp[0] == '\\' && (strp[1] == '{' || strp[1] == '<'))
876 {
877 struct buffer *oldbuf;
878 ptrdiff_t start_idx;
879 /* This is for computing the SHADOWS arg for describe_map_tree. */
880 Lisp_Object active_maps = Fcurrent_active_maps (Qnil, Qnil);
881 Lisp_Object earlier_maps;
882 ptrdiff_t count = SPECPDL_INDEX ();
883
884 strp += 2; /* skip \{ or \< */
885 start = strp;
886 start_idx = start - SDATA (string);
887
888 while ((strp - SDATA (string) < SBYTES (string))
889 && *strp != '}' && *strp != '>')
890 strp++;
891
892 length_byte = strp - start;
893 strp++; /* skip } or > */
894
895 /* Save STRP in IDX. */
896 idx = strp - SDATA (string);
897
898 /* Get the value of the keymap in TEM, or nil if undefined.
899 Do this while still in the user's current buffer
900 in case it is a local variable. */
901 name = Fintern (make_string ((char *) start, length_byte), Qnil);
902 tem = Fboundp (name);
903 if (! NILP (tem))
904 {
905 tem = Fsymbol_value (name);
906 if (! NILP (tem))
907 {
908 tem = get_keymap (tem, 0, 1);
909 /* Note that get_keymap can GC. */
910 strp = SDATA (string) + idx;
911 start = SDATA (string) + start_idx;
912 }
913 }
914
915 /* Now switch to a temp buffer. */
916 oldbuf = current_buffer;
917 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer));
918 /* This is for an unusual case where some after-change
919 function uses 'format' or 'prin1' or something else that
920 will thrash Vprin1_to_string_buffer we are using. */
921 specbind (Qinhibit_modification_hooks, Qt);
922
923 if (NILP (tem))
924 {
925 name = Fsymbol_name (name);
926 insert1 (Fsubstitute_command_keys
927 (build_string ("\nUses keymap "uLSQM)));
928 insert_from_string (name, 0, 0,
929 SCHARS (name),
930 SBYTES (name), 1);
931 insert1 (Fsubstitute_command_keys
932 (build_string
933 (uRSQM", which is not currently defined.\n")));
934 if (start[-1] == '<') keymap = Qnil;
935 }
936 else if (start[-1] == '<')
937 keymap = tem;
938 else
939 {
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);
945 }
946 tem = Fbuffer_string ();
947 Ferase_buffer ();
948 set_buffer_internal (oldbuf);
949 unbind_to (count, Qnil);
950
951 subst_string:
952 start = SDATA (tem);
953 length = SCHARS (tem);
954 length_byte = SBYTES (tem);
955 subst:
956 changed = true;
957 {
958 ptrdiff_t offset = bufp - buf;
959 if (STRING_BYTES_BOUND - length_byte < bsize)
960 string_overflow ();
961 buf = xrealloc (buf, bsize += length_byte);
962 bufp = buf + offset;
963 memcpy (bufp, start, length_byte);
964 bufp += length_byte;
965 nchars += length;
966 /* Check STRING again in case gc relocated it. */
967 strp = SDATA (string) + idx;
968 }
969 }
970 else if (strp[0] == '`' && quote_translation == unicode)
971 {
972 in_quote = true;
973 start = LSQM;
974 subst_quote:
975 length = 1;
976 length_byte = 3;
977 idx = strp - SDATA (string) + 1;
978 goto subst;
979 }
980 else if (strp[0] == '`' && quote_translation == apostrophe)
981 {
982 *bufp++ = '\'';
983 strp++;
984 nchars++;
985 changed = true;
986 }
987 else if (strp[0] == '\'' && in_quote)
988 {
989 in_quote = false;
990 start = RSQM;
991 goto subst_quote;
992 }
993 else if (strp[0] == uLSQM0 && strp[1] == uLSQM1
994 && (strp[2] == uLSQM2 || strp[2] == uRSQM2)
995 && quote_translation != unicode)
996 {
997 *bufp++ = (strp[2] == uLSQM2 && quote_translation == grave_accent
998 ? '`' : '\'');
999 strp += 3;
1000 nchars++;
1001 changed = true;
1002 }
1003 else if (! multibyte) /* just copy other chars */
1004 *bufp++ = *strp++, nchars++;
1005 else
1006 {
1007 int len;
1008
1009 STRING_CHAR_AND_LENGTH (strp, len);
1010 if (len == 1)
1011 *bufp = *strp;
1012 else
1013 memcpy (bufp, strp, len);
1014 strp += len;
1015 bufp += len;
1016 nchars++;
1017 }
1018 }
1019
1020 if (changed) /* don't bother if nothing substituted */
1021 tem = make_string_from_bytes (buf, nchars, bufp - buf);
1022 else
1023 tem = string;
1024 xfree (buf);
1025 RETURN_UNGCPRO (tem);
1026 }
1027 \f
1028 void
1029 syms_of_doc (void)
1030 {
1031 DEFSYM (Qfunction_documentation, "function-documentation");
1032 DEFSYM (Qgrave, "grave");
1033 DEFSYM (Qstraight, "straight");
1034
1035 DEFVAR_LISP ("internal-doc-file-name", Vdoc_file_name,
1036 doc: /* Name of file containing documentation strings of built-in symbols. */);
1037 Vdoc_file_name = Qnil;
1038
1039 DEFVAR_LISP ("build-files", Vbuild_files,
1040 doc: /* A list of files used to build this Emacs binary. */);
1041 Vbuild_files = Qnil;
1042
1043 DEFVAR_LISP ("text-quoting-style", Vtext_quoting_style,
1044 doc: /* Style to use for single quotes when generating text.
1045 ‘curve’ means quote with curved single quotes \\=‘like this\\=’.
1046 ‘straight’ means quote with straight apostrophes 'like this'.
1047 ‘grave’ means quote with grave accent and apostrophe \\=`like this'.
1048 The default value nil acts like ‘curve’ if curved single quotes are
1049 displayable, and like ‘grave’ otherwise. */);
1050 Vtext_quoting_style = Qnil;
1051
1052 defsubr (&Sdocumentation);
1053 defsubr (&Sdocumentation_property);
1054 defsubr (&Ssnarf_documentation);
1055 defsubr (&Ssubstitute_command_keys);
1056 }