/* Record indices of function doc strings stored in a file.
- Copyright (C) 1985-1986, 1993-1995, 1997-2011
+ Copyright (C) 1985-1986, 1993-1995, 1997-2012
Free Software Foundation, Inc.
This file is part of GNU Emacs.
extern Lisp_Object Qclosure;
/* Buffer used for reading from documentation file. */
static char *get_doc_string_buffer;
-static int get_doc_string_buffer_size;
+static ptrdiff_t get_doc_string_buffer_size;
static unsigned char *read_bytecode_pointer;
-Lisp_Object Fsnarf_documentation (Lisp_Object);
+static Lisp_Object Fdocumentation_property (Lisp_Object, Lisp_Object,
+ Lisp_Object);
+static Lisp_Object Fsnarf_documentation (Lisp_Object);
/* readchar in lread.c calls back here to fetch the next byte.
If UNREADFLAG is 1, we unread a byte. */
If it is relative, combine it with Vdoc_directory. */
tem = Ffile_name_absolute_p (file);
+ file = ENCODE_FILE (file);
if (NILP (tem))
{
- minsize = SCHARS (Vdoc_directory);
+ Lisp_Object docdir = ENCODE_FILE (Vdoc_directory);
+ minsize = SCHARS (docdir);
/* sizeof ("../etc/") == 8 */
if (minsize < 8)
minsize = 8;
name = (char *) alloca (minsize + SCHARS (file) + 8);
- strcpy (name, SSDATA (Vdoc_directory));
+ strcpy (name, SSDATA (docdir));
strcat (name, SSDATA (file));
}
else
if (!NILP (Vpurify_flag))
{
/* Preparing to dump; DOC file is probably not installed.
- So check in ../etc. */
+ So check in ../etc. */
strcpy (name, "../etc/");
strcat (name, SSDATA (file));
if (0 > lseek (fd, position - offset, 0))
{
emacs_close (fd);
- error ("Position %"pEd" out of range in doc string file \"%s\"",
+ error ("Position %"pI"d out of range in doc string file \"%s\"",
position, name);
}
p = get_doc_string_buffer;
while (1)
{
- EMACS_INT space_left = (get_doc_string_buffer_size
+ ptrdiff_t space_left = (get_doc_string_buffer_size - 1
- (p - get_doc_string_buffer));
int nread;
/* Allocate or grow the buffer if we need to. */
- if (space_left == 0)
+ if (space_left <= 0)
{
- EMACS_INT in_buffer = p - get_doc_string_buffer;
- get_doc_string_buffer_size += 16 * 1024;
- get_doc_string_buffer
- = (char *) xrealloc (get_doc_string_buffer,
- get_doc_string_buffer_size + 1);
+ ptrdiff_t in_buffer = p - get_doc_string_buffer;
+ get_doc_string_buffer =
+ xpalloc (get_doc_string_buffer, &get_doc_string_buffer_size,
+ 16 * 1024, -1, 1);
p = get_doc_string_buffer + in_buffer;
- space_left = (get_doc_string_buffer_size
+ space_left = (get_doc_string_buffer_size - 1
- (p - get_doc_string_buffer));
}
else if (c == '_')
*to++ = 037;
else
- error ("Invalid data in documentation file -- ^A followed by code 0%o", c);
+ {
+ unsigned char uc = c;
+ error ("\
+Invalid data in documentation file -- %c followed by code %03o",
+ 1, uc);
+ }
}
else
*to++ = *from++;
{
if (XSUBR (fun)->doc == 0)
return Qnil;
- else if ((EMACS_INT) XSUBR (fun)->doc >= 0)
+ /* 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 ((EMACS_INT) XSUBR (fun)->doc);
+ doc = make_number ((intptr_t) XSUBR (fun)->doc);
}
else if (COMPILEDP (fun))
{
/* Scanning the DOC files and placing docstring offsets into functions. */
static void
-store_function_docstring (Lisp_Object fun, EMACS_INT offset)
+store_function_docstring (Lisp_Object obj, EMACS_INT offset)
/* Use EMACS_INT because we get offset from pointer subtraction. */
{
- fun = indirect_function (fun);
+ /* 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;
/* The type determines where the docstring is stored. */
/* Lisp_Subrs have a slot for it. */
if (SUBRP (fun))
- XSUBR (fun)->doc = (char *) - offset;
+ {
+ intptr_t negative_offset = - offset;
+ XSUBR (fun)->doc = (char *) negative_offset;
+ }
/* If it's a lisp form, stick it in the form. */
else if (CONSP (fun))
; /* Just a source file name boundary marker. Ignore it. */
else
- error ("DOC file invalid at position %"pEd, pos);
+ error ("DOC file invalid at position %"pI"d", pos);
}
}
pos += end - buf;
int changed = 0;
register unsigned char *strp;
register char *bufp;
- EMACS_INT idx;
- EMACS_INT bsize;
+ ptrdiff_t idx;
+ ptrdiff_t bsize;
Lisp_Object tem;
Lisp_Object keymap;
unsigned char *start;
- EMACS_INT length, length_byte;
+ ptrdiff_t length, length_byte;
Lisp_Object name;
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
int multibyte;
- EMACS_INT nchars;
+ ptrdiff_t nchars;
if (NILP (string))
return Qnil;
}
else if (strp[0] == '\\' && strp[1] == '[')
{
- EMACS_INT start_idx;
+ ptrdiff_t start_idx;
int follow_remap = 1;
changed = 1;
do_remap:
tem = Fwhere_is_internal (name, keymap, Qt, Qnil, Qnil);
- if (VECTORP (tem) && XVECTOR (tem)->size > 1
+ if (VECTORP (tem) && ASIZE (tem) > 1
&& EQ (AREF (tem, 0), Qremap) && SYMBOLP (AREF (tem, 1))
&& follow_remap)
{
if (NILP (tem)) /* but not on any keys */
{
- EMACS_INT offset = bufp - buf;
+ ptrdiff_t offset = bufp - buf;
+ if (STRING_BYTES_BOUND - 4 < bsize)
+ string_overflow ();
buf = (char *) xrealloc (buf, bsize += 4);
bufp = buf + offset;
memcpy (bufp, "M-x ", 4);
else if (strp[0] == '\\' && (strp[1] == '{' || strp[1] == '<'))
{
struct buffer *oldbuf;
- EMACS_INT start_idx;
+ ptrdiff_t start_idx;
/* This is for computing the SHADOWS arg for describe_map_tree. */
Lisp_Object active_maps = Fcurrent_active_maps (Qnil, Qnil);
Lisp_Object earlier_maps;
length_byte = SBYTES (tem);
subst:
{
- EMACS_INT offset = bufp - buf;
+ ptrdiff_t offset = bufp - buf;
+ if (STRING_BYTES_BOUND - length_byte < bsize)
+ string_overflow ();
buf = (char *) xrealloc (buf, bsize += length_byte);
bufp = buf + offset;
memcpy (bufp, start, length_byte);
void
syms_of_doc (void)
{
- Qfunction_documentation = intern_c_string ("function-documentation");
- staticpro (&Qfunction_documentation);
+ DEFSYM (Qfunction_documentation, "function-documentation");
DEFVAR_LISP ("internal-doc-file-name", Vdoc_file_name,
doc: /* Name of file containing documentation strings of built-in symbols. */);