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