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