static int get_doc_string_buffer_size;
static unsigned char *read_bytecode_pointer;
+Lisp_Object Fsnarf_documentation P_ ((Lisp_Object));
/* readchar in lread.c calls back here to fetch the next byte.
If UNREADFLAG is 1, we unread a byte. */
(A negative integer is used for user variables, so we can distinguish
them without actually fetching the doc string.)
+ If the location does not point to the beginning of a docstring
+ (e.g. because the file has been modified and the location is stale),
+ return nil.
+
If UNIBYTE is nonzero, always make a unibyte string.
If DEFINITION is nonzero, assume this is for reading
{
file = XCAR (filepos);
position = XINT (XCDR (filepos));
- if (position < 0)
- position = - position;
}
else
return Qnil;
+ if (position < 0)
+ position = - position;
+
if (!STRINGP (Vdoc_directory))
return Qnil;
if (!STRINGP (file))
return Qnil;
-
+
/* Put the file name in NAME as a C string.
If it is relative, combine it with Vdoc_directory. */
tem = Ffile_name_absolute_p (file);
if (NILP (tem))
{
- minsize = XSTRING (Vdoc_directory)->size;
+ minsize = SCHARS (Vdoc_directory);
/* sizeof ("../etc/") == 8 */
if (minsize < 8)
minsize = 8;
- name = (char *) alloca (minsize + XSTRING (file)->size + 8);
- strcpy (name, XSTRING (Vdoc_directory)->data);
- strcat (name, XSTRING (file)->data);
+ name = (char *) alloca (minsize + SCHARS (file) + 8);
+ strcpy (name, SDATA (Vdoc_directory));
+ strcat (name, SDATA (file));
munge_doc_file_name (name);
}
else
{
- name = (char *) XSTRING (file)->data;
+ name = (char *) SDATA (file);
}
fd = emacs_open (name, O_RDONLY, 0);
/* Preparing to dump; DOC file is probably not installed.
So check in ../etc. */
strcpy (name, "../etc/");
- strcat (name, XSTRING (file)->data);
+ strcat (name, SDATA (file));
munge_doc_file_name (name);
fd = emacs_open (name, O_RDONLY, 0);
}
/* Seek only to beginning of disk block. */
- offset = position % (8 * 1024);
+ /* Make sure we read at least 1024 bytes before `position'
+ so we can check the leading text for consistency. */
+ offset = min (position, max (1024, position % (8 * 1024)));
if (0 > lseek (fd, position - offset, 0))
{
emacs_close (fd);
}
emacs_close (fd);
+ /* Sanity checking. */
+ if (CONSP (filepos))
+ {
+ int test = 1;
+ if (get_doc_string_buffer[offset - test++] != ' ')
+ return Qnil;
+ while (get_doc_string_buffer[offset - test] >= '0'
+ && get_doc_string_buffer[offset - test] <= '9')
+ test++;
+ if (get_doc_string_buffer[offset - test++] != '@'
+ || get_doc_string_buffer[offset - test] != '#')
+ return Qnil;
+ }
+ else
+ {
+ int test = 1;
+ if (get_doc_string_buffer[offset - test++] != '\n')
+ return Qnil;
+ while (get_doc_string_buffer[offset - test] > ' ')
+ test++;
+ if (get_doc_string_buffer[offset - test] != '\037')
+ return Qnil;
+ }
+
/* Scan the text and perform quoting with ^A (char code 1).
^A^A becomes ^A, ^A0 becomes a null char, and ^A_ becomes a ^_. */
from = get_doc_string_buffer + offset;
return get_doc_string (filepos, 0, 1);
}
+static int
+reread_doc_file (file)
+ Lisp_Object file;
+{
+#if 0
+ Lisp_Object reply, prompt[3];
+ struct gcpro gcpro1;
+ GCPRO1 (file);
+ prompt[0] = build_string ("File ");
+ prompt[1] = NILP (file) ? Vdoc_file_name : file;
+ prompt[2] = build_string (" is out of sync. Reload? ");
+ reply = Fy_or_n_p (Fconcat (3, prompt));
+ UNGCPRO;
+ if (NILP (reply))
+ return 0;
+#endif
+
+ if (NILP (file))
+ Fsnarf_documentation (Vdoc_file_name);
+ else
+ Fload (file, Qt, Qt, Qt, Qnil);
+
+ return 1;
+}
+
DEFUN ("documentation", Fdocumentation, Sdocumentation, 1, 2, 0,
doc: /* Return the documentation string of FUNCTION.
Unless a non-nil second argument RAW is given, the
Lisp_Object fun;
Lisp_Object funcar;
Lisp_Object tem, doc;
+ int try_reload = 1;
+
+ documentation:
doc = Qnil;
-
+
if (SYMBOLP (function)
&& (tem = Fget (function, Qfunction_documentation),
!NILP (tem)))
return Fdocumentation_property (function, Qfunction_documentation, raw);
-
+
fun = Findirect_function (function);
if (SUBRP (fun))
{
else if ((EMACS_INT) XSUBR (fun)->doc >= 0)
doc = build_string (XSUBR (fun)->doc);
else
- doc = get_doc_string (make_number (- (EMACS_INT) XSUBR (fun)->doc),
- 0, 0);
+ doc = make_number ((EMACS_INT) XSUBR (fun)->doc);
}
else if (COMPILEDP (fun))
{
- if ((XVECTOR (fun)->size & PSEUDOVECTOR_SIZE_MASK) <= COMPILED_DOC_STRING)
+ if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) <= COMPILED_DOC_STRING)
return Qnil;
- tem = XVECTOR (fun)->contents[COMPILED_DOC_STRING];
+ tem = AREF (fun, COMPILED_DOC_STRING);
if (STRINGP (tem))
doc = tem;
else if (NATNUMP (tem) || CONSP (tem))
- doc = get_doc_string (tem, 0, 0);
+ doc = tem;
else
return Qnil;
}
doc = tem;
/* Handle a doc reference--but these never come last
in the function body, so reject them if they are last. */
- else if ((NATNUMP (tem) || CONSP (tem))
- && ! NILP (XCDR (tem1)))
- doc = get_doc_string (tem, 0, 0);
+ else if ((NATNUMP (tem) || (CONSP (tem) && INTEGERP (XCDR (tem))))
+ && !NILP (XCDR (tem1)))
+ doc = tem;
else
return Qnil;
}
- else if (EQ (funcar, Qmocklisp))
- return Qnil;
else if (EQ (funcar, Qmacro))
return Fdocumentation (Fcdr (fun), raw);
else
Fsignal (Qinvalid_function, Fcons (fun, Qnil));
}
+ /* 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)))
+ doc = Qnil;
+ if (INTEGERP (doc) || CONSP (doc))
+ {
+ Lisp_Object tem;
+ tem = get_doc_string (doc, 0, 0);
+ if (NILP (tem) && try_reload)
+ {
+ /* The file is newer, we need to reset the pointers. */
+ struct gcpro gcpro1, gcpro2;
+ GCPRO2 (function, raw);
+ try_reload = reread_doc_file (Fcar_safe (doc));
+ UNGCPRO;
+ if (try_reload)
+ {
+ try_reload = 0;
+ goto documentation;
+ }
+ }
+ else
+ doc = tem;
+ }
+
if (NILP (raw))
doc = Fsubstitute_command_keys (doc);
return doc;
(symbol, prop, raw)
Lisp_Object symbol, prop, raw;
{
+ int try_reload = 1;
Lisp_Object tem;
+ documentation_property:
+
tem = Fget (symbol, prop);
- if (INTEGERP (tem))
- tem = get_doc_string (XINT (tem) > 0 ? tem : make_number (- XINT (tem)), 0, 0);
- else if (CONSP (tem) && INTEGERP (XCDR (tem)))
- tem = get_doc_string (tem, 0, 0);
+ if (EQ (tem, make_number (0)))
+ tem = Qnil;
+ if (INTEGERP (tem) || (CONSP (tem) && INTEGERP (XCDR (tem))))
+ {
+ Lisp_Object doc = tem;
+ tem = get_doc_string (tem, 0, 0);
+ if (NILP (tem) && try_reload)
+ {
+ /* The file is newer, we need to reset the pointers. */
+ struct gcpro gcpro1, gcpro2, gcpro3;
+ GCPRO3 (symbol, prop, raw);
+ try_reload = reread_doc_file (Fcar_safe (doc));
+ UNGCPRO;
+ if (try_reload)
+ {
+ try_reload = 0;
+ goto documentation_property;
+ }
+ }
+ }
else if (!STRINGP (tem))
/* Feval protects its argument. */
tem = Feval (tem);
-
+
if (NILP (raw) && STRINGP (tem))
tem = Fsubstitute_command_keys (tem);
return tem;
{
/* This bytecode object must have a slot for the
docstring, since we've found a docstring for it. */
- if ((XVECTOR (fun)->size & PSEUDOVECTOR_SIZE_MASK) > COMPILED_DOC_STRING)
- XSETFASTINT (XVECTOR (fun)->contents[COMPILED_DOC_STRING], offset);
+ if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) > COMPILED_DOC_STRING)
+ XSETFASTINT (AREF (fun, COMPILED_DOC_STRING), offset);
}
}
DEFUN ("Snarf-documentation", Fsnarf_documentation, Ssnarf_documentation,
1, 1, 0,
- doc: /* Used during Emacs initialization, before dumping runnable Emacs,
-to find pointers to doc strings stored in `etc/DOC...' and
-record them in function definitions.
-One arg, FILENAME, a string which does not include a directory.
-The file is found in `../etc' now; found in the `data-directory'
-when doc strings are referred to later in the dumped Emacs. */)
+ doc: /* Used during Emacs initialization to scan the `etc/DOC...' file.
+This searches the `etc/DOC...' file for doc strings and
+records them in function and variable definitions.
+The function takes one argument, FILENAME, a string;
+it specifies the file name (without a directory) of the DOC file.
+That file is found in `../etc' now; later, when the dumped Emacs is run,
+the same file name is found in the `data-directory'. */)
(filename)
Lisp_Object filename;
{
Lisp_Object sym;
char *name;
-#ifndef CANNOT_DUMP
- if (NILP (Vpurify_flag))
- error ("Snarf-documentation can only be called in an undumped Emacs");
-#endif
-
CHECK_STRING (filename);
+ if
#ifndef CANNOT_DUMP
- name = (char *) alloca (XSTRING (filename)->size + 14);
- strcpy (name, "../etc/");
+ (!NILP (Vpurify_flag))
#else /* CANNOT_DUMP */
- CHECK_STRING (Vdoc_directory);
- name = (char *) alloca (XSTRING (filename)->size
- + XSTRING (Vdoc_directory)->size + 1);
- strcpy (name, XSTRING (Vdoc_directory)->data);
+ (0)
#endif /* CANNOT_DUMP */
- strcat (name, XSTRING (filename)->data); /*** Add this line ***/
+ {
+ name = (char *) alloca (SCHARS (filename) + 14);
+ strcpy (name, "../etc/");
+ }
+ else
+ {
+ CHECK_STRING (Vdoc_directory);
+ name = (char *) alloca (SCHARS (filename)
+ + SCHARS (Vdoc_directory) + 1);
+ strcpy (name, SDATA (Vdoc_directory));
+ }
+ strcat (name, SDATA (filename)); /*** Add this line ***/
#ifdef VMS
#ifndef VMS4_4
/* For VMS versions with limited file name syntax,
if (NILP (keymap))
keymap = Voverriding_local_map;
- bsize = STRING_BYTES (XSTRING (string));
+ bsize = SBYTES (string);
bufp = buf = (unsigned char *) xmalloc (bsize);
- strp = (unsigned char *) XSTRING (string)->data;
- while (strp < XSTRING (string)->data + STRING_BYTES (XSTRING (string)))
+ strp = (unsigned char *) SDATA (string);
+ while (strp < SDATA (string) + SBYTES (string))
{
if (strp[0] == '\\' && strp[1] == '=')
{
if (multibyte)
{
int len;
- int maxlen = XSTRING (string)->data + STRING_BYTES (XSTRING (string)) - strp;
+ int maxlen = SDATA (string) + SBYTES (string) - strp;
STRING_CHAR_AND_LENGTH (strp, maxlen, len);
if (len == 1)
changed = 1;
strp += 2; /* skip \[ */
start = strp;
- start_idx = start - XSTRING (string)->data;
+ start_idx = start - SDATA (string);
- while ((strp - (unsigned char *) XSTRING (string)->data
- < STRING_BYTES (XSTRING (string)))
+ while ((strp - (unsigned char *) SDATA (string)
+ < SBYTES (string))
&& *strp != ']')
strp++;
length_byte = strp - start;
strp++; /* skip ] */
/* Save STRP in IDX. */
- idx = strp - (unsigned char *) XSTRING (string)->data;
+ idx = strp - (unsigned char *) SDATA (string);
tem = Fintern (make_string (start, length_byte), Qnil);
/* Note the Fwhere_is_internal can GC, so we have to take
relocation of string contents into account. */
- tem = Fwhere_is_internal (tem, keymap, Qt, Qnil);
- strp = XSTRING (string)->data + idx;
- start = XSTRING (string)->data + start_idx;
+ tem = Fwhere_is_internal (tem, keymap, Qt, Qnil, Qnil);
+ strp = SDATA (string) + idx;
+ start = SDATA (string) + start_idx;
/* Disregard menu bar bindings; it is positively annoying to
mention them when there's no menu bar, and it isn't terribly
changed = 1;
strp += 2; /* skip \{ or \< */
start = strp;
- start_idx = start - XSTRING (string)->data;
+ start_idx = start - SDATA (string);
- while ((strp - (unsigned char *) XSTRING (string)->data
- < XSTRING (string)->size)
+ while ((strp - (unsigned char *) SDATA (string)
+ < SCHARS (string))
&& *strp != '}' && *strp != '>')
strp++;
strp++; /* skip } or > */
/* Save STRP in IDX. */
- idx = strp - (unsigned char *) XSTRING (string)->data;
+ idx = strp - (unsigned char *) SDATA (string);
/* Get the value of the keymap in TEM, or nil if undefined.
Do this while still in the user's current buffer
{
tem = get_keymap (tem, 0, 1);
/* Note that get_keymap can GC. */
- strp = XSTRING (string)->data + idx;
- start = XSTRING (string)->data + start_idx;
+ strp = SDATA (string) + idx;
+ start = SDATA (string) + start_idx;
}
}
name = Fsymbol_name (name);
insert_string ("\nUses keymap \"");
insert_from_string (name, 0, 0,
- XSTRING (name)->size,
- STRING_BYTES (XSTRING (name)), 1);
+ SCHARS (name),
+ SBYTES (name), 1);
insert_string ("\", which is not currently defined.\n");
if (start[-1] == '<') keymap = Qnil;
}
set_buffer_internal (oldbuf);
subst_string:
- start = XSTRING (tem)->data;
- length = XSTRING (tem)->size;
- length_byte = STRING_BYTES (XSTRING (tem));
+ start = SDATA (tem);
+ length = SCHARS (tem);
+ length_byte = SBYTES (tem);
subst:
{
int offset = bufp - buf;
bufp += length_byte;
nchars += length;
/* Check STRING again in case gc relocated it. */
- strp = (unsigned char *) XSTRING (string)->data + idx;
+ strp = (unsigned char *) SDATA (string) + idx;
}
}
else if (! multibyte) /* just copy other chars */
else
{
int len;
- int maxlen = XSTRING (string)->data + STRING_BYTES (XSTRING (string)) - strp;
+ int maxlen = SDATA (string) + SBYTES (string) - strp;
STRING_CHAR_AND_LENGTH (strp, maxlen, len);
if (len == 1)
{
Qfunction_documentation = intern ("function-documentation");
staticpro (&Qfunction_documentation);
-
+
DEFVAR_LISP ("internal-doc-file-name", &Vdoc_file_name,
doc: /* Name of file containing documentation strings of built-in symbols. */);
Vdoc_file_name = Qnil;