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