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