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