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