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