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