(store_symval_forwarding): Remove unused variables.
[bpt/emacs.git] / src / doc.c
CommitLineData
c6045832 1/* Record indices of function doc strings stored in a file.
a12a9bd6
SM
2 Copyright (C) 1985, 86,93,94,95,97,98,99,2000,04
3 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
3b7ad313
EN
19the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20Boston, MA 02111-1307, 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*/
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"
141199d1 43#include "charset.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
778d47c7
RS
59/* For VMS versions with limited file name syntax,
60 convert the name to something VMS will allow. */
61static void
62munge_doc_file_name (name)
63 char *name;
c6045832 64{
c6045832
JB
65#ifdef VMS
66#ifndef VMS4_4
67 /* For VMS versions with limited file name syntax,
68 convert the name to something VMS will allow. */
69 p = name;
70 while (*p)
71 {
72 if (*p == '-')
73 *p = '_';
74 p++;
75 }
76#endif /* not VMS4_4 */
77#ifdef VMS4_4
78 strcpy (name, sys_translate_unix (name));
79#endif /* VMS4_4 */
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
502ddf23 388 fun = Findirect_function (function);
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))
c6045832 418 return Fsignal (Qinvalid_function, Fcons (fun, Qnil));
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:
445 Fsignal (Qinvalid_function, Fcons (fun, Qnil));
c6045832 446 }
ee04dc54 447
e5aa79fa
SM
448 /* If DOC is 0, it's typically because of a dumped file missing
449 from the DOC file (bug in src/Makefile.in). */
71cdb109
SM
450 if (EQ (doc, make_number (0)))
451 doc = Qnil;
68d8a8e1 452 if (INTEGERP (doc) || CONSP (doc))
a154a4ef
SM
453 {
454 Lisp_Object tem;
455 tem = get_doc_string (doc, 0, 0);
e5aa79fa 456 if (NILP (tem) && try_reload)
a154a4ef
SM
457 {
458 /* The file is newer, we need to reset the pointers. */
459 struct gcpro gcpro1, gcpro2;
460 GCPRO2 (function, raw);
e5aa79fa 461 try_reload = reread_doc_file (Fcar_safe (doc));
a154a4ef 462 UNGCPRO;
e5aa79fa
SM
463 if (try_reload)
464 {
465 try_reload = 0;
466 goto documentation;
467 }
a154a4ef
SM
468 }
469 else
470 doc = tem;
471 }
87afdd65 472
956ace37 473 if (NILP (raw))
441d75e5 474 doc = Fsubstitute_command_keys (doc);
ee04dc54 475 return doc;
c6045832
JB
476}
477
f6ee1260
GM
478DEFUN ("documentation-property", Fdocumentation_property,
479 Sdocumentation_property, 2, 3, 0,
335c5470
PJ
480 doc: /* Return the documentation string that is SYMBOL's PROP property.
481Third argument RAW omitted or nil means pass the result through
482`substitute-command-keys' if it is a string.
483
484This differs from `get' in that it can refer to strings stored in the
485`etc/DOC' file; and that it evaluates documentation properties that
486aren't strings. */)
4acb738e
EN
487 (symbol, prop, raw)
488 Lisp_Object symbol, prop, raw;
c6045832 489{
e5aa79fa 490 int try_reload = 1;
2f0b74ea 491 Lisp_Object tem;
c6045832 492
e5aa79fa 493 documentation_property:
177c0ea7 494
4acb738e 495 tem = Fget (symbol, prop);
44766095 496 if (EQ (tem, make_number (0)))
71cdb109 497 tem = Qnil;
68d8a8e1 498 if (INTEGERP (tem) || (CONSP (tem) && INTEGERP (XCDR (tem))))
a154a4ef
SM
499 {
500 Lisp_Object doc = tem;
501 tem = get_doc_string (tem, 0, 0);
e5aa79fa 502 if (NILP (tem) && try_reload)
a154a4ef
SM
503 {
504 /* The file is newer, we need to reset the pointers. */
505 struct gcpro gcpro1, gcpro2, gcpro3;
506 GCPRO3 (symbol, prop, raw);
e5aa79fa 507 try_reload = reread_doc_file (Fcar_safe (doc));
a154a4ef 508 UNGCPRO;
e5aa79fa
SM
509 if (try_reload)
510 {
511 try_reload = 0;
512 goto documentation_property;
513 }
a154a4ef
SM
514 }
515 }
f6ee1260
GM
516 else if (!STRINGP (tem))
517 /* Feval protects its argument. */
518 tem = Feval (tem);
177c0ea7 519
e6d12642 520 if (NILP (raw) && STRINGP (tem))
bbd7d5d3 521 tem = Fsubstitute_command_keys (tem);
992d176e 522 return tem;
c6045832
JB
523}
524\f
283e1184
JB
525/* Scanning the DOC files and placing docstring offsets into functions. */
526
527static void
528store_function_docstring (fun, offset)
529 Lisp_Object fun;
e343d389
RS
530 /* Use EMACS_INT because we get this from pointer subtraction. */
531 EMACS_INT offset;
283e1184
JB
532{
533 fun = indirect_function (fun);
534
535 /* The type determines where the docstring is stored. */
536
537 /* Lisp_Subrs have a slot for it. */
e6d12642 538 if (SUBRP (fun))
283e1184
JB
539 XSUBR (fun)->doc = (char *) - offset;
540
541 /* If it's a lisp form, stick it in the form. */
542 else if (CONSP (fun))
543 {
544 Lisp_Object tem;
545
03699b14 546 tem = XCAR (fun);
283e1184
JB
547 if (EQ (tem, Qlambda) || EQ (tem, Qautoload))
548 {
549 tem = Fcdr (Fcdr (fun));
03699b14 550 if (CONSP (tem) && INTEGERP (XCAR (tem)))
f3fbd155 551 XSETCARFASTINT (tem, offset);
283e1184
JB
552 }
553 else if (EQ (tem, Qmacro))
03699b14 554 store_function_docstring (XCDR (fun), offset);
283e1184
JB
555 }
556
557 /* Bytecode objects sometimes have slots for it. */
e6d12642 558 else if (COMPILEDP (fun))
283e1184
JB
559 {
560 /* This bytecode object must have a slot for the
561 docstring, since we've found a docstring for it. */
87afdd65
SM
562 if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) > COMPILED_DOC_STRING)
563 XSETFASTINT (AREF (fun, COMPILED_DOC_STRING), offset);
283e1184
JB
564 }
565}
566
567
c6045832 568DEFUN ("Snarf-documentation", Fsnarf_documentation, Ssnarf_documentation,
335c5470 569 1, 1, 0,
f4e25f94
RS
570 doc: /* Used during Emacs initialization to scan the `etc/DOC...' file.
571This searches the `etc/DOC...' file for doc strings and
572records them in function and variable definitions.
573The function takes one argument, FILENAME, a string;
574it specifies the file name (without a directory) of the DOC file.
575That file is found in `../etc' now; later, when the dumped Emacs is run,
98b6690a 576the same file name is found in the `doc-directory'. */)
335c5470 577 (filename)
c6045832
JB
578 Lisp_Object filename;
579{
580 int fd;
581 char buf[1024 + 1];
582 register int filled;
583 register int pos;
584 register char *p, *end;
24109c98 585 Lisp_Object sym;
c6045832 586 char *name;
d87a9ab8 587 int skip_file = 0;
c6045832 588
b7826503 589 CHECK_STRING (filename);
c6045832 590
a154a4ef 591 if
c6045832 592#ifndef CANNOT_DUMP
a154a4ef 593 (!NILP (Vpurify_flag))
c6045832 594#else /* CANNOT_DUMP */
a154a4ef 595 (0)
c6045832 596#endif /* CANNOT_DUMP */
a154a4ef 597 {
d5db4077 598 name = (char *) alloca (SCHARS (filename) + 14);
a154a4ef
SM
599 strcpy (name, "../etc/");
600 }
601 else
602 {
603 CHECK_STRING (Vdoc_directory);
d5db4077
KR
604 name = (char *) alloca (SCHARS (filename)
605 + SCHARS (Vdoc_directory) + 1);
606 strcpy (name, SDATA (Vdoc_directory));
a154a4ef 607 }
d5db4077 608 strcat (name, SDATA (filename)); /*** Add this line ***/
c6045832
JB
609#ifdef VMS
610#ifndef VMS4_4
611 /* For VMS versions with limited file name syntax,
612 convert the name to something VMS will allow. */
613 p = name;
614 while (*p)
615 {
616 if (*p == '-')
617 *p = '_';
618 p++;
619 }
a12a9bd6 620#else /* VMS4_4 */
c6045832
JB
621 strcpy (name, sys_translate_unix (name));
622#endif /* VMS4_4 */
623#endif /* VMS */
624
d87a9ab8
JD
625 /* Vbuild_files is nil when temacs is run, and non-nil after that. */
626 if (NILP (Vbuild_files))
627 {
628 size_t cp_size = 0;
629 size_t to_read;
630 int nr_read;
631 char *cp = NULL;
632 char *beg, *end;
633
634 fd = emacs_open ("buildobj.lst", O_RDONLY, 0);
635 if (fd < 0)
636 report_file_error ("Opening file buildobj.lst", Qnil);
637
638 filled = 0;
639 for (;;)
640 {
641 cp_size += 1024;
642 to_read = cp_size - 1 - filled;
643 cp = xrealloc (cp, cp_size);
644 nr_read = emacs_read (fd, &cp[filled], to_read);
645 filled += nr_read;
646 if (nr_read < to_read)
647 break;
648 }
649
650 emacs_close (fd);
651 cp[filled] = 0;
652
653 for (beg = cp; *beg; beg = end)
654 {
655 int len;
656
657 while (*beg && isspace (*beg)) ++beg;
658
659 for (end = beg; *end && ! isspace (*end); ++end)
660 if (*end == '/') beg = end+1; /* skip directory part */
661
662 len = end - beg;
663 if (len > 4 && end[-4] == '.' && end[-3] == 'o')
664 len -= 2; /* Just take .o if it ends in .obj */
665
666 if (len > 0)
667 Vbuild_files = Fcons (make_string (beg, len), Vbuild_files);
668 }
669
670 xfree (cp);
671 }
672
68c45bf0 673 fd = emacs_open (name, O_RDONLY, 0);
c6045832
JB
674 if (fd < 0)
675 report_file_error ("Opening doc string file",
676 Fcons (build_string (name), Qnil));
677 Vdoc_file_name = filename;
678 filled = 0;
679 pos = 0;
680 while (1)
681 {
682 if (filled < 512)
68c45bf0 683 filled += emacs_read (fd, &buf[filled], sizeof buf - 1 - filled);
c6045832
JB
684 if (!filled)
685 break;
686
687 buf[filled] = 0;
688 p = buf;
689 end = buf + (filled < 512 ? filled : filled - 128);
690 while (p != end && *p != '\037') p++;
691 /* p points to ^_Ffunctionname\n or ^_Vvarname\n. */
692 if (p != end)
693 {
a847af86 694 end = (char *) index (p, '\n');
d87a9ab8
JD
695
696 /* See if this is a file name, and if it is a file in build-files. */
697 if (p[1] == 'S' && end - p > 4 && end[-2] == '.'
698 && (end[-1] == 'o' || end[-1] == 'c'))
699 {
700 int len = end - p - 2;
701 char *fromfile = alloca (len + 1);
702 strncpy (fromfile, &p[2], len);
703 fromfile[len] = 0;
704 if (fromfile[len-1] == 'c')
705 fromfile[len-1] = 'o';
706
707 if (EQ (Fmember (build_string (fromfile), Vbuild_files), Qnil))
708 skip_file = 1;
709 else
710 skip_file = 0;
711 }
712
141199d1
RS
713 sym = oblookup (Vobarray, p + 2,
714 multibyte_chars_in_text (p + 2, end - p - 2),
715 end - p - 2);
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
a12a9bd6
SM
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.
751Return a new string which is STRING with substrings of the form \\=\\[COMMAND]
752replaced by either: a keystroke sequence that will invoke COMMAND,
753or "M-x COMMAND" if COMMAND is not on any keys.
754Substrings of the form \\=\\{MAPVAR} are replaced by summaries
755\(made by describe-bindings) of the value of MAPVAR, taken as a keymap.
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;
759thus, \\=\\=\\=\\= puts \\=\\= into the output, and \\=\\=\\=\\[ puts \\=\\[ into the output. */)
760 (string)
4acb738e 761 Lisp_Object string;
c6045832
JB
762{
763 unsigned char *buf;
764 int changed = 0;
765 register unsigned char *strp;
766 register unsigned char *bufp;
767 int idx;
768 int bsize;
665d3046 769 Lisp_Object tem;
c6045832
JB
770 Lisp_Object keymap;
771 unsigned char *start;
2d0aa229 772 int length, length_byte;
665d3046
JB
773 Lisp_Object name;
774 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
141199d1
RS
775 int multibyte;
776 int nchars;
c6045832 777
4acb738e 778 if (NILP (string))
c6045832
JB
779 return Qnil;
780
b7826503 781 CHECK_STRING (string);
665d3046
JB
782 tem = Qnil;
783 keymap = Qnil;
784 name = Qnil;
4acb738e 785 GCPRO4 (string, tem, keymap, name);
c6045832 786
141199d1
RS
787 multibyte = STRING_MULTIBYTE (string);
788 nchars = 0;
789
9a425dcb
RS
790 /* KEYMAP is either nil (which means search all the active keymaps)
791 or a specified local map (which means search just that and the
792 global map). If non-nil, it might come from Voverriding_local_map,
4acb738e 793 or from a \\<mapname> construct in STRING itself.. */
f73d1163
KH
794 keymap = current_kboard->Voverriding_terminal_local_map;
795 if (NILP (keymap))
796 keymap = Voverriding_local_map;
c6045832 797
d5db4077 798 bsize = SBYTES (string);
c6045832
JB
799 bufp = buf = (unsigned char *) xmalloc (bsize);
800
8a7bde3e 801 strp = SDATA (string);
d5db4077 802 while (strp < SDATA (string) + SBYTES (string))
c6045832
JB
803 {
804 if (strp[0] == '\\' && strp[1] == '=')
805 {
806 /* \= quotes the next character;
807 thus, to put in \[ without its special meaning, use \=\[. */
808 changed = 1;
141199d1
RS
809 strp += 2;
810 if (multibyte)
811 {
812 int len;
d5db4077 813 int maxlen = SDATA (string) + SBYTES (string) - strp;
141199d1
RS
814
815 STRING_CHAR_AND_LENGTH (strp, maxlen, len);
816 if (len == 1)
817 *bufp = *strp;
818 else
819 bcopy (strp, bufp, len);
820 strp += len;
821 bufp += len;
822 nchars++;
823 }
824 else
825 *bufp++ = *strp++, nchars++;
c6045832
JB
826 }
827 else if (strp[0] == '\\' && strp[1] == '[')
828 {
b6c53774 829 Lisp_Object firstkey;
11f9d6e1 830 int start_idx;
b6c53774 831
c6045832
JB
832 changed = 1;
833 strp += 2; /* skip \[ */
834 start = strp;
d5db4077 835 start_idx = start - SDATA (string);
c6045832 836
8a7bde3e 837 while ((strp - SDATA (string)
d5db4077 838 < SBYTES (string))
c6045832
JB
839 && *strp != ']')
840 strp++;
141199d1
RS
841 length_byte = strp - start;
842
c6045832
JB
843 strp++; /* skip ] */
844
845 /* Save STRP in IDX. */
8a7bde3e 846 idx = strp - SDATA (string);
3584d95d 847 name = Fintern (make_string (start, length_byte), Qnil);
11f9d6e1 848
332e51c1 849 /* Ignore remappings unless there are no ordinary bindings. */
3584d95d 850 tem = Fwhere_is_internal (name, keymap, Qt, Qnil, Qt);
332e51c1 851 if (NILP (tem))
3584d95d 852 tem = Fwhere_is_internal (name, keymap, Qt, Qnil, Qnil);
332e51c1 853
11f9d6e1
GM
854 /* Note the Fwhere_is_internal can GC, so we have to take
855 relocation of string contents into account. */
d5db4077
KR
856 strp = SDATA (string) + idx;
857 start = SDATA (string) + start_idx;
c6045832 858
265a9e55 859 if (NILP (tem)) /* but not on any keys */
c6045832 860 {
8d17fe0b
GM
861 int offset = bufp - buf;
862 buf = (unsigned char *) xrealloc (buf, bsize += 4);
863 bufp = buf + offset;
c6045832
JB
864 bcopy ("M-x ", bufp, 4);
865 bufp += 4;
141199d1
RS
866 nchars += 4;
867 if (multibyte)
868 length = multibyte_chars_in_text (start, length_byte);
869 else
870 length = length_byte;
c6045832
JB
871 goto subst;
872 }
873 else
874 { /* function is on a key */
a1bfe073 875 tem = Fkey_description (tem, Qnil);
c6045832
JB
876 goto subst_string;
877 }
878 }
879 /* \{foo} is replaced with a summary of the keymap (symbol-value foo).
880 \<foo> just sets the keymap used for \[cmd]. */
881 else if (strp[0] == '\\' && (strp[1] == '{' || strp[1] == '<'))
882 {
883 struct buffer *oldbuf;
11f9d6e1 884 int start_idx;
c6045832
JB
885
886 changed = 1;
887 strp += 2; /* skip \{ or \< */
888 start = strp;
d5db4077 889 start_idx = start - SDATA (string);
c6045832 890
409949b5 891 while ((strp - SDATA (string) < SBYTES (string))
c6045832
JB
892 && *strp != '}' && *strp != '>')
893 strp++;
141199d1
RS
894
895 length_byte = strp - start;
c6045832
JB
896 strp++; /* skip } or > */
897
898 /* Save STRP in IDX. */
8a7bde3e 899 idx = strp - SDATA (string);
c6045832
JB
900
901 /* Get the value of the keymap in TEM, or nil if undefined.
902 Do this while still in the user's current buffer
903 in case it is a local variable. */
141199d1 904 name = Fintern (make_string (start, length_byte), Qnil);
c6045832 905 tem = Fboundp (name);
265a9e55 906 if (! NILP (tem))
c6045832
JB
907 {
908 tem = Fsymbol_value (name);
265a9e55 909 if (! NILP (tem))
11f9d6e1 910 {
02067692
SM
911 tem = get_keymap (tem, 0, 1);
912 /* Note that get_keymap can GC. */
d5db4077
KR
913 strp = SDATA (string) + idx;
914 start = SDATA (string) + start_idx;
11f9d6e1 915 }
c6045832
JB
916 }
917
918 /* Now switch to a temp buffer. */
919 oldbuf = current_buffer;
920 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer));
921
265a9e55 922 if (NILP (tem))
c6045832
JB
923 {
924 name = Fsymbol_name (name);
925 insert_string ("\nUses keymap \"");
141199d1 926 insert_from_string (name, 0, 0,
d5db4077
KR
927 SCHARS (name),
928 SBYTES (name), 1);
c6045832
JB
929 insert_string ("\", which is not currently defined.\n");
930 if (start[-1] == '<') keymap = Qnil;
931 }
932 else if (start[-1] == '<')
933 keymap = tem;
934 else
7523d17c 935 describe_map_tree (tem, 1, Qnil, Qnil, (char *)0, 1, 0, 0);
c6045832
JB
936 tem = Fbuffer_string ();
937 Ferase_buffer ();
938 set_buffer_internal (oldbuf);
939
940 subst_string:
d5db4077
KR
941 start = SDATA (tem);
942 length = SCHARS (tem);
943 length_byte = SBYTES (tem);
c6045832 944 subst:
8d17fe0b
GM
945 {
946 int offset = bufp - buf;
947 buf = (unsigned char *) xrealloc (buf, bsize += length_byte);
948 bufp = buf + offset;
949 bcopy (start, bufp, length_byte);
950 bufp += length_byte;
951 nchars += length;
952 /* Check STRING again in case gc relocated it. */
d5db4077 953 strp = (unsigned char *) SDATA (string) + idx;
8d17fe0b 954 }
c6045832 955 }
141199d1
RS
956 else if (! multibyte) /* just copy other chars */
957 *bufp++ = *strp++, nchars++;
958 else
959 {
960 int len;
d5db4077 961 int maxlen = SDATA (string) + SBYTES (string) - strp;
141199d1
RS
962
963 STRING_CHAR_AND_LENGTH (strp, maxlen, len);
964 if (len == 1)
965 *bufp = *strp;
966 else
967 bcopy (strp, bufp, len);
968 strp += len;
969 bufp += len;
970 nchars++;
971 }
c6045832
JB
972 }
973
974 if (changed) /* don't bother if nothing substituted */
cc5bf9eb 975 tem = make_string_from_bytes (buf, nchars, bufp - buf);
c6045832 976 else
4acb738e 977 tem = string;
9ac0d9e0 978 xfree (buf);
665d3046 979 RETURN_UNGCPRO (tem);
c6045832
JB
980}
981\f
dfcf069d 982void
c6045832
JB
983syms_of_doc ()
984{
9191c8ae
GM
985 Qfunction_documentation = intern ("function-documentation");
986 staticpro (&Qfunction_documentation);
177c0ea7 987
c6045832 988 DEFVAR_LISP ("internal-doc-file-name", &Vdoc_file_name,
335c5470 989 doc: /* Name of file containing documentation strings of built-in symbols. */);
c6045832
JB
990 Vdoc_file_name = Qnil;
991
d87a9ab8
JD
992 DEFVAR_LISP ("build-files", &Vbuild_files,
993 doc: /* A list of files used to build this Emacs binary. */);
994 Vbuild_files = Qnil;
995
c6045832
JB
996 defsubr (&Sdocumentation);
997 defsubr (&Sdocumentation_property);
998 defsubr (&Ssnarf_documentation);
999 defsubr (&Ssubstitute_command_keys);
1000}
ab5796a9
MB
1001
1002/* arch-tag: 56281d4d-6949-43e2-be2e-f6517de744ba
1003 (do not change this comment) */