* simple.el (list-processes--refresh): Delete exited processes.
[bpt/emacs.git] / src / doc.c
CommitLineData
c6045832 1/* Record indices of function doc strings stored in a file.
acaf905b 2 Copyright (C) 1985-1986, 1993-1995, 1997-2012
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;
3d0c92a2 42static ptrdiff_t get_doc_string_buffer_size;
912e8480 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);
8fe012c4 119 file = ENCODE_FILE (file);
700ea809
RS
120 if (NILP (tem))
121 {
8fe012c4
SM
122 Lisp_Object docdir = ENCODE_FILE (Vdoc_directory);
123 minsize = SCHARS (docdir);
700ea809
RS
124 /* sizeof ("../etc/") == 8 */
125 if (minsize < 8)
126 minsize = 8;
d5db4077 127 name = (char *) alloca (minsize + SCHARS (file) + 8);
8fe012c4 128 strcpy (name, SSDATA (docdir));
42a5b22f 129 strcat (name, SSDATA (file));
700ea809
RS
130 }
131 else
132 {
51b59d79 133 name = SSDATA (file);
700ea809 134 }
c6045832 135
68c45bf0 136 fd = emacs_open (name, O_RDONLY, 0);
c6045832 137 if (fd < 0)
778d47c7
RS
138 {
139#ifndef CANNOT_DUMP
140 if (!NILP (Vpurify_flag))
141 {
142 /* Preparing to dump; DOC file is probably not installed.
8fe012c4 143 So check in ../etc. */
778d47c7 144 strcpy (name, "../etc/");
42a5b22f 145 strcat (name, SSDATA (file));
778d47c7 146
68c45bf0 147 fd = emacs_open (name, O_RDONLY, 0);
778d47c7
RS
148 }
149#endif
778d47c7
RS
150 if (fd < 0)
151 error ("Cannot open doc string file \"%s\"", name);
152 }
153
0fded513 154 /* Seek only to beginning of disk block. */
a154a4ef
SM
155 /* Make sure we read at least 1024 bytes before `position'
156 so we can check the leading text for consistency. */
157 offset = min (position, max (1024, position % (8 * 1024)));
0fded513 158 if (0 > lseek (fd, position - offset, 0))
c6045832 159 {
68c45bf0 160 emacs_close (fd);
c2982e87 161 error ("Position %"pI"d out of range in doc string file \"%s\"",
700ea809 162 position, name);
c6045832 163 }
700ea809 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. */
9eee99eb
PE
282 EMACS_INT nchars =
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
e5aa79fa 302static int
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;
e5aa79fa
SM
335 int try_reload = 1;
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 {
c6045832 382 funcar = Fcar (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{
e5aa79fa 467 int 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
1449fa1d 505store_function_docstring (Lisp_Object sym, EMACS_INT offset)
b8ce688b 506/* Use EMACS_INT because we get offset from pointer subtraction. */
283e1184 507{
1449fa1d
CY
508 /* Don't use indirect_function here, or defaliases will apply their
509 docstrings to the base functions (Bug#2603). */
510 Lisp_Object fun = XSYMBOL (sym)->function;
283e1184
JB
511
512 /* The type determines where the docstring is stored. */
513
514 /* Lisp_Subrs have a slot for it. */
e6d12642 515 if (SUBRP (fun))
b08a63cc
PE
516 {
517 intptr_t negative_offset = - offset;
518 XSUBR (fun)->doc = (char *) negative_offset;
519 }
283e1184
JB
520
521 /* If it's a lisp form, stick it in the form. */
522 else if (CONSP (fun))
523 {
524 Lisp_Object tem;
525
03699b14 526 tem = XCAR (fun);
23aba0ea
SM
527 if (EQ (tem, Qlambda) || EQ (tem, Qautoload)
528 || (EQ (tem, Qclosure) && (fun = XCDR (fun), 1)))
283e1184
JB
529 {
530 tem = Fcdr (Fcdr (fun));
03699b14 531 if (CONSP (tem) && INTEGERP (XCAR (tem)))
d6d23852 532 XSETCAR (tem, make_number (offset));
283e1184
JB
533 }
534 else if (EQ (tem, Qmacro))
03699b14 535 store_function_docstring (XCDR (fun), offset);
283e1184
JB
536 }
537
538 /* Bytecode objects sometimes have slots for it. */
e6d12642 539 else if (COMPILEDP (fun))
283e1184
JB
540 {
541 /* This bytecode object must have a slot for the
542 docstring, since we've found a docstring for it. */
87afdd65 543 if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) > COMPILED_DOC_STRING)
3ae565b3 544 ASET (fun, COMPILED_DOC_STRING, make_number (offset));
283e1184
JB
545 }
546}
547
878bde49 548static const char buildobj[] = BUILDOBJ;
283e1184 549
c6045832 550DEFUN ("Snarf-documentation", Fsnarf_documentation, Ssnarf_documentation,
335c5470 551 1, 1, 0,
f4e25f94
RS
552 doc: /* Used during Emacs initialization to scan the `etc/DOC...' file.
553This searches the `etc/DOC...' file for doc strings and
554records them in function and variable definitions.
555The function takes one argument, FILENAME, a string;
556it specifies the file name (without a directory) of the DOC file.
557That file is found in `../etc' now; later, when the dumped Emacs is run,
98b6690a 558the same file name is found in the `doc-directory'. */)
5842a27b 559 (Lisp_Object filename)
c6045832
JB
560{
561 int fd;
562 char buf[1024 + 1];
84c9ce05
LMI
563 register EMACS_INT filled;
564 register EMACS_INT pos;
a415e694 565 register char *p;
24109c98 566 Lisp_Object sym;
c6045832 567 char *name;
d87a9ab8 568 int skip_file = 0;
c6045832 569
b7826503 570 CHECK_STRING (filename);
c6045832 571
a154a4ef 572 if
c6045832 573#ifndef CANNOT_DUMP
a154a4ef 574 (!NILP (Vpurify_flag))
c6045832 575#else /* CANNOT_DUMP */
a154a4ef 576 (0)
c6045832 577#endif /* CANNOT_DUMP */
a154a4ef 578 {
d5db4077 579 name = (char *) alloca (SCHARS (filename) + 14);
a154a4ef
SM
580 strcpy (name, "../etc/");
581 }
582 else
583 {
584 CHECK_STRING (Vdoc_directory);
d5db4077
KR
585 name = (char *) alloca (SCHARS (filename)
586 + SCHARS (Vdoc_directory) + 1);
42a5b22f 587 strcpy (name, SSDATA (Vdoc_directory));
a154a4ef 588 }
42a5b22f 589 strcat (name, SSDATA (filename)); /*** Add this line ***/
c6045832 590
d87a9ab8
JD
591 /* Vbuild_files is nil when temacs is run, and non-nil after that. */
592 if (NILP (Vbuild_files))
593 {
878bde49 594 const char *beg, *end;
d87a9ab8 595
878bde49 596 for (beg = buildobj; *beg; beg = end)
d87a9ab8 597 {
84c9ce05 598 EMACS_INT len;
d87a9ab8
JD
599
600 while (*beg && isspace (*beg)) ++beg;
601
602 for (end = beg; *end && ! isspace (*end); ++end)
603 if (*end == '/') beg = end+1; /* skip directory part */
604
605 len = end - beg;
606 if (len > 4 && end[-4] == '.' && end[-3] == 'o')
607 len -= 2; /* Just take .o if it ends in .obj */
608
609 if (len > 0)
610 Vbuild_files = Fcons (make_string (beg, len), Vbuild_files);
611 }
a4ada374 612 Vbuild_files = Fpurecopy (Vbuild_files);
d87a9ab8
JD
613 }
614
68c45bf0 615 fd = emacs_open (name, O_RDONLY, 0);
c6045832
JB
616 if (fd < 0)
617 report_file_error ("Opening doc string file",
618 Fcons (build_string (name), Qnil));
619 Vdoc_file_name = filename;
620 filled = 0;
621 pos = 0;
622 while (1)
623 {
a415e694 624 register char *end;
c6045832 625 if (filled < 512)
68c45bf0 626 filled += emacs_read (fd, &buf[filled], sizeof buf - 1 - filled);
c6045832
JB
627 if (!filled)
628 break;
629
630 buf[filled] = 0;
631 p = buf;
632 end = buf + (filled < 512 ? filled : filled - 128);
633 while (p != end && *p != '\037') p++;
983b8302 634 /* p points to ^_Ffunctionname\n or ^_Vvarname\n or ^_Sfilename\n. */
c6045832
JB
635 if (p != end)
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 {
84c9ce05 646 EMACS_INT len = end - p - 2;
983b8302
J
647 char *fromfile = alloca (len + 1);
648 strncpy (fromfile, &p[2], len);
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 `*'). */
674 Fput (sym, Qvariable_documentation,
675 make_number ((pos + end + 1 - buf)
676 * (end[1] == '*' ? -1 : 1)));
677 }
678
283e1184 679 /* Attach a docstring to a function? */
c6045832 680 else if (p[1] == 'F')
283e1184
JB
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.
c698360f
KS
701Substrings of the form \\=\\[COMMAND] replaced by either: a keystroke
702sequence that will invoke COMMAND, or "M-x COMMAND" if COMMAND is not
703on any keys.
335c5470 704Substrings of the form \\=\\{MAPVAR} are replaced by summaries
04bf6783 705\(made by `describe-bindings') of the value of MAPVAR, taken as a keymap.
335c5470
PJ
706Substrings of the form \\=\\<MAPVAR> specify to use the value of MAPVAR
707as the keymap for future \\=\\[COMMAND] substrings.
708\\=\\= quotes the following character and is discarded;
c698360f
KS
709thus, \\=\\=\\=\\= puts \\=\\= into the output, and \\=\\=\\=\\[ puts \\=\\[ into the output.
710
2610bf68 711Returns original STRING if no substitutions were made. Otherwise,
c698360f 712a new string, without any text properties, is returned. */)
5842a27b 713 (Lisp_Object string)
c6045832 714{
9eee99eb 715 char *buf;
c6045832
JB
716 int changed = 0;
717 register unsigned char *strp;
9eee99eb 718 register char *bufp;
3d0c92a2
PE
719 ptrdiff_t idx;
720 ptrdiff_t bsize;
665d3046 721 Lisp_Object tem;
c6045832
JB
722 Lisp_Object keymap;
723 unsigned char *start;
3d0c92a2 724 ptrdiff_t length, length_byte;
665d3046
JB
725 Lisp_Object name;
726 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
141199d1 727 int multibyte;
3d0c92a2 728 ptrdiff_t nchars;
c6045832 729
4acb738e 730 if (NILP (string))
c6045832
JB
731 return Qnil;
732
b7826503 733 CHECK_STRING (string);
665d3046
JB
734 tem = Qnil;
735 keymap = Qnil;
736 name = Qnil;
4acb738e 737 GCPRO4 (string, tem, keymap, name);
c6045832 738
141199d1
RS
739 multibyte = STRING_MULTIBYTE (string);
740 nchars = 0;
741
9a425dcb
RS
742 /* KEYMAP is either nil (which means search all the active keymaps)
743 or a specified local map (which means search just that and the
744 global map). If non-nil, it might come from Voverriding_local_map,
4acb738e 745 or from a \\<mapname> construct in STRING itself.. */
1344aad4 746 keymap = KVAR (current_kboard, Voverriding_terminal_local_map);
f73d1163
KH
747 if (NILP (keymap))
748 keymap = Voverriding_local_map;
c6045832 749
d5db4077 750 bsize = SBYTES (string);
9eee99eb 751 bufp = buf = (char *) xmalloc (bsize);
c6045832 752
8a7bde3e 753 strp = SDATA (string);
d5db4077 754 while (strp < SDATA (string) + SBYTES (string))
c6045832
JB
755 {
756 if (strp[0] == '\\' && strp[1] == '=')
757 {
758 /* \= quotes the next character;
759 thus, to put in \[ without its special meaning, use \=\[. */
760 changed = 1;
141199d1
RS
761 strp += 2;
762 if (multibyte)
763 {
764 int len;
141199d1 765
62a6e103 766 STRING_CHAR_AND_LENGTH (strp, len);
141199d1
RS
767 if (len == 1)
768 *bufp = *strp;
769 else
72af86bd 770 memcpy (bufp, strp, len);
141199d1
RS
771 strp += len;
772 bufp += len;
773 nchars++;
774 }
775 else
776 *bufp++ = *strp++, nchars++;
c6045832
JB
777 }
778 else if (strp[0] == '\\' && strp[1] == '[')
779 {
3d0c92a2 780 ptrdiff_t start_idx;
a1d3a188 781 int follow_remap = 1;
b6c53774 782
c6045832
JB
783 changed = 1;
784 strp += 2; /* skip \[ */
785 start = strp;
d5db4077 786 start_idx = start - SDATA (string);
c6045832 787
8a7bde3e 788 while ((strp - SDATA (string)
d5db4077 789 < SBYTES (string))
c6045832
JB
790 && *strp != ']')
791 strp++;
141199d1
RS
792 length_byte = strp - start;
793
c6045832
JB
794 strp++; /* skip ] */
795
796 /* Save STRP in IDX. */
8a7bde3e 797 idx = strp - SDATA (string);
9eee99eb 798 name = Fintern (make_string ((char *) start, length_byte), Qnil);
11f9d6e1 799
a1d3a188 800 do_remap:
a88a5372 801 tem = Fwhere_is_internal (name, keymap, Qt, Qnil, Qnil);
332e51c1 802
77b37c05 803 if (VECTORP (tem) && ASIZE (tem) > 1
a1d3a188
KS
804 && EQ (AREF (tem, 0), Qremap) && SYMBOLP (AREF (tem, 1))
805 && follow_remap)
806 {
807 name = AREF (tem, 1);
808 follow_remap = 0;
809 goto do_remap;
810 }
811
11f9d6e1
GM
812 /* Note the Fwhere_is_internal can GC, so we have to take
813 relocation of string contents into account. */
d5db4077
KR
814 strp = SDATA (string) + idx;
815 start = SDATA (string) + start_idx;
c6045832 816
265a9e55 817 if (NILP (tem)) /* but not on any keys */
c6045832 818 {
3d0c92a2
PE
819 ptrdiff_t offset = bufp - buf;
820 if (STRING_BYTES_BOUND - 4 < bsize)
821 string_overflow ();
9eee99eb 822 buf = (char *) xrealloc (buf, bsize += 4);
8d17fe0b 823 bufp = buf + offset;
72af86bd 824 memcpy (bufp, "M-x ", 4);
c6045832 825 bufp += 4;
141199d1
RS
826 nchars += 4;
827 if (multibyte)
828 length = multibyte_chars_in_text (start, length_byte);
829 else
830 length = length_byte;
c6045832
JB
831 goto subst;
832 }
833 else
834 { /* function is on a key */
a1bfe073 835 tem = Fkey_description (tem, Qnil);
c6045832
JB
836 goto subst_string;
837 }
838 }
839 /* \{foo} is replaced with a summary of the keymap (symbol-value foo).
840 \<foo> just sets the keymap used for \[cmd]. */
841 else if (strp[0] == '\\' && (strp[1] == '{' || strp[1] == '<'))
842 {
843 struct buffer *oldbuf;
3d0c92a2 844 ptrdiff_t start_idx;
e679a3c1 845 /* This is for computing the SHADOWS arg for describe_map_tree. */
9a51747b 846 Lisp_Object active_maps = Fcurrent_active_maps (Qnil, Qnil);
e679a3c1 847 Lisp_Object earlier_maps;
c6045832
JB
848
849 changed = 1;
850 strp += 2; /* skip \{ or \< */
851 start = strp;
d5db4077 852 start_idx = start - SDATA (string);
c6045832 853
ccddfb9e 854 while ((strp - SDATA (string) < SBYTES (string))
c6045832
JB
855 && *strp != '}' && *strp != '>')
856 strp++;
141199d1
RS
857
858 length_byte = strp - start;
c6045832
JB
859 strp++; /* skip } or > */
860
861 /* Save STRP in IDX. */
8a7bde3e 862 idx = strp - SDATA (string);
c6045832
JB
863
864 /* Get the value of the keymap in TEM, or nil if undefined.
865 Do this while still in the user's current buffer
866 in case it is a local variable. */
9eee99eb 867 name = Fintern (make_string ((char *) start, length_byte), Qnil);
c6045832 868 tem = Fboundp (name);
265a9e55 869 if (! NILP (tem))
c6045832
JB
870 {
871 tem = Fsymbol_value (name);
265a9e55 872 if (! NILP (tem))
11f9d6e1 873 {
02067692
SM
874 tem = get_keymap (tem, 0, 1);
875 /* Note that get_keymap can GC. */
d5db4077
KR
876 strp = SDATA (string) + idx;
877 start = SDATA (string) + start_idx;
11f9d6e1 878 }
c6045832
JB
879 }
880
881 /* Now switch to a temp buffer. */
882 oldbuf = current_buffer;
883 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer));
884
265a9e55 885 if (NILP (tem))
c6045832
JB
886 {
887 name = Fsymbol_name (name);
888 insert_string ("\nUses keymap \"");
141199d1 889 insert_from_string (name, 0, 0,
d5db4077
KR
890 SCHARS (name),
891 SBYTES (name), 1);
c6045832
JB
892 insert_string ("\", which is not currently defined.\n");
893 if (start[-1] == '<') keymap = Qnil;
894 }
895 else if (start[-1] == '<')
896 keymap = tem;
897 else
e679a3c1
RS
898 {
899 /* Get the list of active keymaps that precede this one.
900 If this one's not active, get nil. */
901 earlier_maps = Fcdr (Fmemq (tem, Freverse (active_maps)));
902 describe_map_tree (tem, 1, Fnreverse (earlier_maps),
903 Qnil, (char *)0, 1, 0, 0, 1);
904 }
c6045832
JB
905 tem = Fbuffer_string ();
906 Ferase_buffer ();
907 set_buffer_internal (oldbuf);
908
909 subst_string:
d5db4077
KR
910 start = SDATA (tem);
911 length = SCHARS (tem);
912 length_byte = SBYTES (tem);
c6045832 913 subst:
8d17fe0b 914 {
3d0c92a2
PE
915 ptrdiff_t offset = bufp - buf;
916 if (STRING_BYTES_BOUND - length_byte < bsize)
917 string_overflow ();
9eee99eb 918 buf = (char *) xrealloc (buf, bsize += length_byte);
8d17fe0b 919 bufp = buf + offset;
72af86bd 920 memcpy (bufp, start, length_byte);
8d17fe0b
GM
921 bufp += length_byte;
922 nchars += length;
923 /* Check STRING again in case gc relocated it. */
51b59d79 924 strp = SDATA (string) + idx;
8d17fe0b 925 }
c6045832 926 }
141199d1
RS
927 else if (! multibyte) /* just copy other chars */
928 *bufp++ = *strp++, nchars++;
929 else
930 {
931 int len;
141199d1 932
62a6e103 933 STRING_CHAR_AND_LENGTH (strp, len);
141199d1
RS
934 if (len == 1)
935 *bufp = *strp;
936 else
72af86bd 937 memcpy (bufp, strp, len);
141199d1
RS
938 strp += len;
939 bufp += len;
940 nchars++;
941 }
c6045832
JB
942 }
943
944 if (changed) /* don't bother if nothing substituted */
cc5bf9eb 945 tem = make_string_from_bytes (buf, nchars, bufp - buf);
c6045832 946 else
4acb738e 947 tem = string;
9ac0d9e0 948 xfree (buf);
665d3046 949 RETURN_UNGCPRO (tem);
c6045832
JB
950}
951\f
dfcf069d 952void
971de7fb 953syms_of_doc (void)
c6045832 954{
cd3520a4 955 DEFSYM (Qfunction_documentation, "function-documentation");
177c0ea7 956
29208e82 957 DEFVAR_LISP ("internal-doc-file-name", Vdoc_file_name,
335c5470 958 doc: /* Name of file containing documentation strings of built-in symbols. */);
c6045832
JB
959 Vdoc_file_name = Qnil;
960
29208e82 961 DEFVAR_LISP ("build-files", Vbuild_files,
d87a9ab8
JD
962 doc: /* A list of files used to build this Emacs binary. */);
963 Vbuild_files = Qnil;
964
c6045832
JB
965 defsubr (&Sdocumentation);
966 defsubr (&Sdocumentation_property);
967 defsubr (&Ssnarf_documentation);
968 defsubr (&Ssubstitute_command_keys);
969}