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