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