X-Git-Url: https://git.hcoop.net/bpt/emacs.git/blobdiff_plain/d14365f9411ab4b20db6c455aa9cf24ce6a0bcb1..b06bf4dc3ceea6aa39aae5ed64c2b9345eb1920f:/src/doc.c
diff --git a/src/doc.c b/src/doc.c
index 770cb1eb64..e65159dd02 100644
--- a/src/doc.c
+++ b/src/doc.c
@@ -1,7 +1,6 @@
/* Record indices of function doc strings stored in a file.
-Copyright (C) 1985-1986, 1993-1995, 1997-2013 Free Software Foundation,
-Inc.
+Copyright (C) 1985-1986, 1993-1995, 1997-2014 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -21,6 +20,7 @@ along with GNU Emacs. If not, see . */
#include
+#include
#include
#include /* Must be after sys/types.h for USG. */
#include
@@ -33,7 +33,6 @@ along with GNU Emacs. If not, see . */
#include "buffer.h"
#include "keyboard.h"
#include "keymap.h"
-#include "buildobj.h"
Lisp_Object Qfunction_documentation;
@@ -58,7 +57,7 @@ read_bytecode_char (bool unreadflag)
}
/* Extract a doc string from a file. FILEPOS says where to get it.
- If it is an integer, use that position in the standard DOC-... file.
+ If it is an integer, use that position in the standard DOC file.
If it is (FILE . INTEGER), use FILE as the file name
and INTEGER as the position in that file.
But if INTEGER is negative, make it positive.
@@ -144,9 +143,14 @@ get_doc_string (Lisp_Object filepos, bool unibyte, bool definition)
}
#endif
if (fd < 0)
- return concat3 (build_string ("Cannot open doc string file \""),
- file, build_string ("\"\n"));
+ {
+ SAFE_FREE ();
+ return concat3 (build_string ("Cannot open doc string file \""),
+ file, build_string ("\"\n"));
+ }
}
+ dynwind_begin ();
+ record_unwind_protect_int (close_file_unwind, fd);
/* Seek only to beginning of disk block. */
/* Make sure we read at least 1024 bytes before `position'
@@ -154,13 +158,8 @@ get_doc_string (Lisp_Object filepos, bool unibyte, bool definition)
offset = min (position, max (1024, position % (8 * 1024)));
if (TYPE_MAXIMUM (off_t) < position
|| lseek (fd, position - offset, 0) < 0)
- {
- emacs_close (fd);
- error ("Position %"pI"d out of range in doc string file \"%s\"",
- position, name);
- }
-
- SAFE_FREE ();
+ error ("Position %"pI"d out of range in doc string file \"%s\"",
+ position, name);
/* Read the doc string into get_doc_string_buffer.
P points beyond the data just read. */
@@ -190,10 +189,7 @@ get_doc_string (Lisp_Object filepos, bool unibyte, bool definition)
space_left = 1024 * 8;
nread = emacs_read (fd, p, space_left);
if (nread < 0)
- {
- emacs_close (fd);
- error ("Read error on documentation file");
- }
+ report_file_error ("Read error on documentation file", file);
p[nread] = 0;
if (!nread)
break;
@@ -209,7 +205,8 @@ get_doc_string (Lisp_Object filepos, bool unibyte, bool definition)
}
p += nread;
}
- emacs_close (fd);
+ dynwind_end ();
+ SAFE_FREE ();
/* Sanity checking. */
if (CONSP (filepos))
@@ -353,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;
@@ -381,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.");
@@ -417,21 +413,6 @@ string is passed through `substitute-command-keys'. */)
xsignal1 (Qinvalid_function, fun);
}
- /* Check for a dynamic docstring. These come with
- a dynamic-docstring-function text property. */
- if (STRINGP (doc))
- {
- Lisp_Object func
- = Fget_text_property (make_number (0),
- intern ("dynamic-docstring-function"),
- doc);
- if (!NILP (func))
- /* Pass both `doc' and `function' since `function' can be needed, and
- finding `doc' can be annoying: calling `documentation' is not an
- option because it would infloop. */
- doc = call2 (func, doc, function);
- }
-
/* If DOC is 0, it's typically because of a dumped file missing
from the DOC file (bug in src/Makefile.in). */
if (EQ (doc, make_number (0)))
@@ -515,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. */
@@ -541,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);
}
@@ -552,10 +534,12 @@ store_function_docstring (Lisp_Object obj, ptrdiff_t offset)
docstring, since we've found a docstring for it. */
if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) > COMPILED_DOC_STRING)
ASET (fun, COMPILED_DOC_STRING, make_number (offset));
+ else
+ message ("No docstring slot for %s",
+ SYMBOLP (obj) ? SSDATA (SYMBOL_NAME (obj)) : "");
}
}
-static const char buildobj[] = BUILDOBJ;
DEFUN ("Snarf-documentation", Fsnarf_documentation, Ssnarf_documentation,
1, 1, 0,
@@ -575,6 +559,13 @@ the same file name is found in the `doc-directory'. */)
Lisp_Object sym;
char *p, *name;
bool skip_file = 0;
+ ptrdiff_t count;
+ /* Preloaded defcustoms using custom-initialize-delay are added to
+ this list, but kept unbound. See http://debbugs.gnu.org/11565 */
+ Lisp_Object delayed_init =
+ find_symbol_value (intern ("custom-delayed-init-variables"));
+
+ if (EQ (delayed_init, Qunbound)) delayed_init = Qnil;
CHECK_STRING (filename);
@@ -598,32 +589,26 @@ the same file name is found in the `doc-directory'. */)
/* Vbuild_files is nil when temacs is run, and non-nil after that. */
if (NILP (Vbuild_files))
- {
- const char *beg, *end;
-
- for (beg = buildobj; *beg; beg = end)
- {
- ptrdiff_t len;
-
- while (*beg && c_isspace (*beg)) ++beg;
-
- for (end = beg; *end && ! c_isspace (*end); ++end)
- if (*end == '/') beg = end+1; /* skip directory part */
-
- len = end - beg;
- if (len > 4 && end[-4] == '.' && end[-3] == 'o')
- len -= 2; /* Just take .o if it ends in .obj */
-
- if (len > 0)
- Vbuild_files = Fcons (make_string (beg, len), Vbuild_files);
- }
- Vbuild_files = Fpurecopy (Vbuild_files);
- }
+ {
+ static char const *const buildobj[] =
+ {
+ #include "buildobj.h"
+ };
+ int i = ARRAYELTS (buildobj);
+ while (0 <= --i)
+ Vbuild_files = Fcons (build_string (buildobj[i]), Vbuild_files);
+ Vbuild_files = Fpurecopy (Vbuild_files);
+ }
fd = emacs_open (name, O_RDONLY, 0);
if (fd < 0)
- report_file_error ("Opening doc string file",
- Fcons (build_string (name), Qnil));
+ {
+ int open_errno = errno;
+ report_file_errno ("Opening doc string file", build_string (name),
+ open_errno);
+ }
+ dynwind_begin ();
+ record_unwind_protect_int (close_file_unwind, fd);
Vdoc_file_name = filename;
filled = 0;
pos = 0;
@@ -662,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')
@@ -678,7 +665,8 @@ the same file name is found in the `doc-directory'. */)
/* Install file-position as variable-documentation property
and make it negative for a user-variable
(doc starts with a `*'). */
- if (!NILP (Fboundp (sym)))
+ if (!NILP (Fboundp (sym))
+ || !NILP (Fmemq (sym, delayed_init)))
Fput (sym, Qvariable_documentation,
make_number ((pos + end + 1 - buf)
* (end[1] == '*' ? -1 : 1)));
@@ -701,7 +689,7 @@ the same file name is found in the `doc-directory'. */)
filled -= end - buf;
memmove (buf, end, filled);
}
- emacs_close (fd);
+ dynwind_end ();
return Qnil;
}
@@ -724,7 +712,7 @@ as the keymap for future \\=\\[COMMAND] substrings.
thus, \\=\\=\\=\\= puts \\=\\= into the output, and \\=\\=\\=\\[ puts \\=\\[ into the output.
Return the original STRING if no substitutions are made.
-Otherwise, return a new string, without any text properties. */)
+Otherwise, return a new string. */)
(Lisp_Object string)
{
char *buf;
@@ -758,12 +746,10 @@ Otherwise, return a new string, without any text properties. */)
or a specified local map (which means search just that and the
global map). If non-nil, it might come from Voverriding_local_map,
or from a \\ construct in STRING itself.. */
- keymap = KVAR (current_kboard, Voverriding_terminal_local_map);
- if (NILP (keymap))
- keymap = Voverriding_local_map;
+ 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))
@@ -860,6 +846,7 @@ Otherwise, return a new string, without any text properties. */)
/* This is for computing the SHADOWS arg for describe_map_tree. */
Lisp_Object active_maps = Fcurrent_active_maps (Qnil, Qnil);
Lisp_Object earlier_maps;
+ dynwind_begin ();
changed = 1;
strp += 2; /* skip \{ or \< */
@@ -896,6 +883,10 @@ Otherwise, return a new string, without any text properties. */)
/* Now switch to a temp buffer. */
oldbuf = current_buffer;
set_buffer_internal (XBUFFER (Vprin1_to_string_buffer));
+ /* This is for an unusual case where some after-change
+ function uses 'format' or 'prin1' or something else that
+ will thrash Vprin1_to_string_buffer we are using. */
+ specbind (Qinhibit_modification_hooks, Qt);
if (NILP (tem))
{
@@ -915,11 +906,12 @@ Otherwise, return a new string, without any text properties. */)
If this one's not active, get nil. */
earlier_maps = Fcdr (Fmemq (tem, Freverse (active_maps)));
describe_map_tree (tem, 1, Fnreverse (earlier_maps),
- Qnil, (char *)0, 1, 0, 0, 1);
+ Qnil, 0, 1, 0, 0, 1);
}
tem = Fbuffer_string ();
Ferase_buffer ();
set_buffer_internal (oldbuf);
+ dynwind_end ();
subst_string:
start = SDATA (tem);
@@ -961,12 +953,14 @@ Otherwise, return a new string, without any text properties. */)
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,
@@ -976,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);
}