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