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