X-Git-Url: https://git.hcoop.net/bpt/emacs.git/blobdiff_plain/f4da4720dfdefbdace402201c6a5fc8017bb98aa..b06bf4dc3ceea6aa39aae5ed64c2b9345eb1920f:/src/doc.c diff --git a/src/doc.c b/src/doc.c index df8cfba3f2..e65159dd02 100644 --- a/src/doc.c +++ b/src/doc.c @@ -84,7 +84,6 @@ get_doc_string (Lisp_Object filepos, bool unibyte, bool definition) int offset; EMACS_INT position; Lisp_Object file, tem, pos; - ptrdiff_t count; USE_SAFE_ALLOCA; if (INTEGERP (filepos)) @@ -150,7 +149,7 @@ get_doc_string (Lisp_Object filepos, bool unibyte, bool definition) file, build_string ("\"\n")); } } - count = SPECPDL_INDEX (); + dynwind_begin (); record_unwind_protect_int (close_file_unwind, fd); /* Seek only to beginning of disk block. */ @@ -206,7 +205,7 @@ get_doc_string (Lisp_Object filepos, bool unibyte, bool definition) } p += nread; } - unbind_to (count, Qnil); + dynwind_end (); SAFE_FREE (); /* Sanity checking. */ @@ -351,20 +350,11 @@ string is passed through `substitute-command-keys'. */) } fun = Findirect_function (function, Qnil); - if (CONSP (fun) && EQ (XCAR (fun), Qmacro)) + if (CONSP (fun) + && (EQ (XCAR (fun), Qmacro) + || EQ (XCAR (fun), Qspecial_operator))) fun = XCDR (fun); - if (SUBRP (fun)) - { - if (XSUBR (fun)->doc == 0) - return Qnil; - /* FIXME: This is not portable, as it assumes that string - pointers have the top bit clear. */ - else if ((intptr_t) XSUBR (fun)->doc >= 0) - doc = build_string (XSUBR (fun)->doc); - else - doc = make_number ((intptr_t) XSUBR (fun)->doc); - } - else if (COMPILEDP (fun)) + if (COMPILEDP (fun)) { if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) <= COMPILED_DOC_STRING) return Qnil; @@ -379,6 +369,14 @@ string is passed through `substitute-command-keys'. */) return Qnil; } } + else if (scm_is_true (scm_procedure_p (fun))) + { + Lisp_Object tem = scm_procedure_property (fun, intern ("emacs-documentation")); + if (scm_is_true (tem)) + doc = tem; + else + return Qnil; + } else if (STRINGP (fun) || VECTORP (fun)) { return build_string ("Keyboard macro."); @@ -498,15 +496,16 @@ store_function_docstring (Lisp_Object obj, ptrdiff_t offset) { /* Don't use indirect_function here, or defaliases will apply their docstrings to the base functions (Bug#2603). */ - Lisp_Object fun = SYMBOLP (obj) ? XSYMBOL (obj)->function : obj; + Lisp_Object fun = SYMBOLP (obj) ? SYMBOL_FUNCTION (obj) : obj; /* The type determines where the docstring is stored. */ - /* Lisp_Subrs have a slot for it. */ - if (SUBRP (fun)) + + if (scm_is_true (scm_procedure_p (fun))) { - intptr_t negative_offset = - offset; - XSUBR (fun)->doc = (char *) negative_offset; + scm_set_procedure_property_x (fun, + intern ("emacs-documentation"), + make_number (offset)); } /* If it's a lisp form, stick it in the form. */ @@ -524,7 +523,7 @@ store_function_docstring (Lisp_Object obj, ptrdiff_t offset) correctness is quite delicate. */ XSETCAR (tem, make_number (offset)); } - else if (EQ (tem, Qmacro)) + else if (EQ (tem, Qmacro) || EQ (tem, Qspecial_operator)) store_function_docstring (XCDR (fun), offset); } @@ -608,7 +607,7 @@ the same file name is found in the `doc-directory'. */) report_file_errno ("Opening doc string file", build_string (name), open_errno); } - count = SPECPDL_INDEX (); + dynwind_begin (); record_unwind_protect_int (close_file_unwind, fd); Vdoc_file_name = filename; filled = 0; @@ -648,15 +647,17 @@ the same file name is found in the `doc-directory'. */) } } - sym = oblookup (Vobarray, p + 2, - multibyte_chars_in_text ((unsigned char *) p + 2, - end - p - 2), - end - p - 2); + Lisp_Object tem = Ffind_symbol (make_specified_string (p + 2, + -1, + end - p - 2, + true), + Qnil); + sym = scm_c_value_ref (tem, 0); /* Check skip_file so that when a function is defined several times in different files (typically, once in xterm, once in w32term, ...), we only pay attention to the one that matters. */ - if (! skip_file && SYMBOLP (sym)) + if (! skip_file && ! NILP (scm_c_value_ref (tem, 1))) { /* Attach a docstring to a variable? */ if (p[1] == 'V') @@ -688,7 +689,8 @@ the same file name is found in the `doc-directory'. */) filled -= end - buf; memmove (buf, end, filled); } - return unbind_to (count, Qnil); + dynwind_end (); + return Qnil; } DEFUN ("substitute-command-keys", Fsubstitute_command_keys, @@ -747,7 +749,7 @@ Otherwise, return a new string. */) keymap = Voverriding_local_map; bsize = SBYTES (string); - bufp = buf = xmalloc (bsize); + bufp = buf = xmalloc_atomic (bsize); strp = SDATA (string); while (strp < SDATA (string) + SBYTES (string)) @@ -844,7 +846,7 @@ Otherwise, return a new string. */) /* This is for computing the SHADOWS arg for describe_map_tree. */ Lisp_Object active_maps = Fcurrent_active_maps (Qnil, Qnil); Lisp_Object earlier_maps; - ptrdiff_t count = SPECPDL_INDEX (); + dynwind_begin (); changed = 1; strp += 2; /* skip \{ or \< */ @@ -909,7 +911,7 @@ Otherwise, return a new string. */) tem = Fbuffer_string (); Ferase_buffer (); set_buffer_internal (oldbuf); - unbind_to (count, Qnil); + dynwind_end (); subst_string: start = SDATA (tem); @@ -951,12 +953,14 @@ Otherwise, return a new string. */) else tem = string; xfree (buf); - RETURN_UNGCPRO (tem); + return tem; } void syms_of_doc (void) { +#include "doc.x" + DEFSYM (Qfunction_documentation, "function-documentation"); DEFVAR_LISP ("internal-doc-file-name", Vdoc_file_name, @@ -966,9 +970,4 @@ syms_of_doc (void) DEFVAR_LISP ("build-files", Vbuild_files, doc: /* A list of files used to build this Emacs binary. */); Vbuild_files = Qnil; - - defsubr (&Sdocumentation); - defsubr (&Sdocumentation_property); - defsubr (&Ssnarf_documentation); - defsubr (&Ssubstitute_command_keys); }