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