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