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