]> code.delx.au - gnu-emacs/blob - src/doc.c
Don't misencode C-generated messages
[gnu-emacs] / src / doc.c
1 /* Record indices of function doc strings stored in a file.
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 "keyboard.h"
36 #include "keymap.h"
37
38 /* Buffer used for reading from documentation file. */
39 static char *get_doc_string_buffer;
40 static ptrdiff_t get_doc_string_buffer_size;
41
42 static unsigned char *read_bytecode_pointer;
43
44 static char const sibling_etc[] = "../etc/";
45
46 /* `readchar' in lread.c calls back here to fetch the next byte.
47 If UNREADFLAG is 1, we unread a byte. */
48
49 int
50 read_bytecode_char (bool unreadflag)
51 {
52 if (unreadflag)
53 {
54 read_bytecode_pointer--;
55 return 0;
56 }
57 return *read_bytecode_pointer++;
58 }
59
60 /* Extract a doc string from a file. FILEPOS says where to get it.
61 If it is an integer, use that position in the standard DOC file.
62 If it is (FILE . INTEGER), use FILE as the file name
63 and INTEGER as the position in that file.
64 But if INTEGER is negative, make it positive.
65 (A negative integer is used for user variables, so we can distinguish
66 them without actually fetching the doc string.)
67
68 If the location does not point to the beginning of a docstring
69 (e.g. because the file has been modified and the location is stale),
70 return nil.
71
72 If UNIBYTE, always make a unibyte string.
73
74 If DEFINITION, assume this is for reading
75 a dynamic function definition; convert the bytestring
76 and the constants vector with appropriate byte handling,
77 and return a cons cell. */
78
79 Lisp_Object
80 get_doc_string (Lisp_Object filepos, bool unibyte, bool definition)
81 {
82 char *from, *to, *name, *p, *p1;
83 int fd;
84 int offset;
85 EMACS_INT position;
86 Lisp_Object file, tem, pos;
87 ptrdiff_t count;
88 USE_SAFE_ALLOCA;
89
90 if (INTEGERP (filepos))
91 {
92 file = Vdoc_file_name;
93 pos = filepos;
94 }
95 else if (CONSP (filepos))
96 {
97 file = XCAR (filepos);
98 pos = XCDR (filepos);
99 }
100 else
101 return Qnil;
102
103 position = eabs (XINT (pos));
104
105 if (!STRINGP (Vdoc_directory))
106 return Qnil;
107
108 if (!STRINGP (file))
109 return Qnil;
110
111 /* Put the file name in NAME as a C string.
112 If it is relative, combine it with Vdoc_directory. */
113
114 tem = Ffile_name_absolute_p (file);
115 file = ENCODE_FILE (file);
116 Lisp_Object docdir
117 = NILP (tem) ? ENCODE_FILE (Vdoc_directory) : empty_unibyte_string;
118 ptrdiff_t docdir_sizemax = SBYTES (docdir) + 1;
119 #ifndef CANNOT_DUMP
120 docdir_sizemax = max (docdir_sizemax, sizeof sibling_etc);
121 #endif
122 name = SAFE_ALLOCA (docdir_sizemax + SBYTES (file));
123 lispstpcpy (lispstpcpy (name, docdir), file);
124
125 fd = emacs_open (name, O_RDONLY, 0);
126 if (fd < 0)
127 {
128 #ifndef CANNOT_DUMP
129 if (!NILP (Vpurify_flag))
130 {
131 /* Preparing to dump; DOC file is probably not installed.
132 So check in ../etc. */
133 lispstpcpy (stpcpy (name, sibling_etc), file);
134
135 fd = emacs_open (name, O_RDONLY, 0);
136 }
137 #endif
138 if (fd < 0)
139 {
140 SAFE_FREE ();
141 AUTO_STRING (cannot_open, "Cannot open doc string file \"");
142 AUTO_STRING (quote_nl, "\"\n");
143 return concat3 (cannot_open, file, quote_nl);
144 }
145 }
146 count = SPECPDL_INDEX ();
147 record_unwind_protect_int (close_file_unwind, fd);
148
149 /* Seek only to beginning of disk block. */
150 /* Make sure we read at least 1024 bytes before `position'
151 so we can check the leading text for consistency. */
152 offset = min (position, max (1024, position % (8 * 1024)));
153 if (TYPE_MAXIMUM (off_t) < position
154 || lseek (fd, position - offset, 0) < 0)
155 error ("Position %"pI"d out of range in doc string file \"%s\"",
156 position, name);
157
158 /* Read the doc string into get_doc_string_buffer.
159 P points beyond the data just read. */
160
161 p = get_doc_string_buffer;
162 while (1)
163 {
164 ptrdiff_t space_left = (get_doc_string_buffer_size - 1
165 - (p - get_doc_string_buffer));
166 int nread;
167
168 /* Allocate or grow the buffer if we need to. */
169 if (space_left <= 0)
170 {
171 ptrdiff_t in_buffer = p - get_doc_string_buffer;
172 get_doc_string_buffer
173 = xpalloc (get_doc_string_buffer, &get_doc_string_buffer_size,
174 16 * 1024, -1, 1);
175 p = get_doc_string_buffer + in_buffer;
176 space_left = (get_doc_string_buffer_size - 1
177 - (p - get_doc_string_buffer));
178 }
179
180 /* Read a disk block at a time.
181 If we read the same block last time, maybe skip this? */
182 if (space_left > 1024 * 8)
183 space_left = 1024 * 8;
184 nread = emacs_read (fd, p, space_left);
185 if (nread < 0)
186 report_file_error ("Read error on documentation file", file);
187 p[nread] = 0;
188 if (!nread)
189 break;
190 if (p == get_doc_string_buffer)
191 p1 = strchr (p + offset, '\037');
192 else
193 p1 = strchr (p, '\037');
194 if (p1)
195 {
196 *p1 = 0;
197 p = p1;
198 break;
199 }
200 p += nread;
201 }
202 unbind_to (count, Qnil);
203 SAFE_FREE ();
204
205 /* Sanity checking. */
206 if (CONSP (filepos))
207 {
208 int test = 1;
209 /* A dynamic docstring should be either at the very beginning of a "#@
210 comment" or right after a dynamic docstring delimiter (in case we
211 pack several such docstrings within the same comment). */
212 if (get_doc_string_buffer[offset - test] != '\037')
213 {
214 if (get_doc_string_buffer[offset - test++] != ' ')
215 return Qnil;
216 while (get_doc_string_buffer[offset - test] >= '0'
217 && get_doc_string_buffer[offset - test] <= '9')
218 test++;
219 if (get_doc_string_buffer[offset - test++] != '@'
220 || get_doc_string_buffer[offset - test] != '#')
221 return Qnil;
222 }
223 }
224 else
225 {
226 int test = 1;
227 if (get_doc_string_buffer[offset - test++] != '\n')
228 return Qnil;
229 while (get_doc_string_buffer[offset - test] > ' ')
230 test++;
231 if (get_doc_string_buffer[offset - test] != '\037')
232 return Qnil;
233 }
234
235 /* Scan the text and perform quoting with ^A (char code 1).
236 ^A^A becomes ^A, ^A0 becomes a null char, and ^A_ becomes a ^_. */
237 from = get_doc_string_buffer + offset;
238 to = get_doc_string_buffer + offset;
239 while (from != p)
240 {
241 if (*from == 1)
242 {
243 int c;
244
245 from++;
246 c = *from++;
247 if (c == 1)
248 *to++ = c;
249 else if (c == '0')
250 *to++ = 0;
251 else if (c == '_')
252 *to++ = 037;
253 else
254 {
255 unsigned char uc = c;
256 error ("\
257 Invalid data in documentation file -- %c followed by code %03o",
258 1, uc);
259 }
260 }
261 else
262 *to++ = *from++;
263 }
264
265 /* If DEFINITION, read from this buffer
266 the same way we would read bytes from a file. */
267 if (definition)
268 {
269 read_bytecode_pointer = (unsigned char *) get_doc_string_buffer + offset;
270 return Fread (Qlambda);
271 }
272
273 if (unibyte)
274 return make_unibyte_string (get_doc_string_buffer + offset,
275 to - (get_doc_string_buffer + offset));
276 else
277 {
278 /* The data determines whether the string is multibyte. */
279 ptrdiff_t nchars
280 = multibyte_chars_in_text (((unsigned char *) get_doc_string_buffer
281 + offset),
282 to - (get_doc_string_buffer + offset));
283 return make_string_from_bytes (get_doc_string_buffer + offset,
284 nchars,
285 to - (get_doc_string_buffer + offset));
286 }
287 }
288
289 /* Get a string from position FILEPOS and pass it through the Lisp reader.
290 We use this for fetching the bytecode string and constants vector
291 of a compiled function from the .elc file. */
292
293 Lisp_Object
294 read_doc_string (Lisp_Object filepos)
295 {
296 return get_doc_string (filepos, 0, 1);
297 }
298
299 static bool
300 reread_doc_file (Lisp_Object file)
301 {
302 if (NILP (file))
303 Fsnarf_documentation (Vdoc_file_name);
304 else
305 Fload (file, Qt, Qt, Qt, Qnil);
306
307 return 1;
308 }
309
310 DEFUN ("documentation", Fdocumentation, Sdocumentation, 1, 2, 0,
311 doc: /* Return the documentation string of FUNCTION.
312 Unless a non-nil second argument RAW is given, the
313 string is passed through `substitute-command-keys'. */)
314 (Lisp_Object function, Lisp_Object raw)
315 {
316 Lisp_Object fun;
317 Lisp_Object funcar;
318 Lisp_Object doc;
319 bool try_reload = 1;
320
321 documentation:
322
323 doc = Qnil;
324
325 if (SYMBOLP (function))
326 {
327 Lisp_Object tem = Fget (function, Qfunction_documentation);
328 if (!NILP (tem))
329 return Fdocumentation_property (function, Qfunction_documentation,
330 raw);
331 }
332
333 fun = Findirect_function (function, Qnil);
334 if (CONSP (fun) && EQ (XCAR (fun), Qmacro))
335 fun = XCDR (fun);
336 if (SUBRP (fun))
337 {
338 if (XSUBR (fun)->doc == 0)
339 return Qnil;
340 /* FIXME: This is not portable, as it assumes that string
341 pointers have the top bit clear. */
342 else if ((intptr_t) XSUBR (fun)->doc >= 0)
343 doc = build_string (XSUBR (fun)->doc);
344 else
345 doc = make_number ((intptr_t) XSUBR (fun)->doc);
346 }
347 else if (COMPILEDP (fun))
348 {
349 if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) <= COMPILED_DOC_STRING)
350 return Qnil;
351 else
352 {
353 Lisp_Object tem = AREF (fun, COMPILED_DOC_STRING);
354 if (STRINGP (tem))
355 doc = tem;
356 else if (NATNUMP (tem) || CONSP (tem))
357 doc = tem;
358 else
359 return Qnil;
360 }
361 }
362 else if (STRINGP (fun) || VECTORP (fun))
363 {
364 return build_string ("Keyboard macro.");
365 }
366 else if (CONSP (fun))
367 {
368 funcar = XCAR (fun);
369 if (!SYMBOLP (funcar))
370 xsignal1 (Qinvalid_function, fun);
371 else if (EQ (funcar, Qkeymap))
372 return build_string ("Prefix command (definition is a keymap associating keystrokes with commands).");
373 else if (EQ (funcar, Qlambda)
374 || (EQ (funcar, Qclosure) && (fun = XCDR (fun), 1))
375 || EQ (funcar, Qautoload))
376 {
377 Lisp_Object tem1 = Fcdr (Fcdr (fun));
378 Lisp_Object tem = Fcar (tem1);
379 if (STRINGP (tem))
380 doc = tem;
381 /* Handle a doc reference--but these never come last
382 in the function body, so reject them if they are last. */
383 else if ((NATNUMP (tem) || (CONSP (tem) && INTEGERP (XCDR (tem))))
384 && !NILP (XCDR (tem1)))
385 doc = tem;
386 else
387 return Qnil;
388 }
389 else
390 goto oops;
391 }
392 else
393 {
394 oops:
395 xsignal1 (Qinvalid_function, fun);
396 }
397
398 /* If DOC is 0, it's typically because of a dumped file missing
399 from the DOC file (bug in src/Makefile.in). */
400 if (EQ (doc, make_number (0)))
401 doc = Qnil;
402 if (INTEGERP (doc) || CONSP (doc))
403 {
404 Lisp_Object tem;
405 tem = get_doc_string (doc, 0, 0);
406 if (NILP (tem) && try_reload)
407 {
408 /* The file is newer, we need to reset the pointers. */
409 struct gcpro gcpro1, gcpro2;
410 GCPRO2 (function, raw);
411 try_reload = reread_doc_file (Fcar_safe (doc));
412 UNGCPRO;
413 if (try_reload)
414 {
415 try_reload = 0;
416 goto documentation;
417 }
418 }
419 else
420 doc = tem;
421 }
422
423 if (NILP (raw))
424 doc = Fsubstitute_command_keys (doc);
425 return doc;
426 }
427
428 DEFUN ("documentation-property", Fdocumentation_property,
429 Sdocumentation_property, 2, 3, 0,
430 doc: /* Return the documentation string that is SYMBOL's PROP property.
431 Third argument RAW omitted or nil means pass the result through
432 `substitute-command-keys' if it is a string.
433
434 This differs from `get' in that it can refer to strings stored in the
435 `etc/DOC' file; and that it evaluates documentation properties that
436 aren't strings. */)
437 (Lisp_Object symbol, Lisp_Object prop, Lisp_Object raw)
438 {
439 bool try_reload = 1;
440 Lisp_Object tem;
441
442 documentation_property:
443
444 tem = Fget (symbol, prop);
445 if (EQ (tem, make_number (0)))
446 tem = Qnil;
447 if (INTEGERP (tem) || (CONSP (tem) && INTEGERP (XCDR (tem))))
448 {
449 Lisp_Object doc = tem;
450 tem = get_doc_string (tem, 0, 0);
451 if (NILP (tem) && try_reload)
452 {
453 /* The file is newer, we need to reset the pointers. */
454 struct gcpro gcpro1, gcpro2, gcpro3;
455 GCPRO3 (symbol, prop, raw);
456 try_reload = reread_doc_file (Fcar_safe (doc));
457 UNGCPRO;
458 if (try_reload)
459 {
460 try_reload = 0;
461 goto documentation_property;
462 }
463 }
464 }
465 else if (!STRINGP (tem))
466 /* Feval protects its argument. */
467 tem = Feval (tem, Qnil);
468
469 if (NILP (raw) && STRINGP (tem))
470 tem = Fsubstitute_command_keys (tem);
471 return tem;
472 }
473 \f
474 /* Scanning the DOC files and placing docstring offsets into functions. */
475
476 static void
477 store_function_docstring (Lisp_Object obj, ptrdiff_t offset)
478 {
479 /* Don't use indirect_function here, or defaliases will apply their
480 docstrings to the base functions (Bug#2603). */
481 Lisp_Object fun = SYMBOLP (obj) ? XSYMBOL (obj)->function : obj;
482
483 /* The type determines where the docstring is stored. */
484
485 /* Lisp_Subrs have a slot for it. */
486 if (SUBRP (fun))
487 {
488 intptr_t negative_offset = - offset;
489 XSUBR (fun)->doc = (char *) negative_offset;
490 }
491
492 /* If it's a lisp form, stick it in the form. */
493 else if (CONSP (fun))
494 {
495 Lisp_Object tem;
496
497 tem = XCAR (fun);
498 if (EQ (tem, Qlambda) || EQ (tem, Qautoload)
499 || (EQ (tem, Qclosure) && (fun = XCDR (fun), 1)))
500 {
501 tem = Fcdr (Fcdr (fun));
502 if (CONSP (tem) && INTEGERP (XCAR (tem)))
503 /* FIXME: This modifies typically pure hash-cons'd data, so its
504 correctness is quite delicate. */
505 XSETCAR (tem, make_number (offset));
506 }
507 else if (EQ (tem, Qmacro))
508 store_function_docstring (XCDR (fun), offset);
509 }
510
511 /* Bytecode objects sometimes have slots for it. */
512 else if (COMPILEDP (fun))
513 {
514 /* This bytecode object must have a slot for the
515 docstring, since we've found a docstring for it. */
516 if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) > COMPILED_DOC_STRING)
517 ASET (fun, COMPILED_DOC_STRING, make_number (offset));
518 else
519 {
520 AUTO_STRING (format, "No docstring slot for %s");
521 CALLN (Fmessage, format,
522 (SYMBOLP (obj)
523 ? SYMBOL_NAME (obj)
524 : build_string ("<anonymous>")));
525 }
526 }
527 }
528
529
530 DEFUN ("Snarf-documentation", Fsnarf_documentation, Ssnarf_documentation,
531 1, 1, 0,
532 doc: /* Used during Emacs initialization to scan the `etc/DOC...' file.
533 This searches the `etc/DOC...' file for doc strings and
534 records them in function and variable definitions.
535 The function takes one argument, FILENAME, a string;
536 it specifies the file name (without a directory) of the DOC file.
537 That file is found in `../etc' now; later, when the dumped Emacs is run,
538 the same file name is found in the `doc-directory'. */)
539 (Lisp_Object filename)
540 {
541 int fd;
542 char buf[1024 + 1];
543 int filled;
544 EMACS_INT pos;
545 Lisp_Object sym;
546 char *p, *name;
547 bool skip_file = 0;
548 ptrdiff_t count;
549 char const *dirname;
550 ptrdiff_t dirlen;
551 /* Preloaded defcustoms using custom-initialize-delay are added to
552 this list, but kept unbound. See http://debbugs.gnu.org/11565 */
553 Lisp_Object delayed_init =
554 find_symbol_value (intern ("custom-delayed-init-variables"));
555
556 if (EQ (delayed_init, Qunbound)) delayed_init = Qnil;
557
558 CHECK_STRING (filename);
559
560 if
561 #ifndef CANNOT_DUMP
562 (!NILP (Vpurify_flag))
563 #else /* CANNOT_DUMP */
564 (0)
565 #endif /* CANNOT_DUMP */
566 {
567 dirname = sibling_etc;
568 dirlen = sizeof sibling_etc - 1;
569 }
570 else
571 {
572 CHECK_STRING (Vdoc_directory);
573 dirname = SSDATA (Vdoc_directory);
574 dirlen = SBYTES (Vdoc_directory);
575 }
576
577 count = SPECPDL_INDEX ();
578 USE_SAFE_ALLOCA;
579 name = SAFE_ALLOCA (dirlen + SBYTES (filename) + 1);
580 lispstpcpy (stpcpy (name, dirname), filename); /*** Add this line ***/
581
582 /* Vbuild_files is nil when temacs is run, and non-nil after that. */
583 if (NILP (Vbuild_files))
584 {
585 static char const *const buildobj[] =
586 {
587 #include "buildobj.h"
588 };
589 int i = ARRAYELTS (buildobj);
590 while (0 <= --i)
591 Vbuild_files = Fcons (build_string (buildobj[i]), Vbuild_files);
592 Vbuild_files = Fpurecopy (Vbuild_files);
593 }
594
595 fd = emacs_open (name, O_RDONLY, 0);
596 if (fd < 0)
597 {
598 int open_errno = errno;
599 report_file_errno ("Opening doc string file", build_string (name),
600 open_errno);
601 }
602 record_unwind_protect_int (close_file_unwind, fd);
603 Vdoc_file_name = filename;
604 filled = 0;
605 pos = 0;
606 while (1)
607 {
608 register char *end;
609 if (filled < 512)
610 filled += emacs_read (fd, &buf[filled], sizeof buf - 1 - filled);
611 if (!filled)
612 break;
613
614 buf[filled] = 0;
615 end = buf + (filled < 512 ? filled : filled - 128);
616 p = memchr (buf, '\037', end - buf);
617 /* p points to ^_Ffunctionname\n or ^_Vvarname\n or ^_Sfilename\n. */
618 if (p)
619 {
620 end = strchr (p, '\n');
621
622 /* See if this is a file name, and if it is a file in build-files. */
623 if (p[1] == 'S')
624 {
625 skip_file = 0;
626 if (end - p > 4 && end[-2] == '.'
627 && (end[-1] == 'o' || end[-1] == 'c'))
628 {
629 ptrdiff_t len = end - p - 2;
630 char *fromfile = SAFE_ALLOCA (len + 1);
631 memcpy (fromfile, &p[2], len);
632 fromfile[len] = 0;
633 if (fromfile[len-1] == 'c')
634 fromfile[len-1] = 'o';
635
636 skip_file = NILP (Fmember (build_string (fromfile),
637 Vbuild_files));
638 }
639 }
640
641 sym = oblookup (Vobarray, p + 2,
642 multibyte_chars_in_text ((unsigned char *) p + 2,
643 end - p - 2),
644 end - p - 2);
645 /* Check skip_file so that when a function is defined several
646 times in different files (typically, once in xterm, once in
647 w32term, ...), we only pay attention to the one that
648 matters. */
649 if (! skip_file && SYMBOLP (sym))
650 {
651 /* Attach a docstring to a variable? */
652 if (p[1] == 'V')
653 {
654 /* Install file-position as variable-documentation property
655 and make it negative for a user-variable
656 (doc starts with a `*'). */
657 if (!NILP (Fboundp (sym))
658 || !NILP (Fmemq (sym, delayed_init)))
659 Fput (sym, Qvariable_documentation,
660 make_number ((pos + end + 1 - buf)
661 * (end[1] == '*' ? -1 : 1)));
662 }
663
664 /* Attach a docstring to a function? */
665 else if (p[1] == 'F')
666 {
667 if (!NILP (Ffboundp (sym)))
668 store_function_docstring (sym, pos + end + 1 - buf);
669 }
670 else if (p[1] == 'S')
671 ; /* Just a source file name boundary marker. Ignore it. */
672
673 else
674 error ("DOC file invalid at position %"pI"d", pos);
675 }
676 }
677 pos += end - buf;
678 filled -= end - buf;
679 memmove (buf, end, filled);
680 }
681
682 SAFE_FREE ();
683 return unbind_to (count, Qnil);
684 }
685 \f
686 DEFUN ("substitute-command-keys", Fsubstitute_command_keys,
687 Ssubstitute_command_keys, 1, 1, 0,
688 doc: /* Substitute key descriptions for command names in STRING.
689 Each substring of the form \\=\\[COMMAND] is replaced by either a
690 keystroke sequence that invokes COMMAND, or "M-x COMMAND" if COMMAND
691 is not on any keys.
692
693 Each substring of the form \\=\\{MAPVAR} is replaced by a summary of
694 the value of MAPVAR as a keymap. This summary is similar to the one
695 produced by `describe-bindings'. The summary ends in two newlines
696 \(used by the helper function `help-make-xrefs' to find the end of the
697 summary).
698
699 Each substring of the form \\=\\<MAPVAR> specifies the use of MAPVAR
700 as the keymap for future \\=\\[COMMAND] substrings.
701
702 Each \\=` is replaced by ‘. Each ' preceded by \\=` and without
703 intervening ' is replaced by ’.
704
705 \\=\\= quotes the following character and is discarded; thus,
706 \\=\\=\\=\\= puts \\=\\= into the output, \\=\\=\\=\\[ puts \\=\\[ into the output, and
707 \\=\\=\\=` puts \\=` into the output.
708
709 Return the original STRING if no substitutions are made.
710 Otherwise, return a new string. */)
711 (Lisp_Object string)
712 {
713 char *buf;
714 bool changed = false;
715 bool in_quote = false;
716 unsigned char *strp;
717 char *bufp;
718 ptrdiff_t idx;
719 ptrdiff_t bsize;
720 Lisp_Object tem;
721 Lisp_Object keymap;
722 unsigned char *start;
723 ptrdiff_t length, length_byte;
724 Lisp_Object name;
725 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
726 bool multibyte;
727 ptrdiff_t nchars;
728
729 if (NILP (string))
730 return Qnil;
731
732 CHECK_STRING (string);
733 tem = Qnil;
734 keymap = Qnil;
735 name = Qnil;
736 GCPRO4 (string, tem, keymap, name);
737
738 multibyte = STRING_MULTIBYTE (string);
739 nchars = 0;
740
741 /* KEYMAP is either nil (which means search all the active keymaps)
742 or a specified local map (which means search just that and the
743 global map). If non-nil, it might come from Voverriding_local_map,
744 or from a \\<mapname> construct in STRING itself.. */
745 keymap = Voverriding_local_map;
746
747 bsize = SBYTES (string);
748
749 /* Add some room for expansion due to quote replacement. */
750 enum { EXTRA_ROOM = 20 };
751 if (bsize <= STRING_BYTES_BOUND - EXTRA_ROOM)
752 bsize += EXTRA_ROOM;
753
754 bufp = buf = xmalloc (bsize);
755
756 strp = SDATA (string);
757 while (strp < SDATA (string) + SBYTES (string))
758 {
759 if (strp[0] == '\\' && strp[1] == '=')
760 {
761 /* \= quotes the next character;
762 thus, to put in \[ without its special meaning, use \=\[. */
763 changed = true;
764 strp += 2;
765 if (multibyte)
766 {
767 int len;
768
769 STRING_CHAR_AND_LENGTH (strp, len);
770 if (len == 1)
771 *bufp = *strp;
772 else
773 memcpy (bufp, strp, len);
774 strp += len;
775 bufp += len;
776 nchars++;
777 }
778 else
779 *bufp++ = *strp++, nchars++;
780 }
781 else if (strp[0] == '\\' && strp[1] == '[')
782 {
783 ptrdiff_t start_idx;
784 bool follow_remap = 1;
785
786 strp += 2; /* skip \[ */
787 start = strp;
788 start_idx = start - SDATA (string);
789
790 while ((strp - SDATA (string)
791 < SBYTES (string))
792 && *strp != ']')
793 strp++;
794 length_byte = strp - start;
795
796 strp++; /* skip ] */
797
798 /* Save STRP in IDX. */
799 idx = strp - SDATA (string);
800 name = Fintern (make_string ((char *) start, length_byte), Qnil);
801
802 do_remap:
803 tem = Fwhere_is_internal (name, keymap, Qt, Qnil, Qnil);
804
805 if (VECTORP (tem) && ASIZE (tem) > 1
806 && EQ (AREF (tem, 0), Qremap) && SYMBOLP (AREF (tem, 1))
807 && follow_remap)
808 {
809 name = AREF (tem, 1);
810 follow_remap = 0;
811 goto do_remap;
812 }
813
814 /* Note the Fwhere_is_internal can GC, so we have to take
815 relocation of string contents into account. */
816 strp = SDATA (string) + idx;
817 start = SDATA (string) + start_idx;
818
819 if (NILP (tem)) /* but not on any keys */
820 {
821 ptrdiff_t offset = bufp - buf;
822 if (STRING_BYTES_BOUND - 4 < bsize)
823 string_overflow ();
824 buf = xrealloc (buf, bsize += 4);
825 bufp = buf + offset;
826 memcpy (bufp, "M-x ", 4);
827 bufp += 4;
828 nchars += 4;
829 if (multibyte)
830 length = multibyte_chars_in_text (start, length_byte);
831 else
832 length = length_byte;
833 goto subst;
834 }
835 else
836 { /* function is on a key */
837 tem = Fkey_description (tem, Qnil);
838 goto subst_string;
839 }
840 }
841 /* \{foo} is replaced with a summary of the keymap (symbol-value foo).
842 \<foo> just sets the keymap used for \[cmd]. */
843 else if (strp[0] == '\\' && (strp[1] == '{' || strp[1] == '<'))
844 {
845 struct buffer *oldbuf;
846 ptrdiff_t start_idx;
847 /* This is for computing the SHADOWS arg for describe_map_tree. */
848 Lisp_Object active_maps = Fcurrent_active_maps (Qnil, Qnil);
849 Lisp_Object earlier_maps;
850 ptrdiff_t count = SPECPDL_INDEX ();
851
852 strp += 2; /* skip \{ or \< */
853 start = strp;
854 start_idx = start - SDATA (string);
855
856 while ((strp - SDATA (string) < SBYTES (string))
857 && *strp != '}' && *strp != '>')
858 strp++;
859
860 length_byte = strp - start;
861 strp++; /* skip } or > */
862
863 /* Save STRP in IDX. */
864 idx = strp - SDATA (string);
865
866 /* Get the value of the keymap in TEM, or nil if undefined.
867 Do this while still in the user's current buffer
868 in case it is a local variable. */
869 name = Fintern (make_string ((char *) start, length_byte), Qnil);
870 tem = Fboundp (name);
871 if (! NILP (tem))
872 {
873 tem = Fsymbol_value (name);
874 if (! NILP (tem))
875 {
876 tem = get_keymap (tem, 0, 1);
877 /* Note that get_keymap can GC. */
878 strp = SDATA (string) + idx;
879 start = SDATA (string) + start_idx;
880 }
881 }
882
883 /* Now switch to a temp buffer. */
884 oldbuf = current_buffer;
885 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer));
886 /* This is for an unusual case where some after-change
887 function uses 'format' or 'prin1' or something else that
888 will thrash Vprin1_to_string_buffer we are using. */
889 specbind (Qinhibit_modification_hooks, Qt);
890
891 if (NILP (tem))
892 {
893 name = Fsymbol_name (name);
894 insert_string ("\nUses keymap `");
895 insert_from_string (name, 0, 0,
896 SCHARS (name),
897 SBYTES (name), 1);
898 insert_string ("', which is not currently defined.\n");
899 if (start[-1] == '<') keymap = Qnil;
900 }
901 else if (start[-1] == '<')
902 keymap = tem;
903 else
904 {
905 /* Get the list of active keymaps that precede this one.
906 If this one's not active, get nil. */
907 earlier_maps = Fcdr (Fmemq (tem, Freverse (active_maps)));
908 describe_map_tree (tem, 1, Fnreverse (earlier_maps),
909 Qnil, 0, 1, 0, 0, 1);
910 }
911 tem = Fbuffer_string ();
912 Ferase_buffer ();
913 set_buffer_internal (oldbuf);
914 unbind_to (count, Qnil);
915
916 subst_string:
917 start = SDATA (tem);
918 length = SCHARS (tem);
919 length_byte = SBYTES (tem);
920 subst:
921 changed = true;
922 {
923 ptrdiff_t offset = bufp - buf;
924 if (STRING_BYTES_BOUND - length_byte < bsize)
925 string_overflow ();
926 buf = xrealloc (buf, bsize += length_byte);
927 bufp = buf + offset;
928 memcpy (bufp, start, length_byte);
929 bufp += length_byte;
930 nchars += length;
931 /* Check STRING again in case gc relocated it. */
932 strp = SDATA (string) + idx;
933 }
934 }
935 else if (strp[0] == '`')
936 {
937 in_quote = true;
938 start = (unsigned char *) "\xE2\x80\x98"; /* ‘ */
939 subst_quote:
940 length = 1;
941 length_byte = 3;
942 idx = strp - SDATA (string) + 1;
943 goto subst;
944 }
945 else if (strp[0] == '\'' && in_quote)
946 {
947 in_quote = false;
948 start = (unsigned char *) "\xE2\x80\x99"; /* ’ */
949 goto subst_quote;
950 }
951 else if (! multibyte) /* just copy other chars */
952 *bufp++ = *strp++, nchars++;
953 else
954 {
955 int len;
956
957 STRING_CHAR_AND_LENGTH (strp, len);
958 if (len == 1)
959 *bufp = *strp;
960 else
961 memcpy (bufp, strp, len);
962 strp += len;
963 bufp += len;
964 nchars++;
965 }
966 }
967
968 if (changed) /* don't bother if nothing substituted */
969 tem = make_string_from_bytes (buf, nchars, bufp - buf);
970 else
971 tem = string;
972 xfree (buf);
973 RETURN_UNGCPRO (tem);
974 }
975 \f
976 void
977 syms_of_doc (void)
978 {
979 DEFSYM (Qfunction_documentation, "function-documentation");
980
981 DEFVAR_LISP ("internal-doc-file-name", Vdoc_file_name,
982 doc: /* Name of file containing documentation strings of built-in symbols. */);
983 Vdoc_file_name = Qnil;
984
985 DEFVAR_LISP ("build-files", Vbuild_files,
986 doc: /* A list of files used to build this Emacs binary. */);
987 Vbuild_files = Qnil;
988
989 defsubr (&Sdocumentation);
990 defsubr (&Sdocumentation_property);
991 defsubr (&Ssnarf_documentation);
992 defsubr (&Ssubstitute_command_keys);
993 }