Simplify via eabs.
[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 <fcntl.h>
26 #include <unistd.h>
27
28 #include <c-ctype.h>
29
30 #include "lisp.h"
31 #include "character.h"
32 #include "buffer.h"
33 #include "keyboard.h"
34 #include "keymap.h"
35 #include "buildobj.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 USE_SAFE_ALLOCA;
88
89 if (INTEGERP (filepos))
90 {
91 file = Vdoc_file_name;
92 pos = filepos;
93 }
94 else if (CONSP (filepos))
95 {
96 file = XCAR (filepos);
97 pos = XCDR (filepos);
98 }
99 else
100 return Qnil;
101
102 position = eabs (XINT (pos));
103
104 if (!STRINGP (Vdoc_directory))
105 return Qnil;
106
107 if (!STRINGP (file))
108 return Qnil;
109
110 /* Put the file name in NAME as a C string.
111 If it is relative, combine it with Vdoc_directory. */
112
113 tem = Ffile_name_absolute_p (file);
114 file = ENCODE_FILE (file);
115 if (NILP (tem))
116 {
117 Lisp_Object docdir = ENCODE_FILE (Vdoc_directory);
118 minsize = SCHARS (docdir);
119 /* sizeof ("../etc/") == 8 */
120 if (minsize < 8)
121 minsize = 8;
122 name = SAFE_ALLOCA (minsize + SCHARS (file) + 8);
123 strcpy (name, SSDATA (docdir));
124 strcat (name, SSDATA (file));
125 }
126 else
127 {
128 name = SSDATA (file);
129 }
130
131 fd = emacs_open (name, O_RDONLY, 0);
132 if (fd < 0)
133 {
134 #ifndef CANNOT_DUMP
135 if (!NILP (Vpurify_flag))
136 {
137 /* Preparing to dump; DOC file is probably not installed.
138 So check in ../etc. */
139 strcpy (name, "../etc/");
140 strcat (name, SSDATA (file));
141
142 fd = emacs_open (name, O_RDONLY, 0);
143 }
144 #endif
145 if (fd < 0)
146 return concat3 (build_string ("Cannot open doc string file \""),
147 file, build_string ("\"\n"));
148 }
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 {
157 emacs_close (fd);
158 error ("Position %"pI"d out of range in doc string file \"%s\"",
159 position, name);
160 }
161
162 SAFE_FREE ();
163
164 /* Read the doc string into get_doc_string_buffer.
165 P points beyond the data just read. */
166
167 p = get_doc_string_buffer;
168 while (1)
169 {
170 ptrdiff_t space_left = (get_doc_string_buffer_size - 1
171 - (p - get_doc_string_buffer));
172 int nread;
173
174 /* Allocate or grow the buffer if we need to. */
175 if (space_left <= 0)
176 {
177 ptrdiff_t in_buffer = p - get_doc_string_buffer;
178 get_doc_string_buffer =
179 xpalloc (get_doc_string_buffer, &get_doc_string_buffer_size,
180 16 * 1024, -1, 1);
181 p = get_doc_string_buffer + in_buffer;
182 space_left = (get_doc_string_buffer_size - 1
183 - (p - get_doc_string_buffer));
184 }
185
186 /* Read a disk block at a time.
187 If we read the same block last time, maybe skip this? */
188 if (space_left > 1024 * 8)
189 space_left = 1024 * 8;
190 nread = emacs_read (fd, p, space_left);
191 if (nread < 0)
192 {
193 emacs_close (fd);
194 error ("Read error on documentation file");
195 }
196 p[nread] = 0;
197 if (!nread)
198 break;
199 if (p == get_doc_string_buffer)
200 p1 = strchr (p + offset, '\037');
201 else
202 p1 = strchr (p, '\037');
203 if (p1)
204 {
205 *p1 = 0;
206 p = p1;
207 break;
208 }
209 p += nread;
210 }
211 emacs_close (fd);
212
213 /* Sanity checking. */
214 if (CONSP (filepos))
215 {
216 int test = 1;
217 if (get_doc_string_buffer[offset - test++] != ' ')
218 return Qnil;
219 while (get_doc_string_buffer[offset - test] >= '0'
220 && get_doc_string_buffer[offset - test] <= '9')
221 test++;
222 if (get_doc_string_buffer[offset - test++] != '@'
223 || get_doc_string_buffer[offset - test] != '#')
224 return Qnil;
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 /* Check for a dynamic docstring. These come with
414 a dynamic-docstring-function text property. */
415 if (STRINGP (doc))
416 {
417 Lisp_Object func
418 = Fget_text_property (make_number (0),
419 intern ("dynamic-docstring-function"),
420 doc);
421 if (!NILP (func))
422 /* Pass both `doc' and `function' since `function' can be needed, and
423 finding `doc' can be annoying: calling `documentation' is not an
424 option because it would infloop. */
425 doc = call2 (func, doc, function);
426 }
427
428 /* If DOC is 0, it's typically because of a dumped file missing
429 from the DOC file (bug in src/Makefile.in). */
430 if (EQ (doc, make_number (0)))
431 doc = Qnil;
432 if (INTEGERP (doc) || CONSP (doc))
433 {
434 Lisp_Object tem;
435 tem = get_doc_string (doc, 0, 0);
436 if (NILP (tem) && try_reload)
437 {
438 /* The file is newer, we need to reset the pointers. */
439 struct gcpro gcpro1, gcpro2;
440 GCPRO2 (function, raw);
441 try_reload = reread_doc_file (Fcar_safe (doc));
442 UNGCPRO;
443 if (try_reload)
444 {
445 try_reload = 0;
446 goto documentation;
447 }
448 }
449 else
450 doc = tem;
451 }
452
453 if (NILP (raw))
454 doc = Fsubstitute_command_keys (doc);
455 return doc;
456 }
457
458 DEFUN ("documentation-property", Fdocumentation_property,
459 Sdocumentation_property, 2, 3, 0,
460 doc: /* Return the documentation string that is SYMBOL's PROP property.
461 Third argument RAW omitted or nil means pass the result through
462 `substitute-command-keys' if it is a string.
463
464 This differs from `get' in that it can refer to strings stored in the
465 `etc/DOC' file; and that it evaluates documentation properties that
466 aren't strings. */)
467 (Lisp_Object symbol, Lisp_Object prop, Lisp_Object raw)
468 {
469 bool try_reload = 1;
470 Lisp_Object tem;
471
472 documentation_property:
473
474 tem = Fget (symbol, prop);
475 if (EQ (tem, make_number (0)))
476 tem = Qnil;
477 if (INTEGERP (tem) || (CONSP (tem) && INTEGERP (XCDR (tem))))
478 {
479 Lisp_Object doc = tem;
480 tem = get_doc_string (tem, 0, 0);
481 if (NILP (tem) && try_reload)
482 {
483 /* The file is newer, we need to reset the pointers. */
484 struct gcpro gcpro1, gcpro2, gcpro3;
485 GCPRO3 (symbol, prop, raw);
486 try_reload = reread_doc_file (Fcar_safe (doc));
487 UNGCPRO;
488 if (try_reload)
489 {
490 try_reload = 0;
491 goto documentation_property;
492 }
493 }
494 }
495 else if (!STRINGP (tem))
496 /* Feval protects its argument. */
497 tem = Feval (tem, Qnil);
498
499 if (NILP (raw) && STRINGP (tem))
500 tem = Fsubstitute_command_keys (tem);
501 return tem;
502 }
503 \f
504 /* Scanning the DOC files and placing docstring offsets into functions. */
505
506 static void
507 store_function_docstring (Lisp_Object obj, ptrdiff_t offset)
508 {
509 /* Don't use indirect_function here, or defaliases will apply their
510 docstrings to the base functions (Bug#2603). */
511 Lisp_Object fun = SYMBOLP (obj) ? XSYMBOL (obj)->function : obj;
512
513 /* The type determines where the docstring is stored. */
514
515 /* Lisp_Subrs have a slot for it. */
516 if (SUBRP (fun))
517 {
518 intptr_t negative_offset = - offset;
519 XSUBR (fun)->doc = (char *) negative_offset;
520 }
521
522 /* If it's a lisp form, stick it in the form. */
523 else if (CONSP (fun))
524 {
525 Lisp_Object tem;
526
527 tem = XCAR (fun);
528 if (EQ (tem, Qlambda) || EQ (tem, Qautoload)
529 || (EQ (tem, Qclosure) && (fun = XCDR (fun), 1)))
530 {
531 tem = Fcdr (Fcdr (fun));
532 if (CONSP (tem) && INTEGERP (XCAR (tem)))
533 /* FIXME: This modifies typically pure hash-cons'd data, so its
534 correctness is quite delicate. */
535 XSETCAR (tem, make_number (offset));
536 }
537 else if (EQ (tem, Qmacro))
538 store_function_docstring (XCDR (fun), offset);
539 }
540
541 /* Bytecode objects sometimes have slots for it. */
542 else if (COMPILEDP (fun))
543 {
544 /* This bytecode object must have a slot for the
545 docstring, since we've found a docstring for it. */
546 if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) > COMPILED_DOC_STRING)
547 ASET (fun, COMPILED_DOC_STRING, make_number (offset));
548 }
549 }
550
551 static const char buildobj[] = BUILDOBJ;
552
553 DEFUN ("Snarf-documentation", Fsnarf_documentation, Ssnarf_documentation,
554 1, 1, 0,
555 doc: /* Used during Emacs initialization to scan the `etc/DOC...' file.
556 This searches the `etc/DOC...' file for doc strings and
557 records them in function and variable definitions.
558 The function takes one argument, FILENAME, a string;
559 it specifies the file name (without a directory) of the DOC file.
560 That file is found in `../etc' now; later, when the dumped Emacs is run,
561 the same file name is found in the `doc-directory'. */)
562 (Lisp_Object filename)
563 {
564 int fd;
565 char buf[1024 + 1];
566 int filled;
567 EMACS_INT pos;
568 Lisp_Object sym;
569 char *p, *name;
570 bool skip_file = 0;
571
572 CHECK_STRING (filename);
573
574 if
575 #ifndef CANNOT_DUMP
576 (!NILP (Vpurify_flag))
577 #else /* CANNOT_DUMP */
578 (0)
579 #endif /* CANNOT_DUMP */
580 {
581 name = alloca (SCHARS (filename) + 14);
582 strcpy (name, "../etc/");
583 }
584 else
585 {
586 CHECK_STRING (Vdoc_directory);
587 name = alloca (SCHARS (filename) + SCHARS (Vdoc_directory) + 1);
588 strcpy (name, SSDATA (Vdoc_directory));
589 }
590 strcat (name, SSDATA (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 const char *beg, *end;
596
597 for (beg = buildobj; *beg; beg = end)
598 {
599 ptrdiff_t len;
600
601 while (*beg && c_isspace (*beg)) ++beg;
602
603 for (end = beg; *end && ! c_isspace (*end); ++end)
604 if (*end == '/') beg = end+1; /* skip directory part */
605
606 len = end - beg;
607 if (len > 4 && end[-4] == '.' && end[-3] == 'o')
608 len -= 2; /* Just take .o if it ends in .obj */
609
610 if (len > 0)
611 Vbuild_files = Fcons (make_string (beg, len), Vbuild_files);
612 }
613 Vbuild_files = Fpurecopy (Vbuild_files);
614 }
615
616 fd = emacs_open (name, O_RDONLY, 0);
617 if (fd < 0)
618 report_file_error ("Opening doc string file",
619 Fcons (build_string (name), Qnil));
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 p = buf;
633 end = buf + (filled < 512 ? filled : filled - 128);
634 while (p != end && *p != '\037') p++;
635 /* p points to ^_Ffunctionname\n or ^_Vvarname\n or ^_Sfilename\n. */
636 if (p != end)
637 {
638 end = strchr (p, '\n');
639
640 /* See if this is a file name, and if it is a file in build-files. */
641 if (p[1] == 'S')
642 {
643 skip_file = 0;
644 if (end - p > 4 && end[-2] == '.'
645 && (end[-1] == 'o' || end[-1] == 'c'))
646 {
647 ptrdiff_t len = end - p - 2;
648 char *fromfile = alloca (len + 1);
649 memcpy (fromfile, &p[2], len);
650 fromfile[len] = 0;
651 if (fromfile[len-1] == 'c')
652 fromfile[len-1] = 'o';
653
654 skip_file = NILP (Fmember (build_string (fromfile),
655 Vbuild_files));
656 }
657 }
658
659 sym = oblookup (Vobarray, p + 2,
660 multibyte_chars_in_text ((unsigned char *) p + 2,
661 end - p - 2),
662 end - p - 2);
663 /* Check skip_file so that when a function is defined several
664 times in different files (typically, once in xterm, once in
665 w32term, ...), we only pay attention to the one that
666 matters. */
667 if (! skip_file && SYMBOLP (sym))
668 {
669 /* Attach a docstring to a variable? */
670 if (p[1] == 'V')
671 {
672 /* Install file-position as variable-documentation property
673 and make it negative for a user-variable
674 (doc starts with a `*'). */
675 if (!NILP (Fboundp (sym)))
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 emacs_close (fd);
699 return Qnil;
700 }
701 \f
702 DEFUN ("substitute-command-keys", Fsubstitute_command_keys,
703 Ssubstitute_command_keys, 1, 1, 0,
704 doc: /* Substitute key descriptions for command names in STRING.
705 Each substring of the form \\=\\[COMMAND] is replaced by either a
706 keystroke sequence that invokes COMMAND, or "M-x COMMAND" if COMMAND
707 is not on any keys.
708
709 Each substring of the form \\=\\{MAPVAR} is replaced by a summary of
710 the value of MAPVAR as a keymap. This summary is similar to the one
711 produced by `describe-bindings'. The summary ends in two newlines
712 \(used by the helper function `help-make-xrefs' to find the end of the
713 summary).
714
715 Each substring of the form \\=\\<MAPVAR> specifies the use of MAPVAR
716 as the keymap for future \\=\\[COMMAND] substrings.
717 \\=\\= quotes the following character and is discarded;
718 thus, \\=\\=\\=\\= puts \\=\\= into the output, and \\=\\=\\=\\[ puts \\=\\[ into the output.
719
720 Return the original STRING if no substitutions are made.
721 Otherwise, return a new string, without any text properties. */)
722 (Lisp_Object string)
723 {
724 char *buf;
725 bool changed = 0;
726 unsigned char *strp;
727 char *bufp;
728 ptrdiff_t idx;
729 ptrdiff_t bsize;
730 Lisp_Object tem;
731 Lisp_Object keymap;
732 unsigned char *start;
733 ptrdiff_t length, length_byte;
734 Lisp_Object name;
735 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
736 bool multibyte;
737 ptrdiff_t nchars;
738
739 if (NILP (string))
740 return Qnil;
741
742 CHECK_STRING (string);
743 tem = Qnil;
744 keymap = Qnil;
745 name = Qnil;
746 GCPRO4 (string, tem, keymap, name);
747
748 multibyte = STRING_MULTIBYTE (string);
749 nchars = 0;
750
751 /* KEYMAP is either nil (which means search all the active keymaps)
752 or a specified local map (which means search just that and the
753 global map). If non-nil, it might come from Voverriding_local_map,
754 or from a \\<mapname> construct in STRING itself.. */
755 keymap = KVAR (current_kboard, Voverriding_terminal_local_map);
756 if (NILP (keymap))
757 keymap = Voverriding_local_map;
758
759 bsize = SBYTES (string);
760 bufp = buf = xmalloc (bsize);
761
762 strp = SDATA (string);
763 while (strp < SDATA (string) + SBYTES (string))
764 {
765 if (strp[0] == '\\' && strp[1] == '=')
766 {
767 /* \= quotes the next character;
768 thus, to put in \[ without its special meaning, use \=\[. */
769 changed = 1;
770 strp += 2;
771 if (multibyte)
772 {
773 int len;
774
775 STRING_CHAR_AND_LENGTH (strp, len);
776 if (len == 1)
777 *bufp = *strp;
778 else
779 memcpy (bufp, strp, len);
780 strp += len;
781 bufp += len;
782 nchars++;
783 }
784 else
785 *bufp++ = *strp++, nchars++;
786 }
787 else if (strp[0] == '\\' && strp[1] == '[')
788 {
789 ptrdiff_t start_idx;
790 bool follow_remap = 1;
791
792 changed = 1;
793 strp += 2; /* skip \[ */
794 start = strp;
795 start_idx = start - SDATA (string);
796
797 while ((strp - SDATA (string)
798 < SBYTES (string))
799 && *strp != ']')
800 strp++;
801 length_byte = strp - start;
802
803 strp++; /* skip ] */
804
805 /* Save STRP in IDX. */
806 idx = strp - SDATA (string);
807 name = Fintern (make_string ((char *) start, length_byte), Qnil);
808
809 do_remap:
810 tem = Fwhere_is_internal (name, keymap, Qt, Qnil, Qnil);
811
812 if (VECTORP (tem) && ASIZE (tem) > 1
813 && EQ (AREF (tem, 0), Qremap) && SYMBOLP (AREF (tem, 1))
814 && follow_remap)
815 {
816 name = AREF (tem, 1);
817 follow_remap = 0;
818 goto do_remap;
819 }
820
821 /* Note the Fwhere_is_internal can GC, so we have to take
822 relocation of string contents into account. */
823 strp = SDATA (string) + idx;
824 start = SDATA (string) + start_idx;
825
826 if (NILP (tem)) /* but not on any keys */
827 {
828 ptrdiff_t offset = bufp - buf;
829 if (STRING_BYTES_BOUND - 4 < bsize)
830 string_overflow ();
831 buf = xrealloc (buf, bsize += 4);
832 bufp = buf + offset;
833 memcpy (bufp, "M-x ", 4);
834 bufp += 4;
835 nchars += 4;
836 if (multibyte)
837 length = multibyte_chars_in_text (start, length_byte);
838 else
839 length = length_byte;
840 goto subst;
841 }
842 else
843 { /* function is on a key */
844 tem = Fkey_description (tem, Qnil);
845 goto subst_string;
846 }
847 }
848 /* \{foo} is replaced with a summary of the keymap (symbol-value foo).
849 \<foo> just sets the keymap used for \[cmd]. */
850 else if (strp[0] == '\\' && (strp[1] == '{' || strp[1] == '<'))
851 {
852 struct buffer *oldbuf;
853 ptrdiff_t start_idx;
854 /* This is for computing the SHADOWS arg for describe_map_tree. */
855 Lisp_Object active_maps = Fcurrent_active_maps (Qnil, Qnil);
856 Lisp_Object earlier_maps;
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
894 if (NILP (tem))
895 {
896 name = Fsymbol_name (name);
897 insert_string ("\nUses keymap `");
898 insert_from_string (name, 0, 0,
899 SCHARS (name),
900 SBYTES (name), 1);
901 insert_string ("', which is not currently defined.\n");
902 if (start[-1] == '<') keymap = Qnil;
903 }
904 else if (start[-1] == '<')
905 keymap = tem;
906 else
907 {
908 /* Get the list of active keymaps that precede this one.
909 If this one's not active, get nil. */
910 earlier_maps = Fcdr (Fmemq (tem, Freverse (active_maps)));
911 describe_map_tree (tem, 1, Fnreverse (earlier_maps),
912 Qnil, (char *)0, 1, 0, 0, 1);
913 }
914 tem = Fbuffer_string ();
915 Ferase_buffer ();
916 set_buffer_internal (oldbuf);
917
918 subst_string:
919 start = SDATA (tem);
920 length = SCHARS (tem);
921 length_byte = SBYTES (tem);
922 subst:
923 {
924 ptrdiff_t offset = bufp - buf;
925 if (STRING_BYTES_BOUND - length_byte < bsize)
926 string_overflow ();
927 buf = xrealloc (buf, bsize += length_byte);
928 bufp = buf + offset;
929 memcpy (bufp, start, length_byte);
930 bufp += length_byte;
931 nchars += length;
932 /* Check STRING again in case gc relocated it. */
933 strp = SDATA (string) + idx;
934 }
935 }
936 else if (! multibyte) /* just copy other chars */
937 *bufp++ = *strp++, nchars++;
938 else
939 {
940 int len;
941
942 STRING_CHAR_AND_LENGTH (strp, len);
943 if (len == 1)
944 *bufp = *strp;
945 else
946 memcpy (bufp, strp, len);
947 strp += len;
948 bufp += len;
949 nchars++;
950 }
951 }
952
953 if (changed) /* don't bother if nothing substituted */
954 tem = make_string_from_bytes (buf, nchars, bufp - buf);
955 else
956 tem = string;
957 xfree (buf);
958 RETURN_UNGCPRO (tem);
959 }
960 \f
961 void
962 syms_of_doc (void)
963 {
964 DEFSYM (Qfunction_documentation, "function-documentation");
965
966 DEFVAR_LISP ("internal-doc-file-name", Vdoc_file_name,
967 doc: /* Name of file containing documentation strings of built-in symbols. */);
968 Vdoc_file_name = Qnil;
969
970 DEFVAR_LISP ("build-files", Vbuild_files,
971 doc: /* A list of files used to build this Emacs binary. */);
972 Vbuild_files = Qnil;
973
974 defsubr (&Sdocumentation);
975 defsubr (&Sdocumentation_property);
976 defsubr (&Ssnarf_documentation);
977 defsubr (&Ssubstitute_command_keys);
978 }