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