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