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