(display_line): On ttys, produce more than one
[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
8d17fe0b
GM
316 doc = Qnil;
317
9191c8ae
GM
318 if (SYMBOLP (function)
319 && (tem = Fget (function, Qfunction_documentation),
320 !NILP (tem)))
321 return Fdocumentation_property (function, Qfunction_documentation, raw);
322
502ddf23 323 fun = Findirect_function (function);
5b5f6883 324 if (SUBRP (fun))
c6045832 325 {
9191c8ae
GM
326 if (XSUBR (fun)->doc == 0)
327 return Qnil;
328 else if ((EMACS_INT) XSUBR (fun)->doc >= 0)
ee04dc54 329 doc = build_string (XSUBR (fun)->doc);
c6045832 330 else
e96179b3
RS
331 doc = get_doc_string (make_number (- (EMACS_INT) XSUBR (fun)->doc),
332 0, 0);
712c597e
DL
333 if (! NILP (tem = Fassq (function, Vhelp_manyarg_func_alist)))
334 doc = concat3 (doc, build_string ("\n"), Fcdr (tem));
5b5f6883
KH
335 }
336 else if (COMPILEDP (fun))
337 {
f9b4aacf 338 if ((XVECTOR (fun)->size & PSEUDOVECTOR_SIZE_MASK) <= COMPILED_DOC_STRING)
c6045832
JB
339 return Qnil;
340 tem = XVECTOR (fun)->contents[COMPILED_DOC_STRING];
e6d12642 341 if (STRINGP (tem))
ee04dc54 342 doc = tem;
700ea809 343 else if (NATNUMP (tem) || CONSP (tem))
49da2e49 344 doc = get_doc_string (tem, 0, 0);
ee04dc54
RM
345 else
346 return Qnil;
5b5f6883
KH
347 }
348 else if (STRINGP (fun) || VECTORP (fun))
349 {
c6045832 350 return build_string ("Keyboard macro.");
5b5f6883
KH
351 }
352 else if (CONSP (fun))
353 {
c6045832 354 funcar = Fcar (fun);
e6d12642 355 if (!SYMBOLP (funcar))
c6045832 356 return Fsignal (Qinvalid_function, Fcons (fun, Qnil));
502ddf23 357 else if (EQ (funcar, Qkeymap))
a3cec380 358 return build_string ("Prefix command (definition is a keymap associating keystrokes with commands).");
502ddf23
JB
359 else if (EQ (funcar, Qlambda)
360 || EQ (funcar, Qautoload))
c6045832 361 {
ae44f7a4
RS
362 Lisp_Object tem1;
363 tem1 = Fcdr (Fcdr (fun));
364 tem = Fcar (tem1);
e6d12642 365 if (STRINGP (tem))
ee04dc54 366 doc = tem;
ae44f7a4
RS
367 /* Handle a doc reference--but these never come last
368 in the function body, so reject them if they are last. */
369 else if ((NATNUMP (tem) || CONSP (tem))
03699b14 370 && ! NILP (XCDR (tem1)))
49da2e49 371 doc = get_doc_string (tem, 0, 0);
ee04dc54
RM
372 else
373 return Qnil;
c6045832 374 }
502ddf23 375 else if (EQ (funcar, Qmocklisp))
c6045832 376 return Qnil;
502ddf23 377 else if (EQ (funcar, Qmacro))
ee04dc54 378 return Fdocumentation (Fcdr (fun), raw);
5b5f6883
KH
379 else
380 goto oops;
381 }
382 else
383 {
384 oops:
385 Fsignal (Qinvalid_function, Fcons (fun, Qnil));
c6045832 386 }
ee04dc54 387
956ace37 388 if (NILP (raw))
441d75e5 389 doc = Fsubstitute_command_keys (doc);
ee04dc54 390 return doc;
c6045832
JB
391}
392
f6ee1260
GM
393DEFUN ("documentation-property", Fdocumentation_property,
394 Sdocumentation_property, 2, 3, 0,
c6045832 395 "Return the documentation string that is SYMBOL's PROP property.\n\
f6ee1260
GM
396Third argument RAW omitted or nil means pass the result through\n\
397`substitute-command-keys' if it is a string.\n\
398\n\
399This is differs from `get' in that it can refer to strings stored in the\n\
400`etc/DOC' file; and that it evaluates documentation properties that\n\
401aren't strings.")
4acb738e
EN
402 (symbol, prop, raw)
403 Lisp_Object symbol, prop, raw;
c6045832 404{
2f0b74ea 405 Lisp_Object tem;
c6045832 406
4acb738e 407 tem = Fget (symbol, prop);
e6d12642 408 if (INTEGERP (tem))
e96179b3 409 tem = get_doc_string (XINT (tem) > 0 ? tem : make_number (- XINT (tem)), 0, 0);
f6ee1260 410 else if (CONSP (tem) && INTEGERP (XCDR (tem)))
e96179b3 411 tem = get_doc_string (tem, 0, 0);
f6ee1260
GM
412 else if (!STRINGP (tem))
413 /* Feval protects its argument. */
414 tem = Feval (tem);
415
e6d12642 416 if (NILP (raw) && STRINGP (tem))
bbd7d5d3 417 tem = Fsubstitute_command_keys (tem);
992d176e 418 return tem;
c6045832
JB
419}
420\f
283e1184
JB
421/* Scanning the DOC files and placing docstring offsets into functions. */
422
423static void
424store_function_docstring (fun, offset)
425 Lisp_Object fun;
e343d389
RS
426 /* Use EMACS_INT because we get this from pointer subtraction. */
427 EMACS_INT offset;
283e1184
JB
428{
429 fun = indirect_function (fun);
430
431 /* The type determines where the docstring is stored. */
432
433 /* Lisp_Subrs have a slot for it. */
e6d12642 434 if (SUBRP (fun))
283e1184
JB
435 XSUBR (fun)->doc = (char *) - offset;
436
437 /* If it's a lisp form, stick it in the form. */
438 else if (CONSP (fun))
439 {
440 Lisp_Object tem;
441
03699b14 442 tem = XCAR (fun);
283e1184
JB
443 if (EQ (tem, Qlambda) || EQ (tem, Qautoload))
444 {
445 tem = Fcdr (Fcdr (fun));
03699b14
KR
446 if (CONSP (tem) && INTEGERP (XCAR (tem)))
447 XSETFASTINT (XCAR (tem), offset);
283e1184
JB
448 }
449 else if (EQ (tem, Qmacro))
03699b14 450 store_function_docstring (XCDR (fun), offset);
283e1184
JB
451 }
452
453 /* Bytecode objects sometimes have slots for it. */
e6d12642 454 else if (COMPILEDP (fun))
283e1184
JB
455 {
456 /* This bytecode object must have a slot for the
457 docstring, since we've found a docstring for it. */
f9b4aacf 458 if ((XVECTOR (fun)->size & PSEUDOVECTOR_SIZE_MASK) > COMPILED_DOC_STRING)
2ee7863a 459 XSETFASTINT (XVECTOR (fun)->contents[COMPILED_DOC_STRING], offset);
283e1184
JB
460 }
461}
462
463
c6045832
JB
464DEFUN ("Snarf-documentation", Fsnarf_documentation, Ssnarf_documentation,
465 1, 1, 0,
466 "Used during Emacs initialization, before dumping runnable Emacs,\n\
08564963 467to find pointers to doc strings stored in `etc/DOC...' and\n\
c6045832
JB
468record them in function definitions.\n\
469One arg, FILENAME, a string which does not include a directory.\n\
08564963 470The file is found in `../etc' now; found in the `data-directory'\n\
c6045832
JB
471when doc strings are referred to later in the dumped Emacs.")
472 (filename)
473 Lisp_Object filename;
474{
475 int fd;
476 char buf[1024 + 1];
477 register int filled;
478 register int pos;
479 register char *p, *end;
24109c98 480 Lisp_Object sym;
c6045832 481 char *name;
c6045832 482
2bda628c
JB
483#ifndef CANNOT_DUMP
484 if (NILP (Vpurify_flag))
485 error ("Snarf-documentation can only be called in an undumped Emacs");
486#endif
487
c6045832
JB
488 CHECK_STRING (filename, 0);
489
490#ifndef CANNOT_DUMP
6367dc09 491 name = (char *) alloca (XSTRING (filename)->size + 14);
08564963 492 strcpy (name, "../etc/");
c6045832 493#else /* CANNOT_DUMP */
ba870521 494 CHECK_STRING (Vdoc_directory, 0);
c6045832 495 name = (char *) alloca (XSTRING (filename)->size +
ba870521
KH
496 XSTRING (Vdoc_directory)->size + 1);
497 strcpy (name, XSTRING (Vdoc_directory)->data);
c6045832
JB
498#endif /* CANNOT_DUMP */
499 strcat (name, XSTRING (filename)->data); /*** Add this line ***/
500#ifdef VMS
501#ifndef VMS4_4
502 /* For VMS versions with limited file name syntax,
503 convert the name to something VMS will allow. */
504 p = name;
505 while (*p)
506 {
507 if (*p == '-')
508 *p = '_';
509 p++;
510 }
511#endif /* not VMS4_4 */
512#ifdef VMS4_4
513 strcpy (name, sys_translate_unix (name));
514#endif /* VMS4_4 */
515#endif /* VMS */
516
68c45bf0 517 fd = emacs_open (name, O_RDONLY, 0);
c6045832
JB
518 if (fd < 0)
519 report_file_error ("Opening doc string file",
520 Fcons (build_string (name), Qnil));
521 Vdoc_file_name = filename;
522 filled = 0;
523 pos = 0;
524 while (1)
525 {
526 if (filled < 512)
68c45bf0 527 filled += emacs_read (fd, &buf[filled], sizeof buf - 1 - filled);
c6045832
JB
528 if (!filled)
529 break;
530
531 buf[filled] = 0;
532 p = buf;
533 end = buf + (filled < 512 ? filled : filled - 128);
534 while (p != end && *p != '\037') p++;
535 /* p points to ^_Ffunctionname\n or ^_Vvarname\n. */
536 if (p != end)
537 {
a847af86 538 end = (char *) index (p, '\n');
141199d1
RS
539 sym = oblookup (Vobarray, p + 2,
540 multibyte_chars_in_text (p + 2, end - p - 2),
541 end - p - 2);
e6d12642 542 if (SYMBOLP (sym))
c6045832
JB
543 {
544 /* Attach a docstring to a variable? */
545 if (p[1] == 'V')
546 {
547 /* Install file-position as variable-documentation property
548 and make it negative for a user-variable
549 (doc starts with a `*'). */
550 Fput (sym, Qvariable_documentation,
551 make_number ((pos + end + 1 - buf)
552 * (end[1] == '*' ? -1 : 1)));
553 }
554
283e1184 555 /* Attach a docstring to a function? */
c6045832 556 else if (p[1] == 'F')
283e1184
JB
557 store_function_docstring (sym, pos + end + 1 - buf);
558
559 else
560 error ("DOC file invalid at position %d", pos);
c6045832
JB
561 }
562 }
563 pos += end - buf;
564 filled -= end - buf;
565 bcopy (end, buf, filled);
566 }
68c45bf0 567 emacs_close (fd);
c6045832
JB
568 return Qnil;
569}
570\f
571DEFUN ("substitute-command-keys", Fsubstitute_command_keys,
572 Ssubstitute_command_keys, 1, 1, 0,
573 "Substitute key descriptions for command names in STRING.\n\
574Return a new string which is STRING with substrings of the form \\=\\[COMMAND]\n\
575replaced by either: a keystroke sequence that will invoke COMMAND,\n\
576or \"M-x COMMAND\" if COMMAND is not on any keys.\n\
577Substrings of the form \\=\\{MAPVAR} are replaced by summaries\n\
578\(made by describe-bindings) of the value of MAPVAR, taken as a keymap.\n\
579Substrings of the form \\=\\<MAPVAR> specify to use the value of MAPVAR\n\
580as the keymap for future \\=\\[COMMAND] substrings.\n\
581\\=\\= quotes the following character and is discarded;\n\
582thus, \\=\\=\\=\\= puts \\=\\= into the output, and \\=\\=\\=\\[ puts \\=\\[ into the output.")
4acb738e
EN
583 (string)
584 Lisp_Object string;
c6045832
JB
585{
586 unsigned char *buf;
587 int changed = 0;
588 register unsigned char *strp;
589 register unsigned char *bufp;
590 int idx;
591 int bsize;
665d3046 592 Lisp_Object tem;
c6045832
JB
593 Lisp_Object keymap;
594 unsigned char *start;
2d0aa229 595 int length, length_byte;
665d3046
JB
596 Lisp_Object name;
597 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
141199d1
RS
598 int multibyte;
599 int nchars;
c6045832 600
4acb738e 601 if (NILP (string))
c6045832
JB
602 return Qnil;
603
4acb738e 604 CHECK_STRING (string, 0);
665d3046
JB
605 tem = Qnil;
606 keymap = Qnil;
607 name = Qnil;
4acb738e 608 GCPRO4 (string, tem, keymap, name);
c6045832 609
141199d1
RS
610 multibyte = STRING_MULTIBYTE (string);
611 nchars = 0;
612
9a425dcb
RS
613 /* KEYMAP is either nil (which means search all the active keymaps)
614 or a specified local map (which means search just that and the
615 global map). If non-nil, it might come from Voverriding_local_map,
4acb738e 616 or from a \\<mapname> construct in STRING itself.. */
f73d1163
KH
617 keymap = current_kboard->Voverriding_terminal_local_map;
618 if (NILP (keymap))
619 keymap = Voverriding_local_map;
c6045832 620
fc932ac6 621 bsize = STRING_BYTES (XSTRING (string));
c6045832
JB
622 bufp = buf = (unsigned char *) xmalloc (bsize);
623
4acb738e 624 strp = (unsigned char *) XSTRING (string)->data;
fc932ac6 625 while (strp < XSTRING (string)->data + STRING_BYTES (XSTRING (string)))
c6045832
JB
626 {
627 if (strp[0] == '\\' && strp[1] == '=')
628 {
629 /* \= quotes the next character;
630 thus, to put in \[ without its special meaning, use \=\[. */
631 changed = 1;
141199d1
RS
632 strp += 2;
633 if (multibyte)
634 {
635 int len;
fc932ac6 636 int maxlen = XSTRING (string)->data + STRING_BYTES (XSTRING (string)) - strp;
141199d1
RS
637
638 STRING_CHAR_AND_LENGTH (strp, maxlen, len);
639 if (len == 1)
640 *bufp = *strp;
641 else
642 bcopy (strp, bufp, len);
643 strp += len;
644 bufp += len;
645 nchars++;
646 }
647 else
648 *bufp++ = *strp++, nchars++;
c6045832
JB
649 }
650 else if (strp[0] == '\\' && strp[1] == '[')
651 {
b6c53774 652 Lisp_Object firstkey;
11f9d6e1 653 int start_idx;
b6c53774 654
c6045832
JB
655 changed = 1;
656 strp += 2; /* skip \[ */
657 start = strp;
11f9d6e1 658 start_idx = start - XSTRING (string)->data;
c6045832 659
4acb738e 660 while ((strp - (unsigned char *) XSTRING (string)->data
fc932ac6 661 < STRING_BYTES (XSTRING (string)))
c6045832
JB
662 && *strp != ']')
663 strp++;
141199d1
RS
664 length_byte = strp - start;
665
c6045832
JB
666 strp++; /* skip ] */
667
668 /* Save STRP in IDX. */
4acb738e 669 idx = strp - (unsigned char *) XSTRING (string)->data;
141199d1 670 tem = Fintern (make_string (start, length_byte), Qnil);
11f9d6e1
GM
671
672 /* Note the Fwhere_is_internal can GC, so we have to take
673 relocation of string contents into account. */
9a425dcb 674 tem = Fwhere_is_internal (tem, keymap, Qt, Qnil);
11f9d6e1
GM
675 strp = XSTRING (string)->data + idx;
676 start = XSTRING (string)->data + start_idx;
c6045832 677
b6c53774
RS
678 /* Disregard menu bar bindings; it is positively annoying to
679 mention them when there's no menu bar, and it isn't terribly
680 useful even when there is a menu bar. */
ef586bbd
RS
681 if (!NILP (tem))
682 {
683 firstkey = Faref (tem, make_number (0));
684 if (EQ (firstkey, Qmenu_bar))
685 tem = Qnil;
686 }
b6c53774 687
265a9e55 688 if (NILP (tem)) /* but not on any keys */
c6045832 689 {
8d17fe0b
GM
690 int offset = bufp - buf;
691 buf = (unsigned char *) xrealloc (buf, bsize += 4);
692 bufp = buf + offset;
c6045832
JB
693 bcopy ("M-x ", bufp, 4);
694 bufp += 4;
141199d1
RS
695 nchars += 4;
696 if (multibyte)
697 length = multibyte_chars_in_text (start, length_byte);
698 else
699 length = length_byte;
c6045832
JB
700 goto subst;
701 }
702 else
703 { /* function is on a key */
704 tem = Fkey_description (tem);
705 goto subst_string;
706 }
707 }
708 /* \{foo} is replaced with a summary of the keymap (symbol-value foo).
709 \<foo> just sets the keymap used for \[cmd]. */
710 else if (strp[0] == '\\' && (strp[1] == '{' || strp[1] == '<'))
711 {
712 struct buffer *oldbuf;
11f9d6e1 713 int start_idx;
c6045832
JB
714
715 changed = 1;
716 strp += 2; /* skip \{ or \< */
717 start = strp;
11f9d6e1 718 start_idx = start - XSTRING (string)->data;
c6045832 719
4acb738e
EN
720 while ((strp - (unsigned char *) XSTRING (string)->data
721 < XSTRING (string)->size)
c6045832
JB
722 && *strp != '}' && *strp != '>')
723 strp++;
141199d1
RS
724
725 length_byte = strp - start;
c6045832
JB
726 strp++; /* skip } or > */
727
728 /* Save STRP in IDX. */
4acb738e 729 idx = strp - (unsigned char *) XSTRING (string)->data;
c6045832
JB
730
731 /* Get the value of the keymap in TEM, or nil if undefined.
732 Do this while still in the user's current buffer
733 in case it is a local variable. */
141199d1 734 name = Fintern (make_string (start, length_byte), Qnil);
c6045832 735 tem = Fboundp (name);
265a9e55 736 if (! NILP (tem))
c6045832
JB
737 {
738 tem = Fsymbol_value (name);
265a9e55 739 if (! NILP (tem))
11f9d6e1 740 {
02067692
SM
741 tem = get_keymap (tem, 0, 1);
742 /* Note that get_keymap can GC. */
11f9d6e1
GM
743 strp = XSTRING (string)->data + idx;
744 start = XSTRING (string)->data + start_idx;
745 }
c6045832
JB
746 }
747
748 /* Now switch to a temp buffer. */
749 oldbuf = current_buffer;
750 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer));
751
265a9e55 752 if (NILP (tem))
c6045832
JB
753 {
754 name = Fsymbol_name (name);
755 insert_string ("\nUses keymap \"");
141199d1
RS
756 insert_from_string (name, 0, 0,
757 XSTRING (name)->size,
fc932ac6 758 STRING_BYTES (XSTRING (name)), 1);
c6045832
JB
759 insert_string ("\", which is not currently defined.\n");
760 if (start[-1] == '<') keymap = Qnil;
761 }
762 else if (start[-1] == '<')
763 keymap = tem;
764 else
7523d17c 765 describe_map_tree (tem, 1, Qnil, Qnil, (char *)0, 1, 0, 0);
c6045832
JB
766 tem = Fbuffer_string ();
767 Ferase_buffer ();
768 set_buffer_internal (oldbuf);
769
770 subst_string:
771 start = XSTRING (tem)->data;
772 length = XSTRING (tem)->size;
fc932ac6 773 length_byte = STRING_BYTES (XSTRING (tem));
c6045832 774 subst:
8d17fe0b
GM
775 {
776 int offset = bufp - buf;
777 buf = (unsigned char *) xrealloc (buf, bsize += length_byte);
778 bufp = buf + offset;
779 bcopy (start, bufp, length_byte);
780 bufp += length_byte;
781 nchars += length;
782 /* Check STRING again in case gc relocated it. */
783 strp = (unsigned char *) XSTRING (string)->data + idx;
784 }
c6045832 785 }
141199d1
RS
786 else if (! multibyte) /* just copy other chars */
787 *bufp++ = *strp++, nchars++;
788 else
789 {
790 int len;
fc932ac6 791 int maxlen = XSTRING (string)->data + STRING_BYTES (XSTRING (string)) - strp;
141199d1
RS
792
793 STRING_CHAR_AND_LENGTH (strp, maxlen, len);
794 if (len == 1)
795 *bufp = *strp;
796 else
797 bcopy (strp, bufp, len);
798 strp += len;
799 bufp += len;
800 nchars++;
801 }
c6045832
JB
802 }
803
804 if (changed) /* don't bother if nothing substituted */
cc5bf9eb 805 tem = make_string_from_bytes (buf, nchars, bufp - buf);
c6045832 806 else
4acb738e 807 tem = string;
9ac0d9e0 808 xfree (buf);
665d3046 809 RETURN_UNGCPRO (tem);
c6045832
JB
810}
811\f
dfcf069d 812void
c6045832
JB
813syms_of_doc ()
814{
9191c8ae
GM
815 Qfunction_documentation = intern ("function-documentation");
816 staticpro (&Qfunction_documentation);
817
c6045832
JB
818 DEFVAR_LISP ("internal-doc-file-name", &Vdoc_file_name,
819 "Name of file containing documentation strings of built-in symbols.");
820 Vdoc_file_name = Qnil;
712c597e
DL
821 DEFVAR_LISP ("help-manyarg-func-alist", &Vhelp_manyarg_func_alist,
822 "Alist of primitive functions and descriptions of their arg lists.\n\
823All special forms and primitives which effectively have &rest args\n\
824should have an entry here so that `documentation' can provide their\n\
825arg list.");
826 Vhelp_manyarg_func_alist = Qnil;
c6045832
JB
827
828 defsubr (&Sdocumentation);
829 defsubr (&Sdocumentation_property);
830 defsubr (&Ssnarf_documentation);
831 defsubr (&Ssubstitute_command_keys);
832}