Prefer intptr_t/uintptr_t for integers the same widths as pointers.
[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 int 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 EMACS_INT 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 EMACS_INT in_buffer = p - get_doc_string_buffer;
177 get_doc_string_buffer_size += 16 * 1024;
178 get_doc_string_buffer
179 = (char *) xrealloc (get_doc_string_buffer,
180 get_doc_string_buffer_size + 1);
181 p = get_doc_string_buffer + in_buffer;
182 space_left = (get_doc_string_buffer_size
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 {
193 emacs_close (fd);
194 error ("Read error on documentation file");
195 }
196 p[nread] = 0;
197 if (!nread)
198 break;
199 if (p == get_doc_string_buffer)
200 p1 = strchr (p + offset, '\037');
201 else
202 p1 = strchr (p, '\037');
203 if (p1)
204 {
205 *p1 = 0;
206 p = p1;
207 break;
208 }
209 p += nread;
210 }
211 emacs_close (fd);
212
213 /* Sanity checking. */
214 if (CONSP (filepos))
215 {
216 int test = 1;
217 if (get_doc_string_buffer[offset - test++] != ' ')
218 return Qnil;
219 while (get_doc_string_buffer[offset - test] >= '0'
220 && get_doc_string_buffer[offset - test] <= '9')
221 test++;
222 if (get_doc_string_buffer[offset - test++] != '@'
223 || get_doc_string_buffer[offset - test] != '#')
224 return Qnil;
225 }
226 else
227 {
228 int test = 1;
229 if (get_doc_string_buffer[offset - test++] != '\n')
230 return Qnil;
231 while (get_doc_string_buffer[offset - test] > ' ')
232 test++;
233 if (get_doc_string_buffer[offset - test] != '\037')
234 return Qnil;
235 }
236
237 /* Scan the text and perform quoting with ^A (char code 1).
238 ^A^A becomes ^A, ^A0 becomes a null char, and ^A_ becomes a ^_. */
239 from = get_doc_string_buffer + offset;
240 to = get_doc_string_buffer + offset;
241 while (from != p)
242 {
243 if (*from == 1)
244 {
245 int c;
246
247 from++;
248 c = *from++;
249 if (c == 1)
250 *to++ = c;
251 else if (c == '0')
252 *to++ = 0;
253 else if (c == '_')
254 *to++ = 037;
255 else
256 error ("\
257 Invalid data in documentation file -- %c followed by code %03o",
258 1, (unsigned)c);
259 }
260 else
261 *to++ = *from++;
262 }
263
264 /* If DEFINITION, read from this buffer
265 the same way we would read bytes from a file. */
266 if (definition)
267 {
268 read_bytecode_pointer = (unsigned char *) get_doc_string_buffer + offset;
269 return Fread (Qlambda);
270 }
271
272 if (unibyte)
273 return make_unibyte_string (get_doc_string_buffer + offset,
274 to - (get_doc_string_buffer + offset));
275 else
276 {
277 /* The data determines whether the string is multibyte. */
278 EMACS_INT nchars =
279 multibyte_chars_in_text (((unsigned char *) get_doc_string_buffer
280 + offset),
281 to - (get_doc_string_buffer + offset));
282 return make_string_from_bytes (get_doc_string_buffer + offset,
283 nchars,
284 to - (get_doc_string_buffer + offset));
285 }
286 }
287
288 /* Get a string from position FILEPOS and pass it through the Lisp reader.
289 We use this for fetching the bytecode string and constants vector
290 of a compiled function from the .elc file. */
291
292 Lisp_Object
293 read_doc_string (Lisp_Object filepos)
294 {
295 return get_doc_string (filepos, 0, 1);
296 }
297
298 static int
299 reread_doc_file (Lisp_Object file)
300 {
301 #if 0
302 Lisp_Object reply, prompt[3];
303 struct gcpro gcpro1;
304 GCPRO1 (file);
305 prompt[0] = build_string ("File ");
306 prompt[1] = NILP (file) ? Vdoc_file_name : file;
307 prompt[2] = build_string (" is out of sync. Reload? ");
308 reply = Fy_or_n_p (Fconcat (3, prompt));
309 UNGCPRO;
310 if (NILP (reply))
311 return 0;
312 #endif
313
314 if (NILP (file))
315 Fsnarf_documentation (Vdoc_file_name);
316 else
317 Fload (file, Qt, Qt, Qt, Qnil);
318
319 return 1;
320 }
321
322 DEFUN ("documentation", Fdocumentation, Sdocumentation, 1, 2, 0,
323 doc: /* Return the documentation string of FUNCTION.
324 Unless a non-nil second argument RAW is given, the
325 string is passed through `substitute-command-keys'. */)
326 (Lisp_Object function, Lisp_Object raw)
327 {
328 Lisp_Object fun;
329 Lisp_Object funcar;
330 Lisp_Object doc;
331 int try_reload = 1;
332
333 documentation:
334
335 doc = Qnil;
336
337 if (SYMBOLP (function))
338 {
339 Lisp_Object tem = Fget (function, Qfunction_documentation);
340 if (!NILP (tem))
341 return Fdocumentation_property (function, Qfunction_documentation,
342 raw);
343 }
344
345 fun = Findirect_function (function, Qnil);
346 if (SUBRP (fun))
347 {
348 if (XSUBR (fun)->doc == 0)
349 return Qnil;
350 /* FIXME: This is not portable, as it assumes that string
351 pointers have the top bit clear. */
352 else if ((EMACS_INTPTR) XSUBR (fun)->doc >= 0)
353 doc = build_string (XSUBR (fun)->doc);
354 else
355 doc = make_number ((EMACS_INTPTR) XSUBR (fun)->doc);
356 }
357 else if (COMPILEDP (fun))
358 {
359 if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) <= COMPILED_DOC_STRING)
360 return Qnil;
361 else
362 {
363 Lisp_Object tem = AREF (fun, COMPILED_DOC_STRING);
364 if (STRINGP (tem))
365 doc = tem;
366 else if (NATNUMP (tem) || CONSP (tem))
367 doc = tem;
368 else
369 return Qnil;
370 }
371 }
372 else if (STRINGP (fun) || VECTORP (fun))
373 {
374 return build_string ("Keyboard macro.");
375 }
376 else if (CONSP (fun))
377 {
378 funcar = Fcar (fun);
379 if (!SYMBOLP (funcar))
380 xsignal1 (Qinvalid_function, fun);
381 else if (EQ (funcar, Qkeymap))
382 return build_string ("Prefix command (definition is a keymap associating keystrokes with commands).");
383 else if (EQ (funcar, Qlambda)
384 || (EQ (funcar, Qclosure) && (fun = XCDR (fun), 1))
385 || EQ (funcar, Qautoload))
386 {
387 Lisp_Object tem1 = Fcdr (Fcdr (fun));
388 Lisp_Object tem = Fcar (tem1);
389 if (STRINGP (tem))
390 doc = tem;
391 /* Handle a doc reference--but these never come last
392 in the function body, so reject them if they are last. */
393 else if ((NATNUMP (tem) || (CONSP (tem) && INTEGERP (XCDR (tem))))
394 && !NILP (XCDR (tem1)))
395 doc = tem;
396 else
397 return Qnil;
398 }
399 else if (EQ (funcar, Qmacro))
400 return Fdocumentation (Fcdr (fun), raw);
401 else
402 goto oops;
403 }
404 else
405 {
406 oops:
407 xsignal1 (Qinvalid_function, fun);
408 }
409
410 /* Check for an advised function. Its doc string
411 has an `ad-advice-info' text property. */
412 if (STRINGP (doc))
413 {
414 Lisp_Object innerfunc;
415 innerfunc = Fget_text_property (make_number (0),
416 intern ("ad-advice-info"),
417 doc);
418 if (! NILP (innerfunc))
419 doc = call1 (intern ("ad-make-advised-docstring"), innerfunc);
420 }
421
422 /* If DOC is 0, it's typically because of a dumped file missing
423 from the DOC file (bug in src/Makefile.in). */
424 if (EQ (doc, make_number (0)))
425 doc = Qnil;
426 if (INTEGERP (doc) || CONSP (doc))
427 {
428 Lisp_Object tem;
429 tem = get_doc_string (doc, 0, 0);
430 if (NILP (tem) && try_reload)
431 {
432 /* The file is newer, we need to reset the pointers. */
433 struct gcpro gcpro1, gcpro2;
434 GCPRO2 (function, raw);
435 try_reload = reread_doc_file (Fcar_safe (doc));
436 UNGCPRO;
437 if (try_reload)
438 {
439 try_reload = 0;
440 goto documentation;
441 }
442 }
443 else
444 doc = tem;
445 }
446
447 if (NILP (raw))
448 doc = Fsubstitute_command_keys (doc);
449 return doc;
450 }
451
452 DEFUN ("documentation-property", Fdocumentation_property,
453 Sdocumentation_property, 2, 3, 0,
454 doc: /* Return the documentation string that is SYMBOL's PROP property.
455 Third argument RAW omitted or nil means pass the result through
456 `substitute-command-keys' if it is a string.
457
458 This differs from `get' in that it can refer to strings stored in the
459 `etc/DOC' file; and that it evaluates documentation properties that
460 aren't strings. */)
461 (Lisp_Object symbol, Lisp_Object prop, Lisp_Object raw)
462 {
463 int try_reload = 1;
464 Lisp_Object tem;
465
466 documentation_property:
467
468 tem = Fget (symbol, prop);
469 if (EQ (tem, make_number (0)))
470 tem = Qnil;
471 if (INTEGERP (tem) || (CONSP (tem) && INTEGERP (XCDR (tem))))
472 {
473 Lisp_Object doc = tem;
474 tem = get_doc_string (tem, 0, 0);
475 if (NILP (tem) && try_reload)
476 {
477 /* The file is newer, we need to reset the pointers. */
478 struct gcpro gcpro1, gcpro2, gcpro3;
479 GCPRO3 (symbol, prop, raw);
480 try_reload = reread_doc_file (Fcar_safe (doc));
481 UNGCPRO;
482 if (try_reload)
483 {
484 try_reload = 0;
485 goto documentation_property;
486 }
487 }
488 }
489 else if (!STRINGP (tem))
490 /* Feval protects its argument. */
491 tem = Feval (tem, Qnil);
492
493 if (NILP (raw) && STRINGP (tem))
494 tem = Fsubstitute_command_keys (tem);
495 return tem;
496 }
497 \f
498 /* Scanning the DOC files and placing docstring offsets into functions. */
499
500 static void
501 store_function_docstring (Lisp_Object fun, EMACS_INT offset)
502 /* Use EMACS_INT because we get offset from pointer subtraction. */
503 {
504 fun = indirect_function (fun);
505
506 /* The type determines where the docstring is stored. */
507
508 /* Lisp_Subrs have a slot for it. */
509 if (SUBRP (fun))
510 {
511 EMACS_INTPTR negative_offset = - offset;
512 XSUBR (fun)->doc = (char *) negative_offset;
513 }
514
515 /* If it's a lisp form, stick it in the form. */
516 else if (CONSP (fun))
517 {
518 Lisp_Object tem;
519
520 tem = XCAR (fun);
521 if (EQ (tem, Qlambda) || EQ (tem, Qautoload)
522 || (EQ (tem, Qclosure) && (fun = XCDR (fun), 1)))
523 {
524 tem = Fcdr (Fcdr (fun));
525 if (CONSP (tem) && INTEGERP (XCAR (tem)))
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 static const char buildobj[] = BUILDOBJ;
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 register EMACS_INT filled;
558 register EMACS_INT pos;
559 register char *p;
560 Lisp_Object sym;
561 char *name;
562 int skip_file = 0;
563
564 CHECK_STRING (filename);
565
566 if
567 #ifndef CANNOT_DUMP
568 (!NILP (Vpurify_flag))
569 #else /* CANNOT_DUMP */
570 (0)
571 #endif /* CANNOT_DUMP */
572 {
573 name = (char *) alloca (SCHARS (filename) + 14);
574 strcpy (name, "../etc/");
575 }
576 else
577 {
578 CHECK_STRING (Vdoc_directory);
579 name = (char *) alloca (SCHARS (filename)
580 + SCHARS (Vdoc_directory) + 1);
581 strcpy (name, SSDATA (Vdoc_directory));
582 }
583 strcat (name, SSDATA (filename)); /*** Add this line ***/
584
585 /* Vbuild_files is nil when temacs is run, and non-nil after that. */
586 if (NILP (Vbuild_files))
587 {
588 const char *beg, *end;
589
590 for (beg = buildobj; *beg; beg = end)
591 {
592 EMACS_INT len;
593
594 while (*beg && isspace (*beg)) ++beg;
595
596 for (end = beg; *end && ! isspace (*end); ++end)
597 if (*end == '/') beg = end+1; /* skip directory part */
598
599 len = end - beg;
600 if (len > 4 && end[-4] == '.' && end[-3] == 'o')
601 len -= 2; /* Just take .o if it ends in .obj */
602
603 if (len > 0)
604 Vbuild_files = Fcons (make_string (beg, len), Vbuild_files);
605 }
606 Vbuild_files = Fpurecopy (Vbuild_files);
607 }
608
609 fd = emacs_open (name, O_RDONLY, 0);
610 if (fd < 0)
611 report_file_error ("Opening doc string file",
612 Fcons (build_string (name), Qnil));
613 Vdoc_file_name = filename;
614 filled = 0;
615 pos = 0;
616 while (1)
617 {
618 register char *end;
619 if (filled < 512)
620 filled += emacs_read (fd, &buf[filled], sizeof buf - 1 - filled);
621 if (!filled)
622 break;
623
624 buf[filled] = 0;
625 p = buf;
626 end = buf + (filled < 512 ? filled : filled - 128);
627 while (p != end && *p != '\037') p++;
628 /* p points to ^_Ffunctionname\n or ^_Vvarname\n or ^_Sfilename\n. */
629 if (p != end)
630 {
631 end = strchr (p, '\n');
632
633 /* See if this is a file name, and if it is a file in build-files. */
634 if (p[1] == 'S')
635 {
636 skip_file = 0;
637 if (end - p > 4 && end[-2] == '.'
638 && (end[-1] == 'o' || end[-1] == 'c'))
639 {
640 EMACS_INT len = end - p - 2;
641 char *fromfile = alloca (len + 1);
642 strncpy (fromfile, &p[2], len);
643 fromfile[len] = 0;
644 if (fromfile[len-1] == 'c')
645 fromfile[len-1] = 'o';
646
647 skip_file = NILP (Fmember (build_string (fromfile),
648 Vbuild_files));
649 }
650 }
651
652 sym = oblookup (Vobarray, p + 2,
653 multibyte_chars_in_text ((unsigned char *) p + 2,
654 end - p - 2),
655 end - p - 2);
656 /* Check skip_file so that when a function is defined several
657 times in different files (typically, once in xterm, once in
658 w32term, ...), we only pay attention to the one that
659 matters. */
660 if (! skip_file && SYMBOLP (sym))
661 {
662 /* Attach a docstring to a variable? */
663 if (p[1] == 'V')
664 {
665 /* Install file-position as variable-documentation property
666 and make it negative for a user-variable
667 (doc starts with a `*'). */
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 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 emacs_close (fd);
689 return Qnil;
690 }
691 \f
692 DEFUN ("substitute-command-keys", Fsubstitute_command_keys,
693 Ssubstitute_command_keys, 1, 1, 0,
694 doc: /* Substitute key descriptions for command names in STRING.
695 Substrings of the form \\=\\[COMMAND] replaced by either: a keystroke
696 sequence that will invoke COMMAND, or "M-x COMMAND" if COMMAND is not
697 on any keys.
698 Substrings of the form \\=\\{MAPVAR} are replaced by summaries
699 \(made by `describe-bindings') of the value of MAPVAR, taken as a keymap.
700 Substrings of the form \\=\\<MAPVAR> specify to use the value of MAPVAR
701 as the keymap for future \\=\\[COMMAND] substrings.
702 \\=\\= quotes the following character and is discarded;
703 thus, \\=\\=\\=\\= puts \\=\\= into the output, and \\=\\=\\=\\[ puts \\=\\[ into the output.
704
705 Returns original STRING if no substitutions were made. Otherwise,
706 a new string, without any text properties, is returned. */)
707 (Lisp_Object string)
708 {
709 char *buf;
710 int changed = 0;
711 register unsigned char *strp;
712 register char *bufp;
713 EMACS_INT idx;
714 EMACS_INT bsize;
715 Lisp_Object tem;
716 Lisp_Object keymap;
717 unsigned char *start;
718 EMACS_INT length, length_byte;
719 Lisp_Object name;
720 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
721 int multibyte;
722 EMACS_INT nchars;
723
724 if (NILP (string))
725 return Qnil;
726
727 CHECK_STRING (string);
728 tem = Qnil;
729 keymap = Qnil;
730 name = Qnil;
731 GCPRO4 (string, tem, keymap, name);
732
733 multibyte = STRING_MULTIBYTE (string);
734 nchars = 0;
735
736 /* KEYMAP is either nil (which means search all the active keymaps)
737 or a specified local map (which means search just that and the
738 global map). If non-nil, it might come from Voverriding_local_map,
739 or from a \\<mapname> construct in STRING itself.. */
740 keymap = KVAR (current_kboard, Voverriding_terminal_local_map);
741 if (NILP (keymap))
742 keymap = Voverriding_local_map;
743
744 bsize = SBYTES (string);
745 bufp = buf = (char *) xmalloc (bsize);
746
747 strp = SDATA (string);
748 while (strp < SDATA (string) + SBYTES (string))
749 {
750 if (strp[0] == '\\' && strp[1] == '=')
751 {
752 /* \= quotes the next character;
753 thus, to put in \[ without its special meaning, use \=\[. */
754 changed = 1;
755 strp += 2;
756 if (multibyte)
757 {
758 int len;
759
760 STRING_CHAR_AND_LENGTH (strp, len);
761 if (len == 1)
762 *bufp = *strp;
763 else
764 memcpy (bufp, strp, len);
765 strp += len;
766 bufp += len;
767 nchars++;
768 }
769 else
770 *bufp++ = *strp++, nchars++;
771 }
772 else if (strp[0] == '\\' && strp[1] == '[')
773 {
774 EMACS_INT start_idx;
775 int follow_remap = 1;
776
777 changed = 1;
778 strp += 2; /* skip \[ */
779 start = strp;
780 start_idx = start - SDATA (string);
781
782 while ((strp - SDATA (string)
783 < SBYTES (string))
784 && *strp != ']')
785 strp++;
786 length_byte = strp - start;
787
788 strp++; /* skip ] */
789
790 /* Save STRP in IDX. */
791 idx = strp - SDATA (string);
792 name = Fintern (make_string ((char *) start, length_byte), Qnil);
793
794 do_remap:
795 tem = Fwhere_is_internal (name, keymap, Qt, Qnil, Qnil);
796
797 if (VECTORP (tem) && ASIZE (tem) > 1
798 && EQ (AREF (tem, 0), Qremap) && SYMBOLP (AREF (tem, 1))
799 && follow_remap)
800 {
801 name = AREF (tem, 1);
802 follow_remap = 0;
803 goto do_remap;
804 }
805
806 /* Note the Fwhere_is_internal can GC, so we have to take
807 relocation of string contents into account. */
808 strp = SDATA (string) + idx;
809 start = SDATA (string) + start_idx;
810
811 if (NILP (tem)) /* but not on any keys */
812 {
813 EMACS_INT offset = bufp - buf;
814 buf = (char *) xrealloc (buf, bsize += 4);
815 bufp = buf + offset;
816 memcpy (bufp, "M-x ", 4);
817 bufp += 4;
818 nchars += 4;
819 if (multibyte)
820 length = multibyte_chars_in_text (start, length_byte);
821 else
822 length = length_byte;
823 goto subst;
824 }
825 else
826 { /* function is on a key */
827 tem = Fkey_description (tem, Qnil);
828 goto subst_string;
829 }
830 }
831 /* \{foo} is replaced with a summary of the keymap (symbol-value foo).
832 \<foo> just sets the keymap used for \[cmd]. */
833 else if (strp[0] == '\\' && (strp[1] == '{' || strp[1] == '<'))
834 {
835 struct buffer *oldbuf;
836 EMACS_INT start_idx;
837 /* This is for computing the SHADOWS arg for describe_map_tree. */
838 Lisp_Object active_maps = Fcurrent_active_maps (Qnil, Qnil);
839 Lisp_Object earlier_maps;
840
841 changed = 1;
842 strp += 2; /* skip \{ or \< */
843 start = strp;
844 start_idx = start - SDATA (string);
845
846 while ((strp - SDATA (string) < SBYTES (string))
847 && *strp != '}' && *strp != '>')
848 strp++;
849
850 length_byte = strp - start;
851 strp++; /* skip } or > */
852
853 /* Save STRP in IDX. */
854 idx = strp - SDATA (string);
855
856 /* Get the value of the keymap in TEM, or nil if undefined.
857 Do this while still in the user's current buffer
858 in case it is a local variable. */
859 name = Fintern (make_string ((char *) start, length_byte), Qnil);
860 tem = Fboundp (name);
861 if (! NILP (tem))
862 {
863 tem = Fsymbol_value (name);
864 if (! NILP (tem))
865 {
866 tem = get_keymap (tem, 0, 1);
867 /* Note that get_keymap can GC. */
868 strp = SDATA (string) + idx;
869 start = SDATA (string) + start_idx;
870 }
871 }
872
873 /* Now switch to a temp buffer. */
874 oldbuf = current_buffer;
875 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer));
876
877 if (NILP (tem))
878 {
879 name = Fsymbol_name (name);
880 insert_string ("\nUses keymap \"");
881 insert_from_string (name, 0, 0,
882 SCHARS (name),
883 SBYTES (name), 1);
884 insert_string ("\", which is not currently defined.\n");
885 if (start[-1] == '<') keymap = Qnil;
886 }
887 else if (start[-1] == '<')
888 keymap = tem;
889 else
890 {
891 /* Get the list of active keymaps that precede this one.
892 If this one's not active, get nil. */
893 earlier_maps = Fcdr (Fmemq (tem, Freverse (active_maps)));
894 describe_map_tree (tem, 1, Fnreverse (earlier_maps),
895 Qnil, (char *)0, 1, 0, 0, 1);
896 }
897 tem = Fbuffer_string ();
898 Ferase_buffer ();
899 set_buffer_internal (oldbuf);
900
901 subst_string:
902 start = SDATA (tem);
903 length = SCHARS (tem);
904 length_byte = SBYTES (tem);
905 subst:
906 {
907 EMACS_INT offset = bufp - buf;
908 buf = (char *) xrealloc (buf, bsize += length_byte);
909 bufp = buf + offset;
910 memcpy (bufp, start, length_byte);
911 bufp += length_byte;
912 nchars += length;
913 /* Check STRING again in case gc relocated it. */
914 strp = SDATA (string) + idx;
915 }
916 }
917 else if (! multibyte) /* just copy other chars */
918 *bufp++ = *strp++, nchars++;
919 else
920 {
921 int len;
922
923 STRING_CHAR_AND_LENGTH (strp, len);
924 if (len == 1)
925 *bufp = *strp;
926 else
927 memcpy (bufp, strp, len);
928 strp += len;
929 bufp += len;
930 nchars++;
931 }
932 }
933
934 if (changed) /* don't bother if nothing substituted */
935 tem = make_string_from_bytes (buf, nchars, bufp - buf);
936 else
937 tem = string;
938 xfree (buf);
939 RETURN_UNGCPRO (tem);
940 }
941 \f
942 void
943 syms_of_doc (void)
944 {
945 Qfunction_documentation = intern_c_string ("function-documentation");
946 staticpro (&Qfunction_documentation);
947
948 DEFVAR_LISP ("internal-doc-file-name", Vdoc_file_name,
949 doc: /* Name of file containing documentation strings of built-in symbols. */);
950 Vdoc_file_name = Qnil;
951
952 DEFVAR_LISP ("build-files", Vbuild_files,
953 doc: /* A list of files used to build this Emacs binary. */);
954 Vbuild_files = Qnil;
955
956 defsubr (&Sdocumentation);
957 defsubr (&Sdocumentation_property);
958 defsubr (&Ssnarf_documentation);
959 defsubr (&Ssubstitute_command_keys);
960 }