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