use dynwind_begin and dynwind_end
[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, 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 USE_SAFE_ALLOCA;
88
89 if (INTEGERP (filepos))
90 {
91 file = Vdoc_file_name;
92 pos = filepos;
93 }
94 else if (CONSP (filepos))
95 {
96 file = XCAR (filepos);
97 pos = XCDR (filepos);
98 }
99 else
100 return Qnil;
101
102 position = eabs (XINT (pos));
103
104 if (!STRINGP (Vdoc_directory))
105 return Qnil;
106
107 if (!STRINGP (file))
108 return Qnil;
109
110 /* Put the file name in NAME as a C string.
111 If it is relative, combine it with Vdoc_directory. */
112
113 tem = Ffile_name_absolute_p (file);
114 file = ENCODE_FILE (file);
115 if (NILP (tem))
116 {
117 Lisp_Object docdir = ENCODE_FILE (Vdoc_directory);
118 minsize = SCHARS (docdir);
119 /* sizeof ("../etc/") == 8 */
120 if (minsize < 8)
121 minsize = 8;
122 name = SAFE_ALLOCA (minsize + SCHARS (file) + 8);
123 strcpy (name, SSDATA (docdir));
124 strcat (name, SSDATA (file));
125 }
126 else
127 {
128 name = SSDATA (file);
129 }
130
131 fd = emacs_open (name, O_RDONLY, 0);
132 if (fd < 0)
133 {
134 #ifndef CANNOT_DUMP
135 if (!NILP (Vpurify_flag))
136 {
137 /* Preparing to dump; DOC file is probably not installed.
138 So check in ../etc. */
139 strcpy (name, "../etc/");
140 strcat (name, SSDATA (file));
141
142 fd = emacs_open (name, O_RDONLY, 0);
143 }
144 #endif
145 if (fd < 0)
146 {
147 SAFE_FREE ();
148 return concat3 (build_string ("Cannot open doc string file \""),
149 file, build_string ("\"\n"));
150 }
151 }
152 dynwind_begin ();
153 record_unwind_protect_int (close_file_unwind, fd);
154
155 /* Seek only to beginning of disk block. */
156 /* Make sure we read at least 1024 bytes before `position'
157 so we can check the leading text for consistency. */
158 offset = min (position, max (1024, position % (8 * 1024)));
159 if (TYPE_MAXIMUM (off_t) < position
160 || lseek (fd, position - offset, 0) < 0)
161 error ("Position %"pI"d out of range in doc string file \"%s\"",
162 position, name);
163
164 /* Read the doc string into get_doc_string_buffer.
165 P points beyond the data just read. */
166
167 p = get_doc_string_buffer;
168 while (1)
169 {
170 ptrdiff_t space_left = (get_doc_string_buffer_size - 1
171 - (p - get_doc_string_buffer));
172 int nread;
173
174 /* Allocate or grow the buffer if we need to. */
175 if (space_left <= 0)
176 {
177 ptrdiff_t in_buffer = p - get_doc_string_buffer;
178 get_doc_string_buffer
179 = xpalloc (get_doc_string_buffer, &get_doc_string_buffer_size,
180 16 * 1024, -1, 1);
181 p = get_doc_string_buffer + in_buffer;
182 space_left = (get_doc_string_buffer_size - 1
183 - (p - get_doc_string_buffer));
184 }
185
186 /* Read a disk block at a time.
187 If we read the same block last time, maybe skip this? */
188 if (space_left > 1024 * 8)
189 space_left = 1024 * 8;
190 nread = emacs_read (fd, p, space_left);
191 if (nread < 0)
192 report_file_error ("Read error on documentation file", file);
193 p[nread] = 0;
194 if (!nread)
195 break;
196 if (p == get_doc_string_buffer)
197 p1 = strchr (p + offset, '\037');
198 else
199 p1 = strchr (p, '\037');
200 if (p1)
201 {
202 *p1 = 0;
203 p = p1;
204 break;
205 }
206 p += nread;
207 }
208 dynwind_end ();
209 SAFE_FREE ();
210
211 /* Sanity checking. */
212 if (CONSP (filepos))
213 {
214 int test = 1;
215 /* A dynamic docstring should be either at the very beginning of a "#@
216 comment" or right after a dynamic docstring delimiter (in case we
217 pack several such docstrings within the same comment). */
218 if (get_doc_string_buffer[offset - test] != '\037')
219 {
220 if (get_doc_string_buffer[offset - test++] != ' ')
221 return Qnil;
222 while (get_doc_string_buffer[offset - test] >= '0'
223 && get_doc_string_buffer[offset - test] <= '9')
224 test++;
225 if (get_doc_string_buffer[offset - test++] != '@'
226 || get_doc_string_buffer[offset - test] != '#')
227 return Qnil;
228 }
229 }
230 else
231 {
232 int test = 1;
233 if (get_doc_string_buffer[offset - test++] != '\n')
234 return Qnil;
235 while (get_doc_string_buffer[offset - test] > ' ')
236 test++;
237 if (get_doc_string_buffer[offset - test] != '\037')
238 return Qnil;
239 }
240
241 /* Scan the text and perform quoting with ^A (char code 1).
242 ^A^A becomes ^A, ^A0 becomes a null char, and ^A_ becomes a ^_. */
243 from = get_doc_string_buffer + offset;
244 to = get_doc_string_buffer + offset;
245 while (from != p)
246 {
247 if (*from == 1)
248 {
249 int c;
250
251 from++;
252 c = *from++;
253 if (c == 1)
254 *to++ = c;
255 else if (c == '0')
256 *to++ = 0;
257 else if (c == '_')
258 *to++ = 037;
259 else
260 {
261 unsigned char uc = c;
262 error ("\
263 Invalid data in documentation file -- %c followed by code %03o",
264 1, uc);
265 }
266 }
267 else
268 *to++ = *from++;
269 }
270
271 /* If DEFINITION, read from this buffer
272 the same way we would read bytes from a file. */
273 if (definition)
274 {
275 read_bytecode_pointer = (unsigned char *) get_doc_string_buffer + offset;
276 return Fread (Qlambda);
277 }
278
279 if (unibyte)
280 return make_unibyte_string (get_doc_string_buffer + offset,
281 to - (get_doc_string_buffer + offset));
282 else
283 {
284 /* The data determines whether the string is multibyte. */
285 ptrdiff_t nchars
286 = multibyte_chars_in_text (((unsigned char *) get_doc_string_buffer
287 + offset),
288 to - (get_doc_string_buffer + offset));
289 return make_string_from_bytes (get_doc_string_buffer + offset,
290 nchars,
291 to - (get_doc_string_buffer + offset));
292 }
293 }
294
295 /* Get a string from position FILEPOS and pass it through the Lisp reader.
296 We use this for fetching the bytecode string and constants vector
297 of a compiled function from the .elc file. */
298
299 Lisp_Object
300 read_doc_string (Lisp_Object filepos)
301 {
302 return get_doc_string (filepos, 0, 1);
303 }
304
305 static bool
306 reread_doc_file (Lisp_Object file)
307 {
308 #if 0
309 Lisp_Object reply, prompt[3];
310 struct gcpro gcpro1;
311 GCPRO1 (file);
312 prompt[0] = build_string ("File ");
313 prompt[1] = NILP (file) ? Vdoc_file_name : file;
314 prompt[2] = build_string (" is out of sync. Reload? ");
315 reply = Fy_or_n_p (Fconcat (3, prompt));
316 UNGCPRO;
317 if (NILP (reply))
318 return 0;
319 #endif
320
321 if (NILP (file))
322 Fsnarf_documentation (Vdoc_file_name);
323 else
324 Fload (file, Qt, Qt, Qt, Qnil);
325
326 return 1;
327 }
328
329 DEFUN ("documentation", Fdocumentation, Sdocumentation, 1, 2, 0,
330 doc: /* Return the documentation string of FUNCTION.
331 Unless a non-nil second argument RAW is given, the
332 string is passed through `substitute-command-keys'. */)
333 (Lisp_Object function, Lisp_Object raw)
334 {
335 Lisp_Object fun;
336 Lisp_Object funcar;
337 Lisp_Object doc;
338 bool try_reload = 1;
339
340 documentation:
341
342 doc = Qnil;
343
344 if (SYMBOLP (function))
345 {
346 Lisp_Object tem = Fget (function, Qfunction_documentation);
347 if (!NILP (tem))
348 return Fdocumentation_property (function, Qfunction_documentation,
349 raw);
350 }
351
352 fun = Findirect_function (function, Qnil);
353 if (CONSP (fun) && EQ (XCAR (fun), Qmacro))
354 fun = XCDR (fun);
355 if (SUBRP (fun))
356 {
357 if (XSUBR (fun)->doc == 0)
358 return Qnil;
359 /* FIXME: This is not portable, as it assumes that string
360 pointers have the top bit clear. */
361 else if ((intptr_t) XSUBR (fun)->doc >= 0)
362 doc = build_string (XSUBR (fun)->doc);
363 else
364 doc = make_number ((intptr_t) XSUBR (fun)->doc);
365 }
366 else if (COMPILEDP (fun))
367 {
368 if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) <= COMPILED_DOC_STRING)
369 return Qnil;
370 else
371 {
372 Lisp_Object tem = AREF (fun, COMPILED_DOC_STRING);
373 if (STRINGP (tem))
374 doc = tem;
375 else if (NATNUMP (tem) || CONSP (tem))
376 doc = tem;
377 else
378 return Qnil;
379 }
380 }
381 else if (STRINGP (fun) || VECTORP (fun))
382 {
383 return build_string ("Keyboard macro.");
384 }
385 else if (CONSP (fun))
386 {
387 funcar = XCAR (fun);
388 if (!SYMBOLP (funcar))
389 xsignal1 (Qinvalid_function, fun);
390 else if (EQ (funcar, Qkeymap))
391 return build_string ("Prefix command (definition is a keymap associating keystrokes with commands).");
392 else if (EQ (funcar, Qlambda)
393 || (EQ (funcar, Qclosure) && (fun = XCDR (fun), 1))
394 || EQ (funcar, Qautoload))
395 {
396 Lisp_Object tem1 = Fcdr (Fcdr (fun));
397 Lisp_Object tem = Fcar (tem1);
398 if (STRINGP (tem))
399 doc = tem;
400 /* Handle a doc reference--but these never come last
401 in the function body, so reject them if they are last. */
402 else if ((NATNUMP (tem) || (CONSP (tem) && INTEGERP (XCDR (tem))))
403 && !NILP (XCDR (tem1)))
404 doc = tem;
405 else
406 return Qnil;
407 }
408 else
409 goto oops;
410 }
411 else
412 {
413 oops:
414 xsignal1 (Qinvalid_function, fun);
415 }
416
417 /* If DOC is 0, it's typically because of a dumped file missing
418 from the DOC file (bug in src/Makefile.in). */
419 if (EQ (doc, make_number (0)))
420 doc = Qnil;
421 if (INTEGERP (doc) || CONSP (doc))
422 {
423 Lisp_Object tem;
424 tem = get_doc_string (doc, 0, 0);
425 if (NILP (tem) && try_reload)
426 {
427 /* The file is newer, we need to reset the pointers. */
428 struct gcpro gcpro1, gcpro2;
429 GCPRO2 (function, raw);
430 try_reload = reread_doc_file (Fcar_safe (doc));
431 UNGCPRO;
432 if (try_reload)
433 {
434 try_reload = 0;
435 goto documentation;
436 }
437 }
438 else
439 doc = tem;
440 }
441
442 if (NILP (raw))
443 doc = Fsubstitute_command_keys (doc);
444 return doc;
445 }
446
447 DEFUN ("documentation-property", Fdocumentation_property,
448 Sdocumentation_property, 2, 3, 0,
449 doc: /* Return the documentation string that is SYMBOL's PROP property.
450 Third argument RAW omitted or nil means pass the result through
451 `substitute-command-keys' if it is a string.
452
453 This differs from `get' in that it can refer to strings stored in the
454 `etc/DOC' file; and that it evaluates documentation properties that
455 aren't strings. */)
456 (Lisp_Object symbol, Lisp_Object prop, Lisp_Object raw)
457 {
458 bool try_reload = 1;
459 Lisp_Object tem;
460
461 documentation_property:
462
463 tem = Fget (symbol, prop);
464 if (EQ (tem, make_number (0)))
465 tem = Qnil;
466 if (INTEGERP (tem) || (CONSP (tem) && INTEGERP (XCDR (tem))))
467 {
468 Lisp_Object doc = tem;
469 tem = get_doc_string (tem, 0, 0);
470 if (NILP (tem) && try_reload)
471 {
472 /* The file is newer, we need to reset the pointers. */
473 struct gcpro gcpro1, gcpro2, gcpro3;
474 GCPRO3 (symbol, prop, raw);
475 try_reload = reread_doc_file (Fcar_safe (doc));
476 UNGCPRO;
477 if (try_reload)
478 {
479 try_reload = 0;
480 goto documentation_property;
481 }
482 }
483 }
484 else if (!STRINGP (tem))
485 /* Feval protects its argument. */
486 tem = Feval (tem, Qnil);
487
488 if (NILP (raw) && STRINGP (tem))
489 tem = Fsubstitute_command_keys (tem);
490 return tem;
491 }
492 \f
493 /* Scanning the DOC files and placing docstring offsets into functions. */
494
495 static void
496 store_function_docstring (Lisp_Object obj, ptrdiff_t offset)
497 {
498 /* Don't use indirect_function here, or defaliases will apply their
499 docstrings to the base functions (Bug#2603). */
500 Lisp_Object fun = SYMBOLP (obj) ? XSYMBOL (obj)->function : obj;
501
502 /* The type determines where the docstring is stored. */
503
504 /* Lisp_Subrs have a slot for it. */
505 if (SUBRP (fun))
506 {
507 intptr_t negative_offset = - offset;
508 XSUBR (fun)->doc = (char *) negative_offset;
509 }
510
511 /* If it's a lisp form, stick it in the form. */
512 else if (CONSP (fun))
513 {
514 Lisp_Object tem;
515
516 tem = XCAR (fun);
517 if (EQ (tem, Qlambda) || EQ (tem, Qautoload)
518 || (EQ (tem, Qclosure) && (fun = XCDR (fun), 1)))
519 {
520 tem = Fcdr (Fcdr (fun));
521 if (CONSP (tem) && INTEGERP (XCAR (tem)))
522 /* FIXME: This modifies typically pure hash-cons'd data, so its
523 correctness is quite delicate. */
524 XSETCAR (tem, make_number (offset));
525 }
526 else if (EQ (tem, Qmacro))
527 store_function_docstring (XCDR (fun), offset);
528 }
529
530 /* Bytecode objects sometimes have slots for it. */
531 else if (COMPILEDP (fun))
532 {
533 /* This bytecode object must have a slot for the
534 docstring, since we've found a docstring for it. */
535 if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) > COMPILED_DOC_STRING)
536 ASET (fun, COMPILED_DOC_STRING, make_number (offset));
537 else
538 message ("No docstring slot for %s",
539 SYMBOLP (obj) ? SSDATA (SYMBOL_NAME (obj)) : "<anonymous>");
540 }
541 }
542
543
544 DEFUN ("Snarf-documentation", Fsnarf_documentation, Ssnarf_documentation,
545 1, 1, 0,
546 doc: /* Used during Emacs initialization to scan the `etc/DOC...' file.
547 This searches the `etc/DOC...' file for doc strings and
548 records them in function and variable definitions.
549 The function takes one argument, FILENAME, a string;
550 it specifies the file name (without a directory) of the DOC file.
551 That file is found in `../etc' now; later, when the dumped Emacs is run,
552 the same file name is found in the `doc-directory'. */)
553 (Lisp_Object filename)
554 {
555 int fd;
556 char buf[1024 + 1];
557 int filled;
558 EMACS_INT pos;
559 Lisp_Object sym;
560 char *p, *name;
561 bool skip_file = 0;
562 ptrdiff_t count;
563 /* Preloaded defcustoms using custom-initialize-delay are added to
564 this list, but kept unbound. See http://debbugs.gnu.org/11565 */
565 Lisp_Object delayed_init =
566 find_symbol_value (intern ("custom-delayed-init-variables"));
567
568 if (EQ (delayed_init, Qunbound)) delayed_init = Qnil;
569
570 CHECK_STRING (filename);
571
572 if
573 #ifndef CANNOT_DUMP
574 (!NILP (Vpurify_flag))
575 #else /* CANNOT_DUMP */
576 (0)
577 #endif /* CANNOT_DUMP */
578 {
579 name = alloca (SCHARS (filename) + 14);
580 strcpy (name, "../etc/");
581 }
582 else
583 {
584 CHECK_STRING (Vdoc_directory);
585 name = alloca (SCHARS (filename) + SCHARS (Vdoc_directory) + 1);
586 strcpy (name, SSDATA (Vdoc_directory));
587 }
588 strcat (name, SSDATA (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 dynwind_begin ();
611 record_unwind_protect_int (close_file_unwind, fd);
612 Vdoc_file_name = filename;
613 filled = 0;
614 pos = 0;
615 while (1)
616 {
617 register char *end;
618 if (filled < 512)
619 filled += emacs_read (fd, &buf[filled], sizeof buf - 1 - filled);
620 if (!filled)
621 break;
622
623 buf[filled] = 0;
624 end = buf + (filled < 512 ? filled : filled - 128);
625 p = memchr (buf, '\037', end - buf);
626 /* p points to ^_Ffunctionname\n or ^_Vvarname\n or ^_Sfilename\n. */
627 if (p)
628 {
629 end = strchr (p, '\n');
630
631 /* See if this is a file name, and if it is a file in build-files. */
632 if (p[1] == 'S')
633 {
634 skip_file = 0;
635 if (end - p > 4 && end[-2] == '.'
636 && (end[-1] == 'o' || end[-1] == 'c'))
637 {
638 ptrdiff_t len = end - p - 2;
639 char *fromfile = alloca (len + 1);
640 memcpy (fromfile, &p[2], len);
641 fromfile[len] = 0;
642 if (fromfile[len-1] == 'c')
643 fromfile[len-1] = 'o';
644
645 skip_file = NILP (Fmember (build_string (fromfile),
646 Vbuild_files));
647 }
648 }
649
650 sym = oblookup (Vobarray, p + 2,
651 multibyte_chars_in_text ((unsigned char *) p + 2,
652 end - p - 2),
653 end - p - 2);
654 /* Check skip_file so that when a function is defined several
655 times in different files (typically, once in xterm, once in
656 w32term, ...), we only pay attention to the one that
657 matters. */
658 if (! skip_file && SYMBOLP (sym))
659 {
660 /* Attach a docstring to a variable? */
661 if (p[1] == 'V')
662 {
663 /* Install file-position as variable-documentation property
664 and make it negative for a user-variable
665 (doc starts with a `*'). */
666 if (!NILP (Fboundp (sym))
667 || !NILP (Fmemq (sym, delayed_init)))
668 Fput (sym, Qvariable_documentation,
669 make_number ((pos + end + 1 - buf)
670 * (end[1] == '*' ? -1 : 1)));
671 }
672
673 /* Attach a docstring to a function? */
674 else if (p[1] == 'F')
675 {
676 if (!NILP (Ffboundp (sym)))
677 store_function_docstring (sym, pos + end + 1 - buf);
678 }
679 else if (p[1] == 'S')
680 ; /* Just a source file name boundary marker. Ignore it. */
681
682 else
683 error ("DOC file invalid at position %"pI"d", pos);
684 }
685 }
686 pos += end - buf;
687 filled -= end - buf;
688 memmove (buf, end, filled);
689 }
690 dynwind_end ();
691 return 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_atomic (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 tem;
955 }
956 \f
957 void
958 syms_of_doc (void)
959 {
960 #include "doc.x"
961
962 DEFSYM (Qfunction_documentation, "function-documentation");
963
964 DEFVAR_LISP ("internal-doc-file-name", Vdoc_file_name,
965 doc: /* Name of file containing documentation strings of built-in symbols. */);
966 Vdoc_file_name = Qnil;
967
968 DEFVAR_LISP ("build-files", Vbuild_files,
969 doc: /* A list of files used to build this Emacs binary. */);
970 Vbuild_files = Qnil;
971 }