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