]> code.delx.au - gnu-emacs/blob - src/doc.c
merge master, fix conflicts
[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 0
303 Lisp_Object reply, prompt[3];
304 struct gcpro gcpro1;
305 GCPRO1 (file);
306 prompt[0] = build_string ("File ");
307 prompt[1] = NILP (file) ? Vdoc_file_name : file;
308 prompt[2] = build_string (" is out of sync. Reload? ");
309 reply = Fy_or_n_p (Fconcat (3, prompt));
310 UNGCPRO;
311 if (NILP (reply))
312 return 0;
313 #endif
314
315 if (NILP (file))
316 Fsnarf_documentation (Vdoc_file_name);
317 else
318 Fload (file, Qt, Qt, Qt, Qnil);
319
320 return 1;
321 }
322
323 DEFUN ("documentation", Fdocumentation, Sdocumentation, 1, 2, 0,
324 doc: /* Return the documentation string of FUNCTION.
325 Unless a non-nil second argument RAW is given, the
326 string is passed through `substitute-command-keys'. */)
327 (Lisp_Object function, Lisp_Object raw)
328 {
329 Lisp_Object fun;
330 Lisp_Object funcar;
331 Lisp_Object doc;
332 bool try_reload = 1;
333
334 documentation:
335
336 doc = Qnil;
337
338 if (SYMBOLP (function))
339 {
340 Lisp_Object tem = Fget (function, Qfunction_documentation);
341 if (!NILP (tem))
342 return Fdocumentation_property (function, Qfunction_documentation,
343 raw);
344 }
345
346 fun = Findirect_function (function, Qnil);
347 if (CONSP (fun) && EQ (XCAR (fun), Qmacro))
348 fun = XCDR (fun);
349 if (SUBRP (fun))
350 {
351 if (XSUBR (fun)->doc == 0)
352 return Qnil;
353 /* FIXME: This is not portable, as it assumes that string
354 pointers have the top bit clear. */
355 else if ((intptr_t) XSUBR (fun)->doc >= 0)
356 doc = build_string (XSUBR (fun)->doc);
357 else
358 doc = make_number ((intptr_t) XSUBR (fun)->doc);
359 }
360 else if (COMPILEDP (fun))
361 {
362 if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) <= COMPILED_DOC_STRING)
363 return Qnil;
364 else
365 {
366 Lisp_Object tem = AREF (fun, COMPILED_DOC_STRING);
367 if (STRINGP (tem))
368 doc = tem;
369 else if (NATNUMP (tem) || CONSP (tem))
370 doc = tem;
371 else
372 return Qnil;
373 }
374 }
375 else if (STRINGP (fun) || VECTORP (fun))
376 {
377 return build_string ("Keyboard macro.");
378 }
379 else if (CONSP (fun))
380 {
381 funcar = XCAR (fun);
382 if (!SYMBOLP (funcar))
383 xsignal1 (Qinvalid_function, fun);
384 else if (EQ (funcar, Qkeymap))
385 return build_string ("Prefix command (definition is a keymap associating keystrokes with commands).");
386 else if (EQ (funcar, Qlambda)
387 || (EQ (funcar, Qclosure) && (fun = XCDR (fun), 1))
388 || EQ (funcar, Qautoload))
389 {
390 Lisp_Object tem1 = Fcdr (Fcdr (fun));
391 Lisp_Object tem = Fcar (tem1);
392 if (STRINGP (tem))
393 doc = tem;
394 /* Handle a doc reference--but these never come last
395 in the function body, so reject them if they are last. */
396 else if ((NATNUMP (tem) || (CONSP (tem) && INTEGERP (XCDR (tem))))
397 && !NILP (XCDR (tem1)))
398 doc = tem;
399 else
400 return Qnil;
401 }
402 else
403 goto oops;
404 }
405 else
406 {
407 oops:
408 xsignal1 (Qinvalid_function, fun);
409 }
410
411 /* If DOC is 0, it's typically because of a dumped file missing
412 from the DOC file (bug in src/Makefile.in). */
413 if (EQ (doc, make_number (0)))
414 doc = Qnil;
415 if (INTEGERP (doc) || CONSP (doc))
416 {
417 Lisp_Object tem;
418 tem = get_doc_string (doc, 0, 0);
419 if (NILP (tem) && try_reload)
420 {
421 /* The file is newer, we need to reset the pointers. */
422 struct gcpro gcpro1, gcpro2;
423 GCPRO2 (function, raw);
424 try_reload = reread_doc_file (Fcar_safe (doc));
425 UNGCPRO;
426 if (try_reload)
427 {
428 try_reload = 0;
429 goto documentation;
430 }
431 }
432 else
433 doc = tem;
434 }
435
436 if (NILP (raw))
437 doc = Fsubstitute_command_keys (doc);
438 return doc;
439 }
440
441 DEFUN ("documentation-property", Fdocumentation_property,
442 Sdocumentation_property, 2, 3, 0,
443 doc: /* Return the documentation string that is SYMBOL's PROP property.
444 Third argument RAW omitted or nil means pass the result through
445 `substitute-command-keys' if it is a string.
446
447 This differs from `get' in that it can refer to strings stored in the
448 `etc/DOC' file; and that it evaluates documentation properties that
449 aren't strings. */)
450 (Lisp_Object symbol, Lisp_Object prop, Lisp_Object raw)
451 {
452 bool try_reload = 1;
453 Lisp_Object tem;
454
455 documentation_property:
456
457 tem = Fget (symbol, prop);
458 if (EQ (tem, make_number (0)))
459 tem = Qnil;
460 if (INTEGERP (tem) || (CONSP (tem) && INTEGERP (XCDR (tem))))
461 {
462 Lisp_Object doc = tem;
463 tem = get_doc_string (tem, 0, 0);
464 if (NILP (tem) && try_reload)
465 {
466 /* The file is newer, we need to reset the pointers. */
467 struct gcpro gcpro1, gcpro2, gcpro3;
468 GCPRO3 (symbol, prop, raw);
469 try_reload = reread_doc_file (Fcar_safe (doc));
470 UNGCPRO;
471 if (try_reload)
472 {
473 try_reload = 0;
474 goto documentation_property;
475 }
476 }
477 }
478 else if (!STRINGP (tem))
479 /* Feval protects its argument. */
480 tem = Feval (tem, Qnil);
481
482 if (NILP (raw) && STRINGP (tem))
483 tem = Fsubstitute_command_keys (tem);
484 return tem;
485 }
486 \f
487 /* Scanning the DOC files and placing docstring offsets into functions. */
488
489 static void
490 store_function_docstring (Lisp_Object obj, ptrdiff_t offset)
491 {
492 /* Don't use indirect_function here, or defaliases will apply their
493 docstrings to the base functions (Bug#2603). */
494 Lisp_Object fun = SYMBOLP (obj) ? XSYMBOL (obj)->function : obj;
495
496 /* The type determines where the docstring is stored. */
497
498 /* Lisp_Subrs have a slot for it. */
499 if (SUBRP (fun))
500 {
501 intptr_t negative_offset = - offset;
502 XSUBR (fun)->doc = (char *) negative_offset;
503 }
504
505 /* If it's a lisp form, stick it in the form. */
506 else if (CONSP (fun))
507 {
508 Lisp_Object tem;
509
510 tem = XCAR (fun);
511 if (EQ (tem, Qlambda) || EQ (tem, Qautoload)
512 || (EQ (tem, Qclosure) && (fun = XCDR (fun), 1)))
513 {
514 tem = Fcdr (Fcdr (fun));
515 if (CONSP (tem) && INTEGERP (XCAR (tem)))
516 /* FIXME: This modifies typically pure hash-cons'd data, so its
517 correctness is quite delicate. */
518 XSETCAR (tem, make_number (offset));
519 }
520 else if (EQ (tem, Qmacro))
521 store_function_docstring (XCDR (fun), offset);
522 }
523
524 /* Bytecode objects sometimes have slots for it. */
525 else if (COMPILEDP (fun))
526 {
527 /* This bytecode object must have a slot for the
528 docstring, since we've found a docstring for it. */
529 if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) > COMPILED_DOC_STRING)
530 ASET (fun, COMPILED_DOC_STRING, make_number (offset));
531 else
532 message ("No docstring slot for %s",
533 SYMBOLP (obj) ? SSDATA (SYMBOL_NAME (obj)) : "<anonymous>");
534 }
535 }
536
537
538 DEFUN ("Snarf-documentation", Fsnarf_documentation, Ssnarf_documentation,
539 1, 1, 0,
540 doc: /* Used during Emacs initialization to scan the `etc/DOC...' file.
541 This searches the `etc/DOC...' file for doc strings and
542 records them in function and variable definitions.
543 The function takes one argument, FILENAME, a string;
544 it specifies the file name (without a directory) of the DOC file.
545 That file is found in `../etc' now; later, when the dumped Emacs is run,
546 the same file name is found in the `doc-directory'. */)
547 (Lisp_Object filename)
548 {
549 int fd;
550 char buf[1024 + 1];
551 int filled;
552 EMACS_INT pos;
553 Lisp_Object sym;
554 char *p, *name;
555 bool skip_file = 0;
556 ptrdiff_t count;
557 char const *dirname;
558 ptrdiff_t dirlen;
559 /* Preloaded defcustoms using custom-initialize-delay are added to
560 this list, but kept unbound. See http://debbugs.gnu.org/11565 */
561 Lisp_Object delayed_init =
562 find_symbol_value (intern ("custom-delayed-init-variables"));
563
564 if (EQ (delayed_init, Qunbound)) delayed_init = Qnil;
565
566 CHECK_STRING (filename);
567
568 if
569 #ifndef CANNOT_DUMP
570 (!NILP (Vpurify_flag))
571 #else /* CANNOT_DUMP */
572 (0)
573 #endif /* CANNOT_DUMP */
574 {
575 dirname = sibling_etc;
576 dirlen = sizeof sibling_etc - 1;
577 }
578 else
579 {
580 CHECK_STRING (Vdoc_directory);
581 dirname = SSDATA (Vdoc_directory);
582 dirlen = SBYTES (Vdoc_directory);
583 }
584
585 count = SPECPDL_INDEX ();
586 USE_SAFE_ALLOCA;
587 name = SAFE_ALLOCA (dirlen + SBYTES (filename) + 1);
588 lispstpcpy (stpcpy (name, dirname), filename); /*** Add this line ***/
589
590 /* Vbuild_files is nil when temacs is run, and non-nil after that. */
591 if (NILP (Vbuild_files))
592 {
593 static char const *const buildobj[] =
594 {
595 #include "buildobj.h"
596 };
597 int i = ARRAYELTS (buildobj);
598 while (0 <= --i)
599 Vbuild_files = Fcons (build_string (buildobj[i]), Vbuild_files);
600 Vbuild_files = Fpurecopy (Vbuild_files);
601 }
602
603 fd = emacs_open (name, O_RDONLY, 0);
604 if (fd < 0)
605 {
606 int open_errno = errno;
607 report_file_errno ("Opening doc string file", build_string (name),
608 open_errno);
609 }
610 record_unwind_protect_int (close_file_unwind, fd);
611 Vdoc_file_name = filename;
612 filled = 0;
613 pos = 0;
614 while (1)
615 {
616 register char *end;
617 if (filled < 512)
618 filled += emacs_read (fd, &buf[filled], sizeof buf - 1 - filled);
619 if (!filled)
620 break;
621
622 buf[filled] = 0;
623 end = buf + (filled < 512 ? filled : filled - 128);
624 p = memchr (buf, '\037', end - buf);
625 /* p points to ^_Ffunctionname\n or ^_Vvarname\n or ^_Sfilename\n. */
626 if (p)
627 {
628 end = strchr (p, '\n');
629
630 /* See if this is a file name, and if it is a file in build-files. */
631 if (p[1] == 'S')
632 {
633 skip_file = 0;
634 if (end - p > 4 && end[-2] == '.'
635 && (end[-1] == 'o' || end[-1] == 'c'))
636 {
637 ptrdiff_t len = end - p - 2;
638 char *fromfile = SAFE_ALLOCA (len + 1);
639 memcpy (fromfile, &p[2], len);
640 fromfile[len] = 0;
641 if (fromfile[len-1] == 'c')
642 fromfile[len-1] = 'o';
643
644 skip_file = NILP (Fmember (build_string (fromfile),
645 Vbuild_files));
646 }
647 }
648
649 sym = oblookup (Vobarray, p + 2,
650 multibyte_chars_in_text ((unsigned char *) p + 2,
651 end - p - 2),
652 end - p - 2);
653 /* Check skip_file so that when a function is defined several
654 times in different files (typically, once in xterm, once in
655 w32term, ...), we only pay attention to the one that
656 matters. */
657 if (! skip_file && SYMBOLP (sym))
658 {
659 /* Attach a docstring to a variable? */
660 if (p[1] == 'V')
661 {
662 /* Install file-position as variable-documentation property
663 and make it negative for a user-variable
664 (doc starts with a `*'). */
665 if (!NILP (Fboundp (sym))
666 || !NILP (Fmemq (sym, delayed_init)))
667 Fput (sym, Qvariable_documentation,
668 make_number ((pos + end + 1 - buf)
669 * (end[1] == '*' ? -1 : 1)));
670 }
671
672 /* Attach a docstring to a function? */
673 else if (p[1] == 'F')
674 {
675 if (!NILP (Ffboundp (sym)))
676 store_function_docstring (sym, pos + end + 1 - buf);
677 }
678 else if (p[1] == 'S')
679 ; /* Just a source file name boundary marker. Ignore it. */
680
681 else
682 error ("DOC file invalid at position %"pI"d", pos);
683 }
684 }
685 pos += end - buf;
686 filled -= end - buf;
687 memmove (buf, end, filled);
688 }
689
690 SAFE_FREE ();
691 return unbind_to (count, Qnil);
692 }
693 \f
694 DEFUN ("substitute-command-keys", Fsubstitute_command_keys,
695 Ssubstitute_command_keys, 1, 1, 0,
696 doc: /* Substitute key descriptions for command names in STRING.
697 Each substring of the form \\=\\[COMMAND] is replaced by either a
698 keystroke sequence that invokes COMMAND, or "M-x COMMAND" if COMMAND
699 is not on any keys.
700
701 Each substring of the form \\=\\{MAPVAR} is replaced by a summary of
702 the value of MAPVAR as a keymap. This summary is similar to the one
703 produced by `describe-bindings'. The summary ends in two newlines
704 \(used by the helper function `help-make-xrefs' to find the end of the
705 summary).
706
707 Each substring of the form \\=\\<MAPVAR> specifies the use of MAPVAR
708 as the keymap for future \\=\\[COMMAND] substrings.
709 \\=\\= quotes the following character and is discarded;
710 thus, \\=\\=\\=\\= puts \\=\\= into the output, and \\=\\=\\=\\[ puts \\=\\[ into the output.
711
712 Return the original STRING if no substitutions are made.
713 Otherwise, return a new string. */)
714 (Lisp_Object string)
715 {
716 char *buf;
717 bool changed = 0;
718 unsigned char *strp;
719 char *bufp;
720 ptrdiff_t idx;
721 ptrdiff_t bsize;
722 Lisp_Object tem;
723 Lisp_Object keymap;
724 unsigned char *start;
725 ptrdiff_t length, length_byte;
726 Lisp_Object name;
727 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
728 bool multibyte;
729 ptrdiff_t nchars;
730
731 if (NILP (string))
732 return Qnil;
733
734 CHECK_STRING (string);
735 tem = Qnil;
736 keymap = Qnil;
737 name = Qnil;
738 GCPRO4 (string, tem, keymap, name);
739
740 multibyte = STRING_MULTIBYTE (string);
741 nchars = 0;
742
743 /* KEYMAP is either nil (which means search all the active keymaps)
744 or a specified local map (which means search just that and the
745 global map). If non-nil, it might come from Voverriding_local_map,
746 or from a \\<mapname> construct in STRING itself.. */
747 keymap = Voverriding_local_map;
748
749 bsize = SBYTES (string);
750 bufp = buf = xmalloc (bsize);
751
752 strp = SDATA (string);
753 while (strp < SDATA (string) + SBYTES (string))
754 {
755 if (strp[0] == '\\' && strp[1] == '=')
756 {
757 /* \= quotes the next character;
758 thus, to put in \[ without its special meaning, use \=\[. */
759 changed = 1;
760 strp += 2;
761 if (multibyte)
762 {
763 int len;
764
765 STRING_CHAR_AND_LENGTH (strp, len);
766 if (len == 1)
767 *bufp = *strp;
768 else
769 memcpy (bufp, strp, len);
770 strp += len;
771 bufp += len;
772 nchars++;
773 }
774 else
775 *bufp++ = *strp++, nchars++;
776 }
777 else if (strp[0] == '\\' && strp[1] == '[')
778 {
779 ptrdiff_t start_idx;
780 bool follow_remap = 1;
781
782 changed = 1;
783 strp += 2; /* skip \[ */
784 start = strp;
785 start_idx = start - SDATA (string);
786
787 while ((strp - SDATA (string)
788 < SBYTES (string))
789 && *strp != ']')
790 strp++;
791 length_byte = strp - start;
792
793 strp++; /* skip ] */
794
795 /* Save STRP in IDX. */
796 idx = strp - SDATA (string);
797 name = Fintern (make_string ((char *) start, length_byte), Qnil);
798
799 do_remap:
800 tem = Fwhere_is_internal (name, keymap, Qt, Qnil, Qnil);
801
802 if (VECTORP (tem) && ASIZE (tem) > 1
803 && EQ (AREF (tem, 0), Qremap) && SYMBOLP (AREF (tem, 1))
804 && follow_remap)
805 {
806 name = AREF (tem, 1);
807 follow_remap = 0;
808 goto do_remap;
809 }
810
811 /* Note the Fwhere_is_internal can GC, so we have to take
812 relocation of string contents into account. */
813 strp = SDATA (string) + idx;
814 start = SDATA (string) + start_idx;
815
816 if (NILP (tem)) /* but not on any keys */
817 {
818 ptrdiff_t offset = bufp - buf;
819 if (STRING_BYTES_BOUND - 4 < bsize)
820 string_overflow ();
821 buf = xrealloc (buf, bsize += 4);
822 bufp = buf + offset;
823 memcpy (bufp, "M-x ", 4);
824 bufp += 4;
825 nchars += 4;
826 if (multibyte)
827 length = multibyte_chars_in_text (start, length_byte);
828 else
829 length = length_byte;
830 goto subst;
831 }
832 else
833 { /* function is on a key */
834 tem = Fkey_description (tem, Qnil);
835 goto subst_string;
836 }
837 }
838 /* \{foo} is replaced with a summary of the keymap (symbol-value foo).
839 \<foo> just sets the keymap used for \[cmd]. */
840 else if (strp[0] == '\\' && (strp[1] == '{' || strp[1] == '<'))
841 {
842 struct buffer *oldbuf;
843 ptrdiff_t start_idx;
844 /* This is for computing the SHADOWS arg for describe_map_tree. */
845 Lisp_Object active_maps = Fcurrent_active_maps (Qnil, Qnil);
846 Lisp_Object earlier_maps;
847 ptrdiff_t count = SPECPDL_INDEX ();
848
849 changed = 1;
850 strp += 2; /* skip \{ or \< */
851 start = strp;
852 start_idx = start - SDATA (string);
853
854 while ((strp - SDATA (string) < SBYTES (string))
855 && *strp != '}' && *strp != '>')
856 strp++;
857
858 length_byte = strp - start;
859 strp++; /* skip } or > */
860
861 /* Save STRP in IDX. */
862 idx = strp - SDATA (string);
863
864 /* Get the value of the keymap in TEM, or nil if undefined.
865 Do this while still in the user's current buffer
866 in case it is a local variable. */
867 name = Fintern (make_string ((char *) start, length_byte), Qnil);
868 tem = Fboundp (name);
869 if (! NILP (tem))
870 {
871 tem = Fsymbol_value (name);
872 if (! NILP (tem))
873 {
874 tem = get_keymap (tem, 0, 1);
875 /* Note that get_keymap can GC. */
876 strp = SDATA (string) + idx;
877 start = SDATA (string) + start_idx;
878 }
879 }
880
881 /* Now switch to a temp buffer. */
882 oldbuf = current_buffer;
883 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer));
884 /* This is for an unusual case where some after-change
885 function uses 'format' or 'prin1' or something else that
886 will thrash Vprin1_to_string_buffer we are using. */
887 specbind (Qinhibit_modification_hooks, Qt);
888
889 if (NILP (tem))
890 {
891 name = Fsymbol_name (name);
892 insert_string ("\nUses keymap `");
893 insert_from_string (name, 0, 0,
894 SCHARS (name),
895 SBYTES (name), 1);
896 insert_string ("', which is not currently defined.\n");
897 if (start[-1] == '<') keymap = Qnil;
898 }
899 else if (start[-1] == '<')
900 keymap = tem;
901 else
902 {
903 /* Get the list of active keymaps that precede this one.
904 If this one's not active, get nil. */
905 earlier_maps = Fcdr (Fmemq (tem, Freverse (active_maps)));
906 describe_map_tree (tem, 1, Fnreverse (earlier_maps),
907 Qnil, 0, 1, 0, 0, 1);
908 }
909 tem = Fbuffer_string ();
910 Ferase_buffer ();
911 set_buffer_internal (oldbuf);
912 unbind_to (count, Qnil);
913
914 subst_string:
915 start = SDATA (tem);
916 length = SCHARS (tem);
917 length_byte = SBYTES (tem);
918 subst:
919 {
920 ptrdiff_t offset = bufp - buf;
921 if (STRING_BYTES_BOUND - length_byte < bsize)
922 string_overflow ();
923 buf = xrealloc (buf, bsize += length_byte);
924 bufp = buf + offset;
925 memcpy (bufp, start, length_byte);
926 bufp += length_byte;
927 nchars += length;
928 /* Check STRING again in case gc relocated it. */
929 strp = SDATA (string) + idx;
930 }
931 }
932 else if (! multibyte) /* just copy other chars */
933 *bufp++ = *strp++, nchars++;
934 else
935 {
936 int len;
937
938 STRING_CHAR_AND_LENGTH (strp, len);
939 if (len == 1)
940 *bufp = *strp;
941 else
942 memcpy (bufp, strp, len);
943 strp += len;
944 bufp += len;
945 nchars++;
946 }
947 }
948
949 if (changed) /* don't bother if nothing substituted */
950 tem = make_string_from_bytes (buf, nchars, bufp - buf);
951 else
952 tem = string;
953 xfree (buf);
954 RETURN_UNGCPRO (tem);
955 }
956 \f
957 void
958 syms_of_doc (void)
959 {
960 DEFSYM (Qfunction_documentation, "function-documentation");
961
962 DEFVAR_LISP ("internal-doc-file-name", Vdoc_file_name,
963 doc: /* Name of file containing documentation strings of built-in symbols. */);
964 Vdoc_file_name = Qnil;
965
966 DEFVAR_LISP ("build-files", Vbuild_files,
967 doc: /* A list of files used to build this Emacs binary. */);
968 Vbuild_files = Qnil;
969
970 defsubr (&Sdocumentation);
971 defsubr (&Sdocumentation_property);
972 defsubr (&Ssnarf_documentation);
973 defsubr (&Ssubstitute_command_keys);
974 }