New branch for lexbind, losing all history.
[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
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
49 extern char *index P_ ((const char *, int));
50 #endif
51
52 Lisp_Object Vdoc_file_name;
53
54 Lisp_Object Qfunction_documentation;
55
56 /* A list of files used to build this Emacs binary. */
57 static Lisp_Object Vbuild_files;
58
59 extern Lisp_Object Voverriding_local_map, Qclosure;
60
61 extern Lisp_Object Qremap;
62
63 /* Buffer used for reading from documentation file. */
64 static char *get_doc_string_buffer;
65 static int get_doc_string_buffer_size;
66
67 static unsigned char *read_bytecode_pointer;
68 Lisp_Object Fsnarf_documentation P_ ((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
73 int
74 read_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
104 Lisp_Object
105 get_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
313 Lisp_Object
314 read_doc_string (filepos)
315 Lisp_Object filepos;
316 {
317 return get_doc_string (filepos, 0, 1);
318 }
319
320 static int
321 reread_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
345 DEFUN ("documentation", Fdocumentation, Sdocumentation, 1, 2, 0,
346 doc: /* Return the documentation string of FUNCTION.
347 Unless a non-nil second argument RAW is given, the
348 string 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 (FUNVECP (fun))
389 {
390 /* Unless otherwise handled, funvecs have no documentation. */
391 return Qnil;
392 }
393 else if (STRINGP (fun) || VECTORP (fun))
394 {
395 return build_string ("Keyboard macro.");
396 }
397 else if (CONSP (fun))
398 {
399 funcar = Fcar (fun);
400 if (!SYMBOLP (funcar))
401 xsignal1 (Qinvalid_function, fun);
402 else if (EQ (funcar, Qkeymap))
403 return build_string ("Prefix command (definition is a keymap associating keystrokes with commands).");
404 else if (EQ (funcar, Qlambda)
405 || EQ (funcar, Qautoload))
406 {
407 Lisp_Object tem1;
408 tem1 = Fcdr (Fcdr (fun));
409 tem = Fcar (tem1);
410 if (STRINGP (tem))
411 doc = tem;
412 /* Handle a doc reference--but these never come last
413 in the function body, so reject them if they are last. */
414 else if ((NATNUMP (tem) || (CONSP (tem) && INTEGERP (XCDR (tem))))
415 && !NILP (XCDR (tem1)))
416 doc = tem;
417 else
418 return Qnil;
419 }
420 else if (EQ (funcar, Qclosure))
421 return Fdocumentation (Fcdr (XCDR (fun)), raw);
422 else if (EQ (funcar, Qmacro))
423 return Fdocumentation (Fcdr (fun), raw);
424 else
425 goto oops;
426 }
427 else
428 {
429 oops:
430 xsignal1 (Qinvalid_function, fun);
431 }
432
433 /* Check for an advised function. Its doc string
434 has an `ad-advice-info' text property. */
435 if (STRINGP (doc))
436 {
437 Lisp_Object innerfunc;
438 innerfunc = Fget_text_property (make_number (0),
439 intern ("ad-advice-info"),
440 doc);
441 if (! NILP (innerfunc))
442 doc = call1 (intern ("ad-make-advised-docstring"), innerfunc);
443 }
444
445 /* If DOC is 0, it's typically because of a dumped file missing
446 from the DOC file (bug in src/Makefile.in). */
447 if (EQ (doc, make_number (0)))
448 doc = Qnil;
449 if (INTEGERP (doc) || CONSP (doc))
450 {
451 Lisp_Object tem;
452 tem = get_doc_string (doc, 0, 0);
453 if (NILP (tem) && try_reload)
454 {
455 /* The file is newer, we need to reset the pointers. */
456 struct gcpro gcpro1, gcpro2;
457 GCPRO2 (function, raw);
458 try_reload = reread_doc_file (Fcar_safe (doc));
459 UNGCPRO;
460 if (try_reload)
461 {
462 try_reload = 0;
463 goto documentation;
464 }
465 }
466 else
467 doc = tem;
468 }
469
470 if (NILP (raw))
471 doc = Fsubstitute_command_keys (doc);
472 return doc;
473 }
474
475 DEFUN ("documentation-property", Fdocumentation_property,
476 Sdocumentation_property, 2, 3, 0,
477 doc: /* Return the documentation string that is SYMBOL's PROP property.
478 Third argument RAW omitted or nil means pass the result through
479 `substitute-command-keys' if it is a string.
480
481 This differs from `get' in that it can refer to strings stored in the
482 `etc/DOC' file; and that it evaluates documentation properties that
483 aren't strings. */)
484 (symbol, prop, raw)
485 Lisp_Object symbol, prop, raw;
486 {
487 int try_reload = 1;
488 Lisp_Object tem;
489
490 documentation_property:
491
492 tem = Fget (symbol, prop);
493 if (EQ (tem, make_number (0)))
494 tem = Qnil;
495 if (INTEGERP (tem) || (CONSP (tem) && INTEGERP (XCDR (tem))))
496 {
497 Lisp_Object doc = tem;
498 tem = get_doc_string (tem, 0, 0);
499 if (NILP (tem) && try_reload)
500 {
501 /* The file is newer, we need to reset the pointers. */
502 struct gcpro gcpro1, gcpro2, gcpro3;
503 GCPRO3 (symbol, prop, raw);
504 try_reload = reread_doc_file (Fcar_safe (doc));
505 UNGCPRO;
506 if (try_reload)
507 {
508 try_reload = 0;
509 goto documentation_property;
510 }
511 }
512 }
513 else if (!STRINGP (tem))
514 /* Feval protects its argument. */
515 tem = Feval (tem);
516
517 if (NILP (raw) && STRINGP (tem))
518 tem = Fsubstitute_command_keys (tem);
519 return tem;
520 }
521 \f
522 /* Scanning the DOC files and placing docstring offsets into functions. */
523
524 static void
525 store_function_docstring (fun, offset)
526 Lisp_Object fun;
527 /* Use EMACS_INT because we get this from pointer subtraction. */
528 EMACS_INT offset;
529 {
530 fun = indirect_function (fun);
531
532 /* The type determines where the docstring is stored. */
533
534 /* Lisp_Subrs have a slot for it. */
535 if (SUBRP (fun))
536 XSUBR (fun)->doc = (char *) - offset;
537
538 /* If it's a lisp form, stick it in the form. */
539 else if (CONSP (fun))
540 {
541 Lisp_Object tem;
542
543 tem = XCAR (fun);
544 if (EQ (tem, Qlambda) || EQ (tem, Qautoload))
545 {
546 tem = Fcdr (Fcdr (fun));
547 if (CONSP (tem) && INTEGERP (XCAR (tem)))
548 XSETCAR (tem, make_number (offset));
549 }
550 else if (EQ (tem, Qmacro))
551 store_function_docstring (XCDR (fun), offset);
552 else if (EQ (tem, Qclosure))
553 store_function_docstring (Fcdr (XCDR (fun)), offset);
554 }
555
556 /* Bytecode objects sometimes have slots for it. */
557 else if (COMPILEDP (fun))
558 {
559 /* This bytecode object must have a slot for the
560 docstring, since we've found a docstring for it. */
561 if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) > COMPILED_DOC_STRING)
562 ASET (fun, COMPILED_DOC_STRING, make_number (offset));
563 }
564 }
565
566 static const char buildobj[] = BUILDOBJ;
567
568 DEFUN ("Snarf-documentation", Fsnarf_documentation, Ssnarf_documentation,
569 1, 1, 0,
570 doc: /* Used during Emacs initialization to scan the `etc/DOC...' file.
571 This searches the `etc/DOC...' file for doc strings and
572 records them in function and variable definitions.
573 The function takes one argument, FILENAME, a string;
574 it specifies the file name (without a directory) of the DOC file.
575 That file is found in `../etc' now; later, when the dumped Emacs is run,
576 the same file name is found in the `doc-directory'. */)
577 (filename)
578 Lisp_Object filename;
579 {
580 int fd;
581 char buf[1024 + 1];
582 register int filled;
583 register int pos;
584 register char *p, *end;
585 Lisp_Object sym;
586 char *name;
587 int skip_file = 0;
588
589 CHECK_STRING (filename);
590
591 if
592 #ifndef CANNOT_DUMP
593 (!NILP (Vpurify_flag))
594 #else /* CANNOT_DUMP */
595 (0)
596 #endif /* CANNOT_DUMP */
597 {
598 name = (char *) alloca (SCHARS (filename) + 14);
599 strcpy (name, "../etc/");
600 }
601 else
602 {
603 CHECK_STRING (Vdoc_directory);
604 name = (char *) alloca (SCHARS (filename)
605 + SCHARS (Vdoc_directory) + 1);
606 strcpy (name, SDATA (Vdoc_directory));
607 }
608 strcat (name, SDATA (filename)); /*** Add this line ***/
609
610 /* Vbuild_files is nil when temacs is run, and non-nil after that. */
611 if (NILP (Vbuild_files))
612 {
613 const char *beg, *end;
614
615 for (beg = buildobj; *beg; beg = end)
616 {
617 int len;
618
619 while (*beg && isspace (*beg)) ++beg;
620
621 for (end = beg; *end && ! isspace (*end); ++end)
622 if (*end == '/') beg = end+1; /* skip directory part */
623
624 len = end - beg;
625 if (len > 4 && end[-4] == '.' && end[-3] == 'o')
626 len -= 2; /* Just take .o if it ends in .obj */
627
628 if (len > 0)
629 Vbuild_files = Fcons (make_string (beg, len), Vbuild_files);
630 }
631 Vbuild_files = Fpurecopy (Vbuild_files);
632 }
633
634 fd = emacs_open (name, O_RDONLY, 0);
635 if (fd < 0)
636 report_file_error ("Opening doc string file",
637 Fcons (build_string (name), Qnil));
638 Vdoc_file_name = filename;
639 filled = 0;
640 pos = 0;
641 while (1)
642 {
643 if (filled < 512)
644 filled += emacs_read (fd, &buf[filled], sizeof buf - 1 - filled);
645 if (!filled)
646 break;
647
648 buf[filled] = 0;
649 p = buf;
650 end = buf + (filled < 512 ? filled : filled - 128);
651 while (p != end && *p != '\037') p++;
652 /* p points to ^_Ffunctionname\n or ^_Vvarname\n. */
653 if (p != end)
654 {
655 end = (char *) index (p, '\n');
656
657 /* See if this is a file name, and if it is a file in build-files. */
658 if (p[1] == 'S' && end - p > 4 && end[-2] == '.'
659 && (end[-1] == 'o' || end[-1] == 'c'))
660 {
661 int len = end - p - 2;
662 char *fromfile = alloca (len + 1);
663 strncpy (fromfile, &p[2], len);
664 fromfile[len] = 0;
665 if (fromfile[len-1] == 'c')
666 fromfile[len-1] = 'o';
667
668 skip_file = NILP (Fmember (build_string (fromfile),
669 Vbuild_files));
670 }
671
672 sym = oblookup (Vobarray, p + 2,
673 multibyte_chars_in_text (p + 2, end - p - 2),
674 end - p - 2);
675 /* Check skip_file so that when a function is defined several
676 times in different files (typically, once in xterm, once in
677 w32term, ...), we only pay attention to the one that
678 matters. */
679 if (! skip_file && SYMBOLP (sym))
680 {
681 /* Attach a docstring to a variable? */
682 if (p[1] == 'V')
683 {
684 /* Install file-position as variable-documentation property
685 and make it negative for a user-variable
686 (doc starts with a `*'). */
687 Fput (sym, Qvariable_documentation,
688 make_number ((pos + end + 1 - buf)
689 * (end[1] == '*' ? -1 : 1)));
690 }
691
692 /* Attach a docstring to a function? */
693 else if (p[1] == 'F')
694 store_function_docstring (sym, pos + end + 1 - buf);
695
696 else if (p[1] == 'S')
697 ; /* Just a source file name boundary marker. Ignore it. */
698
699 else
700 error ("DOC file invalid at position %d", pos);
701 }
702 }
703 pos += end - buf;
704 filled -= end - buf;
705 bcopy (end, buf, filled);
706 }
707 emacs_close (fd);
708 return Qnil;
709 }
710 \f
711 DEFUN ("substitute-command-keys", Fsubstitute_command_keys,
712 Ssubstitute_command_keys, 1, 1, 0,
713 doc: /* Substitute key descriptions for command names in STRING.
714 Substrings of the form \\=\\[COMMAND] replaced by either: a keystroke
715 sequence that will invoke COMMAND, or "M-x COMMAND" if COMMAND is not
716 on any keys.
717 Substrings of the form \\=\\{MAPVAR} are replaced by summaries
718 \(made by `describe-bindings') of the value of MAPVAR, taken as a keymap.
719 Substrings of the form \\=\\<MAPVAR> specify to use the value of MAPVAR
720 as the keymap for future \\=\\[COMMAND] substrings.
721 \\=\\= quotes the following character and is discarded;
722 thus, \\=\\=\\=\\= puts \\=\\= into the output, and \\=\\=\\=\\[ puts \\=\\[ into the output.
723
724 Returns original STRING if no substitutions were made. Otherwise,
725 a new string, without any text properties, is returned. */)
726 (string)
727 Lisp_Object string;
728 {
729 unsigned char *buf;
730 int changed = 0;
731 register unsigned char *strp;
732 register unsigned char *bufp;
733 int idx;
734 int bsize;
735 Lisp_Object tem;
736 Lisp_Object keymap;
737 unsigned char *start;
738 int length, length_byte;
739 Lisp_Object name;
740 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
741 int multibyte;
742 int nchars;
743
744 if (NILP (string))
745 return Qnil;
746
747 CHECK_STRING (string);
748 tem = Qnil;
749 keymap = Qnil;
750 name = Qnil;
751 GCPRO4 (string, tem, keymap, name);
752
753 multibyte = STRING_MULTIBYTE (string);
754 nchars = 0;
755
756 /* KEYMAP is either nil (which means search all the active keymaps)
757 or a specified local map (which means search just that and the
758 global map). If non-nil, it might come from Voverriding_local_map,
759 or from a \\<mapname> construct in STRING itself.. */
760 keymap = current_kboard->Voverriding_terminal_local_map;
761 if (NILP (keymap))
762 keymap = Voverriding_local_map;
763
764 bsize = SBYTES (string);
765 bufp = buf = (unsigned char *) xmalloc (bsize);
766
767 strp = SDATA (string);
768 while (strp < SDATA (string) + SBYTES (string))
769 {
770 if (strp[0] == '\\' && strp[1] == '=')
771 {
772 /* \= quotes the next character;
773 thus, to put in \[ without its special meaning, use \=\[. */
774 changed = 1;
775 strp += 2;
776 if (multibyte)
777 {
778 int len;
779
780 STRING_CHAR_AND_LENGTH (strp, len);
781 if (len == 1)
782 *bufp = *strp;
783 else
784 bcopy (strp, bufp, len);
785 strp += len;
786 bufp += len;
787 nchars++;
788 }
789 else
790 *bufp++ = *strp++, nchars++;
791 }
792 else if (strp[0] == '\\' && strp[1] == '[')
793 {
794 int start_idx;
795 int follow_remap = 1;
796
797 changed = 1;
798 strp += 2; /* skip \[ */
799 start = strp;
800 start_idx = start - SDATA (string);
801
802 while ((strp - SDATA (string)
803 < SBYTES (string))
804 && *strp != ']')
805 strp++;
806 length_byte = strp - start;
807
808 strp++; /* skip ] */
809
810 /* Save STRP in IDX. */
811 idx = strp - SDATA (string);
812 name = Fintern (make_string (start, length_byte), Qnil);
813
814 do_remap:
815 tem = Fwhere_is_internal (name, keymap, Qt, Qnil, Qnil);
816
817 if (VECTORP (tem) && XVECTOR (tem)->size > 1
818 && EQ (AREF (tem, 0), Qremap) && SYMBOLP (AREF (tem, 1))
819 && follow_remap)
820 {
821 name = AREF (tem, 1);
822 follow_remap = 0;
823 goto do_remap;
824 }
825
826 /* Note the Fwhere_is_internal can GC, so we have to take
827 relocation of string contents into account. */
828 strp = SDATA (string) + idx;
829 start = SDATA (string) + start_idx;
830
831 if (NILP (tem)) /* but not on any keys */
832 {
833 int offset = bufp - buf;
834 buf = (unsigned char *) xrealloc (buf, bsize += 4);
835 bufp = buf + offset;
836 bcopy ("M-x ", bufp, 4);
837 bufp += 4;
838 nchars += 4;
839 if (multibyte)
840 length = multibyte_chars_in_text (start, length_byte);
841 else
842 length = length_byte;
843 goto subst;
844 }
845 else
846 { /* function is on a key */
847 tem = Fkey_description (tem, Qnil);
848 goto subst_string;
849 }
850 }
851 /* \{foo} is replaced with a summary of the keymap (symbol-value foo).
852 \<foo> just sets the keymap used for \[cmd]. */
853 else if (strp[0] == '\\' && (strp[1] == '{' || strp[1] == '<'))
854 {
855 struct buffer *oldbuf;
856 int start_idx;
857 /* This is for computing the SHADOWS arg for describe_map_tree. */
858 Lisp_Object active_maps = Fcurrent_active_maps (Qnil, Qnil);
859 Lisp_Object earlier_maps;
860
861 changed = 1;
862 strp += 2; /* skip \{ or \< */
863 start = strp;
864 start_idx = start - SDATA (string);
865
866 while ((strp - SDATA (string) < SBYTES (string))
867 && *strp != '}' && *strp != '>')
868 strp++;
869
870 length_byte = strp - start;
871 strp++; /* skip } or > */
872
873 /* Save STRP in IDX. */
874 idx = strp - SDATA (string);
875
876 /* Get the value of the keymap in TEM, or nil if undefined.
877 Do this while still in the user's current buffer
878 in case it is a local variable. */
879 name = Fintern (make_string (start, length_byte), Qnil);
880 tem = Fboundp (name);
881 if (! NILP (tem))
882 {
883 tem = Fsymbol_value (name);
884 if (! NILP (tem))
885 {
886 tem = get_keymap (tem, 0, 1);
887 /* Note that get_keymap can GC. */
888 strp = SDATA (string) + idx;
889 start = SDATA (string) + start_idx;
890 }
891 }
892
893 /* Now switch to a temp buffer. */
894 oldbuf = current_buffer;
895 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer));
896
897 if (NILP (tem))
898 {
899 name = Fsymbol_name (name);
900 insert_string ("\nUses keymap \"");
901 insert_from_string (name, 0, 0,
902 SCHARS (name),
903 SBYTES (name), 1);
904 insert_string ("\", which is not currently defined.\n");
905 if (start[-1] == '<') keymap = Qnil;
906 }
907 else if (start[-1] == '<')
908 keymap = tem;
909 else
910 {
911 /* Get the list of active keymaps that precede this one.
912 If this one's not active, get nil. */
913 earlier_maps = Fcdr (Fmemq (tem, Freverse (active_maps)));
914 describe_map_tree (tem, 1, Fnreverse (earlier_maps),
915 Qnil, (char *)0, 1, 0, 0, 1);
916 }
917 tem = Fbuffer_string ();
918 Ferase_buffer ();
919 set_buffer_internal (oldbuf);
920
921 subst_string:
922 start = SDATA (tem);
923 length = SCHARS (tem);
924 length_byte = SBYTES (tem);
925 subst:
926 {
927 int offset = bufp - buf;
928 buf = (unsigned char *) xrealloc (buf, bsize += length_byte);
929 bufp = buf + offset;
930 bcopy (start, bufp, length_byte);
931 bufp += length_byte;
932 nchars += length;
933 /* Check STRING again in case gc relocated it. */
934 strp = (unsigned char *) SDATA (string) + idx;
935 }
936 }
937 else if (! multibyte) /* just copy other chars */
938 *bufp++ = *strp++, nchars++;
939 else
940 {
941 int len;
942
943 STRING_CHAR_AND_LENGTH (strp, len);
944 if (len == 1)
945 *bufp = *strp;
946 else
947 bcopy (strp, bufp, len);
948 strp += len;
949 bufp += len;
950 nchars++;
951 }
952 }
953
954 if (changed) /* don't bother if nothing substituted */
955 tem = make_string_from_bytes (buf, nchars, bufp - buf);
956 else
957 tem = string;
958 xfree (buf);
959 RETURN_UNGCPRO (tem);
960 }
961 \f
962 void
963 syms_of_doc ()
964 {
965 Qfunction_documentation = intern_c_string ("function-documentation");
966 staticpro (&Qfunction_documentation);
967
968 DEFVAR_LISP ("internal-doc-file-name", &Vdoc_file_name,
969 doc: /* Name of file containing documentation strings of built-in symbols. */);
970 Vdoc_file_name = Qnil;
971
972 DEFVAR_LISP ("build-files", &Vbuild_files,
973 doc: /* A list of files used to build this Emacs binary. */);
974 Vbuild_files = Qnil;
975
976 defsubr (&Sdocumentation);
977 defsubr (&Sdocumentation_property);
978 defsubr (&Ssnarf_documentation);
979 defsubr (&Ssubstitute_command_keys);
980 }
981
982 /* arch-tag: 56281d4d-6949-43e2-be2e-f6517de744ba
983 (do not change this comment) */