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