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