Code cleanup: make arguments constant whenever possible.
[emacs.git] / src / doc.c
blobd3e58f4b6cb2e3478f45d476b382bdbb14e5ff46
1 /* Record indices of function doc strings stored in a file.
2 Copyright (C) 1985, 86,93,94,95,97,98,99,2000,04
3 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
10 any later version.
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
23 #include <config.h>
25 #include <sys/types.h>
26 #include <sys/file.h> /* Must be after sys/types.h for USG and BSD4_1*/
27 #include <ctype.h>
29 #ifdef HAVE_FCNTL_H
30 #include <fcntl.h>
31 #endif
33 #ifdef HAVE_UNISTD_H
34 #include <unistd.h>
35 #endif
37 #ifndef O_RDONLY
38 #define O_RDONLY 0
39 #endif
41 #include "lisp.h"
42 #include "buffer.h"
43 #include "keyboard.h"
44 #include "charset.h"
45 #include "keymap.h"
47 #ifdef HAVE_INDEX
48 extern char *index P_ ((const char *, int));
49 #endif
51 Lisp_Object Vdoc_file_name;
53 Lisp_Object Qfunction_documentation;
55 /* A list of files used to build this Emacs binary. */
56 static Lisp_Object Vbuild_files;
58 extern Lisp_Object Voverriding_local_map;
60 /* For VMS versions with limited file name syntax,
61 convert the name to something VMS will allow. */
62 static void
63 munge_doc_file_name (name)
64 char *name;
66 #ifdef VMS
67 #ifndef NO_HYPHENS_IN_FILENAMES
68 extern char * sys_translate_unix (char *ufile);
69 strcpy (name, sys_translate_unix (name));
70 #else /* NO_HYPHENS_IN_FILENAMES */
71 char *p = name;
72 while (*p)
74 if (*p == '-')
75 *p = '_';
76 p++;
78 #endif /* NO_HYPHENS_IN_FILENAMES */
79 #endif /* VMS */
82 /* Buffer used for reading from documentation file. */
83 static char *get_doc_string_buffer;
84 static int get_doc_string_buffer_size;
86 static unsigned char *read_bytecode_pointer;
87 Lisp_Object Fsnarf_documentation P_ ((Lisp_Object));
89 /* readchar in lread.c calls back here to fetch the next byte.
90 If UNREADFLAG is 1, we unread a byte. */
92 int
93 read_bytecode_char (unreadflag)
94 int unreadflag;
96 if (unreadflag)
98 read_bytecode_pointer--;
99 return 0;
101 return *read_bytecode_pointer++;
104 /* Extract a doc string from a file. FILEPOS says where to get it.
105 If it is an integer, use that position in the standard DOC-... file.
106 If it is (FILE . INTEGER), use FILE as the file name
107 and INTEGER as the position in that file.
108 But if INTEGER is negative, make it positive.
109 (A negative integer is used for user variables, so we can distinguish
110 them without actually fetching the doc string.)
112 If the location does not point to the beginning of a docstring
113 (e.g. because the file has been modified and the location is stale),
114 return nil.
116 If UNIBYTE is nonzero, always make a unibyte string.
118 If DEFINITION is nonzero, assume this is for reading
119 a dynamic function definition; convert the bytestring
120 and the constants vector with appropriate byte handling,
121 and return a cons cell. */
123 Lisp_Object
124 get_doc_string (filepos, unibyte, definition)
125 Lisp_Object filepos;
126 int unibyte, definition;
128 char *from, *to;
129 register int fd;
130 register char *name;
131 register char *p, *p1;
132 int minsize;
133 int offset, position;
134 Lisp_Object file, tem;
136 if (INTEGERP (filepos))
138 file = Vdoc_file_name;
139 position = XINT (filepos);
141 else if (CONSP (filepos))
143 file = XCAR (filepos);
144 position = XINT (XCDR (filepos));
146 else
147 return Qnil;
149 if (position < 0)
150 position = - position;
152 if (!STRINGP (Vdoc_directory))
153 return Qnil;
155 if (!STRINGP (file))
156 return Qnil;
158 /* Put the file name in NAME as a C string.
159 If it is relative, combine it with Vdoc_directory. */
161 tem = Ffile_name_absolute_p (file);
162 if (NILP (tem))
164 minsize = SCHARS (Vdoc_directory);
165 /* sizeof ("../etc/") == 8 */
166 if (minsize < 8)
167 minsize = 8;
168 name = (char *) alloca (minsize + SCHARS (file) + 8);
169 strcpy (name, SDATA (Vdoc_directory));
170 strcat (name, SDATA (file));
171 munge_doc_file_name (name);
173 else
175 name = (char *) SDATA (file);
178 fd = emacs_open (name, O_RDONLY, 0);
179 if (fd < 0)
181 #ifndef CANNOT_DUMP
182 if (!NILP (Vpurify_flag))
184 /* Preparing to dump; DOC file is probably not installed.
185 So check in ../etc. */
186 strcpy (name, "../etc/");
187 strcat (name, SDATA (file));
188 munge_doc_file_name (name);
190 fd = emacs_open (name, O_RDONLY, 0);
192 #endif
193 if (fd < 0)
194 error ("Cannot open doc string file \"%s\"", name);
197 /* Seek only to beginning of disk block. */
198 /* Make sure we read at least 1024 bytes before `position'
199 so we can check the leading text for consistency. */
200 offset = min (position, max (1024, position % (8 * 1024)));
201 if (0 > lseek (fd, position - offset, 0))
203 emacs_close (fd);
204 error ("Position %ld out of range in doc string file \"%s\"",
205 position, name);
208 /* Read the doc string into get_doc_string_buffer.
209 P points beyond the data just read. */
211 p = get_doc_string_buffer;
212 while (1)
214 int space_left = (get_doc_string_buffer_size
215 - (p - get_doc_string_buffer));
216 int nread;
218 /* Allocate or grow the buffer if we need to. */
219 if (space_left == 0)
221 int in_buffer = p - get_doc_string_buffer;
222 get_doc_string_buffer_size += 16 * 1024;
223 get_doc_string_buffer
224 = (char *) xrealloc (get_doc_string_buffer,
225 get_doc_string_buffer_size + 1);
226 p = get_doc_string_buffer + in_buffer;
227 space_left = (get_doc_string_buffer_size
228 - (p - get_doc_string_buffer));
231 /* Read a disk block at a time.
232 If we read the same block last time, maybe skip this? */
233 if (space_left > 1024 * 8)
234 space_left = 1024 * 8;
235 nread = emacs_read (fd, p, space_left);
236 if (nread < 0)
238 emacs_close (fd);
239 error ("Read error on documentation file");
241 p[nread] = 0;
242 if (!nread)
243 break;
244 if (p == get_doc_string_buffer)
245 p1 = (char *) index (p + offset, '\037');
246 else
247 p1 = (char *) index (p, '\037');
248 if (p1)
250 *p1 = 0;
251 p = p1;
252 break;
254 p += nread;
256 emacs_close (fd);
258 /* Sanity checking. */
259 if (CONSP (filepos))
261 int test = 1;
262 if (get_doc_string_buffer[offset - test++] != ' ')
263 return Qnil;
264 while (get_doc_string_buffer[offset - test] >= '0'
265 && get_doc_string_buffer[offset - test] <= '9')
266 test++;
267 if (get_doc_string_buffer[offset - test++] != '@'
268 || get_doc_string_buffer[offset - test] != '#')
269 return Qnil;
271 else
273 int test = 1;
274 if (get_doc_string_buffer[offset - test++] != '\n')
275 return Qnil;
276 while (get_doc_string_buffer[offset - test] > ' ')
277 test++;
278 if (get_doc_string_buffer[offset - test] != '\037')
279 return Qnil;
282 /* Scan the text and perform quoting with ^A (char code 1).
283 ^A^A becomes ^A, ^A0 becomes a null char, and ^A_ becomes a ^_. */
284 from = get_doc_string_buffer + offset;
285 to = get_doc_string_buffer + offset;
286 while (from != p)
288 if (*from == 1)
290 int c;
292 from++;
293 c = *from++;
294 if (c == 1)
295 *to++ = c;
296 else if (c == '0')
297 *to++ = 0;
298 else if (c == '_')
299 *to++ = 037;
300 else
301 error ("Invalid data in documentation file -- ^A followed by code 0%o", c);
303 else
304 *to++ = *from++;
307 /* If DEFINITION, read from this buffer
308 the same way we would read bytes from a file. */
309 if (definition)
311 read_bytecode_pointer = get_doc_string_buffer + offset;
312 return Fread (Qlambda);
315 if (unibyte)
316 return make_unibyte_string (get_doc_string_buffer + offset,
317 to - (get_doc_string_buffer + offset));
318 else
320 /* Let the data determine whether the string is multibyte,
321 even if Emacs is running in --unibyte mode. */
322 int nchars = multibyte_chars_in_text (get_doc_string_buffer + offset,
323 to - (get_doc_string_buffer + offset));
324 return make_string_from_bytes (get_doc_string_buffer + offset,
325 nchars,
326 to - (get_doc_string_buffer + offset));
330 /* Get a string from position FILEPOS and pass it through the Lisp reader.
331 We use this for fetching the bytecode string and constants vector
332 of a compiled function from the .elc file. */
334 Lisp_Object
335 read_doc_string (filepos)
336 Lisp_Object filepos;
338 return get_doc_string (filepos, 0, 1);
341 static int
342 reread_doc_file (file)
343 Lisp_Object file;
345 #if 0
346 Lisp_Object reply, prompt[3];
347 struct gcpro gcpro1;
348 GCPRO1 (file);
349 prompt[0] = build_string ("File ");
350 prompt[1] = NILP (file) ? Vdoc_file_name : file;
351 prompt[2] = build_string (" is out of sync. Reload? ");
352 reply = Fy_or_n_p (Fconcat (3, prompt));
353 UNGCPRO;
354 if (NILP (reply))
355 return 0;
356 #endif
358 if (NILP (file))
359 Fsnarf_documentation (Vdoc_file_name);
360 else
361 Fload (file, Qt, Qt, Qt, Qnil);
363 return 1;
366 DEFUN ("documentation", Fdocumentation, Sdocumentation, 1, 2, 0,
367 doc: /* Return the documentation string of FUNCTION.
368 Unless a non-nil second argument RAW is given, the
369 string is passed through `substitute-command-keys'. */)
370 (function, raw)
371 Lisp_Object function, raw;
373 Lisp_Object fun;
374 Lisp_Object funcar;
375 Lisp_Object tem, doc;
376 int try_reload = 1;
378 documentation:
380 doc = Qnil;
382 if (SYMBOLP (function)
383 && (tem = Fget (function, Qfunction_documentation),
384 !NILP (tem)))
385 return Fdocumentation_property (function, Qfunction_documentation, raw);
387 fun = Findirect_function (function);
388 if (SUBRP (fun))
390 if (XSUBR (fun)->doc == 0)
391 return Qnil;
392 else if ((EMACS_INT) XSUBR (fun)->doc >= 0)
393 doc = build_string (XSUBR (fun)->doc);
394 else
395 doc = make_number ((EMACS_INT) XSUBR (fun)->doc);
397 else if (COMPILEDP (fun))
399 if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) <= COMPILED_DOC_STRING)
400 return Qnil;
401 tem = AREF (fun, COMPILED_DOC_STRING);
402 if (STRINGP (tem))
403 doc = tem;
404 else if (NATNUMP (tem) || CONSP (tem))
405 doc = tem;
406 else
407 return Qnil;
409 else if (STRINGP (fun) || VECTORP (fun))
411 return build_string ("Keyboard macro.");
413 else if (CONSP (fun))
415 funcar = Fcar (fun);
416 if (!SYMBOLP (funcar))
417 return Fsignal (Qinvalid_function, Fcons (fun, Qnil));
418 else if (EQ (funcar, Qkeymap))
419 return build_string ("Prefix command (definition is a keymap associating keystrokes with commands).");
420 else if (EQ (funcar, Qlambda)
421 || EQ (funcar, Qautoload))
423 Lisp_Object tem1;
424 tem1 = Fcdr (Fcdr (fun));
425 tem = Fcar (tem1);
426 if (STRINGP (tem))
427 doc = tem;
428 /* Handle a doc reference--but these never come last
429 in the function body, so reject them if they are last. */
430 else if ((NATNUMP (tem) || (CONSP (tem) && INTEGERP (XCDR (tem))))
431 && !NILP (XCDR (tem1)))
432 doc = tem;
433 else
434 return Qnil;
436 else if (EQ (funcar, Qmacro))
437 return Fdocumentation (Fcdr (fun), raw);
438 else
439 goto oops;
441 else
443 oops:
444 Fsignal (Qinvalid_function, Fcons (fun, Qnil));
447 /* If DOC is 0, it's typically because of a dumped file missing
448 from the DOC file (bug in src/Makefile.in). */
449 if (EQ (doc, make_number (0)))
450 doc = Qnil;
451 if (INTEGERP (doc) || CONSP (doc))
453 Lisp_Object tem;
454 tem = get_doc_string (doc, 0, 0);
455 if (NILP (tem) && try_reload)
457 /* The file is newer, we need to reset the pointers. */
458 struct gcpro gcpro1, gcpro2;
459 GCPRO2 (function, raw);
460 try_reload = reread_doc_file (Fcar_safe (doc));
461 UNGCPRO;
462 if (try_reload)
464 try_reload = 0;
465 goto documentation;
468 else
469 doc = tem;
472 if (NILP (raw))
473 doc = Fsubstitute_command_keys (doc);
474 return doc;
477 DEFUN ("documentation-property", Fdocumentation_property,
478 Sdocumentation_property, 2, 3, 0,
479 doc: /* Return the documentation string that is SYMBOL's PROP property.
480 Third argument RAW omitted or nil means pass the result through
481 `substitute-command-keys' if it is a string.
483 This differs from `get' in that it can refer to strings stored in the
484 `etc/DOC' file; and that it evaluates documentation properties that
485 aren't strings. */)
486 (symbol, prop, raw)
487 Lisp_Object symbol, prop, raw;
489 int try_reload = 1;
490 Lisp_Object tem;
492 documentation_property:
494 tem = Fget (symbol, prop);
495 if (EQ (tem, make_number (0)))
496 tem = Qnil;
497 if (INTEGERP (tem) || (CONSP (tem) && INTEGERP (XCDR (tem))))
499 Lisp_Object doc = tem;
500 tem = get_doc_string (tem, 0, 0);
501 if (NILP (tem) && try_reload)
503 /* The file is newer, we need to reset the pointers. */
504 struct gcpro gcpro1, gcpro2, gcpro3;
505 GCPRO3 (symbol, prop, raw);
506 try_reload = reread_doc_file (Fcar_safe (doc));
507 UNGCPRO;
508 if (try_reload)
510 try_reload = 0;
511 goto documentation_property;
515 else if (!STRINGP (tem))
516 /* Feval protects its argument. */
517 tem = Feval (tem);
519 if (NILP (raw) && STRINGP (tem))
520 tem = Fsubstitute_command_keys (tem);
521 return tem;
524 /* Scanning the DOC files and placing docstring offsets into functions. */
526 static void
527 store_function_docstring (fun, offset)
528 Lisp_Object fun;
529 /* Use EMACS_INT because we get this from pointer subtraction. */
530 EMACS_INT offset;
532 fun = indirect_function (fun);
534 /* The type determines where the docstring is stored. */
536 /* Lisp_Subrs have a slot for it. */
537 if (SUBRP (fun))
538 XSUBR (fun)->doc = (char *) - offset;
540 /* If it's a lisp form, stick it in the form. */
541 else if (CONSP (fun))
543 Lisp_Object tem;
545 tem = XCAR (fun);
546 if (EQ (tem, Qlambda) || EQ (tem, Qautoload))
548 tem = Fcdr (Fcdr (fun));
549 if (CONSP (tem) && INTEGERP (XCAR (tem)))
550 XSETCARFASTINT (tem, offset);
552 else if (EQ (tem, Qmacro))
553 store_function_docstring (XCDR (fun), offset);
556 /* Bytecode objects sometimes have slots for it. */
557 else if (COMPILEDP (fun))
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 XSETFASTINT (AREF (fun, COMPILED_DOC_STRING), offset);
567 DEFUN ("Snarf-documentation", Fsnarf_documentation, Ssnarf_documentation,
568 1, 1, 0,
569 doc: /* Used during Emacs initialization to scan the `etc/DOC...' file.
570 This searches the `etc/DOC...' file for doc strings and
571 records them in function and variable definitions.
572 The function takes one argument, FILENAME, a string;
573 it specifies the file name (without a directory) of the DOC file.
574 That file is found in `../etc' now; later, when the dumped Emacs is run,
575 the same file name is found in the `doc-directory'. */)
576 (filename)
577 Lisp_Object filename;
579 int fd;
580 char buf[1024 + 1];
581 register int filled;
582 register int pos;
583 register char *p, *end;
584 Lisp_Object sym;
585 char *name;
586 int skip_file = 0;
588 CHECK_STRING (filename);
591 #ifndef CANNOT_DUMP
592 (!NILP (Vpurify_flag))
593 #else /* CANNOT_DUMP */
595 #endif /* CANNOT_DUMP */
597 name = (char *) alloca (SCHARS (filename) + 14);
598 strcpy (name, "../etc/");
600 else
602 CHECK_STRING (Vdoc_directory);
603 name = (char *) alloca (SCHARS (filename)
604 + SCHARS (Vdoc_directory) + 1);
605 strcpy (name, SDATA (Vdoc_directory));
607 strcat (name, SDATA (filename)); /*** Add this line ***/
608 munge_doc_file_name (name);
610 /* Vbuild_files is nil when temacs is run, and non-nil after that. */
611 if (NILP (Vbuild_files))
613 size_t cp_size = 0;
614 size_t to_read;
615 int nr_read;
616 char *cp = NULL;
617 char *beg, *end;
619 fd = emacs_open ("buildobj.lst", O_RDONLY, 0);
620 if (fd < 0)
621 report_file_error ("Opening file buildobj.lst", Qnil);
623 filled = 0;
624 for (;;)
626 cp_size += 1024;
627 to_read = cp_size - 1 - filled;
628 cp = xrealloc (cp, cp_size);
629 nr_read = emacs_read (fd, &cp[filled], to_read);
630 filled += nr_read;
631 if (nr_read < to_read)
632 break;
635 emacs_close (fd);
636 cp[filled] = 0;
638 for (beg = cp; *beg; beg = end)
640 int len;
642 while (*beg && isspace (*beg)) ++beg;
644 for (end = beg; *end && ! isspace (*end); ++end)
645 if (*end == '/') beg = end+1; /* skip directory part */
647 len = end - beg;
648 if (len > 4 && end[-4] == '.' && end[-3] == 'o')
649 len -= 2; /* Just take .o if it ends in .obj */
651 if (len > 0)
652 Vbuild_files = Fcons (make_string (beg, len), Vbuild_files);
655 xfree (cp);
658 fd = emacs_open (name, O_RDONLY, 0);
659 if (fd < 0)
660 report_file_error ("Opening doc string file",
661 Fcons (build_string (name), Qnil));
662 Vdoc_file_name = filename;
663 filled = 0;
664 pos = 0;
665 while (1)
667 if (filled < 512)
668 filled += emacs_read (fd, &buf[filled], sizeof buf - 1 - filled);
669 if (!filled)
670 break;
672 buf[filled] = 0;
673 p = buf;
674 end = buf + (filled < 512 ? filled : filled - 128);
675 while (p != end && *p != '\037') p++;
676 /* p points to ^_Ffunctionname\n or ^_Vvarname\n. */
677 if (p != end)
679 end = (char *) index (p, '\n');
681 /* See if this is a file name, and if it is a file in build-files. */
682 if (p[1] == 'S' && end - p > 4 && end[-2] == '.'
683 && (end[-1] == 'o' || end[-1] == 'c'))
685 int len = end - p - 2;
686 char *fromfile = alloca (len + 1);
687 strncpy (fromfile, &p[2], len);
688 fromfile[len] = 0;
689 if (fromfile[len-1] == 'c')
690 fromfile[len-1] = 'o';
692 if (EQ (Fmember (build_string (fromfile), Vbuild_files), Qnil))
693 skip_file = 1;
694 else
695 skip_file = 0;
698 sym = oblookup (Vobarray, p + 2,
699 multibyte_chars_in_text (p + 2, end - p - 2),
700 end - p - 2);
701 if (! skip_file && SYMBOLP (sym))
703 /* Attach a docstring to a variable? */
704 if (p[1] == 'V')
706 /* Install file-position as variable-documentation property
707 and make it negative for a user-variable
708 (doc starts with a `*'). */
709 Fput (sym, Qvariable_documentation,
710 make_number ((pos + end + 1 - buf)
711 * (end[1] == '*' ? -1 : 1)));
714 /* Attach a docstring to a function? */
715 else if (p[1] == 'F')
716 store_function_docstring (sym, pos + end + 1 - buf);
718 else if (p[1] == 'S')
719 ; /* Just a source file name boundary marker. Ignore it. */
721 else
722 error ("DOC file invalid at position %d", pos);
725 pos += end - buf;
726 filled -= end - buf;
727 bcopy (end, buf, filled);
729 emacs_close (fd);
730 return Qnil;
733 DEFUN ("substitute-command-keys", Fsubstitute_command_keys,
734 Ssubstitute_command_keys, 1, 1, 0,
735 doc: /* Substitute key descriptions for command names in STRING.
736 Return a new string which is STRING with substrings of the form \\=\\[COMMAND]
737 replaced by either: a keystroke sequence that will invoke COMMAND,
738 or "M-x COMMAND" if COMMAND is not on any keys.
739 Substrings of the form \\=\\{MAPVAR} are replaced by summaries
740 \(made by describe-bindings) of the value of MAPVAR, taken as a keymap.
741 Substrings of the form \\=\\<MAPVAR> specify to use the value of MAPVAR
742 as the keymap for future \\=\\[COMMAND] substrings.
743 \\=\\= quotes the following character and is discarded;
744 thus, \\=\\=\\=\\= puts \\=\\= into the output, and \\=\\=\\=\\[ puts \\=\\[ into the output. */)
745 (string)
746 Lisp_Object string;
748 unsigned char *buf;
749 int changed = 0;
750 register unsigned char *strp;
751 register unsigned char *bufp;
752 int idx;
753 int bsize;
754 Lisp_Object tem;
755 Lisp_Object keymap;
756 unsigned char *start;
757 int length, length_byte;
758 Lisp_Object name;
759 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
760 int multibyte;
761 int nchars;
763 if (NILP (string))
764 return Qnil;
766 CHECK_STRING (string);
767 tem = Qnil;
768 keymap = Qnil;
769 name = Qnil;
770 GCPRO4 (string, tem, keymap, name);
772 multibyte = STRING_MULTIBYTE (string);
773 nchars = 0;
775 /* KEYMAP is either nil (which means search all the active keymaps)
776 or a specified local map (which means search just that and the
777 global map). If non-nil, it might come from Voverriding_local_map,
778 or from a \\<mapname> construct in STRING itself.. */
779 keymap = current_kboard->Voverriding_terminal_local_map;
780 if (NILP (keymap))
781 keymap = Voverriding_local_map;
783 bsize = SBYTES (string);
784 bufp = buf = (unsigned char *) xmalloc (bsize);
786 strp = SDATA (string);
787 while (strp < SDATA (string) + SBYTES (string))
789 if (strp[0] == '\\' && strp[1] == '=')
791 /* \= quotes the next character;
792 thus, to put in \[ without its special meaning, use \=\[. */
793 changed = 1;
794 strp += 2;
795 if (multibyte)
797 int len;
798 int maxlen = SDATA (string) + SBYTES (string) - strp;
800 STRING_CHAR_AND_LENGTH (strp, maxlen, len);
801 if (len == 1)
802 *bufp = *strp;
803 else
804 bcopy (strp, bufp, len);
805 strp += len;
806 bufp += len;
807 nchars++;
809 else
810 *bufp++ = *strp++, nchars++;
812 else if (strp[0] == '\\' && strp[1] == '[')
814 int start_idx;
816 changed = 1;
817 strp += 2; /* skip \[ */
818 start = strp;
819 start_idx = start - SDATA (string);
821 while ((strp - SDATA (string)
822 < SBYTES (string))
823 && *strp != ']')
824 strp++;
825 length_byte = strp - start;
827 strp++; /* skip ] */
829 /* Save STRP in IDX. */
830 idx = strp - SDATA (string);
831 name = Fintern (make_string (start, length_byte), Qnil);
833 /* Ignore remappings unless there are no ordinary bindings. */
834 tem = Fwhere_is_internal (name, keymap, Qt, Qnil, Qt);
835 if (NILP (tem))
836 tem = Fwhere_is_internal (name, keymap, Qt, Qnil, Qnil);
838 /* Note the Fwhere_is_internal can GC, so we have to take
839 relocation of string contents into account. */
840 strp = SDATA (string) + idx;
841 start = SDATA (string) + start_idx;
843 if (NILP (tem)) /* but not on any keys */
845 int offset = bufp - buf;
846 buf = (unsigned char *) xrealloc (buf, bsize += 4);
847 bufp = buf + offset;
848 bcopy ("M-x ", bufp, 4);
849 bufp += 4;
850 nchars += 4;
851 if (multibyte)
852 length = multibyte_chars_in_text (start, length_byte);
853 else
854 length = length_byte;
855 goto subst;
857 else
858 { /* function is on a key */
859 tem = Fkey_description (tem, Qnil);
860 goto subst_string;
863 /* \{foo} is replaced with a summary of the keymap (symbol-value foo).
864 \<foo> just sets the keymap used for \[cmd]. */
865 else if (strp[0] == '\\' && (strp[1] == '{' || strp[1] == '<'))
867 struct buffer *oldbuf;
868 int start_idx;
869 /* This is for computing the SHADOWS arg for describe_map_tree. */
870 Lisp_Object active_maps = Fcurrent_active_maps (Qnil);
871 Lisp_Object earlier_maps;
873 changed = 1;
874 strp += 2; /* skip \{ or \< */
875 start = strp;
876 start_idx = start - SDATA (string);
878 while ((strp - SDATA (string) < SBYTES (string))
879 && *strp != '}' && *strp != '>')
880 strp++;
882 length_byte = strp - start;
883 strp++; /* skip } or > */
885 /* Save STRP in IDX. */
886 idx = strp - SDATA (string);
888 /* Get the value of the keymap in TEM, or nil if undefined.
889 Do this while still in the user's current buffer
890 in case it is a local variable. */
891 name = Fintern (make_string (start, length_byte), Qnil);
892 tem = Fboundp (name);
893 if (! NILP (tem))
895 tem = Fsymbol_value (name);
896 if (! NILP (tem))
898 tem = get_keymap (tem, 0, 1);
899 /* Note that get_keymap can GC. */
900 strp = SDATA (string) + idx;
901 start = SDATA (string) + start_idx;
905 /* Now switch to a temp buffer. */
906 oldbuf = current_buffer;
907 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer));
909 if (NILP (tem))
911 name = Fsymbol_name (name);
912 insert_string ("\nUses keymap \"");
913 insert_from_string (name, 0, 0,
914 SCHARS (name),
915 SBYTES (name), 1);
916 insert_string ("\", which is not currently defined.\n");
917 if (start[-1] == '<') keymap = Qnil;
919 else if (start[-1] == '<')
920 keymap = tem;
921 else
923 /* Get the list of active keymaps that precede this one.
924 If this one's not active, get nil. */
925 earlier_maps = Fcdr (Fmemq (tem, Freverse (active_maps)));
926 describe_map_tree (tem, 1, Fnreverse (earlier_maps),
927 Qnil, (char *)0, 1, 0, 0, 1);
929 tem = Fbuffer_string ();
930 Ferase_buffer ();
931 set_buffer_internal (oldbuf);
933 subst_string:
934 start = SDATA (tem);
935 length = SCHARS (tem);
936 length_byte = SBYTES (tem);
937 subst:
939 int offset = bufp - buf;
940 buf = (unsigned char *) xrealloc (buf, bsize += length_byte);
941 bufp = buf + offset;
942 bcopy (start, bufp, length_byte);
943 bufp += length_byte;
944 nchars += length;
945 /* Check STRING again in case gc relocated it. */
946 strp = (unsigned char *) SDATA (string) + idx;
949 else if (! multibyte) /* just copy other chars */
950 *bufp++ = *strp++, nchars++;
951 else
953 int len;
954 int maxlen = SDATA (string) + SBYTES (string) - strp;
956 STRING_CHAR_AND_LENGTH (strp, maxlen, len);
957 if (len == 1)
958 *bufp = *strp;
959 else
960 bcopy (strp, bufp, len);
961 strp += len;
962 bufp += len;
963 nchars++;
967 if (changed) /* don't bother if nothing substituted */
968 tem = make_string_from_bytes (buf, nchars, bufp - buf);
969 else
970 tem = string;
971 xfree (buf);
972 RETURN_UNGCPRO (tem);
975 void
976 syms_of_doc ()
978 Qfunction_documentation = intern ("function-documentation");
979 staticpro (&Qfunction_documentation);
981 DEFVAR_LISP ("internal-doc-file-name", &Vdoc_file_name,
982 doc: /* Name of file containing documentation strings of built-in symbols. */);
983 Vdoc_file_name = Qnil;
985 DEFVAR_LISP ("build-files", &Vbuild_files,
986 doc: /* A list of files used to build this Emacs binary. */);
987 Vbuild_files = Qnil;
989 defsubr (&Sdocumentation);
990 defsubr (&Sdocumentation_property);
991 defsubr (&Ssnarf_documentation);
992 defsubr (&Ssubstitute_command_keys);
995 /* arch-tag: 56281d4d-6949-43e2-be2e-f6517de744ba
996 (do not change this comment) */