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.
5 This file is part of XEmacs.
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
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
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. */
22 /* Synched up with: FSF 19.30. */
24 /* This file has been Mule-ized except as noted. */
35 Lisp_Object Vinternal_doc_file_name;
37 Lisp_Object QSsubstitute;
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. */
46 unparesseuxify_doc_string (int fd, EMACS_INT position,
47 char *name_nonreloc, Lisp_Object name_reloc)
49 char buf[512 * 32 + 1];
51 int buffer_size = sizeof (buf);
53 REGISTER char *p = buffer;
54 Lisp_Object return_me;
56 if (0 > lseek (fd, position, 0))
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));
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. */
72 int space_left = buffer_size - (p - buffer);
75 /* Switch to a bigger buffer if we need one. */
78 char * old_buffer = buffer;
80 buffer = (char *) xmalloc (buffer_size *= 2);
81 memcpy (buffer, old_buffer, p - old_buffer);
83 buffer = (char *) xrealloc (buffer, buffer_size *= 2);
85 p += buffer - old_buffer;
86 space_left = buffer_size - (p - buffer);
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);
95 return_me = list1 (build_string
96 ("Read error on documentation file"));
103 char *p1 = strchr (p, '\037'); /* End of doc string marker */
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 ^_. */
119 if (*from != 1 /*^A*/)
128 case 1: *to++ = c; break;
129 case '0': *to++ = '\0'; break;
130 case '_': *to++ = '\037'; break;
132 return_me = list2 (build_string
133 ("Invalid data in documentation file -- ^A followed by weird code"),
140 /* #### mrb: following STILL completely broken */
141 return_me = make_ext_string ((Bufbyte *) buffer, to - buffer, FORMAT_BINARY);
144 if (buffer != buf) /* We must have allocated buffer above */
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'
155 /* Extract a doc string from a file. FILEPOS says where to get it.
156 (This could actually be byte code instructions/constants instead
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.) */
166 get_doc_string (Lisp_Object filepos)
168 /* !!#### This function has not been Mule-ized */
170 REGISTER char *name_nonreloc = 0;
173 Lisp_Object file, tem;
174 Lisp_Object name_reloc = Qnil;
178 file = Vinternal_doc_file_name;
179 position = XINT (filepos);
181 else if (CONSP (filepos) && INTP (XCDR (filepos)))
183 file = XCAR (filepos);
184 position = XINT (XCDR (filepos));
186 position = - position;
194 /* Put the file name in NAME as a C string.
195 If it is relative, combine it with Vdoc_directory. */
197 tem = Ffile_name_absolute_p (file);
200 /* XEmacs: Move this check here. OK if called during loadup to
201 load byte code instructions. */
202 if (!STRINGP (Vdoc_directory))
205 minsize = XSTRING_LENGTH (Vdoc_directory);
206 /* sizeof ("../lib-src/") == 12 */
209 name_nonreloc = (char *) alloca (minsize + XSTRING_LENGTH (file) + 8);
210 string_join (name_nonreloc, Vdoc_directory, file);
215 fd = open (name_nonreloc ? name_nonreloc :
216 (char *) XSTRING_DATA (name_reloc), O_RDONLY | OPEN_BINARY, 0);
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));
229 fd = open (name_nonreloc, O_RDONLY | OPEN_BINARY, 0);
231 #endif /* CANNOT_DUMP */
234 error ("Cannot open doc string file \"%s\"",
235 name_nonreloc ? name_nonreloc :
236 (char *) XSTRING_DATA (name_reloc));
239 tem = unparesseuxify_doc_string (fd, position, name_nonreloc, name_reloc);
243 signal_error (Qerror, tem);
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. */
253 read_doc_string (Lisp_Object filepos)
255 Lisp_Object string = get_doc_string (filepos);
257 if (!STRINGP (string))
258 signal_simple_error ("loading bytecode failed to return string", string);
259 return Fread (string);
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'.
269 /* This function can GC */
273 fun = Findirect_function (function);
277 if (XSUBR (fun)->doc == 0)
279 if ((EMACS_INT) XSUBR (fun)->doc >= 0)
280 doc = build_string (XSUBR (fun)->doc);
282 doc = get_doc_string (make_int (- (EMACS_INT) XSUBR (fun)->doc));
284 else if (COMPILED_FUNCTIONP (fun))
287 struct Lisp_Compiled_Function *f = XCOMPILED_FUNCTION (fun);
288 if (! (f->flags.documentationp))
290 tem = compiled_function_documentation (f);
293 else if (NATNUMP (tem) || CONSP (tem))
294 doc = get_doc_string (tem);
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))
304 Lisp_Object funcar = Fcar (fun);
306 if (!SYMBOLP (funcar))
307 return Fsignal (Qinvalid_function, list1 (fun));
308 else if (EQ (funcar, Qlambda)
309 || EQ (funcar, Qautoload))
311 Lisp_Object tem, tem1;
312 tem1 = Fcdr (Fcdr (fun));
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);
324 else if (EQ (funcar, Qmacro))
325 return Fdocumentation (Fcdr (fun), raw);
332 return Fsignal (Qinvalid_function, list1 (fun));
339 Lisp_Object domain = Qnil;
340 if (COMPILED_FUNCTIONP (fun))
341 domain = compiled_function_domain (XCOMPILED_FUNCTION (fun));
343 doc = Fgettext (doc);
345 doc = Fdgettext (domain, doc);
349 doc = Fsubstitute_command_keys (doc);
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
364 /* This function can GC */
365 REGISTER Lisp_Object doc = Qnil;
367 REGISTER Lisp_Object domain;
373 doc = Fget (sym, prop, Qnil);
375 doc = get_doc_string (XINT (doc) > 0 ? doc : make_int (- XINT (doc)));
376 else if (CONSP (doc))
377 doc = get_doc_string (doc);
381 domain = Fget (sym, Qvariable_domain, Qnil);
383 doc = Fgettext (doc);
385 doc = Fdgettext (domain, doc);
388 if (NILP (raw) && STRINGP (doc))
389 doc = Fsubstitute_command_keys (doc);
395 weird_doc (Lisp_Object sym, CONST char *weirdness, CONST char *type, int pos)
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);
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.
413 /* !!#### This function has not been Mule-ized */
418 REGISTER char *p, *end;
419 Lisp_Object sym, fun, tem;
424 error ("Snarf-documentation can only be called in an undumped Emacs");
427 CHECK_STRING (filename);
430 if (!NILP(Vdoc_directory))
432 CHECK_STRING (Vdoc_directory);
433 name = (char *) alloca (XSTRING_LENGTH (filename)
434 + XSTRING_LENGTH (Vdoc_directory)
436 strcpy (name, (char *) XSTRING_DATA (Vdoc_directory));
439 #endif /* CANNOT_DUMP */
441 name = (char *) alloca (XSTRING_LENGTH (filename) + 14);
442 strcpy (name, "../lib-src/");
445 strcat (name, (char *) XSTRING_DATA (filename));
447 fd = open (name, O_RDONLY | OPEN_BINARY, 0);
449 report_file_error ("Opening doc string file",
450 Fcons (build_string (name), Qnil));
451 Vinternal_doc_file_name = filename;
457 filled += read (fd, &buf[filled], sizeof buf - 1 - filled);
463 end = buf + (filled < 512 ? filled : filled - 128);
464 while (p != end && *p != '\037') p++;
465 /* p points to ^_Ffunctionname\n or ^_Vvarname\n. */
468 end = strchr (p, '\n');
469 sym = oblookup (Vobarray, (Bufbyte *) p + 2, end - p - 2);
472 Lisp_Object offset = make_int (pos + end + 1 - buf);
473 /* Attach a docstring to a variable */
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);
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. */
490 Fput (sym, Qvariable_documentation,
492 ? make_int (- XINT (offset))
495 /* Attach a docstring to a function.
496 The type determines where the docstring is stored. */
497 else if (p[1] == 'F')
499 fun = indirect_function (sym,0);
501 if (CONSP (fun) && EQ (XCAR (fun), Qmacro))
506 /* May have been #if'ed out or something */
507 weird_doc (sym, GETTEXT ("not fboundp"),
508 GETTEXT ("function"), pos);
511 else if (SUBRP (fun))
513 /* Lisp_Subrs have a slot for it. */
514 if (XSUBR (fun)->doc)
516 weird_doc (sym, GETTEXT ("duplicate"),
517 GETTEXT ("subr"), pos);
520 XSUBR (fun)->doc = (char *) (- XINT (offset));
522 else if (CONSP (fun))
524 /* If it's a lisp form, stick it in the form. */
526 if (EQ (tem, Qlambda) || EQ (tem, Qautoload))
528 tem = Fcdr (Fcdr (fun));
532 Lisp_Object old = XCAR (tem);
535 weird_doc (sym, GETTEXT ("duplicate"),
538 : GETTEXT ("autoload")),
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
549 else if (!CONSP (tem))
551 weird_doc (sym, GETTEXT ("!CONSP(tem)"),
552 GETTEXT ("function"), pos);
557 /* DOC string is a string not integer 0 */
559 weird_doc (sym, GETTEXT ("!INTP(XCAR(tem))"),
560 GETTEXT ("function"), pos);
567 weird_doc (sym, GETTEXT ("not lambda or autoload"),
568 GETTEXT ("function"), pos);
572 else if (COMPILED_FUNCTIONP (fun))
574 /* Compiled-Function objects sometimes have
576 struct Lisp_Compiled_Function *f =
577 XCOMPILED_FUNCTION (fun);
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. */
586 if (! (f->flags.documentationp))
588 weird_doc (sym, GETTEXT ("no doc slot"),
589 GETTEXT ("bytecode"), pos);
595 compiled_function_documentation (f);
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. */
606 set_compiled_function_documentation (f, offset);
611 /* Otherwise the function is undefined or
612 otherwise weird. Ignore it. */
613 weird_doc (sym, GETTEXT ("weird function"),
614 GETTEXT ("function"), pos);
621 error ("DOC file invalid at position %d", pos);
630 memmove (buf, end, filled);
637 #if 1 /* Don't warn about functions whose doc was lost because they were
638 wrapped by advice-freeze.el... */
640 kludgily_ignore_lost_doc_p (Lisp_Object sym)
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
650 # define kludgily_ignore_lost_doc_p(sym) 0
655 verify_doc_mapper (Lisp_Object sym, void *arg)
657 Lisp_Object closure = *(Lisp_Object *)arg;
659 if (!NILP (Ffboundp (sym)))
662 Lisp_Object fun = XSYMBOL (sym)->function;
664 EQ (XCAR (fun), Qmacro))
668 doc = (EMACS_INT) XSUBR (fun)->doc;
669 else if (SYMBOLP (fun))
671 else if (KEYMAPP (fun))
673 else if (CONSP (fun))
675 Lisp_Object tem = XCAR (fun);
676 if (EQ (tem, Qlambda) || EQ (tem, Qautoload))
679 tem = Fcdr (Fcdr (fun));
682 doc = XINT (XCAR (tem));
685 else if (COMPILED_FUNCTIONP (fun))
687 struct Lisp_Compiled_Function *f = XCOMPILED_FUNCTION (fun);
688 if (! (f->flags.documentationp))
692 Lisp_Object tem = compiled_function_documentation (f);
698 if (doc == 0 && !kludgily_ignore_lost_doc_p (sym))
700 message ("Warning: doc lost for function %s.",
701 string_data (XSYMBOL (sym)->name));
705 if (!NILP (Fboundp (sym)))
707 Lisp_Object doc = Fget (sym, Qvariable_documentation, Qnil);
710 message ("Warning: doc lost for variable %s.",
711 string_data (XSYMBOL (sym)->name));
715 return 0; /* Never stop */
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.
724 Lisp_Object closure = Fcons (Qnil, Qnil);
727 map_obarray (Vobarray, verify_doc_mapper, &closure);
728 if (!NILP (Fcdr (closure)))
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");
733 return NILP (Fcdr (closure)) ? Qt : Qnil;
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.
751 /* This function can GC */
754 REGISTER Bufbyte *strdata;
755 REGISTER Bufbyte *bufp;
765 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
774 GCPRO4 (str, tem, keymap, name);
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);
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.. */
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. */
793 keymap = current_kboard->Voverriding_terminal_local_map;
795 keymap = Voverriding_local_map;
799 strlength = XSTRING_LENGTH (str);
800 bsize = 1 + strlength;
801 buf = (Bufbyte *) xmalloc (bsize);
804 /* Have to reset strdata every time GC might be called */
805 strdata = XSTRING_DATA (str);
806 for (idx = 0; idx < strlength; )
808 Bufbyte *strp = strdata + idx;
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. */
819 else switch (strp[1])
823 /* just copy unknown escape sequences */
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. */
843 idx += 2; /* skip \[ */
847 while ((idx < strlength)
853 length = strp - start;
856 tem = Fintern (make_string (start, length), Qnil);
857 tem = Fwhere_is_internal (tem, keymap, Qt, Qnil, Qnil);
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. */
865 firstkey = Faref (tem, Qzero);
866 if (EQ (firstkey, Qmenu_bar))
871 if (NILP (tem)) /* but not on any keys */
873 new = (Bufbyte *) xrealloc (buf, bsize += 4);
876 memcpy (bufp, "M-x ", 4);
881 { /* function is on a key */
882 tem = Fkey_description (tem);
889 /* ### jump to label `subst_string|subst' crosses
890 initialization of `buffer|_buf' */
894 buffer = Fget_buffer_create (QSsubstitute);
895 buf_ = XBUFFER (buffer);
897 Fbuffer_disable_undo (buffer);
898 Ferase_buffer (buffer);
900 /* \{foo} is replaced with a summary of keymap (symbol-value foo).
901 \<foo> just sets the keymap used for \[cmd]. */
903 idx += 2; /* skip \{ or \< */
907 while ((idx < strlength)
908 && *strp != '}' && *strp != '>')
913 length = strp - start;
914 idx++; /* skip } or > */
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);
923 tem = Fsymbol_value (name);
925 tem = get_keymap (tem, 0, 1);
930 char boof[255], *b = boof;
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)));
939 buffer_insert_c_string (buf_, boof);
941 if (start[-1] == '<') keymap = Qnil;
943 else if (start[-1] == '<')
946 describe_map_tree (tem, 1, Qnil, Qnil, 0, buffer);
948 tem = make_string_from_buffer (buf_, BUF_BEG (buf_),
949 BUF_Z (buf_) - BUF_BEG (buf_));
950 Ferase_buffer (buffer);
954 start = XSTRING_DATA (tem);
955 length = XSTRING_LENGTH (tem);
958 new = (Bufbyte *) xrealloc (buf, bsize);
961 memcpy (bufp, start, length);
964 /* Reset STRDATA in case gc relocated it. */
965 strdata = XSTRING_DATA (str);
972 if (changed) /* don't bother if nothing substituted */
973 tem = make_string (buf, bufp - buf);
982 /************************************************************************/
984 /************************************************************************/
989 DEFSUBR (Fdocumentation);
990 DEFSUBR (Fdocumentation_property);
991 DEFSUBR (Fsnarf_documentation);
992 DEFSUBR (Fverify_documentation);
993 DEFSUBR (Fsubstitute_command_keys);
999 DEFVAR_LISP ("internal-doc-file-name", &Vinternal_doc_file_name /*
1000 Name of file containing documentation strings of built-in symbols.
1002 Vinternal_doc_file_name = Qnil;
1004 QSsubstitute = build_string (" *substitute*");
1005 staticpro (&QSsubstitute);