use dynwind_begin and dynwind_end
[bpt/emacs.git] / src / doc.c
CommitLineData
c6045832 1/* Record indices of function doc strings stored in a file.
05920a43 2
2241d76e 3Copyright (C) 1985-1986, 1993-1995, 1997-2014 Free Software Foundation, Inc.
c6045832
JB
4
5This file is part of GNU Emacs.
6
9ec0b715 7GNU Emacs is free software: you can redistribute it and/or modify
c6045832 8it under the terms of the GNU General Public License as published by
9ec0b715
GM
9the Free Software Foundation, either version 3 of the License, or
10(at your option) any later version.
c6045832
JB
11
12GNU Emacs is distributed in the hope that it will be useful,
13but WITHOUT ANY WARRANTY; without even the implied warranty of
14MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15GNU General Public License for more details.
16
17You should have received a copy of the GNU General Public License
9ec0b715 18along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
c6045832
JB
19
20
18160b98 21#include <config.h>
c6045832 22
b648c163 23#include <errno.h>
c6045832 24#include <sys/types.h>
57618ecf 25#include <sys/file.h> /* Must be after sys/types.h for USG. */
c6045832 26#include <fcntl.h>
29beb080 27#include <unistd.h>
29beb080 28
620f13b0
PE
29#include <c-ctype.h>
30
c6045832 31#include "lisp.h"
e5560ff7 32#include "character.h"
c6045832 33#include "buffer.h"
665d3046 34#include "keyboard.h"
8feddab4 35#include "keymap.h"
c6045832 36
9191c8ae
GM
37Lisp_Object Qfunction_documentation;
38
912e8480
RS
39/* Buffer used for reading from documentation file. */
40static char *get_doc_string_buffer;
3d0c92a2 41static ptrdiff_t get_doc_string_buffer_size;
912e8480 42
32caae30
RS
43static unsigned char *read_bytecode_pointer;
44
57618ecf 45/* `readchar' in lread.c calls back here to fetch the next byte.
32caae30
RS
46 If UNREADFLAG is 1, we unread a byte. */
47
48int
a08d4ba7 49read_bytecode_char (bool unreadflag)
32caae30
RS
50{
51 if (unreadflag)
52 {
53 read_bytecode_pointer--;
54 return 0;
55 }
56 return *read_bytecode_pointer++;
57}
58
700ea809 59/* Extract a doc string from a file. FILEPOS says where to get it.
6e911150 60 If it is an integer, use that position in the standard DOC file.
700ea809 61 If it is (FILE . INTEGER), use FILE as the file name
0c00bc70
RS
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
ba29c3c9
RS
65 them without actually fetching the doc string.)
66
a154a4ef
SM
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
a08d4ba7 71 If UNIBYTE, always make a unibyte string.
e96179b3 72
a08d4ba7 73 If DEFINITION, assume this is for reading
f1df0d67
RS
74 a dynamic function definition; convert the bytestring
75 and the constants vector with appropriate byte handling,
76 and return a cons cell. */
700ea809 77
0c3debbc 78Lisp_Object
a08d4ba7 79get_doc_string (Lisp_Object filepos, bool unibyte, bool definition)
778d47c7 80{
a08d4ba7
PE
81 char *from, *to, *name, *p, *p1;
82 int fd;
d311d28c
PE
83 ptrdiff_t minsize;
84 int offset;
85 EMACS_INT position;
71376d4b 86 Lisp_Object file, tem, pos;
d311d28c 87 USE_SAFE_ALLOCA;
778d47c7 88
700ea809
RS
89 if (INTEGERP (filepos))
90 {
91 file = Vdoc_file_name;
71376d4b 92 pos = filepos;
700ea809
RS
93 }
94 else if (CONSP (filepos))
95 {
03699b14 96 file = XCAR (filepos);
71376d4b 97 pos = XCDR (filepos);
700ea809
RS
98 }
99 else
778d47c7
RS
100 return Qnil;
101
71376d4b 102 position = eabs (XINT (pos));
87afdd65 103
700ea809
RS
104 if (!STRINGP (Vdoc_directory))
105 return Qnil;
106
107 if (!STRINGP (file))
108 return Qnil;
177c0ea7 109
700ea809
RS
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);
8fe012c4 114 file = ENCODE_FILE (file);
700ea809
RS
115 if (NILP (tem))
116 {
8fe012c4
SM
117 Lisp_Object docdir = ENCODE_FILE (Vdoc_directory);
118 minsize = SCHARS (docdir);
700ea809
RS
119 /* sizeof ("../etc/") == 8 */
120 if (minsize < 8)
121 minsize = 8;
98c6f1e3 122 name = SAFE_ALLOCA (minsize + SCHARS (file) + 8);
8fe012c4 123 strcpy (name, SSDATA (docdir));
42a5b22f 124 strcat (name, SSDATA (file));
700ea809
RS
125 }
126 else
127 {
51b59d79 128 name = SSDATA (file);
700ea809 129 }
c6045832 130
68c45bf0 131 fd = emacs_open (name, O_RDONLY, 0);
c6045832 132 if (fd < 0)
778d47c7
RS
133 {
134#ifndef CANNOT_DUMP
135 if (!NILP (Vpurify_flag))
136 {
137 /* Preparing to dump; DOC file is probably not installed.
8fe012c4 138 So check in ../etc. */
778d47c7 139 strcpy (name, "../etc/");
42a5b22f 140 strcat (name, SSDATA (file));
778d47c7 141
68c45bf0 142 fd = emacs_open (name, O_RDONLY, 0);
778d47c7
RS
143 }
144#endif
778d47c7 145 if (fd < 0)
a8cd4836
PE
146 {
147 SAFE_FREE ();
148 return concat3 (build_string ("Cannot open doc string file \""),
149 file, build_string ("\"\n"));
150 }
778d47c7 151 }
9f62b5dd 152 dynwind_begin ();
a8cd4836 153 record_unwind_protect_int (close_file_unwind, fd);
778d47c7 154
0fded513 155 /* Seek only to beginning of disk block. */
a154a4ef
SM
156 /* Make sure we read at least 1024 bytes before `position'
157 so we can check the leading text for consistency. */
158 offset = min (position, max (1024, position % (8 * 1024)));
d311d28c
PE
159 if (TYPE_MAXIMUM (off_t) < position
160 || lseek (fd, position - offset, 0) < 0)
a8cd4836
PE
161 error ("Position %"pI"d out of range in doc string file \"%s\"",
162 position, name);
d311d28c 163
912e8480
RS
164 /* Read the doc string into get_doc_string_buffer.
165 P points beyond the data just read. */
0fded513 166
912e8480 167 p = get_doc_string_buffer;
700ea809 168 while (1)
c6045832 169 {
d31850da 170 ptrdiff_t space_left = (get_doc_string_buffer_size - 1
84c9ce05 171 - (p - get_doc_string_buffer));
700ea809
RS
172 int nread;
173
0fded513 174 /* Allocate or grow the buffer if we need to. */
d31850da 175 if (space_left <= 0)
700ea809 176 {
3d0c92a2 177 ptrdiff_t in_buffer = p - get_doc_string_buffer;
75a65c7e
SM
178 get_doc_string_buffer
179 = xpalloc (get_doc_string_buffer, &get_doc_string_buffer_size,
180 16 * 1024, -1, 1);
912e8480 181 p = get_doc_string_buffer + in_buffer;
d31850da 182 space_left = (get_doc_string_buffer_size - 1
912e8480 183 - (p - get_doc_string_buffer));
700ea809
RS
184 }
185
0fded513
RS
186 /* Read a disk block at a time.
187 If we read the same block last time, maybe skip this? */
700ea809
RS
188 if (space_left > 1024 * 8)
189 space_left = 1024 * 8;
68c45bf0 190 nread = emacs_read (fd, p, space_left);
700ea809 191 if (nread < 0)
a8cd4836 192 report_file_error ("Read error on documentation file", file);
700ea809
RS
193 p[nread] = 0;
194 if (!nread)
c6045832 195 break;
912e8480 196 if (p == get_doc_string_buffer)
8966b757 197 p1 = strchr (p + offset, '\037');
0fded513 198 else
8966b757 199 p1 = strchr (p, '\037');
c6045832
JB
200 if (p1)
201 {
202 *p1 = 0;
203 p = p1;
204 break;
205 }
700ea809 206 p += nread;
c6045832 207 }
9f62b5dd 208 dynwind_end ();
a8cd4836 209 SAFE_FREE ();
700ea809 210
a154a4ef
SM
211 /* Sanity checking. */
212 if (CONSP (filepos))
213 {
214 int test = 1;
759fd763
SM
215 /* A dynamic docstring should be either at the very beginning of a "#@
216 comment" or right after a dynamic docstring delimiter (in case we
217 pack several such docstrings within the same comment). */
218 if (get_doc_string_buffer[offset - test] != '\037')
219 {
220 if (get_doc_string_buffer[offset - test++] != ' ')
221 return Qnil;
222 while (get_doc_string_buffer[offset - test] >= '0'
223 && get_doc_string_buffer[offset - test] <= '9')
224 test++;
225 if (get_doc_string_buffer[offset - test++] != '@'
226 || get_doc_string_buffer[offset - test] != '#')
227 return Qnil;
228 }
a154a4ef
SM
229 }
230 else
231 {
232 int test = 1;
233 if (get_doc_string_buffer[offset - test++] != '\n')
234 return Qnil;
235 while (get_doc_string_buffer[offset - test] > ' ')
236 test++;
237 if (get_doc_string_buffer[offset - test] != '\037')
238 return Qnil;
239 }
240
700ea809
RS
241 /* Scan the text and perform quoting with ^A (char code 1).
242 ^A^A becomes ^A, ^A0 becomes a null char, and ^A_ becomes a ^_. */
912e8480
RS
243 from = get_doc_string_buffer + offset;
244 to = get_doc_string_buffer + offset;
700ea809
RS
245 while (from != p)
246 {
247 if (*from == 1)
248 {
249 int c;
250
251 from++;
252 c = *from++;
253 if (c == 1)
254 *to++ = c;
255 else if (c == '0')
256 *to++ = 0;
257 else if (c == '_')
258 *to++ = 037;
259 else
684a03ef
PE
260 {
261 unsigned char uc = c;
262 error ("\
762b15be 263Invalid data in documentation file -- %c followed by code %03o",
684a03ef
PE
264 1, uc);
265 }
700ea809
RS
266 }
267 else
268 *to++ = *from++;
269 }
270
32caae30
RS
271 /* If DEFINITION, read from this buffer
272 the same way we would read bytes from a file. */
f1df0d67
RS
273 if (definition)
274 {
9eee99eb 275 read_bytecode_pointer = (unsigned char *) get_doc_string_buffer + offset;
32caae30 276 return Fread (Qlambda);
f1df0d67
RS
277 }
278
e96179b3
RS
279 if (unibyte)
280 return make_unibyte_string (get_doc_string_buffer + offset,
281 to - (get_doc_string_buffer + offset));
282 else
fb2fdea7 283 {
198a7a97 284 /* The data determines whether the string is multibyte. */
75a65c7e
SM
285 ptrdiff_t nchars
286 = multibyte_chars_in_text (((unsigned char *) get_doc_string_buffer
287 + offset),
288 to - (get_doc_string_buffer + offset));
fb2fdea7
RS
289 return make_string_from_bytes (get_doc_string_buffer + offset,
290 nchars,
291 to - (get_doc_string_buffer + offset));
292 }
700ea809
RS
293}
294
295/* Get a string from position FILEPOS and pass it through the Lisp reader.
296 We use this for fetching the bytecode string and constants vector
297 of a compiled function from the .elc file. */
298
299Lisp_Object
971de7fb 300read_doc_string (Lisp_Object filepos)
700ea809 301{
e96179b3 302 return get_doc_string (filepos, 0, 1);
c6045832
JB
303}
304
a08d4ba7 305static bool
971de7fb 306reread_doc_file (Lisp_Object file)
a154a4ef 307{
13d7dc77 308#if 0
a154a4ef
SM
309 Lisp_Object reply, prompt[3];
310 struct gcpro gcpro1;
311 GCPRO1 (file);
312 prompt[0] = build_string ("File ");
313 prompt[1] = NILP (file) ? Vdoc_file_name : file;
13d7dc77 314 prompt[2] = build_string (" is out of sync. Reload? ");
a154a4ef
SM
315 reply = Fy_or_n_p (Fconcat (3, prompt));
316 UNGCPRO;
317 if (NILP (reply))
e5aa79fa 318 return 0;
13d7dc77 319#endif
a154a4ef
SM
320
321 if (NILP (file))
322 Fsnarf_documentation (Vdoc_file_name);
323 else
324 Fload (file, Qt, Qt, Qt, Qnil);
e5aa79fa
SM
325
326 return 1;
a154a4ef
SM
327}
328
ee04dc54 329DEFUN ("documentation", Fdocumentation, Sdocumentation, 1, 2, 0,
335c5470
PJ
330 doc: /* Return the documentation string of FUNCTION.
331Unless a non-nil second argument RAW is given, the
332string is passed through `substitute-command-keys'. */)
5842a27b 333 (Lisp_Object function, Lisp_Object raw)
c6045832
JB
334{
335 Lisp_Object fun;
336 Lisp_Object funcar;
a415e694 337 Lisp_Object doc;
a08d4ba7 338 bool try_reload = 1;
e5aa79fa
SM
339
340 documentation:
c6045832 341
8d17fe0b 342 doc = Qnil;
177c0ea7 343
f8aff4c6
JB
344 if (SYMBOLP (function))
345 {
346 Lisp_Object tem = Fget (function, Qfunction_documentation);
347 if (!NILP (tem))
348 return Fdocumentation_property (function, Qfunction_documentation,
349 raw);
350 }
351
a7f96a35 352 fun = Findirect_function (function, Qnil);
57618ecf
SM
353 if (CONSP (fun) && EQ (XCAR (fun), Qmacro))
354 fun = XCDR (fun);
5b5f6883 355 if (SUBRP (fun))
c6045832 356 {
9191c8ae
GM
357 if (XSUBR (fun)->doc == 0)
358 return Qnil;
8f41de3a
PE
359 /* FIXME: This is not portable, as it assumes that string
360 pointers have the top bit clear. */
d01a7826 361 else if ((intptr_t) XSUBR (fun)->doc >= 0)
ee04dc54 362 doc = build_string (XSUBR (fun)->doc);
c6045832 363 else
d01a7826 364 doc = make_number ((intptr_t) XSUBR (fun)->doc);
5b5f6883
KH
365 }
366 else if (COMPILEDP (fun))
367 {
87afdd65 368 if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) <= COMPILED_DOC_STRING)
c6045832 369 return Qnil;
ee04dc54 370 else
a415e694
PE
371 {
372 Lisp_Object tem = AREF (fun, COMPILED_DOC_STRING);
373 if (STRINGP (tem))
374 doc = tem;
375 else if (NATNUMP (tem) || CONSP (tem))
376 doc = tem;
377 else
378 return Qnil;
379 }
5b5f6883
KH
380 }
381 else if (STRINGP (fun) || VECTORP (fun))
382 {
c6045832 383 return build_string ("Keyboard macro.");
5b5f6883
KH
384 }
385 else if (CONSP (fun))
386 {
7d7bbefd 387 funcar = XCAR (fun);
e6d12642 388 if (!SYMBOLP (funcar))
2f0a47f9 389 xsignal1 (Qinvalid_function, fun);
502ddf23 390 else if (EQ (funcar, Qkeymap))
a3cec380 391 return build_string ("Prefix command (definition is a keymap associating keystrokes with commands).");
502ddf23 392 else if (EQ (funcar, Qlambda)
23aba0ea 393 || (EQ (funcar, Qclosure) && (fun = XCDR (fun), 1))
502ddf23 394 || EQ (funcar, Qautoload))
c6045832 395 {
a415e694
PE
396 Lisp_Object tem1 = Fcdr (Fcdr (fun));
397 Lisp_Object tem = Fcar (tem1);
e6d12642 398 if (STRINGP (tem))
ee04dc54 399 doc = tem;
ae44f7a4
RS
400 /* Handle a doc reference--but these never come last
401 in the function body, so reject them if they are last. */
87afdd65
SM
402 else if ((NATNUMP (tem) || (CONSP (tem) && INTEGERP (XCDR (tem))))
403 && !NILP (XCDR (tem1)))
404 doc = tem;
ee04dc54
RM
405 else
406 return Qnil;
c6045832 407 }
5b5f6883
KH
408 else
409 goto oops;
410 }
411 else
412 {
413 oops:
2f0a47f9 414 xsignal1 (Qinvalid_function, fun);
c6045832 415 }
ee04dc54 416
e5aa79fa
SM
417 /* If DOC is 0, it's typically because of a dumped file missing
418 from the DOC file (bug in src/Makefile.in). */
71cdb109
SM
419 if (EQ (doc, make_number (0)))
420 doc = Qnil;
68d8a8e1 421 if (INTEGERP (doc) || CONSP (doc))
a154a4ef
SM
422 {
423 Lisp_Object tem;
424 tem = get_doc_string (doc, 0, 0);
e5aa79fa 425 if (NILP (tem) && try_reload)
a154a4ef
SM
426 {
427 /* The file is newer, we need to reset the pointers. */
428 struct gcpro gcpro1, gcpro2;
429 GCPRO2 (function, raw);
e5aa79fa 430 try_reload = reread_doc_file (Fcar_safe (doc));
a154a4ef 431 UNGCPRO;
e5aa79fa
SM
432 if (try_reload)
433 {
434 try_reload = 0;
435 goto documentation;
436 }
a154a4ef
SM
437 }
438 else
439 doc = tem;
440 }
87afdd65 441
956ace37 442 if (NILP (raw))
441d75e5 443 doc = Fsubstitute_command_keys (doc);
ee04dc54 444 return doc;
c6045832
JB
445}
446
f6ee1260
GM
447DEFUN ("documentation-property", Fdocumentation_property,
448 Sdocumentation_property, 2, 3, 0,
335c5470
PJ
449 doc: /* Return the documentation string that is SYMBOL's PROP property.
450Third argument RAW omitted or nil means pass the result through
451`substitute-command-keys' if it is a string.
452
453This differs from `get' in that it can refer to strings stored in the
454`etc/DOC' file; and that it evaluates documentation properties that
455aren't strings. */)
5842a27b 456 (Lisp_Object symbol, Lisp_Object prop, Lisp_Object raw)
c6045832 457{
a08d4ba7 458 bool try_reload = 1;
2f0b74ea 459 Lisp_Object tem;
c6045832 460
e5aa79fa 461 documentation_property:
177c0ea7 462
4acb738e 463 tem = Fget (symbol, prop);
44766095 464 if (EQ (tem, make_number (0)))
71cdb109 465 tem = Qnil;
68d8a8e1 466 if (INTEGERP (tem) || (CONSP (tem) && INTEGERP (XCDR (tem))))
a154a4ef
SM
467 {
468 Lisp_Object doc = tem;
469 tem = get_doc_string (tem, 0, 0);
e5aa79fa 470 if (NILP (tem) && try_reload)
a154a4ef
SM
471 {
472 /* The file is newer, we need to reset the pointers. */
473 struct gcpro gcpro1, gcpro2, gcpro3;
474 GCPRO3 (symbol, prop, raw);
e5aa79fa 475 try_reload = reread_doc_file (Fcar_safe (doc));
a154a4ef 476 UNGCPRO;
e5aa79fa
SM
477 if (try_reload)
478 {
479 try_reload = 0;
480 goto documentation_property;
481 }
a154a4ef
SM
482 }
483 }
f6ee1260
GM
484 else if (!STRINGP (tem))
485 /* Feval protects its argument. */
a0ee6f27 486 tem = Feval (tem, Qnil);
177c0ea7 487
e6d12642 488 if (NILP (raw) && STRINGP (tem))
bbd7d5d3 489 tem = Fsubstitute_command_keys (tem);
992d176e 490 return tem;
c6045832
JB
491}
492\f
283e1184
JB
493/* Scanning the DOC files and placing docstring offsets into functions. */
494
495static void
6e6c82a4 496store_function_docstring (Lisp_Object obj, ptrdiff_t offset)
283e1184 497{
1449fa1d
CY
498 /* Don't use indirect_function here, or defaliases will apply their
499 docstrings to the base functions (Bug#2603). */
c644523b 500 Lisp_Object fun = SYMBOLP (obj) ? XSYMBOL (obj)->function : obj;
283e1184
JB
501
502 /* The type determines where the docstring is stored. */
503
504 /* Lisp_Subrs have a slot for it. */
e6d12642 505 if (SUBRP (fun))
b08a63cc
PE
506 {
507 intptr_t negative_offset = - offset;
508 XSUBR (fun)->doc = (char *) negative_offset;
509 }
283e1184
JB
510
511 /* If it's a lisp form, stick it in the form. */
512 else if (CONSP (fun))
513 {
514 Lisp_Object tem;
515
03699b14 516 tem = XCAR (fun);
23aba0ea
SM
517 if (EQ (tem, Qlambda) || EQ (tem, Qautoload)
518 || (EQ (tem, Qclosure) && (fun = XCDR (fun), 1)))
283e1184
JB
519 {
520 tem = Fcdr (Fcdr (fun));
03699b14 521 if (CONSP (tem) && INTEGERP (XCAR (tem)))
57618ecf
SM
522 /* FIXME: This modifies typically pure hash-cons'd data, so its
523 correctness is quite delicate. */
d6d23852 524 XSETCAR (tem, make_number (offset));
283e1184
JB
525 }
526 else if (EQ (tem, Qmacro))
03699b14 527 store_function_docstring (XCDR (fun), offset);
283e1184
JB
528 }
529
530 /* Bytecode objects sometimes have slots for it. */
e6d12642 531 else if (COMPILEDP (fun))
283e1184
JB
532 {
533 /* This bytecode object must have a slot for the
534 docstring, since we've found a docstring for it. */
87afdd65 535 if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) > COMPILED_DOC_STRING)
3ae565b3 536 ASET (fun, COMPILED_DOC_STRING, make_number (offset));
049fac7c
SM
537 else
538 message ("No docstring slot for %s",
0df098bf 539 SYMBOLP (obj) ? SSDATA (SYMBOL_NAME (obj)) : "<anonymous>");
283e1184
JB
540 }
541}
542
543
c6045832 544DEFUN ("Snarf-documentation", Fsnarf_documentation, Ssnarf_documentation,
335c5470 545 1, 1, 0,
f4e25f94
RS
546 doc: /* Used during Emacs initialization to scan the `etc/DOC...' file.
547This searches the `etc/DOC...' file for doc strings and
548records them in function and variable definitions.
549The function takes one argument, FILENAME, a string;
550it specifies the file name (without a directory) of the DOC file.
551That file is found in `../etc' now; later, when the dumped Emacs is run,
98b6690a 552the same file name is found in the `doc-directory'. */)
5842a27b 553 (Lisp_Object filename)
c6045832
JB
554{
555 int fd;
556 char buf[1024 + 1];
a08d4ba7
PE
557 int filled;
558 EMACS_INT pos;
24109c98 559 Lisp_Object sym;
a08d4ba7
PE
560 char *p, *name;
561 bool skip_file = 0;
a8cd4836 562 ptrdiff_t count;
2241d76e
GM
563 /* Preloaded defcustoms using custom-initialize-delay are added to
564 this list, but kept unbound. See http://debbugs.gnu.org/11565 */
565 Lisp_Object delayed_init =
566 find_symbol_value (intern ("custom-delayed-init-variables"));
567
568 if (EQ (delayed_init, Qunbound)) delayed_init = Qnil;
c6045832 569
b7826503 570 CHECK_STRING (filename);
c6045832 571
a154a4ef 572 if
c6045832 573#ifndef CANNOT_DUMP
a154a4ef 574 (!NILP (Vpurify_flag))
c6045832 575#else /* CANNOT_DUMP */
a154a4ef 576 (0)
c6045832 577#endif /* CANNOT_DUMP */
a154a4ef 578 {
38182d90 579 name = alloca (SCHARS (filename) + 14);
a154a4ef
SM
580 strcpy (name, "../etc/");
581 }
582 else
583 {
584 CHECK_STRING (Vdoc_directory);
38182d90 585 name = alloca (SCHARS (filename) + SCHARS (Vdoc_directory) + 1);
42a5b22f 586 strcpy (name, SSDATA (Vdoc_directory));
a154a4ef 587 }
42a5b22f 588 strcat (name, SSDATA (filename)); /*** Add this line ***/
c6045832 589
d87a9ab8
JD
590 /* Vbuild_files is nil when temacs is run, and non-nil after that. */
591 if (NILP (Vbuild_files))
c2418359
PE
592 {
593 static char const *const buildobj[] =
594 {
595 #include "buildobj.h"
596 };
faa52174 597 int i = ARRAYELTS (buildobj);
c2418359
PE
598 while (0 <= --i)
599 Vbuild_files = Fcons (build_string (buildobj[i]), Vbuild_files);
600 Vbuild_files = Fpurecopy (Vbuild_files);
601 }
d87a9ab8 602
68c45bf0 603 fd = emacs_open (name, O_RDONLY, 0);
c6045832 604 if (fd < 0)
b648c163
PE
605 {
606 int open_errno = errno;
607 report_file_errno ("Opening doc string file", build_string (name),
608 open_errno);
609 }
9f62b5dd 610 dynwind_begin ();
a8cd4836 611 record_unwind_protect_int (close_file_unwind, fd);
c6045832
JB
612 Vdoc_file_name = filename;
613 filled = 0;
614 pos = 0;
615 while (1)
616 {
a415e694 617 register char *end;
c6045832 618 if (filled < 512)
68c45bf0 619 filled += emacs_read (fd, &buf[filled], sizeof buf - 1 - filled);
c6045832
JB
620 if (!filled)
621 break;
622
623 buf[filled] = 0;
c6045832 624 end = buf + (filled < 512 ? filled : filled - 128);
a84b7c53 625 p = memchr (buf, '\037', end - buf);
983b8302 626 /* p points to ^_Ffunctionname\n or ^_Vvarname\n or ^_Sfilename\n. */
a84b7c53 627 if (p)
c6045832 628 {
8966b757 629 end = strchr (p, '\n');
d87a9ab8
JD
630
631 /* See if this is a file name, and if it is a file in build-files. */
983b8302 632 if (p[1] == 'S')
d87a9ab8 633 {
983b8302
J
634 skip_file = 0;
635 if (end - p > 4 && end[-2] == '.'
636 && (end[-1] == 'o' || end[-1] == 'c'))
637 {
d311d28c 638 ptrdiff_t len = end - p - 2;
983b8302 639 char *fromfile = alloca (len + 1);
e99a530f 640 memcpy (fromfile, &p[2], len);
983b8302
J
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 }
d87a9ab8
JD
648 }
649
141199d1 650 sym = oblookup (Vobarray, p + 2,
9eee99eb
PE
651 multibyte_chars_in_text ((unsigned char *) p + 2,
652 end - p - 2),
141199d1 653 end - p - 2);
11fb4bdb
SM
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. */
d87a9ab8 658 if (! skip_file && SYMBOLP (sym))
c6045832
JB
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 `*'). */
2241d76e
GM
666 if (!NILP (Fboundp (sym))
667 || !NILP (Fmemq (sym, delayed_init)))
05920a43
GM
668 Fput (sym, Qvariable_documentation,
669 make_number ((pos + end + 1 - buf)
670 * (end[1] == '*' ? -1 : 1)));
c6045832
JB
671 }
672
283e1184 673 /* Attach a docstring to a function? */
c6045832 674 else if (p[1] == 'F')
05920a43
GM
675 {
676 if (!NILP (Ffboundp (sym)))
677 store_function_docstring (sym, pos + end + 1 - buf);
678 }
6b61353c
KH
679 else if (p[1] == 'S')
680 ; /* Just a source file name boundary marker. Ignore it. */
681
283e1184 682 else
c2982e87 683 error ("DOC file invalid at position %"pI"d", pos);
c6045832
JB
684 }
685 }
686 pos += end - buf;
687 filled -= end - buf;
840b985a 688 memmove (buf, end, filled);
c6045832 689 }
9f62b5dd
BT
690 dynwind_end ();
691 return Qnil;
c6045832
JB
692}
693\f
a7ca3326 694DEFUN ("substitute-command-keys", Fsubstitute_command_keys,
335c5470
PJ
695 Ssubstitute_command_keys, 1, 1, 0,
696 doc: /* Substitute key descriptions for command names in STRING.
353c87f6
CY
697Each substring of the form \\=\\[COMMAND] is replaced by either a
698keystroke sequence that invokes COMMAND, or "M-x COMMAND" if COMMAND
699is not on any keys.
700
701Each substring of the form \\=\\{MAPVAR} is replaced by a summary of
702the value of MAPVAR as a keymap. This summary is similar to the one
703produced by `describe-bindings'. The summary ends in two newlines
704\(used by the helper function `help-make-xrefs' to find the end of the
705summary).
706
707Each substring of the form \\=\\<MAPVAR> specifies the use of MAPVAR
335c5470
PJ
708as the keymap for future \\=\\[COMMAND] substrings.
709\\=\\= quotes the following character and is discarded;
c698360f
KS
710thus, \\=\\=\\=\\= puts \\=\\= into the output, and \\=\\=\\=\\[ puts \\=\\[ into the output.
711
353c87f6 712Return the original STRING if no substitutions are made.
049fac7c 713Otherwise, return a new string. */)
5842a27b 714 (Lisp_Object string)
c6045832 715{
9eee99eb 716 char *buf;
a08d4ba7
PE
717 bool changed = 0;
718 unsigned char *strp;
719 char *bufp;
3d0c92a2
PE
720 ptrdiff_t idx;
721 ptrdiff_t bsize;
665d3046 722 Lisp_Object tem;
c6045832
JB
723 Lisp_Object keymap;
724 unsigned char *start;
3d0c92a2 725 ptrdiff_t length, length_byte;
665d3046
JB
726 Lisp_Object name;
727 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
a08d4ba7 728 bool multibyte;
3d0c92a2 729 ptrdiff_t nchars;
c6045832 730
4acb738e 731 if (NILP (string))
c6045832
JB
732 return Qnil;
733
b7826503 734 CHECK_STRING (string);
665d3046
JB
735 tem = Qnil;
736 keymap = Qnil;
737 name = Qnil;
4acb738e 738 GCPRO4 (string, tem, keymap, name);
c6045832 739
141199d1
RS
740 multibyte = STRING_MULTIBYTE (string);
741 nchars = 0;
742
9a425dcb
RS
743 /* KEYMAP is either nil (which means search all the active keymaps)
744 or a specified local map (which means search just that and the
745 global map). If non-nil, it might come from Voverriding_local_map,
4acb738e 746 or from a \\<mapname> construct in STRING itself.. */
bfa3acd6 747 keymap = Voverriding_local_map;
c6045832 748
d5db4077 749 bsize = SBYTES (string);
c1ade6f7 750 bufp = buf = xmalloc_atomic (bsize);
c6045832 751
8a7bde3e 752 strp = SDATA (string);
d5db4077 753 while (strp < SDATA (string) + SBYTES (string))
c6045832
JB
754 {
755 if (strp[0] == '\\' && strp[1] == '=')
756 {
757 /* \= quotes the next character;
758 thus, to put in \[ without its special meaning, use \=\[. */
759 changed = 1;
141199d1
RS
760 strp += 2;
761 if (multibyte)
762 {
763 int len;
141199d1 764
62a6e103 765 STRING_CHAR_AND_LENGTH (strp, len);
141199d1
RS
766 if (len == 1)
767 *bufp = *strp;
768 else
72af86bd 769 memcpy (bufp, strp, len);
141199d1
RS
770 strp += len;
771 bufp += len;
772 nchars++;
773 }
774 else
775 *bufp++ = *strp++, nchars++;
c6045832
JB
776 }
777 else if (strp[0] == '\\' && strp[1] == '[')
778 {
3d0c92a2 779 ptrdiff_t start_idx;
a08d4ba7 780 bool follow_remap = 1;
b6c53774 781
c6045832
JB
782 changed = 1;
783 strp += 2; /* skip \[ */
784 start = strp;
d5db4077 785 start_idx = start - SDATA (string);
c6045832 786
8a7bde3e 787 while ((strp - SDATA (string)
d5db4077 788 < SBYTES (string))
c6045832
JB
789 && *strp != ']')
790 strp++;
141199d1
RS
791 length_byte = strp - start;
792
c6045832
JB
793 strp++; /* skip ] */
794
795 /* Save STRP in IDX. */
8a7bde3e 796 idx = strp - SDATA (string);
9eee99eb 797 name = Fintern (make_string ((char *) start, length_byte), Qnil);
11f9d6e1 798
a1d3a188 799 do_remap:
a88a5372 800 tem = Fwhere_is_internal (name, keymap, Qt, Qnil, Qnil);
332e51c1 801
77b37c05 802 if (VECTORP (tem) && ASIZE (tem) > 1
a1d3a188
KS
803 && EQ (AREF (tem, 0), Qremap) && SYMBOLP (AREF (tem, 1))
804 && follow_remap)
805 {
806 name = AREF (tem, 1);
807 follow_remap = 0;
808 goto do_remap;
809 }
810
11f9d6e1
GM
811 /* Note the Fwhere_is_internal can GC, so we have to take
812 relocation of string contents into account. */
d5db4077
KR
813 strp = SDATA (string) + idx;
814 start = SDATA (string) + start_idx;
c6045832 815
265a9e55 816 if (NILP (tem)) /* but not on any keys */
c6045832 817 {
3d0c92a2
PE
818 ptrdiff_t offset = bufp - buf;
819 if (STRING_BYTES_BOUND - 4 < bsize)
820 string_overflow ();
38182d90 821 buf = xrealloc (buf, bsize += 4);
8d17fe0b 822 bufp = buf + offset;
72af86bd 823 memcpy (bufp, "M-x ", 4);
c6045832 824 bufp += 4;
141199d1
RS
825 nchars += 4;
826 if (multibyte)
827 length = multibyte_chars_in_text (start, length_byte);
828 else
829 length = length_byte;
c6045832
JB
830 goto subst;
831 }
832 else
833 { /* function is on a key */
a1bfe073 834 tem = Fkey_description (tem, Qnil);
c6045832
JB
835 goto subst_string;
836 }
837 }
838 /* \{foo} is replaced with a summary of the keymap (symbol-value foo).
839 \<foo> just sets the keymap used for \[cmd]. */
840 else if (strp[0] == '\\' && (strp[1] == '{' || strp[1] == '<'))
841 {
842 struct buffer *oldbuf;
3d0c92a2 843 ptrdiff_t start_idx;
e679a3c1 844 /* This is for computing the SHADOWS arg for describe_map_tree. */
d42f4f0f 845 Lisp_Object active_maps = Fcurrent_active_maps (Qnil, Qnil);
e679a3c1 846 Lisp_Object earlier_maps;
d17f4dba 847 ptrdiff_t count = SPECPDL_INDEX ();
c6045832
JB
848
849 changed = 1;
850 strp += 2; /* skip \{ or \< */
851 start = strp;
d5db4077 852 start_idx = start - SDATA (string);
c6045832 853
ccddfb9e 854 while ((strp - SDATA (string) < SBYTES (string))
c6045832
JB
855 && *strp != '}' && *strp != '>')
856 strp++;
141199d1
RS
857
858 length_byte = strp - start;
c6045832
JB
859 strp++; /* skip } or > */
860
861 /* Save STRP in IDX. */
8a7bde3e 862 idx = strp - SDATA (string);
c6045832
JB
863
864 /* Get the value of the keymap in TEM, or nil if undefined.
865 Do this while still in the user's current buffer
866 in case it is a local variable. */
9eee99eb 867 name = Fintern (make_string ((char *) start, length_byte), Qnil);
c6045832 868 tem = Fboundp (name);
265a9e55 869 if (! NILP (tem))
c6045832
JB
870 {
871 tem = Fsymbol_value (name);
265a9e55 872 if (! NILP (tem))
11f9d6e1 873 {
02067692
SM
874 tem = get_keymap (tem, 0, 1);
875 /* Note that get_keymap can GC. */
d5db4077
KR
876 strp = SDATA (string) + idx;
877 start = SDATA (string) + start_idx;
11f9d6e1 878 }
c6045832
JB
879 }
880
881 /* Now switch to a temp buffer. */
882 oldbuf = current_buffer;
883 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer));
d17f4dba
EZ
884 /* This is for an unusual case where some after-change
885 function uses 'format' or 'prin1' or something else that
886 will thrash Vprin1_to_string_buffer we are using. */
887 specbind (Qinhibit_modification_hooks, Qt);
c6045832 888
265a9e55 889 if (NILP (tem))
c6045832
JB
890 {
891 name = Fsymbol_name (name);
c89926a5 892 insert_string ("\nUses keymap `");
141199d1 893 insert_from_string (name, 0, 0,
d5db4077
KR
894 SCHARS (name),
895 SBYTES (name), 1);
c89926a5 896 insert_string ("', which is not currently defined.\n");
c6045832
JB
897 if (start[-1] == '<') keymap = Qnil;
898 }
899 else if (start[-1] == '<')
900 keymap = tem;
901 else
e679a3c1
RS
902 {
903 /* Get the list of active keymaps that precede this one.
904 If this one's not active, get nil. */
905 earlier_maps = Fcdr (Fmemq (tem, Freverse (active_maps)));
906 describe_map_tree (tem, 1, Fnreverse (earlier_maps),
7d652d97 907 Qnil, 0, 1, 0, 0, 1);
e679a3c1 908 }
c6045832
JB
909 tem = Fbuffer_string ();
910 Ferase_buffer ();
911 set_buffer_internal (oldbuf);
d17f4dba 912 unbind_to (count, Qnil);
c6045832
JB
913
914 subst_string:
d5db4077
KR
915 start = SDATA (tem);
916 length = SCHARS (tem);
917 length_byte = SBYTES (tem);
c6045832 918 subst:
8d17fe0b 919 {
3d0c92a2
PE
920 ptrdiff_t offset = bufp - buf;
921 if (STRING_BYTES_BOUND - length_byte < bsize)
922 string_overflow ();
38182d90 923 buf = xrealloc (buf, bsize += length_byte);
8d17fe0b 924 bufp = buf + offset;
72af86bd 925 memcpy (bufp, start, length_byte);
8d17fe0b
GM
926 bufp += length_byte;
927 nchars += length;
928 /* Check STRING again in case gc relocated it. */
51b59d79 929 strp = SDATA (string) + idx;
8d17fe0b 930 }
c6045832 931 }
141199d1
RS
932 else if (! multibyte) /* just copy other chars */
933 *bufp++ = *strp++, nchars++;
934 else
935 {
936 int len;
141199d1 937
62a6e103 938 STRING_CHAR_AND_LENGTH (strp, len);
141199d1
RS
939 if (len == 1)
940 *bufp = *strp;
941 else
72af86bd 942 memcpy (bufp, strp, len);
141199d1
RS
943 strp += len;
944 bufp += len;
945 nchars++;
946 }
c6045832
JB
947 }
948
949 if (changed) /* don't bother if nothing substituted */
cc5bf9eb 950 tem = make_string_from_bytes (buf, nchars, bufp - buf);
c6045832 951 else
4acb738e 952 tem = string;
9ac0d9e0 953 xfree (buf);
2bfa3d3e 954 return tem;
c6045832
JB
955}
956\f
dfcf069d 957void
971de7fb 958syms_of_doc (void)
c6045832 959{
fe6aa7a1
BT
960#include "doc.x"
961
cd3520a4 962 DEFSYM (Qfunction_documentation, "function-documentation");
177c0ea7 963
29208e82 964 DEFVAR_LISP ("internal-doc-file-name", Vdoc_file_name,
335c5470 965 doc: /* Name of file containing documentation strings of built-in symbols. */);
c6045832
JB
966 Vdoc_file_name = Qnil;
967
29208e82 968 DEFVAR_LISP ("build-files", Vbuild_files,
d87a9ab8
JD
969 doc: /* A list of files used to build this Emacs binary. */);
970 Vbuild_files = Qnil;
c6045832 971}