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