Mercurial > hg > xemacs-beta

comparison src/doc.c @ 428:3ecd8885ac67 r21-2-22

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-22
author cvs
date Mon, 13 Aug 2007 11:28:15 +0200
parents
children 8de8e3f6228a
comparison
equal deleted inserted replaced
427:0a0253eac470 428:3ecd8885ac67
1 /* Record indices of function doc strings stored in a file.
2 Copyright (C) 1985, 1986, 1992, 1993, 1994, 1995
3 Free Software Foundation, Inc.
4
5 This file is part of XEmacs.
6
7 XEmacs is free software; you can redistribute it and/or modify it
8 under the terms of the GNU General Public License as published by the
9 Free Software Foundation; either version 2, or (at your option) any
10 later version.
11
12 XEmacs is distributed in the hope that it will be useful, but WITHOUT
13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
15 for more details.
16
17 You should have received a copy of the GNU General Public License
18 along with XEmacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
21
22 /* Synched up with: FSF 19.30. */
23
24 /* This file has been Mule-ized except as noted. */
25
26 #include <config.h>
27 #include "lisp.h"
28
29 #include "buffer.h"
30 #include "bytecode.h"
31 #include "insdel.h"
32 #include "keymap.h"
33 #include "sysfile.h"
34
35 Lisp_Object Vinternal_doc_file_name;
36
37 Lisp_Object QSsubstitute;
38
39 /* Read and return doc string from open file descriptor FD
40 at position POSITION. Does not close the file. Returns
41 string; or if error, returns a cons holding the error
42 data to pass to Fsignal. NAME_NONRELOC and NAME_RELOC
43 are only used for the error messages. */
44
45 Lisp_Object
46 unparesseuxify_doc_string (int fd, EMACS_INT position,
47 char *name_nonreloc, Lisp_Object name_reloc)
48 {
49 char buf[512 * 32 + 1];
50 char *buffer = buf;
51 int buffer_size = sizeof (buf);
52 char *from, *to;
53 REGISTER char *p = buffer;
54 Lisp_Object return_me;
55
56 if (0 > lseek (fd, position, 0))
57 {
58 if (name_nonreloc)
59 name_reloc = build_string (name_nonreloc);
60 return_me = list3 (build_string
61 ("Position out of range in doc string file"),
62 name_reloc, make_int (position));
63 goto done;
64 }
65
66 /* Read the doc string into a buffer.
67 Use the fixed buffer BUF if it is big enough; otherwise allocate one.
68 We store the buffer in use in BUFFER and its size in BUFFER_SIZE. */
69
70 while (1)
71 {
72 int space_left = buffer_size - (p - buffer);
73 int nread;
74
75 /* Switch to a bigger buffer if we need one. */
76 if (space_left == 0)
77 {
78 char * old_buffer = buffer;
79 if (buffer == buf) {
80 buffer = (char *) xmalloc (buffer_size *= 2);
81 memcpy (buffer, old_buffer, p - old_buffer);
82 } else {
83 buffer = (char *) xrealloc (buffer, buffer_size *= 2);
84 }
85 p += buffer - old_buffer;
86 space_left = buffer_size - (p - buffer);
87 }
88
89 /* Don't read too much at one go. */
90 if (space_left > 1024 * 8)
91 space_left = 1024 * 8;
92 nread = read (fd, p, space_left);
93 if (nread < 0)
94 {
95 return_me = list1 (build_string
96 ("Read error on documentation file"));
97 goto done;
98 }
99 p[nread] = 0;
100 if (!nread)
101 break;
102 {
103 char *p1 = strchr (p, '\037'); /* End of doc string marker */
104 if (p1)
105 {
106 *p1 = 0;
107 p = p1;
108 break;
109 }
110 }
111 p += nread;
112 }
113
114 /* Scan the text and remove quoting with ^A (char code 1).
115 ^A^A becomes ^A, ^A0 becomes a null char, and ^A_ becomes a ^_. */
116 from = to = buffer;
117 while (from < p)
118 {
119 if (*from != 1 /*^A*/)
120 *to++ = *from++;
121 else
122 {
123 int c = *(++from);
124
125 from++;
126 switch (c)
127 {
128 case 1: *to++ = c; break;
129 case '0': *to++ = '\0'; break;
130 case '_': *to++ = '\037'; break;
131 default:
132 return_me = list2 (build_string
133 ("Invalid data in documentation file -- ^A followed by weird code"),
134 make_int (c));
135 goto done;
136 }
137 }
138 }
139
140 /* #### mrb: following STILL completely broken */
141 return_me = make_ext_string ((Bufbyte *) buffer, to - buffer, FORMAT_BINARY);
142
143 done:
144 if (buffer != buf) /* We must have allocated buffer above */
145 xfree (buffer);
146 return return_me;
147 }
148
149 #define string_join(dest, s1, s2) \
150 memcpy ((void *) dest, (void *) XSTRING_DATA (s1), XSTRING_LENGTH (s1)); \
151 memcpy ((void *) ((Bufbyte *) dest + XSTRING_LENGTH (s1)), \
152 (void *) XSTRING_DATA (s2), XSTRING_LENGTH (s2)); \
153 dest[XSTRING_LENGTH (s1) + XSTRING_LENGTH (s2)] = '\0'
154
155 /* Extract a doc string from a file. FILEPOS says where to get it.
156 (This could actually be byte code instructions/constants instead
157 of a doc string.)
158 If it is an integer, use that position in the standard DOC file.
159 If it is (FILE . INTEGER), use FILE as the file name
160 and INTEGER as the position in that file.
161 But if INTEGER is negative, make it positive.
162 (A negative integer is used for user variables, so we can distinguish
163 them without actually fetching the doc string.) */
164
165 static Lisp_Object
166 get_doc_string (Lisp_Object filepos)
167 {
168 /* !!#### This function has not been Mule-ized */
169 REGISTER int fd;
170 REGISTER char *name_nonreloc = 0;
171 int minsize;
172 EMACS_INT position;
173 Lisp_Object file, tem;
174 Lisp_Object name_reloc = Qnil;
175
176 if (INTP (filepos))
177 {
178 file = Vinternal_doc_file_name;
179 position = XINT (filepos);
180 }
181 else if (CONSP (filepos) && INTP (XCDR (filepos)))
182 {
183 file = XCAR (filepos);
184 position = XINT (XCDR (filepos));
185 if (position < 0)
186 position = - position;
187 }
188 else
189 return Qnil;
190
191 if (!STRINGP (file))
192 return Qnil;
193
194 /* Put the file name in NAME as a C string.
195 If it is relative, combine it with Vdoc_directory. */
196
197 tem = Ffile_name_absolute_p (file);
198 if (NILP (tem))
199 {
200 /* XEmacs: Move this check here. OK if called during loadup to
201 load byte code instructions. */
202 if (!STRINGP (Vdoc_directory))
203 return Qnil;
204
205 minsize = XSTRING_LENGTH (Vdoc_directory);
206 /* sizeof ("../lib-src/") == 12 */
207 if (minsize < 12)
208 minsize = 12;
209 name_nonreloc = (char *) alloca (minsize + XSTRING_LENGTH (file) + 8);
210 string_join (name_nonreloc, Vdoc_directory, file);
211 }
212 else
213 name_reloc = file;
214
215 fd = open (name_nonreloc ? name_nonreloc :
216 (char *) XSTRING_DATA (name_reloc), O_RDONLY | OPEN_BINARY, 0);
217 if (fd < 0)
218 {
219 #ifndef CANNOT_DUMP
220 if (purify_flag)
221 {
222 /* sizeof ("../lib-src/") == 12 */
223 name_nonreloc = (char *) alloca (12 + XSTRING_LENGTH (file) + 8);
224 /* Preparing to dump; DOC file is probably not installed.
225 So check in ../lib-src. */
226 strcpy (name_nonreloc, "../lib-src/");
227 strcat (name_nonreloc, (char *) XSTRING_DATA (file));
228
229 fd = open (name_nonreloc, O_RDONLY | OPEN_BINARY, 0);
230 }
231 #endif /* CANNOT_DUMP */
232
233 if (fd < 0)
234 error ("Cannot open doc string file \"%s\"",
235 name_nonreloc ? name_nonreloc :
236 (char *) XSTRING_DATA (name_reloc));
237 }
238
239 tem = unparesseuxify_doc_string (fd, position, name_nonreloc, name_reloc);
240 close (fd);
241
242 if (!STRINGP (tem))
243 signal_error (Qerror, tem);
244
245 return tem;
246 }
247
248 /* Get a string from position FILEPOS and pass it through the Lisp reader.
249 We use this for fetching the bytecode string and constants vector
250 of a compiled function from the .elc file. */
251
252 Lisp_Object
253 read_doc_string (Lisp_Object filepos)
254 {
255 Lisp_Object string = get_doc_string (filepos);
256
257 if (!STRINGP (string))
258 signal_simple_error ("loading bytecode failed to return string", string);
259 return Fread (string);
260 }
261
262 DEFUN ("documentation", Fdocumentation, 1, 2, 0, /*
263 Return the documentation string of FUNCTION.
264 Unless a non-nil second argument is given, the
265 string is passed through `substitute-command-keys'.
266 */
267 (function, raw))
268 {
269 /* This function can GC */
270 Lisp_Object fun;
271 Lisp_Object doc;
272
273 fun = Findirect_function (function);
274
275 if (SUBRP (fun))
276 {
277 if (XSUBR (fun)->doc == 0)
278 return Qnil;
279 if ((EMACS_INT) XSUBR (fun)->doc >= 0)
280 doc = build_string (XSUBR (fun)->doc);
281 else
282 doc = get_doc_string (make_int (- (EMACS_INT) XSUBR (fun)->doc));
283 }
284 else if (COMPILED_FUNCTIONP (fun))
285 {
286 Lisp_Object tem;
287 struct Lisp_Compiled_Function *f = XCOMPILED_FUNCTION (fun);
288 if (! (f->flags.documentationp))
289 return Qnil;
290 tem = compiled_function_documentation (f);
291 if (STRINGP (tem))
292 doc = tem;
293 else if (NATNUMP (tem) || CONSP (tem))
294 doc = get_doc_string (tem);
295 else
296 return Qnil;
297 }
298 else if (KEYMAPP (fun))
299 return build_translated_string ("Prefix command (definition is a keymap of subcommands).");
300 else if (STRINGP (fun) || VECTORP (fun))
301 return build_translated_string ("Keyboard macro.");
302 else if (CONSP (fun))
303 {
304 Lisp_Object funcar = Fcar (fun);
305
306 if (!SYMBOLP (funcar))
307 return Fsignal (Qinvalid_function, list1 (fun));
308 else if (EQ (funcar, Qlambda)
309 || EQ (funcar, Qautoload))
310 {
311 Lisp_Object tem, tem1;
312 tem1 = Fcdr (Fcdr (fun));
313 tem = Fcar (tem1);
314 if (STRINGP (tem))
315 doc = tem;
316 /* Handle a doc reference--but these never come last
317 in the function body, so reject them if they are last. */
318 else if ((NATNUMP (tem) || CONSP (tem))
319 && ! NILP (XCDR (tem1)))
320 doc = get_doc_string (tem);
321 else
322 return Qnil;
323 }
324 else if (EQ (funcar, Qmacro))
325 return Fdocumentation (Fcdr (fun), raw);
326 else
327 goto oops;
328 }
329 else
330 {
331 oops:
332 return Fsignal (Qinvalid_function, list1 (fun));
333 }
334
335 if (NILP (raw))
336 {
337 struct gcpro gcpro1;
338 #ifdef I18N3
339 Lisp_Object domain = Qnil;
340 if (COMPILED_FUNCTIONP (fun))
341 domain = compiled_function_domain (XCOMPILED_FUNCTION (fun));
342 if (NILP (domain))
343 doc = Fgettext (doc);
344 else
345 doc = Fdgettext (domain, doc);
346 #endif
347
348 GCPRO1 (doc);
349 doc = Fsubstitute_command_keys (doc);
350 UNGCPRO;
351 }
352 return doc;
353 }
354
355 DEFUN ("documentation-property", Fdocumentation_property, 2, 3, 0, /*
356 Return the documentation string that is SYMBOL's PROP property.
357 This is like `get', but it can refer to strings stored in the
358 `doc-directory/DOC' file; and if the value is a string, it is passed
359 through `substitute-command-keys'. A non-nil third argument avoids this
360 translation.
361 */
362 (sym, prop, raw))
363 {
364 /* This function can GC */
365 REGISTER Lisp_Object doc = Qnil;
366 #ifdef I18N3
367 REGISTER Lisp_Object domain;
368 #endif
369 struct gcpro gcpro1;
370
371 GCPRO1 (doc);
372
373 doc = Fget (sym, prop, Qnil);
374 if (INTP (doc))
375 doc = get_doc_string (XINT (doc) > 0 ? doc : make_int (- XINT (doc)));
376 else if (CONSP (doc))
377 doc = get_doc_string (doc);
378 #ifdef I18N3
379 if (!NILP (doc))
380 {
381 domain = Fget (sym, Qvariable_domain, Qnil);
382 if (NILP (domain))
383 doc = Fgettext (doc);
384 else
385 doc = Fdgettext (domain, doc);
386 }
387 #endif
388 if (NILP (raw) && STRINGP (doc))
389 doc = Fsubstitute_command_keys (doc);
390 UNGCPRO;
391 return doc;
392 }
393
394 static void
395 weird_doc (Lisp_Object sym, CONST char *weirdness, CONST char *type, int pos)
396 {
397 if (!strcmp (weirdness, GETTEXT ("duplicate"))) return;
398 message ("Note: Strange doc (%s) for %s %s @ %d",
399 weirdness, type, string_data (XSYMBOL (sym)->name), pos);
400 }
401
402
403 DEFUN ("Snarf-documentation", Fsnarf_documentation, 1, 1, 0, /*
404 Used during Emacs initialization, before dumping runnable Emacs,
405 to find pointers to doc strings stored in `.../lib-src/DOC' and
406 record them in function definitions.
407 One arg, FILENAME, a string which does not include a directory.
408 The file is written to `../lib-src', and later found in `exec-directory'
409 when doc strings are referred to in the dumped Emacs.
410 */
411 (filename))
412 {
413 /* !!#### This function has not been Mule-ized */
414 int fd;
415 char buf[1024 + 1];
416 REGISTER int filled;
417 REGISTER int pos;
418 REGISTER char *p, *end;
419 Lisp_Object sym, fun, tem;
420 char *name;
421
422 #ifndef CANNOT_DUMP
423 if (!purify_flag)
424 error ("Snarf-documentation can only be called in an undumped Emacs");
425 #endif
426
427 CHECK_STRING (filename);
428
429 #ifdef CANNOT_DUMP
430 if (!NILP(Vdoc_directory))
431 {
432 CHECK_STRING (Vdoc_directory);
433 name = (char *) alloca (XSTRING_LENGTH (filename)
434 + XSTRING_LENGTH (Vdoc_directory)
435 + 1);
436 strcpy (name, (char *) XSTRING_DATA (Vdoc_directory));
437 }
438 else
439 #endif /* CANNOT_DUMP */
440 {
441 name = (char *) alloca (XSTRING_LENGTH (filename) + 14);
442 strcpy (name, "../lib-src/");
443 }
444
445 strcat (name, (char *) XSTRING_DATA (filename));
446
447 fd = open (name, O_RDONLY | OPEN_BINARY, 0);
448 if (fd < 0)
449 report_file_error ("Opening doc string file",
450 Fcons (build_string (name), Qnil));
451 Vinternal_doc_file_name = filename;
452 filled = 0;
453 pos = 0;
454 while (1)
455 {
456 if (filled < 512)
457 filled += read (fd, &buf[filled], sizeof buf - 1 - filled);
458 if (!filled)
459 break;
460
461 buf[filled] = 0;
462 p = buf;
463 end = buf + (filled < 512 ? filled : filled - 128);
464 while (p != end && *p != '\037') p++;
465 /* p points to ^_Ffunctionname\n or ^_Vvarname\n. */
466 if (p != end)
467 {
468 end = strchr (p, '\n');
469 sym = oblookup (Vobarray, (Bufbyte *) p + 2, end - p - 2);
470 if (SYMBOLP (sym))
471 {
472 Lisp_Object offset = make_int (pos + end + 1 - buf);
473 /* Attach a docstring to a variable */
474 if (p[1] == 'V')
475 {
476 /* Install file-position as variable-documentation property
477 and make it negative for a user-variable
478 (doc starts with a `*'). */
479 Lisp_Object old = Fget (sym, Qvariable_documentation, Qzero);
480 if (!ZEROP (old))
481 {
482 weird_doc (sym, GETTEXT ("duplicate"),
483 GETTEXT ("variable"), pos);
484 /* In the case of duplicate doc file entries, always
485 take the later one. But if the doc is not an int
486 (a string, say) leave it alone. */
487 if (!INTP (old))
488 goto weird;
489 }
490 Fput (sym, Qvariable_documentation,
491 ((end[1] == '*')
492 ? make_int (- XINT (offset))
493 : offset));
494 }
495 /* Attach a docstring to a function.
496 The type determines where the docstring is stored. */
497 else if (p[1] == 'F')
498 {
499 fun = indirect_function (sym,0);
500
501 if (CONSP (fun) && EQ (XCAR (fun), Qmacro))
502 fun = XCDR (fun);
503
504 if (UNBOUNDP (fun))
505 {
506 /* May have been #if'ed out or something */
507 weird_doc (sym, GETTEXT ("not fboundp"),
508 GETTEXT ("function"), pos);
509 goto weird;
510 }
511 else if (SUBRP (fun))
512 {
513 /* Lisp_Subrs have a slot for it. */
514 if (XSUBR (fun)->doc)
515 {
516 weird_doc (sym, GETTEXT ("duplicate"),
517 GETTEXT ("subr"), pos);
518 goto weird;
519 }
520 XSUBR (fun)->doc = (char *) (- XINT (offset));
521 }
522 else if (CONSP (fun))
523 {
524 /* If it's a lisp form, stick it in the form. */
525 tem = XCAR (fun);
526 if (EQ (tem, Qlambda) || EQ (tem, Qautoload))
527 {
528 tem = Fcdr (Fcdr (fun));
529 if (CONSP (tem) &&
530 INTP (XCAR (tem)))
531 {
532 Lisp_Object old = XCAR (tem);
533 if (!ZEROP (old))
534 {
535 weird_doc (sym, GETTEXT ("duplicate"),
536 (EQ (tem, Qlambda)
537 ? GETTEXT ("lambda")
538 : GETTEXT ("autoload")),
539 pos);
540 /* In the case of duplicate doc file entries,
541 always take the later one. But if the doc
542 is not an int (a string, say) leave it
543 alone. */
544 if (!INTP (old))
545 goto weird;
546 }
547 XCAR (tem) = offset;
548 }
549 else if (!CONSP (tem))
550 {
551 weird_doc (sym, GETTEXT ("!CONSP(tem)"),
552 GETTEXT ("function"), pos);
553 goto cont;
554 }
555 else
556 {
557 /* DOC string is a string not integer 0 */
558 #if 0
559 weird_doc (sym, GETTEXT ("!INTP(XCAR(tem))"),
560 GETTEXT ("function"), pos);
561 #endif
562 goto cont;
563 }
564 }
565 else
566 {
567 weird_doc (sym, GETTEXT ("not lambda or autoload"),
568 GETTEXT ("function"), pos);
569 goto cont;
570 }
571 }
572 else if (COMPILED_FUNCTIONP (fun))
573 {
574 /* Compiled-Function objects sometimes have
575 slots for it. */
576 struct Lisp_Compiled_Function *f =
577 XCOMPILED_FUNCTION (fun);
578
579 /* This compiled-function object must have a
580 slot for the docstring, since we've found a
581 docstring for it. Unless there were multiple
582 definitions of it, and the latter one didn't
583 have any doc, which is a legal if slightly
584 bogus situation, so don't blow up. */
585
586 if (! (f->flags.documentationp))
587 {
588 weird_doc (sym, GETTEXT ("no doc slot"),
589 GETTEXT ("bytecode"), pos);
590 goto weird;
591 }
592 else
593 {
594 Lisp_Object old =
595 compiled_function_documentation (f);
596 if (!ZEROP (old))
597 {
598 weird_doc (sym, GETTEXT ("duplicate"),
599 GETTEXT ("bytecode"), pos);
600 /* In the case of duplicate doc file entries,
601 always take the later one. But if the doc is
602 not an int (a string, say) leave it alone. */
603 if (!INTP (old))
604 goto weird;
605 }
606 set_compiled_function_documentation (f, offset);
607 }
608 }
609 else
610 {
611 /* Otherwise the function is undefined or
612 otherwise weird. Ignore it. */
613 weird_doc (sym, GETTEXT ("weird function"),
614 GETTEXT ("function"), pos);
615 goto weird;
616 }
617 }
618 else
619 {
620 /* lose: */
621 error ("DOC file invalid at position %d", pos);
622 weird:
623 /* goto lose */;
624 }
625 }
626 }
627 cont:
628 pos += end - buf;
629 filled -= end - buf;
630 memmove (buf, end, filled);
631 }
632 close (fd);
633 return Qnil;
634 }
635
636
637 #if 1 /* Don't warn about functions whose doc was lost because they were
638 wrapped by advice-freeze.el... */
639 static int
640 kludgily_ignore_lost_doc_p (Lisp_Object sym)
641 {
642 # define kludge_prefix "ad-Orig-"
643 struct Lisp_String *name = XSYMBOL (sym)->name;
644 return (string_length (name) > (Bytecount) (sizeof (kludge_prefix)) &&
645 !strncmp ((char *) string_data (name), kludge_prefix,
646 sizeof (kludge_prefix) - 1));
647 # undef kludge_prefix
648 }
649 #else
650 # define kludgily_ignore_lost_doc_p(sym) 0
651 #endif
652
653
654 static int
655 verify_doc_mapper (Lisp_Object sym, void *arg)
656 {
657 Lisp_Object closure = *(Lisp_Object *)arg;
658
659 if (!NILP (Ffboundp (sym)))
660 {
661 int doc = 0;
662 Lisp_Object fun = XSYMBOL (sym)->function;
663 if (CONSP (fun) &&
664 EQ (XCAR (fun), Qmacro))
665 fun = XCDR (fun);
666
667 if (SUBRP (fun))
668 doc = (EMACS_INT) XSUBR (fun)->doc;
669 else if (SYMBOLP (fun))
670 doc = -1;
671 else if (KEYMAPP (fun))
672 doc = -1;
673 else if (CONSP (fun))
674 {
675 Lisp_Object tem = XCAR (fun);
676 if (EQ (tem, Qlambda) || EQ (tem, Qautoload))
677 {
678 doc = -1;
679 tem = Fcdr (Fcdr (fun));
680 if (CONSP (tem) &&
681 INTP (XCAR (tem)))
682 doc = XINT (XCAR (tem));
683 }
684 }
685 else if (COMPILED_FUNCTIONP (fun))
686 {
687 struct Lisp_Compiled_Function *f = XCOMPILED_FUNCTION (fun);
688 if (! (f->flags.documentationp))
689 doc = -1;
690 else
691 {
692 Lisp_Object tem = compiled_function_documentation (f);
693 if (INTP (tem))
694 doc = XINT (tem);
695 }
696 }
697
698 if (doc == 0 && !kludgily_ignore_lost_doc_p (sym))
699 {
700 message ("Warning: doc lost for function %s.",
701 string_data (XSYMBOL (sym)->name));
702 XCDR (closure) = Qt;
703 }
704 }
705 if (!NILP (Fboundp (sym)))
706 {
707 Lisp_Object doc = Fget (sym, Qvariable_documentation, Qnil);
708 if (ZEROP (doc))
709 {
710 message ("Warning: doc lost for variable %s.",
711 string_data (XSYMBOL (sym)->name));
712 XCDR (closure) = Qt;
713 }
714 }
715 return 0; /* Never stop */
716 }
717
718 DEFUN ("Verify-documentation", Fverify_documentation, 0, 0, 0, /*
719 Used to make sure everything went well with Snarf-documentation.
720 Writes to stderr if not.
721 */
722 ())
723 {
724 Lisp_Object closure = Fcons (Qnil, Qnil);
725 struct gcpro gcpro1;
726 GCPRO1 (closure);
727 map_obarray (Vobarray, verify_doc_mapper, &closure);
728 if (!NILP (Fcdr (closure)))
729 message ("\n"
730 "This is usually because some files were preloaded by loaddefs.el or\n"
731 "site-load.el, but were not passed to make-docfile by Makefile.\n");
732 UNGCPRO;
733 return NILP (Fcdr (closure)) ? Qt : Qnil;
734 }
735
736
737 DEFUN ("substitute-command-keys", Fsubstitute_command_keys, 1, 1, 0, /*
738 Substitute key descriptions for command names in STRING.
739 Return a new string which is STRING with substrings of the form \\=\\[COMMAND]
740 replaced by either: a keystroke sequence that will invoke COMMAND,
741 or "M-x COMMAND" if COMMAND is not on any keys.
742 Substrings of the form \\=\\{MAPVAR} are replaced by summaries
743 \(made by describe-bindings) of the value of MAPVAR, taken as a keymap.
744 Substrings of the form \\=\\<MAPVAR> specify to use the value of MAPVAR
745 as the keymap for future \\=\\[COMMAND] substrings.
746 \\=\\= quotes the following character and is discarded;
747 thus, \\=\\=\\=\\= puts \\=\\= into the output, and \\=\\=\\=\\[ puts \\=\\[ into the output.
748 */
749 (str))
750 {
751 /* This function can GC */
752 Bufbyte *buf;
753 int changed = 0;
754 REGISTER Bufbyte *strdata;
755 REGISTER Bufbyte *bufp;
756 Bytecount strlength;
757 Bytecount idx;
758 Bytecount bsize;
759 Bufbyte *new;
760 Lisp_Object tem;
761 Lisp_Object keymap;
762 Bufbyte *start;
763 Bytecount length;
764 Lisp_Object name;
765 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
766
767 if (NILP (str))
768 return Qnil;
769
770 CHECK_STRING (str);
771 tem = Qnil;
772 keymap = Qnil;
773 name = Qnil;
774 GCPRO4 (str, tem, keymap, name);
775
776 /* There is the possibility that the string is not destined for a
777 translating stream, and it could be argued that we should do the
778 same thing here as in Fformat(), but there are very few times
779 when this will be the case and many calls to this function
780 would have to have `gettext' calls added. (I18N3) */
781 str = LISP_GETTEXT (str);
782
783 /* KEYMAP is either nil (which means search all the active keymaps)
784 or a specified local map (which means search just that and the
785 global map). If non-nil, it might come from Voverriding_local_map,
786 or from a \\<mapname> construct in STR itself.. */
787 #if 0 /* FSFmacs */
788 /* This is really weird and garbagey. If keymap is nil and there's
789 an overriding-local-map, `where-is-internal' will correctly note
790 this, so there's no reason to do it here. Maybe FSFmacs
791 `where-is-internal' is broken. */
792 /*
793 keymap = current_kboard->Voverriding_terminal_local_map;
794 if (NILP (keymap))
795 keymap = Voverriding_local_map;
796 */
797 #endif
798
799 strlength = XSTRING_LENGTH (str);
800 bsize = 1 + strlength;
801 buf = (Bufbyte *) xmalloc (bsize);
802 bufp = buf;
803
804 /* Have to reset strdata every time GC might be called */
805 strdata = XSTRING_DATA (str);
806 for (idx = 0; idx < strlength; )
807 {
808 Bufbyte *strp = strdata + idx;
809
810 if (strp[0] != '\\')
811 {
812 /* just copy other chars */
813 /* As it happens, this will work with Mule even if the
814 character quoted is multi-byte; the remaining multi-byte
815 characters will just be copied by this loop. */
816 *bufp++ = *strp;
817 idx++;
818 }
819 else switch (strp[1])
820 {
821 default:
822 {
823 /* just copy unknown escape sequences */
824 *bufp++ = *strp;
825 idx++;
826 break;
827 }
828 case '=':
829 {
830 /* \= quotes the next character;
831 thus, to put in \[ without its special meaning, use \=\[. */
832 /* As it happens, this will work with Mule even if the
833 character quoted is multi-byte; the remaining multi-byte
834 characters will just be copied by this loop. */
835 changed = 1;
836 *bufp++ = strp[2];
837 idx += 3;
838 break;
839 }
840 case '[':
841 {
842 changed = 1;
843 idx += 2; /* skip \[ */
844 strp += 2;
845 start = strp;
846
847 while ((idx < strlength)
848 && *strp != ']')
849 {
850 strp++;
851 idx++;
852 }
853 length = strp - start;
854 idx++; /* skip ] */
855
856 tem = Fintern (make_string (start, length), Qnil);
857 tem = Fwhere_is_internal (tem, keymap, Qt, Qnil, Qnil);
858
859 #if 0 /* FSFmacs */
860 /* Disregard menu bar bindings; it is positively annoying to
861 mention them when there's no menu bar, and it isn't terribly
862 useful even when there is a menu bar. */
863 if (!NILP (tem))
864 {
865 firstkey = Faref (tem, Qzero);
866 if (EQ (firstkey, Qmenu_bar))
867 tem = Qnil;
868 }
869 #endif
870
871 if (NILP (tem)) /* but not on any keys */
872 {
873 new = (Bufbyte *) xrealloc (buf, bsize += 4);
874 bufp += new - buf;
875 buf = new;
876 memcpy (bufp, "M-x ", 4);
877 bufp += 4;
878 goto subst;
879 }
880 else
881 { /* function is on a key */
882 tem = Fkey_description (tem);
883 goto subst_string;
884 }
885 }
886 case '{':
887 case '<':
888 {
889 /* ### jump to label `subst_string|subst' crosses
890 initialization of `buffer|_buf' */
891 Lisp_Object buffer;
892 struct buffer *buf_;
893
894 buffer = Fget_buffer_create (QSsubstitute);
895 buf_ = XBUFFER (buffer);
896
897 Fbuffer_disable_undo (buffer);
898 Ferase_buffer (buffer);
899
900 /* \{foo} is replaced with a summary of keymap (symbol-value foo).
901 \<foo> just sets the keymap used for \[cmd]. */
902 changed = 1;
903 idx += 2; /* skip \{ or \< */
904 strp += 2;
905 start = strp;
906
907 while ((idx < strlength)
908 && *strp != '}' && *strp != '>')
909 {
910 strp++;
911 idx++;
912 }
913 length = strp - start;
914 idx++; /* skip } or > */
915
916 /* Get the value of the keymap in TEM, or nil if undefined.
917 Do this while still in the user's current buffer
918 in case it is a local variable. */
919 name = Fintern (make_string (start, length), Qnil);
920 tem = Fboundp (name);
921 if (! NILP (tem))
922 {
923 tem = Fsymbol_value (name);
924 if (! NILP (tem))
925 tem = get_keymap (tem, 0, 1);
926 }
927
928 if (NILP (tem))
929 {
930 char boof[255], *b = boof;
931 *b++ = '\n';
932 /* #### This sprintf() is potentially dangerous! */
933 sprintf (b, GETTEXT (
934 "Uses keymap \"%s\", which is not currently defined."),
935 (char *) XSTRING_DATA (Fsymbol_name (name)));
936 b += strlen (b);
937 *b++ = '\n';
938 *b++ = 0;
939 buffer_insert_c_string (buf_, boof);
940
941 if (start[-1] == '<') keymap = Qnil;
942 }
943 else if (start[-1] == '<')
944 keymap = tem;
945 else
946 describe_map_tree (tem, 1, Qnil, Qnil, 0, buffer);
947
948 tem = make_string_from_buffer (buf_, BUF_BEG (buf_),
949 BUF_Z (buf_) - BUF_BEG (buf_));
950 Ferase_buffer (buffer);
951 goto subst_string;
952
953 subst_string:
954 start = XSTRING_DATA (tem);
955 length = XSTRING_LENGTH (tem);
956 subst:
957 bsize += length;
958 new = (Bufbyte *) xrealloc (buf, bsize);
959 bufp += new - buf;
960 buf = new;
961 memcpy (bufp, start, length);
962 bufp += length;
963
964 /* Reset STRDATA in case gc relocated it. */
965 strdata = XSTRING_DATA (str);
966
967 break;
968 }
969 }
970 }
971
972 if (changed) /* don't bother if nothing substituted */
973 tem = make_string (buf, bufp - buf);
974 else
975 tem = str;
976 xfree (buf);
977 UNGCPRO;
978 return tem;
979 }
980
981
982 /************************************************************************/
983 /* initialization */
984 /************************************************************************/
985
986 void
987 syms_of_doc (void)
988 {
989 DEFSUBR (Fdocumentation);
990 DEFSUBR (Fdocumentation_property);
991 DEFSUBR (Fsnarf_documentation);
992 DEFSUBR (Fverify_documentation);
993 DEFSUBR (Fsubstitute_command_keys);
994 }
995
996 void
997 vars_of_doc (void)
998 {
999 DEFVAR_LISP ("internal-doc-file-name", &Vinternal_doc_file_name /*
1000 Name of file containing documentation strings of built-in symbols.
1001 */ );
1002 Vinternal_doc_file_name = Qnil;
1003
1004 QSsubstitute = build_string (" *substitute*");
1005 staticpro (&QSsubstitute);
1006 }