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