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