Fix minor problems found by static checking.
[bpt/emacs.git] / src / doc.c
CommitLineData
c6045832 1/* Record indices of function doc strings stored in a file.
05920a43
GM
2
3Copyright (C) 1985-1986, 1993-1995, 1997-2012 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
JB
22
23#include <sys/types.h>
f2a77c3a 24#include <sys/file.h> /* Must be after sys/types.h for USG*/
d7306fe6 25#include <setjmp.h>
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"
878bde49 36#include "buildobj.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
46/* readchar in lread.c calls back here to fetch the next byte.
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
RS
60/* Extract a doc string from a file. FILEPOS says where to get it.
61 If it is an integer, use that position in the standard DOC-... file.
62 If it is (FILE . INTEGER), use FILE as the file name
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;
700ea809 87 Lisp_Object file, tem;
d311d28c 88 USE_SAFE_ALLOCA;
778d47c7 89
700ea809
RS
90 if (INTEGERP (filepos))
91 {
92 file = Vdoc_file_name;
93 position = XINT (filepos);
94 }
95 else if (CONSP (filepos))
96 {
03699b14
KR
97 file = XCAR (filepos);
98 position = XINT (XCDR (filepos));
700ea809
RS
99 }
100 else
778d47c7
RS
101 return Qnil;
102
87afdd65
SM
103 if (position < 0)
104 position = - position;
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
RS
147 if (fd < 0)
148 error ("Cannot open doc string file \"%s\"", name);
149 }
150
0fded513 151 /* Seek only to beginning of disk block. */
a154a4ef
SM
152 /* Make sure we read at least 1024 bytes before `position'
153 so we can check the leading text for consistency. */
154 offset = min (position, max (1024, position % (8 * 1024)));
d311d28c
PE
155 if (TYPE_MAXIMUM (off_t) < position
156 || lseek (fd, position - offset, 0) < 0)
c6045832 157 {
68c45bf0 158 emacs_close (fd);
c2982e87 159 error ("Position %"pI"d out of range in doc string file \"%s\"",
700ea809 160 position, name);
c6045832 161 }
700ea809 162
d311d28c
PE
163 SAFE_FREE ();
164
912e8480
RS
165 /* Read the doc string into get_doc_string_buffer.
166 P points beyond the data just read. */
0fded513 167
912e8480 168 p = get_doc_string_buffer;
700ea809 169 while (1)
c6045832 170 {
d31850da 171 ptrdiff_t space_left = (get_doc_string_buffer_size - 1
84c9ce05 172 - (p - get_doc_string_buffer));
700ea809
RS
173 int nread;
174
0fded513 175 /* Allocate or grow the buffer if we need to. */
d31850da 176 if (space_left <= 0)
700ea809 177 {
3d0c92a2 178 ptrdiff_t in_buffer = p - get_doc_string_buffer;
0065d054
PE
179 get_doc_string_buffer =
180 xpalloc (get_doc_string_buffer, &get_doc_string_buffer_size,
181 16 * 1024, -1, 1);
912e8480 182 p = get_doc_string_buffer + in_buffer;
d31850da 183 space_left = (get_doc_string_buffer_size - 1
912e8480 184 - (p - get_doc_string_buffer));
700ea809
RS
185 }
186
0fded513
RS
187 /* Read a disk block at a time.
188 If we read the same block last time, maybe skip this? */
700ea809
RS
189 if (space_left > 1024 * 8)
190 space_left = 1024 * 8;
68c45bf0 191 nread = emacs_read (fd, p, space_left);
700ea809
RS
192 if (nread < 0)
193 {
68c45bf0 194 emacs_close (fd);
700ea809
RS
195 error ("Read error on documentation file");
196 }
197 p[nread] = 0;
198 if (!nread)
c6045832 199 break;
912e8480 200 if (p == get_doc_string_buffer)
8966b757 201 p1 = strchr (p + offset, '\037');
0fded513 202 else
8966b757 203 p1 = strchr (p, '\037');
c6045832
JB
204 if (p1)
205 {
206 *p1 = 0;
207 p = p1;
208 break;
209 }
700ea809 210 p += nread;
c6045832 211 }
68c45bf0 212 emacs_close (fd);
700ea809 213
a154a4ef
SM
214 /* Sanity checking. */
215 if (CONSP (filepos))
216 {
217 int test = 1;
218 if (get_doc_string_buffer[offset - test++] != ' ')
219 return Qnil;
220 while (get_doc_string_buffer[offset - test] >= '0'
221 && get_doc_string_buffer[offset - test] <= '9')
222 test++;
223 if (get_doc_string_buffer[offset - test++] != '@'
224 || get_doc_string_buffer[offset - test] != '#')
225 return Qnil;
226 }
227 else
228 {
229 int test = 1;
230 if (get_doc_string_buffer[offset - test++] != '\n')
231 return Qnil;
232 while (get_doc_string_buffer[offset - test] > ' ')
233 test++;
234 if (get_doc_string_buffer[offset - test] != '\037')
235 return Qnil;
236 }
237
700ea809
RS
238 /* Scan the text and perform quoting with ^A (char code 1).
239 ^A^A becomes ^A, ^A0 becomes a null char, and ^A_ becomes a ^_. */
912e8480
RS
240 from = get_doc_string_buffer + offset;
241 to = get_doc_string_buffer + offset;
700ea809
RS
242 while (from != p)
243 {
244 if (*from == 1)
245 {
246 int c;
247
248 from++;
249 c = *from++;
250 if (c == 1)
251 *to++ = c;
252 else if (c == '0')
253 *to++ = 0;
254 else if (c == '_')
255 *to++ = 037;
256 else
684a03ef
PE
257 {
258 unsigned char uc = c;
259 error ("\
762b15be 260Invalid data in documentation file -- %c followed by code %03o",
684a03ef
PE
261 1, uc);
262 }
700ea809
RS
263 }
264 else
265 *to++ = *from++;
266 }
267
32caae30
RS
268 /* If DEFINITION, read from this buffer
269 the same way we would read bytes from a file. */
f1df0d67
RS
270 if (definition)
271 {
9eee99eb 272 read_bytecode_pointer = (unsigned char *) get_doc_string_buffer + offset;
32caae30 273 return Fread (Qlambda);
f1df0d67
RS
274 }
275
e96179b3
RS
276 if (unibyte)
277 return make_unibyte_string (get_doc_string_buffer + offset,
278 to - (get_doc_string_buffer + offset));
279 else
fb2fdea7 280 {
198a7a97 281 /* The data determines whether the string is multibyte. */
d311d28c 282 ptrdiff_t nchars =
9eee99eb
PE
283 multibyte_chars_in_text (((unsigned char *) get_doc_string_buffer
284 + offset),
285 to - (get_doc_string_buffer + offset));
fb2fdea7
RS
286 return make_string_from_bytes (get_doc_string_buffer + offset,
287 nchars,
288 to - (get_doc_string_buffer + offset));
289 }
700ea809
RS
290}
291
292/* Get a string from position FILEPOS and pass it through the Lisp reader.
293 We use this for fetching the bytecode string and constants vector
294 of a compiled function from the .elc file. */
295
296Lisp_Object
971de7fb 297read_doc_string (Lisp_Object filepos)
700ea809 298{
e96179b3 299 return get_doc_string (filepos, 0, 1);
c6045832
JB
300}
301
a08d4ba7 302static bool
971de7fb 303reread_doc_file (Lisp_Object file)
a154a4ef 304{
13d7dc77 305#if 0
a154a4ef
SM
306 Lisp_Object reply, prompt[3];
307 struct gcpro gcpro1;
308 GCPRO1 (file);
309 prompt[0] = build_string ("File ");
310 prompt[1] = NILP (file) ? Vdoc_file_name : file;
13d7dc77 311 prompt[2] = build_string (" is out of sync. Reload? ");
a154a4ef
SM
312 reply = Fy_or_n_p (Fconcat (3, prompt));
313 UNGCPRO;
314 if (NILP (reply))
e5aa79fa 315 return 0;
13d7dc77 316#endif
a154a4ef
SM
317
318 if (NILP (file))
319 Fsnarf_documentation (Vdoc_file_name);
320 else
321 Fload (file, Qt, Qt, Qt, Qnil);
e5aa79fa
SM
322
323 return 1;
a154a4ef
SM
324}
325
ee04dc54 326DEFUN ("documentation", Fdocumentation, Sdocumentation, 1, 2, 0,
335c5470
PJ
327 doc: /* Return the documentation string of FUNCTION.
328Unless a non-nil second argument RAW is given, the
329string is passed through `substitute-command-keys'. */)
5842a27b 330 (Lisp_Object function, Lisp_Object raw)
c6045832
JB
331{
332 Lisp_Object fun;
333 Lisp_Object funcar;
a415e694 334 Lisp_Object doc;
a08d4ba7 335 bool try_reload = 1;
e5aa79fa
SM
336
337 documentation:
c6045832 338
8d17fe0b 339 doc = Qnil;
177c0ea7 340
a415e694
PE
341 if (SYMBOLP (function))
342 {
343 Lisp_Object tem = Fget (function, Qfunction_documentation);
344 if (!NILP (tem))
345 return Fdocumentation_property (function, Qfunction_documentation,
346 raw);
347 }
177c0ea7 348
a7f96a35 349 fun = Findirect_function (function, Qnil);
5b5f6883 350 if (SUBRP (fun))
c6045832 351 {
9191c8ae
GM
352 if (XSUBR (fun)->doc == 0)
353 return Qnil;
8f41de3a
PE
354 /* FIXME: This is not portable, as it assumes that string
355 pointers have the top bit clear. */
d01a7826 356 else if ((intptr_t) XSUBR (fun)->doc >= 0)
ee04dc54 357 doc = build_string (XSUBR (fun)->doc);
c6045832 358 else
d01a7826 359 doc = make_number ((intptr_t) XSUBR (fun)->doc);
5b5f6883
KH
360 }
361 else if (COMPILEDP (fun))
362 {
87afdd65 363 if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) <= COMPILED_DOC_STRING)
c6045832 364 return Qnil;
ee04dc54 365 else
a415e694
PE
366 {
367 Lisp_Object tem = AREF (fun, COMPILED_DOC_STRING);
368 if (STRINGP (tem))
369 doc = tem;
370 else if (NATNUMP (tem) || CONSP (tem))
371 doc = tem;
372 else
373 return Qnil;
374 }
5b5f6883
KH
375 }
376 else if (STRINGP (fun) || VECTORP (fun))
377 {
c6045832 378 return build_string ("Keyboard macro.");
5b5f6883
KH
379 }
380 else if (CONSP (fun))
381 {
7d7bbefd 382 funcar = XCAR (fun);
e6d12642 383 if (!SYMBOLP (funcar))
2f0a47f9 384 xsignal1 (Qinvalid_function, fun);
502ddf23 385 else if (EQ (funcar, Qkeymap))
a3cec380 386 return build_string ("Prefix command (definition is a keymap associating keystrokes with commands).");
502ddf23 387 else if (EQ (funcar, Qlambda)
23aba0ea 388 || (EQ (funcar, Qclosure) && (fun = XCDR (fun), 1))
502ddf23 389 || EQ (funcar, Qautoload))
c6045832 390 {
a415e694
PE
391 Lisp_Object tem1 = Fcdr (Fcdr (fun));
392 Lisp_Object tem = Fcar (tem1);
e6d12642 393 if (STRINGP (tem))
ee04dc54 394 doc = tem;
ae44f7a4
RS
395 /* Handle a doc reference--but these never come last
396 in the function body, so reject them if they are last. */
87afdd65
SM
397 else if ((NATNUMP (tem) || (CONSP (tem) && INTEGERP (XCDR (tem))))
398 && !NILP (XCDR (tem1)))
399 doc = tem;
ee04dc54
RM
400 else
401 return Qnil;
c6045832 402 }
502ddf23 403 else if (EQ (funcar, Qmacro))
ee04dc54 404 return Fdocumentation (Fcdr (fun), raw);
5b5f6883
KH
405 else
406 goto oops;
407 }
408 else
409 {
410 oops:
2f0a47f9 411 xsignal1 (Qinvalid_function, fun);
c6045832 412 }
ee04dc54 413
db3534c3
JB
414 /* Check for an advised function. Its doc string
415 has an `ad-advice-info' text property. */
416 if (STRINGP (doc))
417 {
418 Lisp_Object innerfunc;
419 innerfunc = Fget_text_property (make_number (0),
420 intern ("ad-advice-info"),
421 doc);
422 if (! NILP (innerfunc))
423 doc = call1 (intern ("ad-make-advised-docstring"), innerfunc);
424 }
425
e5aa79fa
SM
426 /* If DOC is 0, it's typically because of a dumped file missing
427 from the DOC file (bug in src/Makefile.in). */
71cdb109
SM
428 if (EQ (doc, make_number (0)))
429 doc = Qnil;
68d8a8e1 430 if (INTEGERP (doc) || CONSP (doc))
a154a4ef
SM
431 {
432 Lisp_Object tem;
433 tem = get_doc_string (doc, 0, 0);
e5aa79fa 434 if (NILP (tem) && try_reload)
a154a4ef
SM
435 {
436 /* The file is newer, we need to reset the pointers. */
437 struct gcpro gcpro1, gcpro2;
438 GCPRO2 (function, raw);
e5aa79fa 439 try_reload = reread_doc_file (Fcar_safe (doc));
a154a4ef 440 UNGCPRO;
e5aa79fa
SM
441 if (try_reload)
442 {
443 try_reload = 0;
444 goto documentation;
445 }
a154a4ef
SM
446 }
447 else
448 doc = tem;
449 }
87afdd65 450
956ace37 451 if (NILP (raw))
441d75e5 452 doc = Fsubstitute_command_keys (doc);
ee04dc54 453 return doc;
c6045832
JB
454}
455
f6ee1260
GM
456DEFUN ("documentation-property", Fdocumentation_property,
457 Sdocumentation_property, 2, 3, 0,
335c5470
PJ
458 doc: /* Return the documentation string that is SYMBOL's PROP property.
459Third argument RAW omitted or nil means pass the result through
460`substitute-command-keys' if it is a string.
461
462This differs from `get' in that it can refer to strings stored in the
463`etc/DOC' file; and that it evaluates documentation properties that
464aren't strings. */)
5842a27b 465 (Lisp_Object symbol, Lisp_Object prop, Lisp_Object raw)
c6045832 466{
a08d4ba7 467 bool try_reload = 1;
2f0b74ea 468 Lisp_Object tem;
c6045832 469
e5aa79fa 470 documentation_property:
177c0ea7 471
4acb738e 472 tem = Fget (symbol, prop);
44766095 473 if (EQ (tem, make_number (0)))
71cdb109 474 tem = Qnil;
68d8a8e1 475 if (INTEGERP (tem) || (CONSP (tem) && INTEGERP (XCDR (tem))))
a154a4ef
SM
476 {
477 Lisp_Object doc = tem;
478 tem = get_doc_string (tem, 0, 0);
e5aa79fa 479 if (NILP (tem) && try_reload)
a154a4ef
SM
480 {
481 /* The file is newer, we need to reset the pointers. */
482 struct gcpro gcpro1, gcpro2, gcpro3;
483 GCPRO3 (symbol, prop, raw);
e5aa79fa 484 try_reload = reread_doc_file (Fcar_safe (doc));
a154a4ef 485 UNGCPRO;
e5aa79fa
SM
486 if (try_reload)
487 {
488 try_reload = 0;
489 goto documentation_property;
490 }
a154a4ef
SM
491 }
492 }
f6ee1260
GM
493 else if (!STRINGP (tem))
494 /* Feval protects its argument. */
a0ee6f27 495 tem = Feval (tem, Qnil);
177c0ea7 496
e6d12642 497 if (NILP (raw) && STRINGP (tem))
bbd7d5d3 498 tem = Fsubstitute_command_keys (tem);
992d176e 499 return tem;
c6045832
JB
500}
501\f
283e1184
JB
502/* Scanning the DOC files and placing docstring offsets into functions. */
503
504static void
6e6c82a4 505store_function_docstring (Lisp_Object obj, ptrdiff_t offset)
283e1184 506{
1449fa1d
CY
507 /* Don't use indirect_function here, or defaliases will apply their
508 docstrings to the base functions (Bug#2603). */
c644523b 509 Lisp_Object fun = SYMBOLP (obj) ? XSYMBOL (obj)->function : obj;
283e1184
JB
510
511 /* The type determines where the docstring is stored. */
512
513 /* Lisp_Subrs have a slot for it. */
e6d12642 514 if (SUBRP (fun))
b08a63cc
PE
515 {
516 intptr_t negative_offset = - offset;
517 XSUBR (fun)->doc = (char *) negative_offset;
518 }
283e1184
JB
519
520 /* If it's a lisp form, stick it in the form. */
521 else if (CONSP (fun))
522 {
523 Lisp_Object tem;
524
03699b14 525 tem = XCAR (fun);
23aba0ea
SM
526 if (EQ (tem, Qlambda) || EQ (tem, Qautoload)
527 || (EQ (tem, Qclosure) && (fun = XCDR (fun), 1)))
283e1184
JB
528 {
529 tem = Fcdr (Fcdr (fun));
03699b14 530 if (CONSP (tem) && INTEGERP (XCAR (tem)))
d6d23852 531 XSETCAR (tem, make_number (offset));
283e1184
JB
532 }
533 else if (EQ (tem, Qmacro))
03699b14 534 store_function_docstring (XCDR (fun), offset);
283e1184
JB
535 }
536
537 /* Bytecode objects sometimes have slots for it. */
e6d12642 538 else if (COMPILEDP (fun))
283e1184
JB
539 {
540 /* This bytecode object must have a slot for the
541 docstring, since we've found a docstring for it. */
87afdd65 542 if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) > COMPILED_DOC_STRING)
3ae565b3 543 ASET (fun, COMPILED_DOC_STRING, make_number (offset));
283e1184
JB
544 }
545}
546
878bde49 547static const char buildobj[] = BUILDOBJ;
283e1184 548
c6045832 549DEFUN ("Snarf-documentation", Fsnarf_documentation, Ssnarf_documentation,
335c5470 550 1, 1, 0,
f4e25f94
RS
551 doc: /* Used during Emacs initialization to scan the `etc/DOC...' file.
552This searches the `etc/DOC...' file for doc strings and
553records them in function and variable definitions.
554The function takes one argument, FILENAME, a string;
555it specifies the file name (without a directory) of the DOC file.
556That file is found in `../etc' now; later, when the dumped Emacs is run,
98b6690a 557the same file name is found in the `doc-directory'. */)
5842a27b 558 (Lisp_Object filename)
c6045832
JB
559{
560 int fd;
561 char buf[1024 + 1];
a08d4ba7
PE
562 int filled;
563 EMACS_INT pos;
24109c98 564 Lisp_Object sym;
a08d4ba7
PE
565 char *p, *name;
566 bool skip_file = 0;
c6045832 567
b7826503 568 CHECK_STRING (filename);
c6045832 569
a154a4ef 570 if
c6045832 571#ifndef CANNOT_DUMP
a154a4ef 572 (!NILP (Vpurify_flag))
c6045832 573#else /* CANNOT_DUMP */
a154a4ef 574 (0)
c6045832 575#endif /* CANNOT_DUMP */
a154a4ef 576 {
38182d90 577 name = alloca (SCHARS (filename) + 14);
a154a4ef
SM
578 strcpy (name, "../etc/");
579 }
580 else
581 {
582 CHECK_STRING (Vdoc_directory);
38182d90 583 name = alloca (SCHARS (filename) + SCHARS (Vdoc_directory) + 1);
42a5b22f 584 strcpy (name, SSDATA (Vdoc_directory));
a154a4ef 585 }
42a5b22f 586 strcat (name, SSDATA (filename)); /*** Add this line ***/
c6045832 587
d87a9ab8
JD
588 /* Vbuild_files is nil when temacs is run, and non-nil after that. */
589 if (NILP (Vbuild_files))
590 {
878bde49 591 const char *beg, *end;
d87a9ab8 592
878bde49 593 for (beg = buildobj; *beg; beg = end)
d87a9ab8 594 {
d311d28c 595 ptrdiff_t len;
d87a9ab8 596
620f13b0 597 while (*beg && c_isspace (*beg)) ++beg;
d87a9ab8 598
620f13b0 599 for (end = beg; *end && ! c_isspace (*end); ++end)
d87a9ab8
JD
600 if (*end == '/') beg = end+1; /* skip directory part */
601
602 len = end - beg;
603 if (len > 4 && end[-4] == '.' && end[-3] == 'o')
604 len -= 2; /* Just take .o if it ends in .obj */
605
606 if (len > 0)
607 Vbuild_files = Fcons (make_string (beg, len), Vbuild_files);
608 }
a4ada374 609 Vbuild_files = Fpurecopy (Vbuild_files);
d87a9ab8
JD
610 }
611
68c45bf0 612 fd = emacs_open (name, O_RDONLY, 0);
c6045832
JB
613 if (fd < 0)
614 report_file_error ("Opening doc string file",
615 Fcons (build_string (name), Qnil));
616 Vdoc_file_name = filename;
617 filled = 0;
618 pos = 0;
619 while (1)
620 {
a415e694 621 register char *end;
c6045832 622 if (filled < 512)
68c45bf0 623 filled += emacs_read (fd, &buf[filled], sizeof buf - 1 - filled);
c6045832
JB
624 if (!filled)
625 break;
626
627 buf[filled] = 0;
628 p = buf;
629 end = buf + (filled < 512 ? filled : filled - 128);
630 while (p != end && *p != '\037') p++;
983b8302 631 /* p points to ^_Ffunctionname\n or ^_Vvarname\n or ^_Sfilename\n. */
c6045832
JB
632 if (p != end)
633 {
8966b757 634 end = strchr (p, '\n');
d87a9ab8
JD
635
636 /* See if this is a file name, and if it is a file in build-files. */
983b8302 637 if (p[1] == 'S')
d87a9ab8 638 {
983b8302
J
639 skip_file = 0;
640 if (end - p > 4 && end[-2] == '.'
641 && (end[-1] == 'o' || end[-1] == 'c'))
642 {
d311d28c 643 ptrdiff_t len = end - p - 2;
983b8302 644 char *fromfile = alloca (len + 1);
e99a530f 645 memcpy (fromfile, &p[2], len);
983b8302
J
646 fromfile[len] = 0;
647 if (fromfile[len-1] == 'c')
648 fromfile[len-1] = 'o';
649
650 skip_file = NILP (Fmember (build_string (fromfile),
651 Vbuild_files));
652 }
d87a9ab8
JD
653 }
654
141199d1 655 sym = oblookup (Vobarray, p + 2,
9eee99eb
PE
656 multibyte_chars_in_text ((unsigned char *) p + 2,
657 end - p - 2),
141199d1 658 end - p - 2);
11fb4bdb
SM
659 /* Check skip_file so that when a function is defined several
660 times in different files (typically, once in xterm, once in
661 w32term, ...), we only pay attention to the one that
662 matters. */
d87a9ab8 663 if (! skip_file && SYMBOLP (sym))
c6045832
JB
664 {
665 /* Attach a docstring to a variable? */
666 if (p[1] == 'V')
667 {
668 /* Install file-position as variable-documentation property
669 and make it negative for a user-variable
670 (doc starts with a `*'). */
05920a43
GM
671 if (!NILP (Fboundp (sym)))
672 Fput (sym, Qvariable_documentation,
673 make_number ((pos + end + 1 - buf)
674 * (end[1] == '*' ? -1 : 1)));
c6045832
JB
675 }
676
283e1184 677 /* Attach a docstring to a function? */
c6045832 678 else if (p[1] == 'F')
05920a43
GM
679 {
680 if (!NILP (Ffboundp (sym)))
681 store_function_docstring (sym, pos + end + 1 - buf);
682 }
6b61353c
KH
683 else if (p[1] == 'S')
684 ; /* Just a source file name boundary marker. Ignore it. */
685
283e1184 686 else
c2982e87 687 error ("DOC file invalid at position %"pI"d", pos);
c6045832
JB
688 }
689 }
690 pos += end - buf;
691 filled -= end - buf;
840b985a 692 memmove (buf, end, filled);
c6045832 693 }
68c45bf0 694 emacs_close (fd);
c6045832
JB
695 return Qnil;
696}
697\f
a7ca3326 698DEFUN ("substitute-command-keys", Fsubstitute_command_keys,
335c5470
PJ
699 Ssubstitute_command_keys, 1, 1, 0,
700 doc: /* Substitute key descriptions for command names in STRING.
353c87f6
CY
701Each substring of the form \\=\\[COMMAND] is replaced by either a
702keystroke sequence that invokes COMMAND, or "M-x COMMAND" if COMMAND
703is not on any keys.
704
705Each substring of the form \\=\\{MAPVAR} is replaced by a summary of
706the value of MAPVAR as a keymap. This summary is similar to the one
707produced by `describe-bindings'. The summary ends in two newlines
708\(used by the helper function `help-make-xrefs' to find the end of the
709summary).
710
711Each substring of the form \\=\\<MAPVAR> specifies the use of MAPVAR
335c5470
PJ
712as the keymap for future \\=\\[COMMAND] substrings.
713\\=\\= quotes the following character and is discarded;
c698360f
KS
714thus, \\=\\=\\=\\= puts \\=\\= into the output, and \\=\\=\\=\\[ puts \\=\\[ into the output.
715
353c87f6
CY
716Return the original STRING if no substitutions are made.
717Otherwise, return a new string, without any text properties. */)
5842a27b 718 (Lisp_Object string)
c6045832 719{
9eee99eb 720 char *buf;
a08d4ba7
PE
721 bool changed = 0;
722 unsigned char *strp;
723 char *bufp;
3d0c92a2
PE
724 ptrdiff_t idx;
725 ptrdiff_t bsize;
665d3046 726 Lisp_Object tem;
c6045832
JB
727 Lisp_Object keymap;
728 unsigned char *start;
3d0c92a2 729 ptrdiff_t length, length_byte;
665d3046
JB
730 Lisp_Object name;
731 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
a08d4ba7 732 bool multibyte;
3d0c92a2 733 ptrdiff_t nchars;
c6045832 734
4acb738e 735 if (NILP (string))
c6045832
JB
736 return Qnil;
737
b7826503 738 CHECK_STRING (string);
665d3046
JB
739 tem = Qnil;
740 keymap = Qnil;
741 name = Qnil;
4acb738e 742 GCPRO4 (string, tem, keymap, name);
c6045832 743
141199d1
RS
744 multibyte = STRING_MULTIBYTE (string);
745 nchars = 0;
746
9a425dcb
RS
747 /* KEYMAP is either nil (which means search all the active keymaps)
748 or a specified local map (which means search just that and the
749 global map). If non-nil, it might come from Voverriding_local_map,
4acb738e 750 or from a \\<mapname> construct in STRING itself.. */
1344aad4 751 keymap = KVAR (current_kboard, Voverriding_terminal_local_map);
f73d1163
KH
752 if (NILP (keymap))
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. */
26d4541d 851 Lisp_Object active_maps;
e679a3c1 852 Lisp_Object earlier_maps;
c6045832 853
26d4541d 854 active_maps = Fcurrent_active_maps (Qnil, Qnil);
c6045832
JB
855 changed = 1;
856 strp += 2; /* skip \{ or \< */
857 start = strp;
d5db4077 858 start_idx = start - SDATA (string);
c6045832 859
ccddfb9e 860 while ((strp - SDATA (string) < SBYTES (string))
c6045832
JB
861 && *strp != '}' && *strp != '>')
862 strp++;
141199d1
RS
863
864 length_byte = strp - start;
c6045832
JB
865 strp++; /* skip } or > */
866
867 /* Save STRP in IDX. */
8a7bde3e 868 idx = strp - SDATA (string);
c6045832
JB
869
870 /* Get the value of the keymap in TEM, or nil if undefined.
871 Do this while still in the user's current buffer
872 in case it is a local variable. */
9eee99eb 873 name = Fintern (make_string ((char *) start, length_byte), Qnil);
c6045832 874 tem = Fboundp (name);
265a9e55 875 if (! NILP (tem))
c6045832
JB
876 {
877 tem = Fsymbol_value (name);
265a9e55 878 if (! NILP (tem))
11f9d6e1 879 {
02067692
SM
880 tem = get_keymap (tem, 0, 1);
881 /* Note that get_keymap can GC. */
d5db4077
KR
882 strp = SDATA (string) + idx;
883 start = SDATA (string) + start_idx;
11f9d6e1 884 }
c6045832
JB
885 }
886
887 /* Now switch to a temp buffer. */
888 oldbuf = current_buffer;
889 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer));
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),
909 Qnil, (char *)0, 1, 0, 0, 1);
910 }
c6045832
JB
911 tem = Fbuffer_string ();
912 Ferase_buffer ();
913 set_buffer_internal (oldbuf);
914
915 subst_string:
d5db4077
KR
916 start = SDATA (tem);
917 length = SCHARS (tem);
918 length_byte = SBYTES (tem);
c6045832 919 subst:
8d17fe0b 920 {
3d0c92a2
PE
921 ptrdiff_t offset = bufp - buf;
922 if (STRING_BYTES_BOUND - length_byte < bsize)
923 string_overflow ();
38182d90 924 buf = xrealloc (buf, bsize += length_byte);
8d17fe0b 925 bufp = buf + offset;
72af86bd 926 memcpy (bufp, start, length_byte);
8d17fe0b
GM
927 bufp += length_byte;
928 nchars += length;
929 /* Check STRING again in case gc relocated it. */
51b59d79 930 strp = SDATA (string) + idx;
8d17fe0b 931 }
c6045832 932 }
141199d1
RS
933 else if (! multibyte) /* just copy other chars */
934 *bufp++ = *strp++, nchars++;
935 else
936 {
937 int len;
141199d1 938
62a6e103 939 STRING_CHAR_AND_LENGTH (strp, len);
141199d1
RS
940 if (len == 1)
941 *bufp = *strp;
942 else
72af86bd 943 memcpy (bufp, strp, len);
141199d1
RS
944 strp += len;
945 bufp += len;
946 nchars++;
947 }
c6045832
JB
948 }
949
950 if (changed) /* don't bother if nothing substituted */
cc5bf9eb 951 tem = make_string_from_bytes (buf, nchars, bufp - buf);
c6045832 952 else
4acb738e 953 tem = string;
9ac0d9e0 954 xfree (buf);
665d3046 955 RETURN_UNGCPRO (tem);
c6045832
JB
956}
957\f
dfcf069d 958void
971de7fb 959syms_of_doc (void)
c6045832 960{
cd3520a4 961 DEFSYM (Qfunction_documentation, "function-documentation");
177c0ea7 962
29208e82 963 DEFVAR_LISP ("internal-doc-file-name", Vdoc_file_name,
335c5470 964 doc: /* Name of file containing documentation strings of built-in symbols. */);
c6045832
JB
965 Vdoc_file_name = Qnil;
966
29208e82 967 DEFVAR_LISP ("build-files", Vbuild_files,
d87a9ab8
JD
968 doc: /* A list of files used to build this Emacs binary. */);
969 Vbuild_files = Qnil;
970
c6045832
JB
971 defsubr (&Sdocumentation);
972 defsubr (&Sdocumentation_property);
973 defsubr (&Ssnarf_documentation);
974 defsubr (&Ssubstitute_command_keys);
975}