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