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