Fix minor problems found by static checking.
[bpt/emacs.git] / src / doc.c
1 /* Record indices of function doc strings stored in a file.
2
3 Copyright (C) 1985-1986, 1993-1995, 1997-2012 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 <setjmp.h>
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 #include "buildobj.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 /* readchar in lread.c calls back here to fetch the next byte.
47 If UNREADFLAG is 1, we unread a byte. */
48
49 int
50 read_bytecode_char (bool unreadflag)
51 {
52 if (unreadflag)
53 {
54 read_bytecode_pointer--;
55 return 0;
56 }
57 return *read_bytecode_pointer++;
58 }
59
60 /* Extract a doc string from a file. FILEPOS says where to get it.
61 If it is an integer, use that position in the standard DOC-... file.
62 If it is (FILE . INTEGER), use FILE as the file name
63 and INTEGER as the position in that file.
64 But if INTEGER is negative, make it positive.
65 (A negative integer is used for user variables, so we can distinguish
66 them without actually fetching the doc string.)
67
68 If the location does not point to the beginning of a docstring
69 (e.g. because the file has been modified and the location is stale),
70 return nil.
71
72 If UNIBYTE, always make a unibyte string.
73
74 If DEFINITION, assume this is for reading
75 a dynamic function definition; convert the bytestring
76 and the constants vector with appropriate byte handling,
77 and return a cons cell. */
78
79 Lisp_Object
80 get_doc_string (Lisp_Object filepos, bool unibyte, bool definition)
81 {
82 char *from, *to, *name, *p, *p1;
83 int fd;
84 ptrdiff_t minsize;
85 int offset;
86 EMACS_INT position;
87 Lisp_Object file, tem;
88 USE_SAFE_ALLOCA;
89
90 if (INTEGERP (filepos))
91 {
92 file = Vdoc_file_name;
93 position = XINT (filepos);
94 }
95 else if (CONSP (filepos))
96 {
97 file = XCAR (filepos);
98 position = XINT (XCDR (filepos));
99 }
100 else
101 return Qnil;
102
103 if (position < 0)
104 position = - position;
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 if (NILP (tem))
118 {
119 Lisp_Object docdir = ENCODE_FILE (Vdoc_directory);
120 minsize = SCHARS (docdir);
121 /* sizeof ("../etc/") == 8 */
122 if (minsize < 8)
123 minsize = 8;
124 name = SAFE_ALLOCA (minsize + SCHARS (file) + 8);
125 strcpy (name, SSDATA (docdir));
126 strcat (name, SSDATA (file));
127 }
128 else
129 {
130 name = SSDATA (file);
131 }
132
133 fd = emacs_open (name, O_RDONLY, 0);
134 if (fd < 0)
135 {
136 #ifndef CANNOT_DUMP
137 if (!NILP (Vpurify_flag))
138 {
139 /* Preparing to dump; DOC file is probably not installed.
140 So check in ../etc. */
141 strcpy (name, "../etc/");
142 strcat (name, SSDATA (file));
143
144 fd = emacs_open (name, O_RDONLY, 0);
145 }
146 #endif
147 if (fd < 0)
148 error ("Cannot open doc string file \"%s\"", name);
149 }
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 {
158 emacs_close (fd);
159 error ("Position %"pI"d out of range in doc string file \"%s\"",
160 position, name);
161 }
162
163 SAFE_FREE ();
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 ptrdiff_t 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 bool
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 bool 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 = 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 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 bool 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 obj, ptrdiff_t offset)
506 {
507 /* Don't use indirect_function here, or defaliases will apply their
508 docstrings to the base functions (Bug#2603). */
509 Lisp_Object fun = SYMBOLP (obj) ? XSYMBOL (obj)->function : obj;
510
511 /* The type determines where the docstring is stored. */
512
513 /* Lisp_Subrs have a slot for it. */
514 if (SUBRP (fun))
515 {
516 intptr_t negative_offset = - offset;
517 XSUBR (fun)->doc = (char *) negative_offset;
518 }
519
520 /* If it's a lisp form, stick it in the form. */
521 else if (CONSP (fun))
522 {
523 Lisp_Object tem;
524
525 tem = XCAR (fun);
526 if (EQ (tem, Qlambda) || EQ (tem, Qautoload)
527 || (EQ (tem, Qclosure) && (fun = XCDR (fun), 1)))
528 {
529 tem = Fcdr (Fcdr (fun));
530 if (CONSP (tem) && INTEGERP (XCAR (tem)))
531 XSETCAR (tem, make_number (offset));
532 }
533 else if (EQ (tem, Qmacro))
534 store_function_docstring (XCDR (fun), offset);
535 }
536
537 /* Bytecode objects sometimes have slots for it. */
538 else if (COMPILEDP (fun))
539 {
540 /* This bytecode object must have a slot for the
541 docstring, since we've found a docstring for it. */
542 if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) > COMPILED_DOC_STRING)
543 ASET (fun, COMPILED_DOC_STRING, make_number (offset));
544 }
545 }
546
547 static const char buildobj[] = BUILDOBJ;
548
549 DEFUN ("Snarf-documentation", Fsnarf_documentation, Ssnarf_documentation,
550 1, 1, 0,
551 doc: /* Used during Emacs initialization to scan the `etc/DOC...' file.
552 This searches the `etc/DOC...' file for doc strings and
553 records them in function and variable definitions.
554 The function takes one argument, FILENAME, a string;
555 it specifies the file name (without a directory) of the DOC file.
556 That file is found in `../etc' now; later, when the dumped Emacs is run,
557 the same file name is found in the `doc-directory'. */)
558 (Lisp_Object filename)
559 {
560 int fd;
561 char buf[1024 + 1];
562 int filled;
563 EMACS_INT pos;
564 Lisp_Object sym;
565 char *p, *name;
566 bool 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 = alloca (SCHARS (filename) + 14);
578 strcpy (name, "../etc/");
579 }
580 else
581 {
582 CHECK_STRING (Vdoc_directory);
583 name = alloca (SCHARS (filename) + SCHARS (Vdoc_directory) + 1);
584 strcpy (name, SSDATA (Vdoc_directory));
585 }
586 strcat (name, SSDATA (filename)); /*** Add this line ***/
587
588 /* Vbuild_files is nil when temacs is run, and non-nil after that. */
589 if (NILP (Vbuild_files))
590 {
591 const char *beg, *end;
592
593 for (beg = buildobj; *beg; beg = end)
594 {
595 ptrdiff_t len;
596
597 while (*beg && c_isspace (*beg)) ++beg;
598
599 for (end = beg; *end && ! c_isspace (*end); ++end)
600 if (*end == '/') beg = end+1; /* skip directory part */
601
602 len = end - beg;
603 if (len > 4 && end[-4] == '.' && end[-3] == 'o')
604 len -= 2; /* Just take .o if it ends in .obj */
605
606 if (len > 0)
607 Vbuild_files = Fcons (make_string (beg, len), Vbuild_files);
608 }
609 Vbuild_files = Fpurecopy (Vbuild_files);
610 }
611
612 fd = emacs_open (name, O_RDONLY, 0);
613 if (fd < 0)
614 report_file_error ("Opening doc string file",
615 Fcons (build_string (name), Qnil));
616 Vdoc_file_name = filename;
617 filled = 0;
618 pos = 0;
619 while (1)
620 {
621 register char *end;
622 if (filled < 512)
623 filled += emacs_read (fd, &buf[filled], sizeof buf - 1 - filled);
624 if (!filled)
625 break;
626
627 buf[filled] = 0;
628 p = buf;
629 end = buf + (filled < 512 ? filled : filled - 128);
630 while (p != end && *p != '\037') p++;
631 /* p points to ^_Ffunctionname\n or ^_Vvarname\n or ^_Sfilename\n. */
632 if (p != end)
633 {
634 end = strchr (p, '\n');
635
636 /* See if this is a file name, and if it is a file in build-files. */
637 if (p[1] == 'S')
638 {
639 skip_file = 0;
640 if (end - p > 4 && end[-2] == '.'
641 && (end[-1] == 'o' || end[-1] == 'c'))
642 {
643 ptrdiff_t len = end - p - 2;
644 char *fromfile = alloca (len + 1);
645 memcpy (fromfile, &p[2], len);
646 fromfile[len] = 0;
647 if (fromfile[len-1] == 'c')
648 fromfile[len-1] = 'o';
649
650 skip_file = NILP (Fmember (build_string (fromfile),
651 Vbuild_files));
652 }
653 }
654
655 sym = oblookup (Vobarray, p + 2,
656 multibyte_chars_in_text ((unsigned char *) p + 2,
657 end - p - 2),
658 end - p - 2);
659 /* Check skip_file so that when a function is defined several
660 times in different files (typically, once in xterm, once in
661 w32term, ...), we only pay attention to the one that
662 matters. */
663 if (! skip_file && SYMBOLP (sym))
664 {
665 /* Attach a docstring to a variable? */
666 if (p[1] == 'V')
667 {
668 /* Install file-position as variable-documentation property
669 and make it negative for a user-variable
670 (doc starts with a `*'). */
671 if (!NILP (Fboundp (sym)))
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 {
680 if (!NILP (Ffboundp (sym)))
681 store_function_docstring (sym, pos + end + 1 - buf);
682 }
683 else if (p[1] == 'S')
684 ; /* Just a source file name boundary marker. Ignore it. */
685
686 else
687 error ("DOC file invalid at position %"pI"d", pos);
688 }
689 }
690 pos += end - buf;
691 filled -= end - buf;
692 memmove (buf, end, filled);
693 }
694 emacs_close (fd);
695 return Qnil;
696 }
697 \f
698 DEFUN ("substitute-command-keys", Fsubstitute_command_keys,
699 Ssubstitute_command_keys, 1, 1, 0,
700 doc: /* Substitute key descriptions for command names in STRING.
701 Each substring of the form \\=\\[COMMAND] is replaced by either a
702 keystroke sequence that invokes COMMAND, or "M-x COMMAND" if COMMAND
703 is not on any keys.
704
705 Each substring of the form \\=\\{MAPVAR} is replaced by a summary of
706 the value of MAPVAR as a keymap. This summary is similar to the one
707 produced by `describe-bindings'. The summary ends in two newlines
708 \(used by the helper function `help-make-xrefs' to find the end of the
709 summary).
710
711 Each substring of the form \\=\\<MAPVAR> specifies the use of MAPVAR
712 as the keymap for future \\=\\[COMMAND] substrings.
713 \\=\\= quotes the following character and is discarded;
714 thus, \\=\\=\\=\\= puts \\=\\= into the output, and \\=\\=\\=\\[ puts \\=\\[ into the output.
715
716 Return the original STRING if no substitutions are made.
717 Otherwise, return a new string, without any text properties. */)
718 (Lisp_Object string)
719 {
720 char *buf;
721 bool changed = 0;
722 unsigned char *strp;
723 char *bufp;
724 ptrdiff_t idx;
725 ptrdiff_t bsize;
726 Lisp_Object tem;
727 Lisp_Object keymap;
728 unsigned char *start;
729 ptrdiff_t length, length_byte;
730 Lisp_Object name;
731 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
732 bool multibyte;
733 ptrdiff_t nchars;
734
735 if (NILP (string))
736 return Qnil;
737
738 CHECK_STRING (string);
739 tem = Qnil;
740 keymap = Qnil;
741 name = Qnil;
742 GCPRO4 (string, tem, keymap, name);
743
744 multibyte = STRING_MULTIBYTE (string);
745 nchars = 0;
746
747 /* KEYMAP is either nil (which means search all the active keymaps)
748 or a specified local map (which means search just that and the
749 global map). If non-nil, it might come from Voverriding_local_map,
750 or from a \\<mapname> construct in STRING itself.. */
751 keymap = KVAR (current_kboard, Voverriding_terminal_local_map);
752 if (NILP (keymap))
753 keymap = Voverriding_local_map;
754
755 bsize = SBYTES (string);
756 bufp = buf = xmalloc (bsize);
757
758 strp = SDATA (string);
759 while (strp < SDATA (string) + SBYTES (string))
760 {
761 if (strp[0] == '\\' && strp[1] == '=')
762 {
763 /* \= quotes the next character;
764 thus, to put in \[ without its special meaning, use \=\[. */
765 changed = 1;
766 strp += 2;
767 if (multibyte)
768 {
769 int len;
770
771 STRING_CHAR_AND_LENGTH (strp, len);
772 if (len == 1)
773 *bufp = *strp;
774 else
775 memcpy (bufp, strp, len);
776 strp += len;
777 bufp += len;
778 nchars++;
779 }
780 else
781 *bufp++ = *strp++, nchars++;
782 }
783 else if (strp[0] == '\\' && strp[1] == '[')
784 {
785 ptrdiff_t start_idx;
786 bool follow_remap = 1;
787
788 changed = 1;
789 strp += 2; /* skip \[ */
790 start = strp;
791 start_idx = start - SDATA (string);
792
793 while ((strp - SDATA (string)
794 < SBYTES (string))
795 && *strp != ']')
796 strp++;
797 length_byte = strp - start;
798
799 strp++; /* skip ] */
800
801 /* Save STRP in IDX. */
802 idx = strp - SDATA (string);
803 name = Fintern (make_string ((char *) start, length_byte), Qnil);
804
805 do_remap:
806 tem = Fwhere_is_internal (name, keymap, Qt, Qnil, Qnil);
807
808 if (VECTORP (tem) && ASIZE (tem) > 1
809 && EQ (AREF (tem, 0), Qremap) && SYMBOLP (AREF (tem, 1))
810 && follow_remap)
811 {
812 name = AREF (tem, 1);
813 follow_remap = 0;
814 goto do_remap;
815 }
816
817 /* Note the Fwhere_is_internal can GC, so we have to take
818 relocation of string contents into account. */
819 strp = SDATA (string) + idx;
820 start = SDATA (string) + start_idx;
821
822 if (NILP (tem)) /* but not on any keys */
823 {
824 ptrdiff_t offset = bufp - buf;
825 if (STRING_BYTES_BOUND - 4 < bsize)
826 string_overflow ();
827 buf = xrealloc (buf, bsize += 4);
828 bufp = buf + offset;
829 memcpy (bufp, "M-x ", 4);
830 bufp += 4;
831 nchars += 4;
832 if (multibyte)
833 length = multibyte_chars_in_text (start, length_byte);
834 else
835 length = length_byte;
836 goto subst;
837 }
838 else
839 { /* function is on a key */
840 tem = Fkey_description (tem, Qnil);
841 goto subst_string;
842 }
843 }
844 /* \{foo} is replaced with a summary of the keymap (symbol-value foo).
845 \<foo> just sets the keymap used for \[cmd]. */
846 else if (strp[0] == '\\' && (strp[1] == '{' || strp[1] == '<'))
847 {
848 struct buffer *oldbuf;
849 ptrdiff_t start_idx;
850 /* This is for computing the SHADOWS arg for describe_map_tree. */
851 Lisp_Object active_maps;
852 Lisp_Object earlier_maps;
853
854 active_maps = Fcurrent_active_maps (Qnil, Qnil);
855 changed = 1;
856 strp += 2; /* skip \{ or \< */
857 start = strp;
858 start_idx = start - SDATA (string);
859
860 while ((strp - SDATA (string) < SBYTES (string))
861 && *strp != '}' && *strp != '>')
862 strp++;
863
864 length_byte = strp - start;
865 strp++; /* skip } or > */
866
867 /* Save STRP in IDX. */
868 idx = strp - SDATA (string);
869
870 /* Get the value of the keymap in TEM, or nil if undefined.
871 Do this while still in the user's current buffer
872 in case it is a local variable. */
873 name = Fintern (make_string ((char *) start, length_byte), Qnil);
874 tem = Fboundp (name);
875 if (! NILP (tem))
876 {
877 tem = Fsymbol_value (name);
878 if (! NILP (tem))
879 {
880 tem = get_keymap (tem, 0, 1);
881 /* Note that get_keymap can GC. */
882 strp = SDATA (string) + idx;
883 start = SDATA (string) + start_idx;
884 }
885 }
886
887 /* Now switch to a temp buffer. */
888 oldbuf = current_buffer;
889 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer));
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, (char *)0, 1, 0, 0, 1);
910 }
911 tem = Fbuffer_string ();
912 Ferase_buffer ();
913 set_buffer_internal (oldbuf);
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 }