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