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