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