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