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