Merge from trunk.
[bpt/emacs.git] / src / doc.c
1 /* Record indices of function doc strings stored in a file.
2 Copyright (C) 1985-1986, 1993-1995, 1997-2011
3 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 <sys/types.h>
24 #include <sys/file.h> /* Must be after sys/types.h for USG*/
25 #include <ctype.h>
26 #include <setjmp.h>
27 #include <fcntl.h>
28 #include <unistd.h>
29
30 #include "lisp.h"
31 #include "buffer.h"
32 #include "keyboard.h"
33 #include "character.h"
34 #include "keymap.h"
35 #include "buildobj.h"
36
37 Lisp_Object Qfunction_documentation;
38
39 extern Lisp_Object Qclosure;
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 static Lisp_Object Fdocumentation_property (Lisp_Object, Lisp_Object,
46 Lisp_Object);
47 static Lisp_Object Fsnarf_documentation (Lisp_Object);
48
49 /* readchar in lread.c calls back here to fetch the next byte.
50 If UNREADFLAG is 1, we unread a byte. */
51
52 int
53 read_bytecode_char (int unreadflag)
54 {
55 if (unreadflag)
56 {
57 read_bytecode_pointer--;
58 return 0;
59 }
60 return *read_bytecode_pointer++;
61 }
62
63 /* Extract a doc string from a file. FILEPOS says where to get it.
64 If it is an integer, use that position in the standard DOC-... file.
65 If it is (FILE . INTEGER), use FILE as the file name
66 and INTEGER as the position in that file.
67 But if INTEGER is negative, make it positive.
68 (A negative integer is used for user variables, so we can distinguish
69 them without actually fetching the doc string.)
70
71 If the location does not point to the beginning of a docstring
72 (e.g. because the file has been modified and the location is stale),
73 return nil.
74
75 If UNIBYTE is nonzero, always make a unibyte string.
76
77 If DEFINITION is nonzero, assume this is for reading
78 a dynamic function definition; convert the bytestring
79 and the constants vector with appropriate byte handling,
80 and return a cons cell. */
81
82 Lisp_Object
83 get_doc_string (Lisp_Object filepos, int unibyte, int definition)
84 {
85 char *from, *to;
86 register int fd;
87 register char *name;
88 register char *p, *p1;
89 EMACS_INT minsize;
90 EMACS_INT offset, position;
91 Lisp_Object file, tem;
92
93 if (INTEGERP (filepos))
94 {
95 file = Vdoc_file_name;
96 position = XINT (filepos);
97 }
98 else if (CONSP (filepos))
99 {
100 file = XCAR (filepos);
101 position = XINT (XCDR (filepos));
102 }
103 else
104 return Qnil;
105
106 if (position < 0)
107 position = - position;
108
109 if (!STRINGP (Vdoc_directory))
110 return Qnil;
111
112 if (!STRINGP (file))
113 return Qnil;
114
115 /* Put the file name in NAME as a C string.
116 If it is relative, combine it with Vdoc_directory. */
117
118 tem = Ffile_name_absolute_p (file);
119 if (NILP (tem))
120 {
121 minsize = SCHARS (Vdoc_directory);
122 /* sizeof ("../etc/") == 8 */
123 if (minsize < 8)
124 minsize = 8;
125 name = (char *) alloca (minsize + SCHARS (file) + 8);
126 strcpy (name, SSDATA (Vdoc_directory));
127 strcat (name, SSDATA (file));
128 }
129 else
130 {
131 name = SSDATA (file);
132 }
133
134 fd = emacs_open (name, O_RDONLY, 0);
135 if (fd < 0)
136 {
137 #ifndef CANNOT_DUMP
138 if (!NILP (Vpurify_flag))
139 {
140 /* Preparing to dump; DOC file is probably not installed.
141 So check in ../etc. */
142 strcpy (name, "../etc/");
143 strcat (name, SSDATA (file));
144
145 fd = emacs_open (name, O_RDONLY, 0);
146 }
147 #endif
148 if (fd < 0)
149 error ("Cannot open doc string file \"%s\"", name);
150 }
151
152 /* Seek only to beginning of disk block. */
153 /* Make sure we read at least 1024 bytes before `position'
154 so we can check the leading text for consistency. */
155 offset = min (position, max (1024, position % (8 * 1024)));
156 if (0 > lseek (fd, position - offset, 0))
157 {
158 emacs_close (fd);
159 error ("Position %"pI"d out of range in doc string file \"%s\"",
160 position, name);
161 }
162
163 /* Read the doc string into get_doc_string_buffer.
164 P points beyond the data just read. */
165
166 p = get_doc_string_buffer;
167 while (1)
168 {
169 ptrdiff_t space_left = (get_doc_string_buffer_size
170 - (p - get_doc_string_buffer));
171 int nread;
172
173 /* Allocate or grow the buffer if we need to. */
174 if (space_left == 0)
175 {
176 ptrdiff_t in_buffer = p - get_doc_string_buffer;
177 get_doc_string_buffer =
178 xpalloc (get_doc_string_buffer, &get_doc_string_buffer_size,
179 16 * 1024, -1, 1);
180 p = get_doc_string_buffer + in_buffer;
181 space_left = (get_doc_string_buffer_size
182 - (p - get_doc_string_buffer));
183 }
184
185 /* Read a disk block at a time.
186 If we read the same block last time, maybe skip this? */
187 if (space_left > 1024 * 8)
188 space_left = 1024 * 8;
189 nread = emacs_read (fd, p, space_left);
190 if (nread < 0)
191 {
192 emacs_close (fd);
193 error ("Read error on documentation file");
194 }
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 emacs_close (fd);
211
212 /* Sanity checking. */
213 if (CONSP (filepos))
214 {
215 int test = 1;
216 if (get_doc_string_buffer[offset - test++] != ' ')
217 return Qnil;
218 while (get_doc_string_buffer[offset - test] >= '0'
219 && get_doc_string_buffer[offset - test] <= '9')
220 test++;
221 if (get_doc_string_buffer[offset - test++] != '@'
222 || get_doc_string_buffer[offset - test] != '#')
223 return Qnil;
224 }
225 else
226 {
227 int test = 1;
228 if (get_doc_string_buffer[offset - test++] != '\n')
229 return Qnil;
230 while (get_doc_string_buffer[offset - test] > ' ')
231 test++;
232 if (get_doc_string_buffer[offset - test] != '\037')
233 return Qnil;
234 }
235
236 /* Scan the text and perform quoting with ^A (char code 1).
237 ^A^A becomes ^A, ^A0 becomes a null char, and ^A_ becomes a ^_. */
238 from = get_doc_string_buffer + offset;
239 to = get_doc_string_buffer + offset;
240 while (from != p)
241 {
242 if (*from == 1)
243 {
244 int c;
245
246 from++;
247 c = *from++;
248 if (c == 1)
249 *to++ = c;
250 else if (c == '0')
251 *to++ = 0;
252 else if (c == '_')
253 *to++ = 037;
254 else
255 {
256 unsigned char uc = c;
257 error ("\
258 Invalid data in documentation file -- %c followed by code %03o",
259 1, uc);
260 }
261 }
262 else
263 *to++ = *from++;
264 }
265
266 /* If DEFINITION, read from this buffer
267 the same way we would read bytes from a file. */
268 if (definition)
269 {
270 read_bytecode_pointer = (unsigned char *) get_doc_string_buffer + offset;
271 return Fread (Qlambda);
272 }
273
274 if (unibyte)
275 return make_unibyte_string (get_doc_string_buffer + offset,
276 to - (get_doc_string_buffer + offset));
277 else
278 {
279 /* The data determines whether the string is multibyte. */
280 EMACS_INT nchars =
281 multibyte_chars_in_text (((unsigned char *) get_doc_string_buffer
282 + offset),
283 to - (get_doc_string_buffer + offset));
284 return make_string_from_bytes (get_doc_string_buffer + offset,
285 nchars,
286 to - (get_doc_string_buffer + offset));
287 }
288 }
289
290 /* Get a string from position FILEPOS and pass it through the Lisp reader.
291 We use this for fetching the bytecode string and constants vector
292 of a compiled function from the .elc file. */
293
294 Lisp_Object
295 read_doc_string (Lisp_Object filepos)
296 {
297 return get_doc_string (filepos, 0, 1);
298 }
299
300 static int
301 reread_doc_file (Lisp_Object file)
302 {
303 #if 0
304 Lisp_Object reply, prompt[3];
305 struct gcpro gcpro1;
306 GCPRO1 (file);
307 prompt[0] = build_string ("File ");
308 prompt[1] = NILP (file) ? Vdoc_file_name : file;
309 prompt[2] = build_string (" is out of sync. Reload? ");
310 reply = Fy_or_n_p (Fconcat (3, prompt));
311 UNGCPRO;
312 if (NILP (reply))
313 return 0;
314 #endif
315
316 if (NILP (file))
317 Fsnarf_documentation (Vdoc_file_name);
318 else
319 Fload (file, Qt, Qt, Qt, Qnil);
320
321 return 1;
322 }
323
324 DEFUN ("documentation", Fdocumentation, Sdocumentation, 1, 2, 0,
325 doc: /* Return the documentation string of FUNCTION.
326 Unless a non-nil second argument RAW is given, the
327 string is passed through `substitute-command-keys'. */)
328 (Lisp_Object function, Lisp_Object raw)
329 {
330 Lisp_Object fun;
331 Lisp_Object funcar;
332 Lisp_Object doc;
333 int try_reload = 1;
334
335 documentation:
336
337 doc = Qnil;
338
339 if (SYMBOLP (function))
340 {
341 Lisp_Object tem = Fget (function, Qfunction_documentation);
342 if (!NILP (tem))
343 return Fdocumentation_property (function, Qfunction_documentation,
344 raw);
345 }
346
347 fun = Findirect_function (function, Qnil);
348 if (SUBRP (fun))
349 {
350 if (XSUBR (fun)->doc == 0)
351 return Qnil;
352 /* FIXME: This is not portable, as it assumes that string
353 pointers have the top bit clear. */
354 else if ((intptr_t) XSUBR (fun)->doc >= 0)
355 doc = build_string (XSUBR (fun)->doc);
356 else
357 doc = make_number ((intptr_t) XSUBR (fun)->doc);
358 }
359 else if (COMPILEDP (fun))
360 {
361 if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) <= COMPILED_DOC_STRING)
362 return Qnil;
363 else
364 {
365 Lisp_Object tem = AREF (fun, COMPILED_DOC_STRING);
366 if (STRINGP (tem))
367 doc = tem;
368 else if (NATNUMP (tem) || CONSP (tem))
369 doc = tem;
370 else
371 return Qnil;
372 }
373 }
374 else if (STRINGP (fun) || VECTORP (fun))
375 {
376 return build_string ("Keyboard macro.");
377 }
378 else if (CONSP (fun))
379 {
380 funcar = Fcar (fun);
381 if (!SYMBOLP (funcar))
382 xsignal1 (Qinvalid_function, fun);
383 else if (EQ (funcar, Qkeymap))
384 return build_string ("Prefix command (definition is a keymap associating keystrokes with commands).");
385 else if (EQ (funcar, Qlambda)
386 || (EQ (funcar, Qclosure) && (fun = XCDR (fun), 1))
387 || EQ (funcar, Qautoload))
388 {
389 Lisp_Object tem1 = Fcdr (Fcdr (fun));
390 Lisp_Object tem = Fcar (tem1);
391 if (STRINGP (tem))
392 doc = tem;
393 /* Handle a doc reference--but these never come last
394 in the function body, so reject them if they are last. */
395 else if ((NATNUMP (tem) || (CONSP (tem) && INTEGERP (XCDR (tem))))
396 && !NILP (XCDR (tem1)))
397 doc = tem;
398 else
399 return Qnil;
400 }
401 else if (EQ (funcar, Qmacro))
402 return Fdocumentation (Fcdr (fun), raw);
403 else
404 goto oops;
405 }
406 else
407 {
408 oops:
409 xsignal1 (Qinvalid_function, fun);
410 }
411
412 /* Check for an advised function. Its doc string
413 has an `ad-advice-info' text property. */
414 if (STRINGP (doc))
415 {
416 Lisp_Object innerfunc;
417 innerfunc = Fget_text_property (make_number (0),
418 intern ("ad-advice-info"),
419 doc);
420 if (! NILP (innerfunc))
421 doc = call1 (intern ("ad-make-advised-docstring"), innerfunc);
422 }
423
424 /* If DOC is 0, it's typically because of a dumped file missing
425 from the DOC file (bug in src/Makefile.in). */
426 if (EQ (doc, make_number (0)))
427 doc = Qnil;
428 if (INTEGERP (doc) || CONSP (doc))
429 {
430 Lisp_Object tem;
431 tem = get_doc_string (doc, 0, 0);
432 if (NILP (tem) && try_reload)
433 {
434 /* The file is newer, we need to reset the pointers. */
435 struct gcpro gcpro1, gcpro2;
436 GCPRO2 (function, raw);
437 try_reload = reread_doc_file (Fcar_safe (doc));
438 UNGCPRO;
439 if (try_reload)
440 {
441 try_reload = 0;
442 goto documentation;
443 }
444 }
445 else
446 doc = tem;
447 }
448
449 if (NILP (raw))
450 doc = Fsubstitute_command_keys (doc);
451 return doc;
452 }
453
454 DEFUN ("documentation-property", Fdocumentation_property,
455 Sdocumentation_property, 2, 3, 0,
456 doc: /* Return the documentation string that is SYMBOL's PROP property.
457 Third argument RAW omitted or nil means pass the result through
458 `substitute-command-keys' if it is a string.
459
460 This differs from `get' in that it can refer to strings stored in the
461 `etc/DOC' file; and that it evaluates documentation properties that
462 aren't strings. */)
463 (Lisp_Object symbol, Lisp_Object prop, Lisp_Object raw)
464 {
465 int try_reload = 1;
466 Lisp_Object tem;
467
468 documentation_property:
469
470 tem = Fget (symbol, prop);
471 if (EQ (tem, make_number (0)))
472 tem = Qnil;
473 if (INTEGERP (tem) || (CONSP (tem) && INTEGERP (XCDR (tem))))
474 {
475 Lisp_Object doc = tem;
476 tem = get_doc_string (tem, 0, 0);
477 if (NILP (tem) && try_reload)
478 {
479 /* The file is newer, we need to reset the pointers. */
480 struct gcpro gcpro1, gcpro2, gcpro3;
481 GCPRO3 (symbol, prop, raw);
482 try_reload = reread_doc_file (Fcar_safe (doc));
483 UNGCPRO;
484 if (try_reload)
485 {
486 try_reload = 0;
487 goto documentation_property;
488 }
489 }
490 }
491 else if (!STRINGP (tem))
492 /* Feval protects its argument. */
493 tem = Feval (tem, Qnil);
494
495 if (NILP (raw) && STRINGP (tem))
496 tem = Fsubstitute_command_keys (tem);
497 return tem;
498 }
499 \f
500 /* Scanning the DOC files and placing docstring offsets into functions. */
501
502 static void
503 store_function_docstring (Lisp_Object fun, EMACS_INT offset)
504 /* Use EMACS_INT because we get offset from pointer subtraction. */
505 {
506 fun = indirect_function (fun);
507
508 /* The type determines where the docstring is stored. */
509
510 /* Lisp_Subrs have a slot for it. */
511 if (SUBRP (fun))
512 {
513 intptr_t negative_offset = - offset;
514 XSUBR (fun)->doc = (char *) negative_offset;
515 }
516
517 /* If it's a lisp form, stick it in the form. */
518 else if (CONSP (fun))
519 {
520 Lisp_Object tem;
521
522 tem = XCAR (fun);
523 if (EQ (tem, Qlambda) || EQ (tem, Qautoload)
524 || (EQ (tem, Qclosure) && (fun = XCDR (fun), 1)))
525 {
526 tem = Fcdr (Fcdr (fun));
527 if (CONSP (tem) && INTEGERP (XCAR (tem)))
528 XSETCAR (tem, make_number (offset));
529 }
530 else if (EQ (tem, Qmacro))
531 store_function_docstring (XCDR (fun), offset);
532 }
533
534 /* Bytecode objects sometimes have slots for it. */
535 else if (COMPILEDP (fun))
536 {
537 /* This bytecode object must have a slot for the
538 docstring, since we've found a docstring for it. */
539 if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) > COMPILED_DOC_STRING)
540 ASET (fun, COMPILED_DOC_STRING, make_number (offset));
541 }
542 }
543
544 static const char buildobj[] = BUILDOBJ;
545
546 DEFUN ("Snarf-documentation", Fsnarf_documentation, Ssnarf_documentation,
547 1, 1, 0,
548 doc: /* Used during Emacs initialization to scan the `etc/DOC...' file.
549 This searches the `etc/DOC...' file for doc strings and
550 records them in function and variable definitions.
551 The function takes one argument, FILENAME, a string;
552 it specifies the file name (without a directory) of the DOC file.
553 That file is found in `../etc' now; later, when the dumped Emacs is run,
554 the same file name is found in the `doc-directory'. */)
555 (Lisp_Object filename)
556 {
557 int fd;
558 char buf[1024 + 1];
559 register EMACS_INT filled;
560 register EMACS_INT pos;
561 register char *p;
562 Lisp_Object sym;
563 char *name;
564 int skip_file = 0;
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 name = (char *) alloca (SCHARS (filename) + 14);
576 strcpy (name, "../etc/");
577 }
578 else
579 {
580 CHECK_STRING (Vdoc_directory);
581 name = (char *) alloca (SCHARS (filename)
582 + SCHARS (Vdoc_directory) + 1);
583 strcpy (name, SSDATA (Vdoc_directory));
584 }
585 strcat (name, SSDATA (filename)); /*** Add this line ***/
586
587 /* Vbuild_files is nil when temacs is run, and non-nil after that. */
588 if (NILP (Vbuild_files))
589 {
590 const char *beg, *end;
591
592 for (beg = buildobj; *beg; beg = end)
593 {
594 EMACS_INT len;
595
596 while (*beg && isspace (*beg)) ++beg;
597
598 for (end = beg; *end && ! isspace (*end); ++end)
599 if (*end == '/') beg = end+1; /* skip directory part */
600
601 len = end - beg;
602 if (len > 4 && end[-4] == '.' && end[-3] == 'o')
603 len -= 2; /* Just take .o if it ends in .obj */
604
605 if (len > 0)
606 Vbuild_files = Fcons (make_string (beg, len), Vbuild_files);
607 }
608 Vbuild_files = Fpurecopy (Vbuild_files);
609 }
610
611 fd = emacs_open (name, O_RDONLY, 0);
612 if (fd < 0)
613 report_file_error ("Opening doc string file",
614 Fcons (build_string (name), Qnil));
615 Vdoc_file_name = filename;
616 filled = 0;
617 pos = 0;
618 while (1)
619 {
620 register char *end;
621 if (filled < 512)
622 filled += emacs_read (fd, &buf[filled], sizeof buf - 1 - filled);
623 if (!filled)
624 break;
625
626 buf[filled] = 0;
627 p = buf;
628 end = buf + (filled < 512 ? filled : filled - 128);
629 while (p != end && *p != '\037') p++;
630 /* p points to ^_Ffunctionname\n or ^_Vvarname\n or ^_Sfilename\n. */
631 if (p != end)
632 {
633 end = strchr (p, '\n');
634
635 /* See if this is a file name, and if it is a file in build-files. */
636 if (p[1] == 'S')
637 {
638 skip_file = 0;
639 if (end - p > 4 && end[-2] == '.'
640 && (end[-1] == 'o' || end[-1] == 'c'))
641 {
642 EMACS_INT len = end - p - 2;
643 char *fromfile = alloca (len + 1);
644 strncpy (fromfile, &p[2], len);
645 fromfile[len] = 0;
646 if (fromfile[len-1] == 'c')
647 fromfile[len-1] = 'o';
648
649 skip_file = NILP (Fmember (build_string (fromfile),
650 Vbuild_files));
651 }
652 }
653
654 sym = oblookup (Vobarray, p + 2,
655 multibyte_chars_in_text ((unsigned char *) p + 2,
656 end - p - 2),
657 end - p - 2);
658 /* Check skip_file so that when a function is defined several
659 times in different files (typically, once in xterm, once in
660 w32term, ...), we only pay attention to the one that
661 matters. */
662 if (! skip_file && SYMBOLP (sym))
663 {
664 /* Attach a docstring to a variable? */
665 if (p[1] == 'V')
666 {
667 /* Install file-position as variable-documentation property
668 and make it negative for a user-variable
669 (doc starts with a `*'). */
670 Fput (sym, Qvariable_documentation,
671 make_number ((pos + end + 1 - buf)
672 * (end[1] == '*' ? -1 : 1)));
673 }
674
675 /* Attach a docstring to a function? */
676 else if (p[1] == 'F')
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 emacs_close (fd);
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 Substrings of the form \\=\\[COMMAND] replaced by either: a keystroke
698 sequence that will invoke COMMAND, or "M-x COMMAND" if COMMAND is not
699 on any keys.
700 Substrings of the form \\=\\{MAPVAR} are replaced by summaries
701 \(made by `describe-bindings') of the value of MAPVAR, taken as a keymap.
702 Substrings of the form \\=\\<MAPVAR> specify to use the value of MAPVAR
703 as the keymap for future \\=\\[COMMAND] substrings.
704 \\=\\= quotes the following character and is discarded;
705 thus, \\=\\=\\=\\= puts \\=\\= into the output, and \\=\\=\\=\\[ puts \\=\\[ into the output.
706
707 Returns original STRING if no substitutions were made. Otherwise,
708 a new string, without any text properties, is returned. */)
709 (Lisp_Object string)
710 {
711 char *buf;
712 int changed = 0;
713 register unsigned char *strp;
714 register char *bufp;
715 ptrdiff_t idx;
716 ptrdiff_t bsize;
717 Lisp_Object tem;
718 Lisp_Object keymap;
719 unsigned char *start;
720 ptrdiff_t length, length_byte;
721 Lisp_Object name;
722 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
723 int multibyte;
724 ptrdiff_t nchars;
725
726 if (NILP (string))
727 return Qnil;
728
729 CHECK_STRING (string);
730 tem = Qnil;
731 keymap = Qnil;
732 name = Qnil;
733 GCPRO4 (string, tem, keymap, name);
734
735 multibyte = STRING_MULTIBYTE (string);
736 nchars = 0;
737
738 /* KEYMAP is either nil (which means search all the active keymaps)
739 or a specified local map (which means search just that and the
740 global map). If non-nil, it might come from Voverriding_local_map,
741 or from a \\<mapname> construct in STRING itself.. */
742 keymap = KVAR (current_kboard, Voverriding_terminal_local_map);
743 if (NILP (keymap))
744 keymap = Voverriding_local_map;
745
746 bsize = SBYTES (string);
747 bufp = buf = (char *) 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 int 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 = (char *) 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
845 changed = 1;
846 strp += 2; /* skip \{ or \< */
847 start = strp;
848 start_idx = start - SDATA (string);
849
850 while ((strp - SDATA (string) < SBYTES (string))
851 && *strp != '}' && *strp != '>')
852 strp++;
853
854 length_byte = strp - start;
855 strp++; /* skip } or > */
856
857 /* Save STRP in IDX. */
858 idx = strp - SDATA (string);
859
860 /* Get the value of the keymap in TEM, or nil if undefined.
861 Do this while still in the user's current buffer
862 in case it is a local variable. */
863 name = Fintern (make_string ((char *) start, length_byte), Qnil);
864 tem = Fboundp (name);
865 if (! NILP (tem))
866 {
867 tem = Fsymbol_value (name);
868 if (! NILP (tem))
869 {
870 tem = get_keymap (tem, 0, 1);
871 /* Note that get_keymap can GC. */
872 strp = SDATA (string) + idx;
873 start = SDATA (string) + start_idx;
874 }
875 }
876
877 /* Now switch to a temp buffer. */
878 oldbuf = current_buffer;
879 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer));
880
881 if (NILP (tem))
882 {
883 name = Fsymbol_name (name);
884 insert_string ("\nUses keymap \"");
885 insert_from_string (name, 0, 0,
886 SCHARS (name),
887 SBYTES (name), 1);
888 insert_string ("\", which is not currently defined.\n");
889 if (start[-1] == '<') keymap = Qnil;
890 }
891 else if (start[-1] == '<')
892 keymap = tem;
893 else
894 {
895 /* Get the list of active keymaps that precede this one.
896 If this one's not active, get nil. */
897 earlier_maps = Fcdr (Fmemq (tem, Freverse (active_maps)));
898 describe_map_tree (tem, 1, Fnreverse (earlier_maps),
899 Qnil, (char *)0, 1, 0, 0, 1);
900 }
901 tem = Fbuffer_string ();
902 Ferase_buffer ();
903 set_buffer_internal (oldbuf);
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 = (char *) 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 }