]> code.delx.au - gnu-emacs/blob - src/doc.c
(toplevel) [HAVE_STRING_H]: Include string.h.
[gnu-emacs] / src / doc.c
1 /* Record indices of function doc strings stored in a file.
2 Copyright (C) 1985, 86,93,94,95,97,98,99, 2000 Free Software Foundation, Inc.
3
4 This file is part of GNU Emacs.
5
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
9 any later version.
10
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
15
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
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 and BSD4_1*/
26
27 #ifdef USG5
28 #include <fcntl.h>
29 #endif
30
31 #ifdef HAVE_UNISTD_H
32 #include <unistd.h>
33 #endif
34
35 #ifndef O_RDONLY
36 #define O_RDONLY 0
37 #endif
38
39 #include "lisp.h"
40 #include "buffer.h"
41 #include "keyboard.h"
42 #include "charset.h"
43
44 #ifdef HAVE_STRING_H
45 #include <string.h>
46 #endif
47
48 #ifdef HAVE_STRINGS_H
49 #include <strings.h>
50 #endif
51
52 Lisp_Object Vdoc_file_name, Vhelp_manyarg_func_alist;
53
54 Lisp_Object Qfunction_documentation;
55
56 extern Lisp_Object Voverriding_local_map;
57
58 /* For VMS versions with limited file name syntax,
59 convert the name to something VMS will allow. */
60 static void
61 munge_doc_file_name (name)
62 char *name;
63 {
64 #ifdef VMS
65 #ifndef VMS4_4
66 /* For VMS versions with limited file name syntax,
67 convert the name to something VMS will allow. */
68 p = name;
69 while (*p)
70 {
71 if (*p == '-')
72 *p = '_';
73 p++;
74 }
75 #endif /* not VMS4_4 */
76 #ifdef VMS4_4
77 strcpy (name, sys_translate_unix (name));
78 #endif /* VMS4_4 */
79 #endif /* VMS */
80 }
81
82 /* Buffer used for reading from documentation file. */
83 static char *get_doc_string_buffer;
84 static int get_doc_string_buffer_size;
85
86 static unsigned char *read_bytecode_pointer;
87
88 /* readchar in lread.c calls back here to fetch the next byte.
89 If UNREADFLAG is 1, we unread a byte. */
90
91 int
92 read_bytecode_char (unreadflag)
93 int unreadflag;
94 {
95 if (unreadflag)
96 {
97 read_bytecode_pointer--;
98 return 0;
99 }
100 return *read_bytecode_pointer++;
101 }
102
103 /* Extract a doc string from a file. FILEPOS says where to get it.
104 If it is an integer, use that position in the standard DOC-... file.
105 If it is (FILE . INTEGER), use FILE as the file name
106 and INTEGER as the position in that file.
107 But if INTEGER is negative, make it positive.
108 (A negative integer is used for user variables, so we can distinguish
109 them without actually fetching the doc string.)
110
111 If UNIBYTE is nonzero, always make a unibyte string.
112
113 If DEFINITION is nonzero, assume this is for reading
114 a dynamic function definition; convert the bytestring
115 and the constants vector with appropriate byte handling,
116 and return a cons cell. */
117
118 Lisp_Object
119 get_doc_string (filepos, unibyte, definition)
120 Lisp_Object filepos;
121 int unibyte, definition;
122 {
123 char *from, *to;
124 register int fd;
125 register char *name;
126 register char *p, *p1;
127 int minsize;
128 int offset, position;
129 Lisp_Object file, tem;
130
131 if (INTEGERP (filepos))
132 {
133 file = Vdoc_file_name;
134 position = XINT (filepos);
135 }
136 else if (CONSP (filepos))
137 {
138 file = XCAR (filepos);
139 position = XINT (XCDR (filepos));
140 if (position < 0)
141 position = - position;
142 }
143 else
144 return Qnil;
145
146 if (!STRINGP (Vdoc_directory))
147 return Qnil;
148
149 if (!STRINGP (file))
150 return Qnil;
151
152 /* Put the file name in NAME as a C string.
153 If it is relative, combine it with Vdoc_directory. */
154
155 tem = Ffile_name_absolute_p (file);
156 if (NILP (tem))
157 {
158 minsize = XSTRING (Vdoc_directory)->size;
159 /* sizeof ("../etc/") == 8 */
160 if (minsize < 8)
161 minsize = 8;
162 name = (char *) alloca (minsize + XSTRING (file)->size + 8);
163 strcpy (name, XSTRING (Vdoc_directory)->data);
164 strcat (name, XSTRING (file)->data);
165 munge_doc_file_name (name);
166 }
167 else
168 {
169 name = (char *) XSTRING (file)->data;
170 }
171
172 fd = emacs_open (name, O_RDONLY, 0);
173 if (fd < 0)
174 {
175 #ifndef CANNOT_DUMP
176 if (!NILP (Vpurify_flag))
177 {
178 /* Preparing to dump; DOC file is probably not installed.
179 So check in ../etc. */
180 strcpy (name, "../etc/");
181 strcat (name, XSTRING (file)->data);
182 munge_doc_file_name (name);
183
184 fd = emacs_open (name, O_RDONLY, 0);
185 }
186 #endif
187 if (fd < 0)
188 error ("Cannot open doc string file \"%s\"", name);
189 }
190
191 /* Seek only to beginning of disk block. */
192 offset = position % (8 * 1024);
193 if (0 > lseek (fd, position - offset, 0))
194 {
195 emacs_close (fd);
196 error ("Position %ld out of range in doc string file \"%s\"",
197 position, name);
198 }
199
200 /* Read the doc string into get_doc_string_buffer.
201 P points beyond the data just read. */
202
203 p = get_doc_string_buffer;
204 while (1)
205 {
206 int space_left = (get_doc_string_buffer_size
207 - (p - get_doc_string_buffer));
208 int nread;
209
210 /* Allocate or grow the buffer if we need to. */
211 if (space_left == 0)
212 {
213 int in_buffer = p - get_doc_string_buffer;
214 get_doc_string_buffer_size += 16 * 1024;
215 get_doc_string_buffer
216 = (char *) xrealloc (get_doc_string_buffer,
217 get_doc_string_buffer_size + 1);
218 p = get_doc_string_buffer + in_buffer;
219 space_left = (get_doc_string_buffer_size
220 - (p - get_doc_string_buffer));
221 }
222
223 /* Read a disk block at a time.
224 If we read the same block last time, maybe skip this? */
225 if (space_left > 1024 * 8)
226 space_left = 1024 * 8;
227 nread = emacs_read (fd, p, space_left);
228 if (nread < 0)
229 {
230 emacs_close (fd);
231 error ("Read error on documentation file");
232 }
233 p[nread] = 0;
234 if (!nread)
235 break;
236 if (p == get_doc_string_buffer)
237 p1 = (char *) index (p + offset, '\037');
238 else
239 p1 = (char *) index (p, '\037');
240 if (p1)
241 {
242 *p1 = 0;
243 p = p1;
244 break;
245 }
246 p += nread;
247 }
248 emacs_close (fd);
249
250 /* Scan the text and perform quoting with ^A (char code 1).
251 ^A^A becomes ^A, ^A0 becomes a null char, and ^A_ becomes a ^_. */
252 from = get_doc_string_buffer + offset;
253 to = get_doc_string_buffer + offset;
254 while (from != p)
255 {
256 if (*from == 1)
257 {
258 int c;
259
260 from++;
261 c = *from++;
262 if (c == 1)
263 *to++ = c;
264 else if (c == '0')
265 *to++ = 0;
266 else if (c == '_')
267 *to++ = 037;
268 else
269 error ("Invalid data in documentation file -- ^A followed by code 0%o", c);
270 }
271 else
272 *to++ = *from++;
273 }
274
275 /* If DEFINITION, read from this buffer
276 the same way we would read bytes from a file. */
277 if (definition)
278 {
279 read_bytecode_pointer = get_doc_string_buffer + offset;
280 return Fread (Qlambda);
281 }
282
283 if (unibyte)
284 return make_unibyte_string (get_doc_string_buffer + offset,
285 to - (get_doc_string_buffer + offset));
286 else
287 {
288 /* Let the data determine whether the string is multibyte,
289 even if Emacs is running in --unibyte mode. */
290 int nchars = multibyte_chars_in_text (get_doc_string_buffer + offset,
291 to - (get_doc_string_buffer + offset));
292 return make_string_from_bytes (get_doc_string_buffer + offset,
293 nchars,
294 to - (get_doc_string_buffer + offset));
295 }
296 }
297
298 /* Get a string from position FILEPOS and pass it through the Lisp reader.
299 We use this for fetching the bytecode string and constants vector
300 of a compiled function from the .elc file. */
301
302 Lisp_Object
303 read_doc_string (filepos)
304 Lisp_Object filepos;
305 {
306 return get_doc_string (filepos, 0, 1);
307 }
308
309 DEFUN ("documentation", Fdocumentation, Sdocumentation, 1, 2, 0,
310 "Return the documentation string of FUNCTION.\n\
311 Unless a non-nil second argument RAW is given, the\n\
312 string is passed through `substitute-command-keys'.")
313 (function, raw)
314 Lisp_Object function, raw;
315 {
316 Lisp_Object fun;
317 Lisp_Object funcar;
318 Lisp_Object tem, doc;
319
320 if (SYMBOLP (function)
321 && (tem = Fget (function, Qfunction_documentation),
322 !NILP (tem)))
323 return Fdocumentation_property (function, Qfunction_documentation, raw);
324
325 fun = Findirect_function (function);
326 if (SUBRP (fun))
327 {
328 if (XSUBR (fun)->doc == 0)
329 return Qnil;
330 else if ((EMACS_INT) XSUBR (fun)->doc >= 0)
331 doc = build_string (XSUBR (fun)->doc);
332 else
333 doc = get_doc_string (make_number (- (EMACS_INT) XSUBR (fun)->doc),
334 0, 0);
335 if (! NILP (tem = Fassq (function, Vhelp_manyarg_func_alist)))
336 doc = concat3 (doc, build_string ("\n"), Fcdr (tem));
337 }
338 else if (COMPILEDP (fun))
339 {
340 if ((XVECTOR (fun)->size & PSEUDOVECTOR_SIZE_MASK) <= COMPILED_DOC_STRING)
341 return Qnil;
342 tem = XVECTOR (fun)->contents[COMPILED_DOC_STRING];
343 if (STRINGP (tem))
344 doc = tem;
345 else if (NATNUMP (tem) || CONSP (tem))
346 doc = get_doc_string (tem, 0, 0);
347 else
348 return Qnil;
349 }
350 else if (STRINGP (fun) || VECTORP (fun))
351 {
352 return build_string ("Keyboard macro.");
353 }
354 else if (CONSP (fun))
355 {
356 funcar = Fcar (fun);
357 if (!SYMBOLP (funcar))
358 return Fsignal (Qinvalid_function, Fcons (fun, Qnil));
359 else if (EQ (funcar, Qkeymap))
360 return build_string ("Prefix command (definition is a keymap associating keystrokes with commands).");
361 else if (EQ (funcar, Qlambda)
362 || EQ (funcar, Qautoload))
363 {
364 Lisp_Object tem1;
365 tem1 = Fcdr (Fcdr (fun));
366 tem = Fcar (tem1);
367 if (STRINGP (tem))
368 doc = tem;
369 /* Handle a doc reference--but these never come last
370 in the function body, so reject them if they are last. */
371 else if ((NATNUMP (tem) || CONSP (tem))
372 && ! NILP (XCDR (tem1)))
373 doc = get_doc_string (tem, 0, 0);
374 else
375 return Qnil;
376 }
377 else if (EQ (funcar, Qmocklisp))
378 return Qnil;
379 else if (EQ (funcar, Qmacro))
380 return Fdocumentation (Fcdr (fun), raw);
381 else
382 goto oops;
383 }
384 else
385 {
386 oops:
387 Fsignal (Qinvalid_function, Fcons (fun, Qnil));
388 }
389
390 if (NILP (raw))
391 doc = Fsubstitute_command_keys (doc);
392 return doc;
393 }
394
395 DEFUN ("documentation-property", Fdocumentation_property,
396 Sdocumentation_property, 2, 3, 0,
397 "Return the documentation string that is SYMBOL's PROP property.\n\
398 Third argument RAW omitted or nil means pass the result through\n\
399 `substitute-command-keys' if it is a string.\n\
400 \n\
401 This is differs from `get' in that it can refer to strings stored in the\n\
402 `etc/DOC' file; and that it evaluates documentation properties that\n\
403 aren't strings.")
404 (symbol, prop, raw)
405 Lisp_Object symbol, prop, raw;
406 {
407 Lisp_Object tem;
408
409 tem = Fget (symbol, prop);
410 if (INTEGERP (tem))
411 tem = get_doc_string (XINT (tem) > 0 ? tem : make_number (- XINT (tem)), 0, 0);
412 else if (CONSP (tem) && INTEGERP (XCDR (tem)))
413 tem = get_doc_string (tem, 0, 0);
414 else if (!STRINGP (tem))
415 /* Feval protects its argument. */
416 tem = Feval (tem);
417
418 if (NILP (raw) && STRINGP (tem))
419 tem = Fsubstitute_command_keys (tem);
420 return tem;
421 }
422 \f
423 /* Scanning the DOC files and placing docstring offsets into functions. */
424
425 static void
426 store_function_docstring (fun, offset)
427 Lisp_Object fun;
428 /* Use EMACS_INT because we get this from pointer subtraction. */
429 EMACS_INT offset;
430 {
431 fun = indirect_function (fun);
432
433 /* The type determines where the docstring is stored. */
434
435 /* Lisp_Subrs have a slot for it. */
436 if (SUBRP (fun))
437 XSUBR (fun)->doc = (char *) - offset;
438
439 /* If it's a lisp form, stick it in the form. */
440 else if (CONSP (fun))
441 {
442 Lisp_Object tem;
443
444 tem = XCAR (fun);
445 if (EQ (tem, Qlambda) || EQ (tem, Qautoload))
446 {
447 tem = Fcdr (Fcdr (fun));
448 if (CONSP (tem) && INTEGERP (XCAR (tem)))
449 XSETFASTINT (XCAR (tem), offset);
450 }
451 else if (EQ (tem, Qmacro))
452 store_function_docstring (XCDR (fun), offset);
453 }
454
455 /* Bytecode objects sometimes have slots for it. */
456 else if (COMPILEDP (fun))
457 {
458 /* This bytecode object must have a slot for the
459 docstring, since we've found a docstring for it. */
460 if ((XVECTOR (fun)->size & PSEUDOVECTOR_SIZE_MASK) > COMPILED_DOC_STRING)
461 XSETFASTINT (XVECTOR (fun)->contents[COMPILED_DOC_STRING], offset);
462 }
463 }
464
465
466 DEFUN ("Snarf-documentation", Fsnarf_documentation, Ssnarf_documentation,
467 1, 1, 0,
468 "Used during Emacs initialization, before dumping runnable Emacs,\n\
469 to find pointers to doc strings stored in `etc/DOC...' and\n\
470 record them in function definitions.\n\
471 One arg, FILENAME, a string which does not include a directory.\n\
472 The file is found in `../etc' now; found in the `data-directory'\n\
473 when doc strings are referred to later in the dumped Emacs.")
474 (filename)
475 Lisp_Object filename;
476 {
477 int fd;
478 char buf[1024 + 1];
479 register int filled;
480 register int pos;
481 register char *p, *end;
482 Lisp_Object sym, fun, tem;
483 char *name;
484
485 #ifndef CANNOT_DUMP
486 if (NILP (Vpurify_flag))
487 error ("Snarf-documentation can only be called in an undumped Emacs");
488 #endif
489
490 CHECK_STRING (filename, 0);
491
492 #ifndef CANNOT_DUMP
493 name = (char *) alloca (XSTRING (filename)->size + 14);
494 strcpy (name, "../etc/");
495 #else /* CANNOT_DUMP */
496 CHECK_STRING (Vdoc_directory, 0);
497 name = (char *) alloca (XSTRING (filename)->size +
498 XSTRING (Vdoc_directory)->size + 1);
499 strcpy (name, XSTRING (Vdoc_directory)->data);
500 #endif /* CANNOT_DUMP */
501 strcat (name, XSTRING (filename)->data); /*** Add this line ***/
502 #ifdef VMS
503 #ifndef VMS4_4
504 /* For VMS versions with limited file name syntax,
505 convert the name to something VMS will allow. */
506 p = name;
507 while (*p)
508 {
509 if (*p == '-')
510 *p = '_';
511 p++;
512 }
513 #endif /* not VMS4_4 */
514 #ifdef VMS4_4
515 strcpy (name, sys_translate_unix (name));
516 #endif /* VMS4_4 */
517 #endif /* VMS */
518
519 fd = emacs_open (name, O_RDONLY, 0);
520 if (fd < 0)
521 report_file_error ("Opening doc string file",
522 Fcons (build_string (name), Qnil));
523 Vdoc_file_name = filename;
524 filled = 0;
525 pos = 0;
526 while (1)
527 {
528 if (filled < 512)
529 filled += emacs_read (fd, &buf[filled], sizeof buf - 1 - filled);
530 if (!filled)
531 break;
532
533 buf[filled] = 0;
534 p = buf;
535 end = buf + (filled < 512 ? filled : filled - 128);
536 while (p != end && *p != '\037') p++;
537 /* p points to ^_Ffunctionname\n or ^_Vvarname\n. */
538 if (p != end)
539 {
540 end = (char *) index (p, '\n');
541 sym = oblookup (Vobarray, p + 2,
542 multibyte_chars_in_text (p + 2, end - p - 2),
543 end - p - 2);
544 if (SYMBOLP (sym))
545 {
546 /* Attach a docstring to a variable? */
547 if (p[1] == 'V')
548 {
549 /* Install file-position as variable-documentation property
550 and make it negative for a user-variable
551 (doc starts with a `*'). */
552 Fput (sym, Qvariable_documentation,
553 make_number ((pos + end + 1 - buf)
554 * (end[1] == '*' ? -1 : 1)));
555 }
556
557 /* Attach a docstring to a function? */
558 else if (p[1] == 'F')
559 store_function_docstring (sym, pos + end + 1 - buf);
560
561 else
562 error ("DOC file invalid at position %d", pos);
563 }
564 }
565 pos += end - buf;
566 filled -= end - buf;
567 bcopy (end, buf, filled);
568 }
569 emacs_close (fd);
570 return Qnil;
571 }
572 \f
573 DEFUN ("substitute-command-keys", Fsubstitute_command_keys,
574 Ssubstitute_command_keys, 1, 1, 0,
575 "Substitute key descriptions for command names in STRING.\n\
576 Return a new string which is STRING with substrings of the form \\=\\[COMMAND]\n\
577 replaced by either: a keystroke sequence that will invoke COMMAND,\n\
578 or \"M-x COMMAND\" if COMMAND is not on any keys.\n\
579 Substrings of the form \\=\\{MAPVAR} are replaced by summaries\n\
580 \(made by describe-bindings) of the value of MAPVAR, taken as a keymap.\n\
581 Substrings of the form \\=\\<MAPVAR> specify to use the value of MAPVAR\n\
582 as the keymap for future \\=\\[COMMAND] substrings.\n\
583 \\=\\= quotes the following character and is discarded;\n\
584 thus, \\=\\=\\=\\= puts \\=\\= into the output, and \\=\\=\\=\\[ puts \\=\\[ into the output.")
585 (string)
586 Lisp_Object string;
587 {
588 unsigned char *buf;
589 int changed = 0;
590 register unsigned char *strp;
591 register unsigned char *bufp;
592 int idx;
593 int bsize;
594 unsigned char *new;
595 Lisp_Object tem;
596 Lisp_Object keymap;
597 unsigned char *start;
598 int length, length_byte;
599 Lisp_Object name;
600 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
601 int multibyte;
602 int nchars;
603
604 if (NILP (string))
605 return Qnil;
606
607 CHECK_STRING (string, 0);
608 tem = Qnil;
609 keymap = Qnil;
610 name = Qnil;
611 GCPRO4 (string, tem, keymap, name);
612
613 multibyte = STRING_MULTIBYTE (string);
614 nchars = 0;
615
616 /* KEYMAP is either nil (which means search all the active keymaps)
617 or a specified local map (which means search just that and the
618 global map). If non-nil, it might come from Voverriding_local_map,
619 or from a \\<mapname> construct in STRING itself.. */
620 keymap = current_kboard->Voverriding_terminal_local_map;
621 if (NILP (keymap))
622 keymap = Voverriding_local_map;
623
624 bsize = STRING_BYTES (XSTRING (string));
625 bufp = buf = (unsigned char *) xmalloc (bsize);
626
627 strp = (unsigned char *) XSTRING (string)->data;
628 while (strp < XSTRING (string)->data + STRING_BYTES (XSTRING (string)))
629 {
630 if (strp[0] == '\\' && strp[1] == '=')
631 {
632 /* \= quotes the next character;
633 thus, to put in \[ without its special meaning, use \=\[. */
634 changed = 1;
635 strp += 2;
636 if (multibyte)
637 {
638 int len;
639 int maxlen = XSTRING (string)->data + STRING_BYTES (XSTRING (string)) - strp;
640
641 STRING_CHAR_AND_LENGTH (strp, maxlen, len);
642 if (len == 1)
643 *bufp = *strp;
644 else
645 bcopy (strp, bufp, len);
646 strp += len;
647 bufp += len;
648 nchars++;
649 }
650 else
651 *bufp++ = *strp++, nchars++;
652 }
653 else if (strp[0] == '\\' && strp[1] == '[')
654 {
655 Lisp_Object firstkey;
656 int start_idx;
657
658 changed = 1;
659 strp += 2; /* skip \[ */
660 start = strp;
661 start_idx = start - XSTRING (string)->data;
662
663 while ((strp - (unsigned char *) XSTRING (string)->data
664 < STRING_BYTES (XSTRING (string)))
665 && *strp != ']')
666 strp++;
667 length_byte = strp - start;
668
669 strp++; /* skip ] */
670
671 /* Save STRP in IDX. */
672 idx = strp - (unsigned char *) XSTRING (string)->data;
673 tem = Fintern (make_string (start, length_byte), Qnil);
674
675 /* Note the Fwhere_is_internal can GC, so we have to take
676 relocation of string contents into account. */
677 tem = Fwhere_is_internal (tem, keymap, Qt, Qnil);
678 strp = XSTRING (string)->data + idx;
679 start = XSTRING (string)->data + start_idx;
680
681 /* Disregard menu bar bindings; it is positively annoying to
682 mention them when there's no menu bar, and it isn't terribly
683 useful even when there is a menu bar. */
684 if (!NILP (tem))
685 {
686 firstkey = Faref (tem, make_number (0));
687 if (EQ (firstkey, Qmenu_bar))
688 tem = Qnil;
689 }
690
691 if (NILP (tem)) /* but not on any keys */
692 {
693 new = (unsigned char *) xrealloc (buf, bsize += 4);
694 bufp += new - buf;
695 buf = new;
696 bcopy ("M-x ", bufp, 4);
697 bufp += 4;
698 nchars += 4;
699 if (multibyte)
700 length = multibyte_chars_in_text (start, length_byte);
701 else
702 length = length_byte;
703 goto subst;
704 }
705 else
706 { /* function is on a key */
707 tem = Fkey_description (tem);
708 goto subst_string;
709 }
710 }
711 /* \{foo} is replaced with a summary of the keymap (symbol-value foo).
712 \<foo> just sets the keymap used for \[cmd]. */
713 else if (strp[0] == '\\' && (strp[1] == '{' || strp[1] == '<'))
714 {
715 struct buffer *oldbuf;
716 int start_idx;
717
718 changed = 1;
719 strp += 2; /* skip \{ or \< */
720 start = strp;
721 start_idx = start - XSTRING (string)->data;
722
723 while ((strp - (unsigned char *) XSTRING (string)->data
724 < XSTRING (string)->size)
725 && *strp != '}' && *strp != '>')
726 strp++;
727
728 length_byte = strp - start;
729 strp++; /* skip } or > */
730
731 /* Save STRP in IDX. */
732 idx = strp - (unsigned char *) XSTRING (string)->data;
733
734 /* Get the value of the keymap in TEM, or nil if undefined.
735 Do this while still in the user's current buffer
736 in case it is a local variable. */
737 name = Fintern (make_string (start, length_byte), Qnil);
738 tem = Fboundp (name);
739 if (! NILP (tem))
740 {
741 tem = Fsymbol_value (name);
742 if (! NILP (tem))
743 {
744 tem = get_keymap_1 (tem, 0, 1);
745 /* Note that get_keymap_1 can GC. */
746 strp = XSTRING (string)->data + idx;
747 start = XSTRING (string)->data + start_idx;
748 }
749 }
750
751 /* Now switch to a temp buffer. */
752 oldbuf = current_buffer;
753 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer));
754
755 if (NILP (tem))
756 {
757 name = Fsymbol_name (name);
758 insert_string ("\nUses keymap \"");
759 insert_from_string (name, 0, 0,
760 XSTRING (name)->size,
761 STRING_BYTES (XSTRING (name)), 1);
762 insert_string ("\", which is not currently defined.\n");
763 if (start[-1] == '<') keymap = Qnil;
764 }
765 else if (start[-1] == '<')
766 keymap = tem;
767 else
768 describe_map_tree (tem, 1, Qnil, Qnil, (char *)0, 1, 0, 0);
769 tem = Fbuffer_string ();
770 Ferase_buffer ();
771 set_buffer_internal (oldbuf);
772
773 subst_string:
774 start = XSTRING (tem)->data;
775 length = XSTRING (tem)->size;
776 length_byte = STRING_BYTES (XSTRING (tem));
777 subst:
778 new = (unsigned char *) xrealloc (buf, bsize += length_byte);
779 bufp += new - buf;
780 buf = new;
781 bcopy (start, bufp, length_byte);
782 bufp += length_byte;
783 nchars += length;
784 /* Check STRING again in case gc relocated it. */
785 strp = (unsigned char *) XSTRING (string)->data + idx;
786 }
787 else if (! multibyte) /* just copy other chars */
788 *bufp++ = *strp++, nchars++;
789 else
790 {
791 int len;
792 int maxlen = XSTRING (string)->data + STRING_BYTES (XSTRING (string)) - strp;
793
794 STRING_CHAR_AND_LENGTH (strp, maxlen, len);
795 if (len == 1)
796 *bufp = *strp;
797 else
798 bcopy (strp, bufp, len);
799 strp += len;
800 bufp += len;
801 nchars++;
802 }
803 }
804
805 if (changed) /* don't bother if nothing substituted */
806 tem = make_string_from_bytes (buf, nchars, bufp - buf);
807 else
808 tem = string;
809 xfree (buf);
810 RETURN_UNGCPRO (tem);
811 }
812 \f
813 void
814 syms_of_doc ()
815 {
816 Qfunction_documentation = intern ("function-documentation");
817 staticpro (&Qfunction_documentation);
818
819 DEFVAR_LISP ("internal-doc-file-name", &Vdoc_file_name,
820 "Name of file containing documentation strings of built-in symbols.");
821 Vdoc_file_name = Qnil;
822 DEFVAR_LISP ("help-manyarg-func-alist", &Vhelp_manyarg_func_alist,
823 "Alist of primitive functions and descriptions of their arg lists.\n\
824 All special forms and primitives which effectively have &rest args\n\
825 should have an entry here so that `documentation' can provide their\n\
826 arg list.");
827 Vhelp_manyarg_func_alist = Qnil;
828
829 defsubr (&Sdocumentation);
830 defsubr (&Sdocumentation_property);
831 defsubr (&Ssnarf_documentation);
832 defsubr (&Ssubstitute_command_keys);
833 }