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