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