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