*** empty log message ***
[bpt/emacs.git] / src / doc.c
CommitLineData
c6045832 1/* Record indices of function doc strings stored in a file.
32d1b897 2 Copyright (C) 1985, 86,93,94,95,97,98,99, 2000 Free Software Foundation, Inc.
c6045832
JB
3
4This file is part of GNU Emacs.
5
6GNU Emacs is free software; you can redistribute it and/or modify
7it under the terms of the GNU General Public License as published by
610f41b7 8the Free Software Foundation; either version 2, or (at your option)
c6045832
JB
9any later version.
10
11GNU Emacs is distributed in the hope that it will be useful,
12but WITHOUT ANY WARRANTY; without even the implied warranty of
13MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14GNU General Public License for more details.
15
16You should have received a copy of the GNU General Public License
17along with GNU Emacs; see the file COPYING. If not, write to
3b7ad313
EN
18the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19Boston, MA 02111-1307, USA. */
c6045832
JB
20
21
18160b98 22#include <config.h>
c6045832
JB
23
24#include <sys/types.h>
25#include <sys/file.h> /* Must be after sys/types.h for USG and BSD4_1*/
26
27#ifdef USG5
28#include <fcntl.h>
29#endif
30
29beb080
RS
31#ifdef HAVE_UNISTD_H
32#include <unistd.h>
33#endif
34
c6045832
JB
35#ifndef O_RDONLY
36#define O_RDONLY 0
37#endif
38
c6045832
JB
39#include "lisp.h"
40#include "buffer.h"
665d3046 41#include "keyboard.h"
141199d1 42#include "charset.h"
c6045832 43
8892f40b
GM
44#ifdef HAVE_INDEX
45extern char *index P_ ((const char *, int));
a847af86
GM
46#endif
47
712c597e 48Lisp_Object Vdoc_file_name, Vhelp_manyarg_func_alist;
c6045832 49
9191c8ae
GM
50Lisp_Object Qfunction_documentation;
51
9a425dcb
RS
52extern Lisp_Object Voverriding_local_map;
53
778d47c7
RS
54/* For VMS versions with limited file name syntax,
55 convert the name to something VMS will allow. */
56static void
57munge_doc_file_name (name)
58 char *name;
c6045832 59{
c6045832
JB
60#ifdef VMS
61#ifndef VMS4_4
62 /* For VMS versions with limited file name syntax,
63 convert the name to something VMS will allow. */
64 p = name;
65 while (*p)
66 {
67 if (*p == '-')
68 *p = '_';
69 p++;
70 }
71#endif /* not VMS4_4 */
72#ifdef VMS4_4
73 strcpy (name, sys_translate_unix (name));
74#endif /* VMS4_4 */
75#endif /* VMS */
778d47c7
RS
76}
77
912e8480
RS
78/* Buffer used for reading from documentation file. */
79static char *get_doc_string_buffer;
80static int get_doc_string_buffer_size;
81
32caae30
RS
82static unsigned char *read_bytecode_pointer;
83
84/* readchar in lread.c calls back here to fetch the next byte.
85 If UNREADFLAG is 1, we unread a byte. */
86
87int
88read_bytecode_char (unreadflag)
33711cc9 89 int unreadflag;
32caae30
RS
90{
91 if (unreadflag)
92 {
93 read_bytecode_pointer--;
94 return 0;
95 }
96 return *read_bytecode_pointer++;
97}
98
700ea809
RS
99/* Extract a doc string from a file. FILEPOS says where to get it.
100 If it is an integer, use that position in the standard DOC-... file.
101 If it is (FILE . INTEGER), use FILE as the file name
0c00bc70
RS
102 and INTEGER as the position in that file.
103 But if INTEGER is negative, make it positive.
104 (A negative integer is used for user variables, so we can distinguish
ba29c3c9
RS
105 them without actually fetching the doc string.)
106
e96179b3
RS
107 If UNIBYTE is nonzero, always make a unibyte string.
108
f1df0d67
RS
109 If DEFINITION is nonzero, assume this is for reading
110 a dynamic function definition; convert the bytestring
111 and the constants vector with appropriate byte handling,
112 and return a cons cell. */
700ea809 113
0c3debbc 114Lisp_Object
e96179b3 115get_doc_string (filepos, unibyte, definition)
700ea809 116 Lisp_Object filepos;
e96179b3 117 int unibyte, definition;
778d47c7 118{
700ea809 119 char *from, *to;
778d47c7
RS
120 register int fd;
121 register char *name;
122 register char *p, *p1;
778d47c7 123 int minsize;
0fded513 124 int offset, position;
700ea809 125 Lisp_Object file, tem;
778d47c7 126
700ea809
RS
127 if (INTEGERP (filepos))
128 {
129 file = Vdoc_file_name;
130 position = XINT (filepos);
131 }
132 else if (CONSP (filepos))
133 {
03699b14
KR
134 file = XCAR (filepos);
135 position = XINT (XCDR (filepos));
0c00bc70
RS
136 if (position < 0)
137 position = - position;
700ea809
RS
138 }
139 else
778d47c7
RS
140 return Qnil;
141
700ea809
RS
142 if (!STRINGP (Vdoc_directory))
143 return Qnil;
144
145 if (!STRINGP (file))
146 return Qnil;
147
148 /* Put the file name in NAME as a C string.
149 If it is relative, combine it with Vdoc_directory. */
150
151 tem = Ffile_name_absolute_p (file);
152 if (NILP (tem))
153 {
154 minsize = XSTRING (Vdoc_directory)->size;
155 /* sizeof ("../etc/") == 8 */
156 if (minsize < 8)
157 minsize = 8;
158 name = (char *) alloca (minsize + XSTRING (file)->size + 8);
159 strcpy (name, XSTRING (Vdoc_directory)->data);
160 strcat (name, XSTRING (file)->data);
161 munge_doc_file_name (name);
162 }
163 else
164 {
a039f534 165 name = (char *) XSTRING (file)->data;
700ea809 166 }
c6045832 167
68c45bf0 168 fd = emacs_open (name, O_RDONLY, 0);
c6045832 169 if (fd < 0)
778d47c7
RS
170 {
171#ifndef CANNOT_DUMP
172 if (!NILP (Vpurify_flag))
173 {
174 /* Preparing to dump; DOC file is probably not installed.
175 So check in ../etc. */
176 strcpy (name, "../etc/");
700ea809 177 strcat (name, XSTRING (file)->data);
778d47c7
RS
178 munge_doc_file_name (name);
179
68c45bf0 180 fd = emacs_open (name, O_RDONLY, 0);
778d47c7
RS
181 }
182#endif
778d47c7
RS
183 if (fd < 0)
184 error ("Cannot open doc string file \"%s\"", name);
185 }
186
0fded513
RS
187 /* Seek only to beginning of disk block. */
188 offset = position % (8 * 1024);
189 if (0 > lseek (fd, position - offset, 0))
c6045832 190 {
68c45bf0 191 emacs_close (fd);
c6045832 192 error ("Position %ld out of range in doc string file \"%s\"",
700ea809 193 position, name);
c6045832 194 }
700ea809 195
912e8480
RS
196 /* Read the doc string into get_doc_string_buffer.
197 P points beyond the data just read. */
0fded513 198
912e8480 199 p = get_doc_string_buffer;
700ea809 200 while (1)
c6045832 201 {
912e8480
RS
202 int space_left = (get_doc_string_buffer_size
203 - (p - get_doc_string_buffer));
700ea809
RS
204 int nread;
205
0fded513 206 /* Allocate or grow the buffer if we need to. */
700ea809
RS
207 if (space_left == 0)
208 {
912e8480
RS
209 int in_buffer = p - get_doc_string_buffer;
210 get_doc_string_buffer_size += 16 * 1024;
211 get_doc_string_buffer
212 = (char *) xrealloc (get_doc_string_buffer,
213 get_doc_string_buffer_size + 1);
214 p = get_doc_string_buffer + in_buffer;
215 space_left = (get_doc_string_buffer_size
216 - (p - get_doc_string_buffer));
700ea809
RS
217 }
218
0fded513
RS
219 /* Read a disk block at a time.
220 If we read the same block last time, maybe skip this? */
700ea809
RS
221 if (space_left > 1024 * 8)
222 space_left = 1024 * 8;
68c45bf0 223 nread = emacs_read (fd, p, space_left);
700ea809
RS
224 if (nread < 0)
225 {
68c45bf0 226 emacs_close (fd);
700ea809
RS
227 error ("Read error on documentation file");
228 }
229 p[nread] = 0;
230 if (!nread)
c6045832 231 break;
912e8480 232 if (p == get_doc_string_buffer)
a847af86 233 p1 = (char *) index (p + offset, '\037');
0fded513 234 else
a847af86 235 p1 = (char *) index (p, '\037');
c6045832
JB
236 if (p1)
237 {
238 *p1 = 0;
239 p = p1;
240 break;
241 }
700ea809 242 p += nread;
c6045832 243 }
68c45bf0 244 emacs_close (fd);
700ea809
RS
245
246 /* Scan the text and perform quoting with ^A (char code 1).
247 ^A^A becomes ^A, ^A0 becomes a null char, and ^A_ becomes a ^_. */
912e8480
RS
248 from = get_doc_string_buffer + offset;
249 to = get_doc_string_buffer + offset;
700ea809
RS
250 while (from != p)
251 {
252 if (*from == 1)
253 {
254 int c;
255
256 from++;
257 c = *from++;
258 if (c == 1)
259 *to++ = c;
260 else if (c == '0')
261 *to++ = 0;
262 else if (c == '_')
263 *to++ = 037;
264 else
265 error ("Invalid data in documentation file -- ^A followed by code 0%o", c);
266 }
267 else
268 *to++ = *from++;
269 }
270
32caae30
RS
271 /* If DEFINITION, read from this buffer
272 the same way we would read bytes from a file. */
f1df0d67
RS
273 if (definition)
274 {
32caae30
RS
275 read_bytecode_pointer = get_doc_string_buffer + offset;
276 return Fread (Qlambda);
f1df0d67
RS
277 }
278
e96179b3
RS
279 if (unibyte)
280 return make_unibyte_string (get_doc_string_buffer + offset,
281 to - (get_doc_string_buffer + offset));
282 else
fb2fdea7
RS
283 {
284 /* Let the data determine whether the string is multibyte,
285 even if Emacs is running in --unibyte mode. */
286 int nchars = multibyte_chars_in_text (get_doc_string_buffer + offset,
287 to - (get_doc_string_buffer + offset));
288 return make_string_from_bytes (get_doc_string_buffer + offset,
289 nchars,
290 to - (get_doc_string_buffer + offset));
291 }
700ea809
RS
292}
293
294/* Get a string from position FILEPOS and pass it through the Lisp reader.
295 We use this for fetching the bytecode string and constants vector
296 of a compiled function from the .elc file. */
297
298Lisp_Object
299read_doc_string (filepos)
300 Lisp_Object filepos;
301{
e96179b3 302 return get_doc_string (filepos, 0, 1);
c6045832
JB
303}
304
ee04dc54 305DEFUN ("documentation", Fdocumentation, Sdocumentation, 1, 2, 0,
08564963 306 "Return the documentation string of FUNCTION.\n\
4acb738e 307Unless a non-nil second argument RAW is given, the\n\
ee04dc54 308string is passed through `substitute-command-keys'.")
502ddf23
JB
309 (function, raw)
310 Lisp_Object function, raw;
c6045832
JB
311{
312 Lisp_Object fun;
313 Lisp_Object funcar;
ee04dc54 314 Lisp_Object tem, doc;
c6045832 315
9191c8ae
GM
316 if (SYMBOLP (function)
317 && (tem = Fget (function, Qfunction_documentation),
318 !NILP (tem)))
319 return Fdocumentation_property (function, Qfunction_documentation, raw);
320
502ddf23 321 fun = Findirect_function (function);
5b5f6883 322 if (SUBRP (fun))
c6045832 323 {
9191c8ae
GM
324 if (XSUBR (fun)->doc == 0)
325 return Qnil;
326 else if ((EMACS_INT) XSUBR (fun)->doc >= 0)
ee04dc54 327 doc = build_string (XSUBR (fun)->doc);
c6045832 328 else
e96179b3
RS
329 doc = get_doc_string (make_number (- (EMACS_INT) XSUBR (fun)->doc),
330 0, 0);
712c597e
DL
331 if (! NILP (tem = Fassq (function, Vhelp_manyarg_func_alist)))
332 doc = concat3 (doc, build_string ("\n"), Fcdr (tem));
5b5f6883
KH
333 }
334 else if (COMPILEDP (fun))
335 {
f9b4aacf 336 if ((XVECTOR (fun)->size & PSEUDOVECTOR_SIZE_MASK) <= COMPILED_DOC_STRING)
c6045832
JB
337 return Qnil;
338 tem = XVECTOR (fun)->contents[COMPILED_DOC_STRING];
e6d12642 339 if (STRINGP (tem))
ee04dc54 340 doc = tem;
700ea809 341 else if (NATNUMP (tem) || CONSP (tem))
49da2e49 342 doc = get_doc_string (tem, 0, 0);
ee04dc54
RM
343 else
344 return Qnil;
5b5f6883
KH
345 }
346 else if (STRINGP (fun) || VECTORP (fun))
347 {
c6045832 348 return build_string ("Keyboard macro.");
5b5f6883
KH
349 }
350 else if (CONSP (fun))
351 {
c6045832 352 funcar = Fcar (fun);
e6d12642 353 if (!SYMBOLP (funcar))
c6045832 354 return Fsignal (Qinvalid_function, Fcons (fun, Qnil));
502ddf23 355 else if (EQ (funcar, Qkeymap))
a3cec380 356 return build_string ("Prefix command (definition is a keymap associating keystrokes with commands).");
502ddf23
JB
357 else if (EQ (funcar, Qlambda)
358 || EQ (funcar, Qautoload))
c6045832 359 {
ae44f7a4
RS
360 Lisp_Object tem1;
361 tem1 = Fcdr (Fcdr (fun));
362 tem = Fcar (tem1);
e6d12642 363 if (STRINGP (tem))
ee04dc54 364 doc = tem;
ae44f7a4
RS
365 /* Handle a doc reference--but these never come last
366 in the function body, so reject them if they are last. */
367 else if ((NATNUMP (tem) || CONSP (tem))
03699b14 368 && ! NILP (XCDR (tem1)))
49da2e49 369 doc = get_doc_string (tem, 0, 0);
ee04dc54
RM
370 else
371 return Qnil;
c6045832 372 }
502ddf23 373 else if (EQ (funcar, Qmocklisp))
c6045832 374 return Qnil;
502ddf23 375 else if (EQ (funcar, Qmacro))
ee04dc54 376 return Fdocumentation (Fcdr (fun), raw);
5b5f6883
KH
377 else
378 goto oops;
379 }
380 else
381 {
382 oops:
383 Fsignal (Qinvalid_function, Fcons (fun, Qnil));
c6045832 384 }
ee04dc54 385
956ace37 386 if (NILP (raw))
441d75e5 387 doc = Fsubstitute_command_keys (doc);
ee04dc54 388 return doc;
c6045832
JB
389}
390
f6ee1260
GM
391DEFUN ("documentation-property", Fdocumentation_property,
392 Sdocumentation_property, 2, 3, 0,
c6045832 393 "Return the documentation string that is SYMBOL's PROP property.\n\
f6ee1260
GM
394Third argument RAW omitted or nil means pass the result through\n\
395`substitute-command-keys' if it is a string.\n\
396\n\
397This is differs from `get' in that it can refer to strings stored in the\n\
398`etc/DOC' file; and that it evaluates documentation properties that\n\
399aren't strings.")
4acb738e
EN
400 (symbol, prop, raw)
401 Lisp_Object symbol, prop, raw;
c6045832 402{
2f0b74ea 403 Lisp_Object tem;
c6045832 404
4acb738e 405 tem = Fget (symbol, prop);
e6d12642 406 if (INTEGERP (tem))
e96179b3 407 tem = get_doc_string (XINT (tem) > 0 ? tem : make_number (- XINT (tem)), 0, 0);
f6ee1260 408 else if (CONSP (tem) && INTEGERP (XCDR (tem)))
e96179b3 409 tem = get_doc_string (tem, 0, 0);
f6ee1260
GM
410 else if (!STRINGP (tem))
411 /* Feval protects its argument. */
412 tem = Feval (tem);
413
e6d12642 414 if (NILP (raw) && STRINGP (tem))
bbd7d5d3 415 tem = Fsubstitute_command_keys (tem);
992d176e 416 return tem;
c6045832
JB
417}
418\f
283e1184
JB
419/* Scanning the DOC files and placing docstring offsets into functions. */
420
421static void
422store_function_docstring (fun, offset)
423 Lisp_Object fun;
e343d389
RS
424 /* Use EMACS_INT because we get this from pointer subtraction. */
425 EMACS_INT offset;
283e1184
JB
426{
427 fun = indirect_function (fun);
428
429 /* The type determines where the docstring is stored. */
430
431 /* Lisp_Subrs have a slot for it. */
e6d12642 432 if (SUBRP (fun))
283e1184
JB
433 XSUBR (fun)->doc = (char *) - offset;
434
435 /* If it's a lisp form, stick it in the form. */
436 else if (CONSP (fun))
437 {
438 Lisp_Object tem;
439
03699b14 440 tem = XCAR (fun);
283e1184
JB
441 if (EQ (tem, Qlambda) || EQ (tem, Qautoload))
442 {
443 tem = Fcdr (Fcdr (fun));
03699b14
KR
444 if (CONSP (tem) && INTEGERP (XCAR (tem)))
445 XSETFASTINT (XCAR (tem), offset);
283e1184
JB
446 }
447 else if (EQ (tem, Qmacro))
03699b14 448 store_function_docstring (XCDR (fun), offset);
283e1184
JB
449 }
450
451 /* Bytecode objects sometimes have slots for it. */
e6d12642 452 else if (COMPILEDP (fun))
283e1184
JB
453 {
454 /* This bytecode object must have a slot for the
455 docstring, since we've found a docstring for it. */
f9b4aacf 456 if ((XVECTOR (fun)->size & PSEUDOVECTOR_SIZE_MASK) > COMPILED_DOC_STRING)
2ee7863a 457 XSETFASTINT (XVECTOR (fun)->contents[COMPILED_DOC_STRING], offset);
283e1184
JB
458 }
459}
460
461
c6045832
JB
462DEFUN ("Snarf-documentation", Fsnarf_documentation, Ssnarf_documentation,
463 1, 1, 0,
464 "Used during Emacs initialization, before dumping runnable Emacs,\n\
08564963 465to find pointers to doc strings stored in `etc/DOC...' and\n\
c6045832
JB
466record them in function definitions.\n\
467One arg, FILENAME, a string which does not include a directory.\n\
08564963 468The file is found in `../etc' now; found in the `data-directory'\n\
c6045832
JB
469when doc strings are referred to later in the dumped Emacs.")
470 (filename)
471 Lisp_Object filename;
472{
473 int fd;
474 char buf[1024 + 1];
475 register int filled;
476 register int pos;
477 register char *p, *end;
478 Lisp_Object sym, fun, tem;
479 char *name;
c6045832 480
2bda628c
JB
481#ifndef CANNOT_DUMP
482 if (NILP (Vpurify_flag))
483 error ("Snarf-documentation can only be called in an undumped Emacs");
484#endif
485
c6045832
JB
486 CHECK_STRING (filename, 0);
487
488#ifndef CANNOT_DUMP
6367dc09 489 name = (char *) alloca (XSTRING (filename)->size + 14);
08564963 490 strcpy (name, "../etc/");
c6045832 491#else /* CANNOT_DUMP */
ba870521 492 CHECK_STRING (Vdoc_directory, 0);
c6045832 493 name = (char *) alloca (XSTRING (filename)->size +
ba870521
KH
494 XSTRING (Vdoc_directory)->size + 1);
495 strcpy (name, XSTRING (Vdoc_directory)->data);
c6045832
JB
496#endif /* CANNOT_DUMP */
497 strcat (name, XSTRING (filename)->data); /*** Add this line ***/
498#ifdef VMS
499#ifndef VMS4_4
500 /* For VMS versions with limited file name syntax,
501 convert the name to something VMS will allow. */
502 p = name;
503 while (*p)
504 {
505 if (*p == '-')
506 *p = '_';
507 p++;
508 }
509#endif /* not VMS4_4 */
510#ifdef VMS4_4
511 strcpy (name, sys_translate_unix (name));
512#endif /* VMS4_4 */
513#endif /* VMS */
514
68c45bf0 515 fd = emacs_open (name, O_RDONLY, 0);
c6045832
JB
516 if (fd < 0)
517 report_file_error ("Opening doc string file",
518 Fcons (build_string (name), Qnil));
519 Vdoc_file_name = filename;
520 filled = 0;
521 pos = 0;
522 while (1)
523 {
524 if (filled < 512)
68c45bf0 525 filled += emacs_read (fd, &buf[filled], sizeof buf - 1 - filled);
c6045832
JB
526 if (!filled)
527 break;
528
529 buf[filled] = 0;
530 p = buf;
531 end = buf + (filled < 512 ? filled : filled - 128);
532 while (p != end && *p != '\037') p++;
533 /* p points to ^_Ffunctionname\n or ^_Vvarname\n. */
534 if (p != end)
535 {
a847af86 536 end = (char *) index (p, '\n');
141199d1
RS
537 sym = oblookup (Vobarray, p + 2,
538 multibyte_chars_in_text (p + 2, end - p - 2),
539 end - p - 2);
e6d12642 540 if (SYMBOLP (sym))
c6045832
JB
541 {
542 /* Attach a docstring to a variable? */
543 if (p[1] == 'V')
544 {
545 /* Install file-position as variable-documentation property
546 and make it negative for a user-variable
547 (doc starts with a `*'). */
548 Fput (sym, Qvariable_documentation,
549 make_number ((pos + end + 1 - buf)
550 * (end[1] == '*' ? -1 : 1)));
551 }
552
283e1184 553 /* Attach a docstring to a function? */
c6045832 554 else if (p[1] == 'F')
283e1184
JB
555 store_function_docstring (sym, pos + end + 1 - buf);
556
557 else
558 error ("DOC file invalid at position %d", pos);
c6045832
JB
559 }
560 }
561 pos += end - buf;
562 filled -= end - buf;
563 bcopy (end, buf, filled);
564 }
68c45bf0 565 emacs_close (fd);
c6045832
JB
566 return Qnil;
567}
568\f
569DEFUN ("substitute-command-keys", Fsubstitute_command_keys,
570 Ssubstitute_command_keys, 1, 1, 0,
571 "Substitute key descriptions for command names in STRING.\n\
572Return a new string which is STRING with substrings of the form \\=\\[COMMAND]\n\
573replaced by either: a keystroke sequence that will invoke COMMAND,\n\
574or \"M-x COMMAND\" if COMMAND is not on any keys.\n\
575Substrings of the form \\=\\{MAPVAR} are replaced by summaries\n\
576\(made by describe-bindings) of the value of MAPVAR, taken as a keymap.\n\
577Substrings of the form \\=\\<MAPVAR> specify to use the value of MAPVAR\n\
578as the keymap for future \\=\\[COMMAND] substrings.\n\
579\\=\\= quotes the following character and is discarded;\n\
580thus, \\=\\=\\=\\= puts \\=\\= into the output, and \\=\\=\\=\\[ puts \\=\\[ into the output.")
4acb738e
EN
581 (string)
582 Lisp_Object string;
c6045832
JB
583{
584 unsigned char *buf;
585 int changed = 0;
586 register unsigned char *strp;
587 register unsigned char *bufp;
588 int idx;
589 int bsize;
590 unsigned char *new;
665d3046 591 Lisp_Object tem;
c6045832
JB
592 Lisp_Object keymap;
593 unsigned char *start;
2d0aa229 594 int length, length_byte;
665d3046
JB
595 Lisp_Object name;
596 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
141199d1
RS
597 int multibyte;
598 int nchars;
c6045832 599
4acb738e 600 if (NILP (string))
c6045832
JB
601 return Qnil;
602
4acb738e 603 CHECK_STRING (string, 0);
665d3046
JB
604 tem = Qnil;
605 keymap = Qnil;
606 name = Qnil;
4acb738e 607 GCPRO4 (string, tem, keymap, name);
c6045832 608
141199d1
RS
609 multibyte = STRING_MULTIBYTE (string);
610 nchars = 0;
611
9a425dcb
RS
612 /* KEYMAP is either nil (which means search all the active keymaps)
613 or a specified local map (which means search just that and the
614 global map). If non-nil, it might come from Voverriding_local_map,
4acb738e 615 or from a \\<mapname> construct in STRING itself.. */
f73d1163
KH
616 keymap = current_kboard->Voverriding_terminal_local_map;
617 if (NILP (keymap))
618 keymap = Voverriding_local_map;
c6045832 619
fc932ac6 620 bsize = STRING_BYTES (XSTRING (string));
c6045832
JB
621 bufp = buf = (unsigned char *) xmalloc (bsize);
622
4acb738e 623 strp = (unsigned char *) XSTRING (string)->data;
fc932ac6 624 while (strp < XSTRING (string)->data + STRING_BYTES (XSTRING (string)))
c6045832
JB
625 {
626 if (strp[0] == '\\' && strp[1] == '=')
627 {
628 /* \= quotes the next character;
629 thus, to put in \[ without its special meaning, use \=\[. */
630 changed = 1;
141199d1
RS
631 strp += 2;
632 if (multibyte)
633 {
634 int len;
fc932ac6 635 int maxlen = XSTRING (string)->data + STRING_BYTES (XSTRING (string)) - strp;
141199d1
RS
636
637 STRING_CHAR_AND_LENGTH (strp, maxlen, len);
638 if (len == 1)
639 *bufp = *strp;
640 else
641 bcopy (strp, bufp, len);
642 strp += len;
643 bufp += len;
644 nchars++;
645 }
646 else
647 *bufp++ = *strp++, nchars++;
c6045832
JB
648 }
649 else if (strp[0] == '\\' && strp[1] == '[')
650 {
b6c53774 651 Lisp_Object firstkey;
11f9d6e1 652 int start_idx;
b6c53774 653
c6045832
JB
654 changed = 1;
655 strp += 2; /* skip \[ */
656 start = strp;
11f9d6e1 657 start_idx = start - XSTRING (string)->data;
c6045832 658
4acb738e 659 while ((strp - (unsigned char *) XSTRING (string)->data
fc932ac6 660 < STRING_BYTES (XSTRING (string)))
c6045832
JB
661 && *strp != ']')
662 strp++;
141199d1
RS
663 length_byte = strp - start;
664
c6045832
JB
665 strp++; /* skip ] */
666
667 /* Save STRP in IDX. */
4acb738e 668 idx = strp - (unsigned char *) XSTRING (string)->data;
141199d1 669 tem = Fintern (make_string (start, length_byte), Qnil);
11f9d6e1
GM
670
671 /* Note the Fwhere_is_internal can GC, so we have to take
672 relocation of string contents into account. */
9a425dcb 673 tem = Fwhere_is_internal (tem, keymap, Qt, Qnil);
11f9d6e1
GM
674 strp = XSTRING (string)->data + idx;
675 start = XSTRING (string)->data + start_idx;
c6045832 676
b6c53774
RS
677 /* Disregard menu bar bindings; it is positively annoying to
678 mention them when there's no menu bar, and it isn't terribly
679 useful even when there is a menu bar. */
ef586bbd
RS
680 if (!NILP (tem))
681 {
682 firstkey = Faref (tem, make_number (0));
683 if (EQ (firstkey, Qmenu_bar))
684 tem = Qnil;
685 }
b6c53774 686
265a9e55 687 if (NILP (tem)) /* but not on any keys */
c6045832
JB
688 {
689 new = (unsigned char *) xrealloc (buf, bsize += 4);
690 bufp += new - buf;
691 buf = new;
692 bcopy ("M-x ", bufp, 4);
693 bufp += 4;
141199d1
RS
694 nchars += 4;
695 if (multibyte)
696 length = multibyte_chars_in_text (start, length_byte);
697 else
698 length = length_byte;
c6045832
JB
699 goto subst;
700 }
701 else
702 { /* function is on a key */
703 tem = Fkey_description (tem);
704 goto subst_string;
705 }
706 }
707 /* \{foo} is replaced with a summary of the keymap (symbol-value foo).
708 \<foo> just sets the keymap used for \[cmd]. */
709 else if (strp[0] == '\\' && (strp[1] == '{' || strp[1] == '<'))
710 {
711 struct buffer *oldbuf;
11f9d6e1 712 int start_idx;
c6045832
JB
713
714 changed = 1;
715 strp += 2; /* skip \{ or \< */
716 start = strp;
11f9d6e1 717 start_idx = start - XSTRING (string)->data;
c6045832 718
4acb738e
EN
719 while ((strp - (unsigned char *) XSTRING (string)->data
720 < XSTRING (string)->size)
c6045832
JB
721 && *strp != '}' && *strp != '>')
722 strp++;
141199d1
RS
723
724 length_byte = strp - start;
c6045832
JB
725 strp++; /* skip } or > */
726
727 /* Save STRP in IDX. */
4acb738e 728 idx = strp - (unsigned char *) XSTRING (string)->data;
c6045832
JB
729
730 /* Get the value of the keymap in TEM, or nil if undefined.
731 Do this while still in the user's current buffer
732 in case it is a local variable. */
141199d1 733 name = Fintern (make_string (start, length_byte), Qnil);
c6045832 734 tem = Fboundp (name);
265a9e55 735 if (! NILP (tem))
c6045832
JB
736 {
737 tem = Fsymbol_value (name);
265a9e55 738 if (! NILP (tem))
11f9d6e1
GM
739 {
740 tem = get_keymap_1 (tem, 0, 1);
741 /* Note that get_keymap_1 can GC. */
742 strp = XSTRING (string)->data + idx;
743 start = XSTRING (string)->data + start_idx;
744 }
c6045832
JB
745 }
746
747 /* Now switch to a temp buffer. */
748 oldbuf = current_buffer;
749 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer));
750
265a9e55 751 if (NILP (tem))
c6045832
JB
752 {
753 name = Fsymbol_name (name);
754 insert_string ("\nUses keymap \"");
141199d1
RS
755 insert_from_string (name, 0, 0,
756 XSTRING (name)->size,
fc932ac6 757 STRING_BYTES (XSTRING (name)), 1);
c6045832
JB
758 insert_string ("\", which is not currently defined.\n");
759 if (start[-1] == '<') keymap = Qnil;
760 }
761 else if (start[-1] == '<')
762 keymap = tem;
763 else
7523d17c 764 describe_map_tree (tem, 1, Qnil, Qnil, (char *)0, 1, 0, 0);
c6045832
JB
765 tem = Fbuffer_string ();
766 Ferase_buffer ();
767 set_buffer_internal (oldbuf);
768
769 subst_string:
770 start = XSTRING (tem)->data;
771 length = XSTRING (tem)->size;
fc932ac6 772 length_byte = STRING_BYTES (XSTRING (tem));
c6045832 773 subst:
141199d1 774 new = (unsigned char *) xrealloc (buf, bsize += length_byte);
c6045832
JB
775 bufp += new - buf;
776 buf = new;
141199d1
RS
777 bcopy (start, bufp, length_byte);
778 bufp += length_byte;
779 nchars += length;
4acb738e
EN
780 /* Check STRING again in case gc relocated it. */
781 strp = (unsigned char *) XSTRING (string)->data + idx;
c6045832 782 }
141199d1
RS
783 else if (! multibyte) /* just copy other chars */
784 *bufp++ = *strp++, nchars++;
785 else
786 {
787 int len;
fc932ac6 788 int maxlen = XSTRING (string)->data + STRING_BYTES (XSTRING (string)) - strp;
141199d1
RS
789
790 STRING_CHAR_AND_LENGTH (strp, maxlen, len);
791 if (len == 1)
792 *bufp = *strp;
793 else
794 bcopy (strp, bufp, len);
795 strp += len;
796 bufp += len;
797 nchars++;
798 }
c6045832
JB
799 }
800
801 if (changed) /* don't bother if nothing substituted */
cc5bf9eb 802 tem = make_string_from_bytes (buf, nchars, bufp - buf);
c6045832 803 else
4acb738e 804 tem = string;
9ac0d9e0 805 xfree (buf);
665d3046 806 RETURN_UNGCPRO (tem);
c6045832
JB
807}
808\f
dfcf069d 809void
c6045832
JB
810syms_of_doc ()
811{
9191c8ae
GM
812 Qfunction_documentation = intern ("function-documentation");
813 staticpro (&Qfunction_documentation);
814
c6045832
JB
815 DEFVAR_LISP ("internal-doc-file-name", &Vdoc_file_name,
816 "Name of file containing documentation strings of built-in symbols.");
817 Vdoc_file_name = Qnil;
712c597e
DL
818 DEFVAR_LISP ("help-manyarg-func-alist", &Vhelp_manyarg_func_alist,
819 "Alist of primitive functions and descriptions of their arg lists.\n\
820All special forms and primitives which effectively have &rest args\n\
821should have an entry here so that `documentation' can provide their\n\
822arg list.");
823 Vhelp_manyarg_func_alist = Qnil;
c6045832
JB
824
825 defsubr (&Sdocumentation);
826 defsubr (&Sdocumentation_property);
827 defsubr (&Ssnarf_documentation);
828 defsubr (&Ssubstitute_command_keys);
829}