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