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