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