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;
}
/* 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;
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);
{
/* 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 */
+ {
+ name = (char *) alloca (XSTRING (filename)->size + 14);
+ strcpy (name, "../etc/");
+ }
+ else
+ {
+ CHECK_STRING (Vdoc_directory);
+ name = (char *) alloca (XSTRING (filename)->size
+ + XSTRING (Vdoc_directory)->size + 1);
+ strcpy (name, XSTRING (Vdoc_directory)->data);
+ }
strcat (name, XSTRING (filename)->data); /*** Add this line ***/
#ifdef VMS
#ifndef VMS4_4
/* 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);
+ tem = Fwhere_is_internal (tem, keymap, Qt, Qnil, Qnil);
strp = XSTRING (string)->data + idx;
start = XSTRING (string)->data + start_idx;