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