guile-elisp bootstrap part (C)
[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);
62947569
BT
353 if (CONSP (fun)
354 && (EQ (XCAR (fun), Qmacro)
355 || EQ (XCAR (fun), Qspecial_operator)))
57618ecf 356 fun = XCDR (fun);
b06bf4dc 357 if (COMPILEDP (fun))
5b5f6883 358 {
87afdd65 359 if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) <= COMPILED_DOC_STRING)
c6045832 360 return Qnil;
ee04dc54 361 else
a415e694
PE
362 {
363 Lisp_Object tem = AREF (fun, COMPILED_DOC_STRING);
364 if (STRINGP (tem))
365 doc = tem;
366 else if (NATNUMP (tem) || CONSP (tem))
367 doc = tem;
368 else
369 return Qnil;
370 }
5b5f6883 371 }
b06bf4dc
BT
372 else if (scm_is_true (scm_procedure_p (fun)))
373 {
374 Lisp_Object tem = scm_procedure_property (fun, intern ("emacs-documentation"));
375 if (scm_is_true (tem))
376 doc = tem;
377 else
378 return Qnil;
379 }
5b5f6883
KH
380 else if (STRINGP (fun) || VECTORP (fun))
381 {
c6045832 382 return build_string ("Keyboard macro.");
5b5f6883
KH
383 }
384 else if (CONSP (fun))
385 {
7d7bbefd 386 funcar = XCAR (fun);
e6d12642 387 if (!SYMBOLP (funcar))
2f0a47f9 388 xsignal1 (Qinvalid_function, fun);
502ddf23 389 else if (EQ (funcar, Qkeymap))
a3cec380 390 return build_string ("Prefix command (definition is a keymap associating keystrokes with commands).");
502ddf23 391 else if (EQ (funcar, Qlambda)
23aba0ea 392 || (EQ (funcar, Qclosure) && (fun = XCDR (fun), 1))
502ddf23 393 || EQ (funcar, Qautoload))
c6045832 394 {
a415e694
PE
395 Lisp_Object tem1 = Fcdr (Fcdr (fun));
396 Lisp_Object tem = Fcar (tem1);
e6d12642 397 if (STRINGP (tem))
ee04dc54 398 doc = tem;
ae44f7a4
RS
399 /* Handle a doc reference--but these never come last
400 in the function body, so reject them if they are last. */
87afdd65
SM
401 else if ((NATNUMP (tem) || (CONSP (tem) && INTEGERP (XCDR (tem))))
402 && !NILP (XCDR (tem1)))
403 doc = tem;
ee04dc54
RM
404 else
405 return Qnil;
c6045832 406 }
5b5f6883
KH
407 else
408 goto oops;
409 }
410 else
411 {
412 oops:
2f0a47f9 413 xsignal1 (Qinvalid_function, fun);
c6045832 414 }
ee04dc54 415
e5aa79fa
SM
416 /* If DOC is 0, it's typically because of a dumped file missing
417 from the DOC file (bug in src/Makefile.in). */
71cdb109
SM
418 if (EQ (doc, make_number (0)))
419 doc = Qnil;
68d8a8e1 420 if (INTEGERP (doc) || CONSP (doc))
a154a4ef
SM
421 {
422 Lisp_Object tem;
423 tem = get_doc_string (doc, 0, 0);
e5aa79fa 424 if (NILP (tem) && try_reload)
a154a4ef
SM
425 {
426 /* The file is newer, we need to reset the pointers. */
427 struct gcpro gcpro1, gcpro2;
428 GCPRO2 (function, raw);
e5aa79fa 429 try_reload = reread_doc_file (Fcar_safe (doc));
a154a4ef 430 UNGCPRO;
e5aa79fa
SM
431 if (try_reload)
432 {
433 try_reload = 0;
434 goto documentation;
435 }
a154a4ef
SM
436 }
437 else
438 doc = tem;
439 }
87afdd65 440
956ace37 441 if (NILP (raw))
441d75e5 442 doc = Fsubstitute_command_keys (doc);
ee04dc54 443 return doc;
c6045832
JB
444}
445
f6ee1260
GM
446DEFUN ("documentation-property", Fdocumentation_property,
447 Sdocumentation_property, 2, 3, 0,
335c5470
PJ
448 doc: /* Return the documentation string that is SYMBOL's PROP property.
449Third argument RAW omitted or nil means pass the result through
450`substitute-command-keys' if it is a string.
451
452This differs from `get' in that it can refer to strings stored in the
453`etc/DOC' file; and that it evaluates documentation properties that
454aren't strings. */)
5842a27b 455 (Lisp_Object symbol, Lisp_Object prop, Lisp_Object raw)
c6045832 456{
a08d4ba7 457 bool try_reload = 1;
2f0b74ea 458 Lisp_Object tem;
c6045832 459
e5aa79fa 460 documentation_property:
177c0ea7 461
4acb738e 462 tem = Fget (symbol, prop);
44766095 463 if (EQ (tem, make_number (0)))
71cdb109 464 tem = Qnil;
68d8a8e1 465 if (INTEGERP (tem) || (CONSP (tem) && INTEGERP (XCDR (tem))))
a154a4ef
SM
466 {
467 Lisp_Object doc = tem;
468 tem = get_doc_string (tem, 0, 0);
e5aa79fa 469 if (NILP (tem) && try_reload)
a154a4ef
SM
470 {
471 /* The file is newer, we need to reset the pointers. */
472 struct gcpro gcpro1, gcpro2, gcpro3;
473 GCPRO3 (symbol, prop, raw);
e5aa79fa 474 try_reload = reread_doc_file (Fcar_safe (doc));
a154a4ef 475 UNGCPRO;
e5aa79fa
SM
476 if (try_reload)
477 {
478 try_reload = 0;
479 goto documentation_property;
480 }
a154a4ef
SM
481 }
482 }
f6ee1260
GM
483 else if (!STRINGP (tem))
484 /* Feval protects its argument. */
a0ee6f27 485 tem = Feval (tem, Qnil);
177c0ea7 486
e6d12642 487 if (NILP (raw) && STRINGP (tem))
bbd7d5d3 488 tem = Fsubstitute_command_keys (tem);
992d176e 489 return tem;
c6045832
JB
490}
491\f
283e1184
JB
492/* Scanning the DOC files and placing docstring offsets into functions. */
493
494static void
6e6c82a4 495store_function_docstring (Lisp_Object obj, ptrdiff_t offset)
283e1184 496{
1449fa1d
CY
497 /* Don't use indirect_function here, or defaliases will apply their
498 docstrings to the base functions (Bug#2603). */
1d59fbe3 499 Lisp_Object fun = SYMBOLP (obj) ? SYMBOL_FUNCTION (obj) : obj;
283e1184
JB
500
501 /* The type determines where the docstring is stored. */
502
62947569
BT
503
504 if (scm_is_true (scm_procedure_p (fun)))
b08a63cc 505 {
62947569
BT
506 scm_set_procedure_property_x (fun,
507 intern ("emacs-documentation"),
508 make_number (offset));
b08a63cc 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 525 }
62947569 526 else if (EQ (tem, Qmacro) || EQ (tem, Qspecial_operator))
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
3250348f
BT
650 Lisp_Object tem = Ffind_symbol (make_specified_string (p + 2,
651 -1,
652 end - p - 2,
653 true),
654 Qnil);
655 sym = scm_c_value_ref (tem, 0);
11fb4bdb
SM
656 /* Check skip_file so that when a function is defined several
657 times in different files (typically, once in xterm, once in
658 w32term, ...), we only pay attention to the one that
659 matters. */
3250348f 660 if (! skip_file && ! NILP (scm_c_value_ref (tem, 1)))
c6045832
JB
661 {
662 /* Attach a docstring to a variable? */
663 if (p[1] == 'V')
664 {
665 /* Install file-position as variable-documentation property
666 and make it negative for a user-variable
667 (doc starts with a `*'). */
2241d76e
GM
668 if (!NILP (Fboundp (sym))
669 || !NILP (Fmemq (sym, delayed_init)))
05920a43
GM
670 Fput (sym, Qvariable_documentation,
671 make_number ((pos + end + 1 - buf)
672 * (end[1] == '*' ? -1 : 1)));
c6045832
JB
673 }
674
283e1184 675 /* Attach a docstring to a function? */
c6045832 676 else if (p[1] == 'F')
05920a43
GM
677 {
678 if (!NILP (Ffboundp (sym)))
679 store_function_docstring (sym, pos + end + 1 - buf);
680 }
6b61353c
KH
681 else if (p[1] == 'S')
682 ; /* Just a source file name boundary marker. Ignore it. */
683
283e1184 684 else
c2982e87 685 error ("DOC file invalid at position %"pI"d", pos);
c6045832
JB
686 }
687 }
688 pos += end - buf;
689 filled -= end - buf;
840b985a 690 memmove (buf, end, filled);
c6045832 691 }
9f62b5dd
BT
692 dynwind_end ();
693 return Qnil;
c6045832
JB
694}
695\f
a7ca3326 696DEFUN ("substitute-command-keys", Fsubstitute_command_keys,
335c5470
PJ
697 Ssubstitute_command_keys, 1, 1, 0,
698 doc: /* Substitute key descriptions for command names in STRING.
353c87f6
CY
699Each substring of the form \\=\\[COMMAND] is replaced by either a
700keystroke sequence that invokes COMMAND, or "M-x COMMAND" if COMMAND
701is not on any keys.
702
703Each substring of the form \\=\\{MAPVAR} is replaced by a summary of
704the value of MAPVAR as a keymap. This summary is similar to the one
705produced by `describe-bindings'. The summary ends in two newlines
706\(used by the helper function `help-make-xrefs' to find the end of the
707summary).
708
709Each substring of the form \\=\\<MAPVAR> specifies the use of MAPVAR
335c5470
PJ
710as the keymap for future \\=\\[COMMAND] substrings.
711\\=\\= quotes the following character and is discarded;
c698360f
KS
712thus, \\=\\=\\=\\= puts \\=\\= into the output, and \\=\\=\\=\\[ puts \\=\\[ into the output.
713
353c87f6 714Return the original STRING if no substitutions are made.
049fac7c 715Otherwise, return a new string. */)
5842a27b 716 (Lisp_Object string)
c6045832 717{
9eee99eb 718 char *buf;
a08d4ba7
PE
719 bool changed = 0;
720 unsigned char *strp;
721 char *bufp;
3d0c92a2
PE
722 ptrdiff_t idx;
723 ptrdiff_t bsize;
665d3046 724 Lisp_Object tem;
c6045832
JB
725 Lisp_Object keymap;
726 unsigned char *start;
3d0c92a2 727 ptrdiff_t length, length_byte;
665d3046
JB
728 Lisp_Object name;
729 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
a08d4ba7 730 bool multibyte;
3d0c92a2 731 ptrdiff_t nchars;
c6045832 732
4acb738e 733 if (NILP (string))
c6045832
JB
734 return Qnil;
735
b7826503 736 CHECK_STRING (string);
665d3046
JB
737 tem = Qnil;
738 keymap = Qnil;
739 name = Qnil;
4acb738e 740 GCPRO4 (string, tem, keymap, name);
c6045832 741
141199d1
RS
742 multibyte = STRING_MULTIBYTE (string);
743 nchars = 0;
744
9a425dcb
RS
745 /* KEYMAP is either nil (which means search all the active keymaps)
746 or a specified local map (which means search just that and the
747 global map). If non-nil, it might come from Voverriding_local_map,
4acb738e 748 or from a \\<mapname> construct in STRING itself.. */
bfa3acd6 749 keymap = Voverriding_local_map;
c6045832 750
d5db4077 751 bsize = SBYTES (string);
c1ade6f7 752 bufp = buf = xmalloc_atomic (bsize);
c6045832 753
8a7bde3e 754 strp = SDATA (string);
d5db4077 755 while (strp < SDATA (string) + SBYTES (string))
c6045832
JB
756 {
757 if (strp[0] == '\\' && strp[1] == '=')
758 {
759 /* \= quotes the next character;
760 thus, to put in \[ without its special meaning, use \=\[. */
761 changed = 1;
141199d1
RS
762 strp += 2;
763 if (multibyte)
764 {
765 int len;
141199d1 766
62a6e103 767 STRING_CHAR_AND_LENGTH (strp, len);
141199d1
RS
768 if (len == 1)
769 *bufp = *strp;
770 else
72af86bd 771 memcpy (bufp, strp, len);
141199d1
RS
772 strp += len;
773 bufp += len;
774 nchars++;
775 }
776 else
777 *bufp++ = *strp++, nchars++;
c6045832
JB
778 }
779 else if (strp[0] == '\\' && strp[1] == '[')
780 {
3d0c92a2 781 ptrdiff_t start_idx;
a08d4ba7 782 bool follow_remap = 1;
b6c53774 783
c6045832
JB
784 changed = 1;
785 strp += 2; /* skip \[ */
786 start = strp;
d5db4077 787 start_idx = start - SDATA (string);
c6045832 788
8a7bde3e 789 while ((strp - SDATA (string)
d5db4077 790 < SBYTES (string))
c6045832
JB
791 && *strp != ']')
792 strp++;
141199d1
RS
793 length_byte = strp - start;
794
c6045832
JB
795 strp++; /* skip ] */
796
797 /* Save STRP in IDX. */
8a7bde3e 798 idx = strp - SDATA (string);
9eee99eb 799 name = Fintern (make_string ((char *) start, length_byte), Qnil);
11f9d6e1 800
a1d3a188 801 do_remap:
a88a5372 802 tem = Fwhere_is_internal (name, keymap, Qt, Qnil, Qnil);
332e51c1 803
77b37c05 804 if (VECTORP (tem) && ASIZE (tem) > 1
a1d3a188
KS
805 && EQ (AREF (tem, 0), Qremap) && SYMBOLP (AREF (tem, 1))
806 && follow_remap)
807 {
808 name = AREF (tem, 1);
809 follow_remap = 0;
810 goto do_remap;
811 }
812
11f9d6e1
GM
813 /* Note the Fwhere_is_internal can GC, so we have to take
814 relocation of string contents into account. */
d5db4077
KR
815 strp = SDATA (string) + idx;
816 start = SDATA (string) + start_idx;
c6045832 817
265a9e55 818 if (NILP (tem)) /* but not on any keys */
c6045832 819 {
3d0c92a2
PE
820 ptrdiff_t offset = bufp - buf;
821 if (STRING_BYTES_BOUND - 4 < bsize)
822 string_overflow ();
38182d90 823 buf = xrealloc (buf, bsize += 4);
8d17fe0b 824 bufp = buf + offset;
72af86bd 825 memcpy (bufp, "M-x ", 4);
c6045832 826 bufp += 4;
141199d1
RS
827 nchars += 4;
828 if (multibyte)
829 length = multibyte_chars_in_text (start, length_byte);
830 else
831 length = length_byte;
c6045832
JB
832 goto subst;
833 }
834 else
835 { /* function is on a key */
a1bfe073 836 tem = Fkey_description (tem, Qnil);
c6045832
JB
837 goto subst_string;
838 }
839 }
840 /* \{foo} is replaced with a summary of the keymap (symbol-value foo).
841 \<foo> just sets the keymap used for \[cmd]. */
842 else if (strp[0] == '\\' && (strp[1] == '{' || strp[1] == '<'))
843 {
844 struct buffer *oldbuf;
3d0c92a2 845 ptrdiff_t start_idx;
e679a3c1 846 /* This is for computing the SHADOWS arg for describe_map_tree. */
d42f4f0f 847 Lisp_Object active_maps = Fcurrent_active_maps (Qnil, Qnil);
e679a3c1 848 Lisp_Object earlier_maps;
d08c3782 849 dynwind_begin ();
c6045832
JB
850
851 changed = 1;
852 strp += 2; /* skip \{ or \< */
853 start = strp;
d5db4077 854 start_idx = start - SDATA (string);
c6045832 855
ccddfb9e 856 while ((strp - SDATA (string) < SBYTES (string))
c6045832
JB
857 && *strp != '}' && *strp != '>')
858 strp++;
141199d1
RS
859
860 length_byte = strp - start;
c6045832
JB
861 strp++; /* skip } or > */
862
863 /* Save STRP in IDX. */
8a7bde3e 864 idx = strp - SDATA (string);
c6045832
JB
865
866 /* Get the value of the keymap in TEM, or nil if undefined.
867 Do this while still in the user's current buffer
868 in case it is a local variable. */
9eee99eb 869 name = Fintern (make_string ((char *) start, length_byte), Qnil);
c6045832 870 tem = Fboundp (name);
265a9e55 871 if (! NILP (tem))
c6045832
JB
872 {
873 tem = Fsymbol_value (name);
265a9e55 874 if (! NILP (tem))
11f9d6e1 875 {
02067692
SM
876 tem = get_keymap (tem, 0, 1);
877 /* Note that get_keymap can GC. */
d5db4077
KR
878 strp = SDATA (string) + idx;
879 start = SDATA (string) + start_idx;
11f9d6e1 880 }
c6045832
JB
881 }
882
883 /* Now switch to a temp buffer. */
884 oldbuf = current_buffer;
885 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer));
d17f4dba
EZ
886 /* This is for an unusual case where some after-change
887 function uses 'format' or 'prin1' or something else that
888 will thrash Vprin1_to_string_buffer we are using. */
889 specbind (Qinhibit_modification_hooks, Qt);
c6045832 890
265a9e55 891 if (NILP (tem))
c6045832
JB
892 {
893 name = Fsymbol_name (name);
c89926a5 894 insert_string ("\nUses keymap `");
141199d1 895 insert_from_string (name, 0, 0,
d5db4077
KR
896 SCHARS (name),
897 SBYTES (name), 1);
c89926a5 898 insert_string ("', which is not currently defined.\n");
c6045832
JB
899 if (start[-1] == '<') keymap = Qnil;
900 }
901 else if (start[-1] == '<')
902 keymap = tem;
903 else
e679a3c1
RS
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),
7d652d97 909 Qnil, 0, 1, 0, 0, 1);
e679a3c1 910 }
c6045832
JB
911 tem = Fbuffer_string ();
912 Ferase_buffer ();
913 set_buffer_internal (oldbuf);
d08c3782 914 dynwind_end ();
c6045832
JB
915
916 subst_string:
d5db4077
KR
917 start = SDATA (tem);
918 length = SCHARS (tem);
919 length_byte = SBYTES (tem);
c6045832 920 subst:
8d17fe0b 921 {
3d0c92a2
PE
922 ptrdiff_t offset = bufp - buf;
923 if (STRING_BYTES_BOUND - length_byte < bsize)
924 string_overflow ();
38182d90 925 buf = xrealloc (buf, bsize += length_byte);
8d17fe0b 926 bufp = buf + offset;
72af86bd 927 memcpy (bufp, start, length_byte);
8d17fe0b
GM
928 bufp += length_byte;
929 nchars += length;
930 /* Check STRING again in case gc relocated it. */
51b59d79 931 strp = SDATA (string) + idx;
8d17fe0b 932 }
c6045832 933 }
141199d1
RS
934 else if (! multibyte) /* just copy other chars */
935 *bufp++ = *strp++, nchars++;
936 else
937 {
938 int len;
141199d1 939
62a6e103 940 STRING_CHAR_AND_LENGTH (strp, len);
141199d1
RS
941 if (len == 1)
942 *bufp = *strp;
943 else
72af86bd 944 memcpy (bufp, strp, len);
141199d1
RS
945 strp += len;
946 bufp += len;
947 nchars++;
948 }
c6045832
JB
949 }
950
951 if (changed) /* don't bother if nothing substituted */
cc5bf9eb 952 tem = make_string_from_bytes (buf, nchars, bufp - buf);
c6045832 953 else
4acb738e 954 tem = string;
9ac0d9e0 955 xfree (buf);
2bfa3d3e 956 return tem;
c6045832
JB
957}
958\f
dfcf069d 959void
971de7fb 960syms_of_doc (void)
c6045832 961{
fe6aa7a1
BT
962#include "doc.x"
963
cd3520a4 964 DEFSYM (Qfunction_documentation, "function-documentation");
177c0ea7 965
29208e82 966 DEFVAR_LISP ("internal-doc-file-name", Vdoc_file_name,
335c5470 967 doc: /* Name of file containing documentation strings of built-in symbols. */);
c6045832
JB
968 Vdoc_file_name = Qnil;
969
29208e82 970 DEFVAR_LISP ("build-files", Vbuild_files,
d87a9ab8
JD
971 doc: /* A list of files used to build this Emacs binary. */);
972 Vbuild_files = Qnil;
c6045832 973}