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