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