#include <config.h>
+/* The following feature selections should be in config.h, but that
+ causes at best a host of warnings on some systems. */
+#undef _XOPEN_SOURCE /* Avoid warnings about redefinition
+ in some cases. */
+#define _XOPEN_SOURCE 500 /* for Unix 98 ftello on GNU */
+#undef __EXTENSIONS__
+#define __EXTENSIONS__ /* Keep Solaris 2.6 happy with the
+ above, else things we need are hidden. */
#include <stdio.h>
#include <sys/types.h>
#include <sys/stat.h>
#include <errno.h>
#include "lisp.h"
#include "intervals.h"
-
-#ifndef standalone
#include "buffer.h"
#include "charset.h"
#include <epaths.h>
#include "commands.h"
#include "keyboard.h"
#include "termhooks.h"
-#endif
#ifdef lint
#include <sys/inode.h>
#define X_OK 01
#endif
-#ifdef LISP_FLOAT_TYPE
#include <math.h>
-#endif /* LISP_FLOAT_TYPE */
#ifdef HAVE_SETLOCALE
#include <locale.h>
if (! NILP (inbuffer->enable_multibyte_characters))
{
- unsigned char workbuf[4];
- unsigned char *str = workbuf;
- int length;
-
/* Fetch the character code from the buffer. */
unsigned char *p = BUF_BYTE_ADDRESS (inbuffer, pt_byte);
BUF_INC_POS (inbuffer, pt_byte);
c = STRING_CHAR (p, pt_byte - orig_pt_byte);
-
- /* Find the byte-sequence representation of that character. */
- if (SINGLE_BYTE_CHAR_P (c))
- length = 1, workbuf[0] = c;
- else
- length = non_ascii_char_to_string (c, workbuf, &str);
-
- /* If the bytes for this character in the buffer
- are not identical with what the character code implies,
- read the bytes one by one from the buffer. */
- if (length != pt_byte - orig_pt_byte
- || (length == 1 ? *str != *p : bcmp (str, p, length)))
- {
- readchar_backlog = pt_byte - orig_pt_byte;
- c = BUF_FETCH_BYTE (inbuffer, orig_pt_byte);
- readchar_backlog--;
- }
}
else
{
if (! NILP (inbuffer->enable_multibyte_characters))
{
- unsigned char workbuf[4];
- unsigned char *str = workbuf;
- int length;
-
/* Fetch the character code from the buffer. */
unsigned char *p = BUF_BYTE_ADDRESS (inbuffer, bytepos);
BUF_INC_POS (inbuffer, bytepos);
c = STRING_CHAR (p, bytepos - orig_bytepos);
-
- /* Find the byte-sequence representation of that character. */
- if (SINGLE_BYTE_CHAR_P (c))
- length = 1, workbuf[0] = c;
- else
- length = non_ascii_char_to_string (c, workbuf, &str);
-
- /* If the bytes for this character in the buffer
- are not identical with what the character code implies,
- read the bytes one by one from the buffer. */
- if (length != bytepos - orig_bytepos
- || (length == 1 ? *str != *p : bcmp (str, p, length)))
- {
- readchar_backlog = bytepos - orig_bytepos;
- c = BUF_FETCH_BYTE (inbuffer, orig_bytepos);
- readchar_backlog--;
- }
}
else
{
input_method)
int no_switch_frame, ascii_required, error_nonascii, input_method;
{
-#ifdef standalone
- return make_number (getchar ());
-#else
register Lisp_Object val, delayed_switch_frame;
+#ifdef HAVE_WINDOW_SYSTEM
+ if (display_busy_cursor_p)
+ cancel_busy_cursor ();
+#endif
+
delayed_switch_frame = Qnil;
/* Read until we get an acceptable event. */
if (! NILP (delayed_switch_frame))
unread_switch_frame = delayed_switch_frame;
- return val;
+#ifdef HAVE_WINDOW_SYSTEM
+ if (display_busy_cursor_p)
+ start_busy_cursor ();
#endif
+ return val;
}
DEFUN ("read-char", Fread_char, Sread_char, 0, 2, 0,
static Lisp_Object load_unwind ();
static Lisp_Object load_descriptor_unwind ();
+/* Non-zero means load dangerous compiled Lisp files. */
+
+int load_dangerous_libraries;
+
+/* A regular expression used to detect files compiled with Emacs. */
+
+static Lisp_Object Vbytecomp_version_regexp;
+
+
+/* Value is non-zero if the file asswociated with file descriptor FD
+ is a compiled Lisp file that's safe to load. Only files compiled
+ with Emacs are safe to load. Files compiled with XEmacs can lead
+ to a crash in Fbyte_code because of an incompatible change in the
+ byte compiler. */
+
+static int
+safe_to_load_p (fd)
+ int fd;
+{
+ char buf[512];
+ int nbytes, i;
+ int safe_p = 1;
+
+ /* Read the first few bytes from the file, and look for a line
+ specifying the byte compiler version used. */
+ nbytes = emacs_read (fd, buf, sizeof buf - 1);
+ if (nbytes > 0)
+ {
+ buf[nbytes] = '\0';
+
+ /* Skip to the next newline, skipping over the initial `ELC'
+ with NUL bytes following it. */
+ for (i = 0; i < nbytes && buf[i] != '\n'; ++i)
+ ;
+
+ if (i < nbytes
+ && fast_c_string_match_ignore_case (Vbytecomp_version_regexp,
+ buf + i) < 0)
+ safe_p = 0;
+ }
+
+ lseek (fd, 0, SEEK_SET);
+ return safe_p;
+}
+
+
DEFUN ("load", Fload, Sload, 1, 5, 0,
"Execute a file of Lisp code named FILE.\n\
First try FILE with `.elc' appended, then try with `.el',\n\
/* 1 means we are loading a compiled file. */
int compiled = 0;
Lisp_Object handler;
+ int safe_p = 1;
char *fmode = "r";
#ifdef DOS_NT
fmode = "rt";
fd = openp (Vload_path, file,
(!NILP (nosuffix) ? ""
- : ! NILP (must_suffix) ? ".elc:.el"
- : ".elc:.el:"),
+ : ! NILP (must_suffix) ? ".elc.gz:.elc:.el.gz:.el"
+ : ".elc:.elc.gz:.el.gz:.el:"),
&found, 0);
UNGCPRO;
}
struct stat s1, s2;
int result;
+ if (!safe_to_load_p (fd))
+ {
+ safe_p = 0;
+ if (!load_dangerous_libraries)
+ error ("File `%s' was not compiled in Emacs",
+ XSTRING (found)->data);
+ else if (!NILP (nomessage))
+ message_with_string ("File `%s' not compiled in Emacs", found, 1);
+ }
+
compiled = 1;
#ifdef DOS_NT
}
else
{
+ load_source:
+
/* We are loading a source file (*.el). */
if (!NILP (Vload_source_file_function))
{
if (NILP (nomessage))
{
- if (!compiled)
+ if (!safe_p)
+ message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
+ file, 1);
+ else if (!compiled)
message_with_string ("Loading %s (source)...", file, 1);
else if (newer)
message_with_string ("Loading %s (compiled; note, source file is newer)...",
saved_doc_string_size = 0;
if (prev_saved_doc_string)
- free (prev_saved_doc_string);
+ xfree (prev_saved_doc_string);
prev_saved_doc_string = 0;
prev_saved_doc_string_size = 0;
if (!noninteractive && NILP (nomessage))
{
- if (!compiled)
+ if (!safe_p)
+ message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
+ file, 1);
+ else if (!compiled)
message_with_string ("Loading %s (source)...done", file, 1);
else if (newer)
message_with_string ("Loading %s (compiled; note, source file is newer)...done",
unbind_to (count, Qnil);
}
-#ifndef standalone
-
DEFUN ("eval-buffer", Feval_buffer, Seval_buffer, 0, 5, "",
"Execute the current buffer as Lisp code.\n\
Programs can pass two arguments, BUFFER and PRINTFLAG.\n\
return unbind_to (count, Qnil);
}
-#endif /* standalone */
\f
DEFUN ("read", Fread, Sread, 0, 1, 0,
"Read one Lisp expression as text from STREAM, return as Lisp object.\n\
new_backquote_flag = 0;
read_objects = Qnil;
-#ifndef standalone
if (EQ (stream, Qread_char))
return Fread_minibuffer (build_string ("Lisp expression: "), Qnil);
-#endif
if (STRINGP (stream))
return Fcar (Fread_from_string (stream, Qnil, Qnil));
{
/* We need the actual character code of this multibyte
characters. */
- unsigned char str[MAX_LENGTH_OF_MULTI_BYTE_FORM];
+ unsigned char str[MAX_MULTIBYTE_LENGTH];
int len = 0;
str[len++] = c;
while ((c = READCHAR) >= 0xA0
- && len < MAX_LENGTH_OF_MULTI_BYTE_FORM)
+ && len < MAX_MULTIBYTE_LENGTH)
str[len++] = c;
UNREAD (c);
return STRING_CHAR (str, len);
}
}
+
+/* Read an integer in radix RADIX using READCHARFUN to read
+ characters. RADIX must be in the interval [2..36]; if it isn't, a
+ read error is signaled . Value is the integer read. Signals an
+ error if encountering invalid read syntax or if RADIX is out of
+ range. */
+
+static Lisp_Object
+read_integer (readcharfun, radix)
+ Lisp_Object readcharfun;
+ int radix;
+{
+ int number, ndigits, invalid_p, c, sign;
+
+ if (radix < 2 || radix > 36)
+ invalid_p = 1;
+ else
+ {
+ number = ndigits = invalid_p = 0;
+ sign = 1;
+
+ c = READCHAR;
+ if (c == '-')
+ {
+ c = READCHAR;
+ sign = -1;
+ }
+ else if (c == '+')
+ c = READCHAR;
+
+ while (c >= 0)
+ {
+ int digit;
+
+ if (c >= '0' && c <= '9')
+ digit = c - '0';
+ else if (c >= 'a' && c <= 'z')
+ digit = c - 'a' + 10;
+ else if (c >= 'A' && c <= 'Z')
+ digit = c - 'A' + 10;
+ else
+ {
+ UNREAD (c);
+ break;
+ }
+
+ if (digit < 0 || digit >= radix)
+ invalid_p = 1;
+
+ number = radix * number + digit;
+ ++ndigits;
+ c = READCHAR;
+ }
+ }
+
+ if (ndigits == 0 || invalid_p)
+ {
+ char buf[50];
+ sprintf (buf, "integer, radix %d", radix);
+ Fsignal (Qinvalid_read_syntax, Fcons (build_string (buf), Qnil));
+ }
+
+ return make_number (sign * number);
+}
+
+
/* If the next token is ')' or ']' or '.', we store that character
in *PCH and the return value is not interesting. Else, we store
zero in *PCH and we read and return one lisp object.
return XCDR (tem);
/* Fall through to error message. */
}
+ else if (c == 'r' || c == 'R')
+ return read_integer (readcharfun, n);
+
/* Fall through to error message. */
}
+ else if (c == 'x' || c == 'X')
+ return read_integer (readcharfun, 16);
+ else if (c == 'o' || c == 'O')
+ return read_integer (readcharfun, 8);
+ else if (c == 'b' || c == 'B')
+ return read_integer (readcharfun, 2);
UNREAD (c);
Fsignal (Qinvalid_read_syntax, Fcons (make_string ("#", 1), Qnil));
while ((c = READCHAR) >= 0
&& c != '\"')
{
- if (end - p < MAX_LENGTH_OF_MULTI_BYTE_FORM)
+ if (end - p < MAX_MULTIBYTE_LENGTH)
{
char *new = (char *) xrealloc (read_buffer, read_buffer_size *= 2);
p += new - read_buffer;
if (! SINGLE_BYTE_CHAR_P ((c & ~CHAR_MODIFIER_MASK)))
{
- unsigned char workbuf[4];
- unsigned char *str = workbuf;
- int length;
-
/* Any modifiers for a multibyte character are invalid. */
if (c & CHAR_MODIFIER_MASK)
error ("Invalid modifier in string");
- length = non_ascii_char_to_string (c, workbuf, &str);
- if (length > 1)
- force_multibyte = 1;
-
- bcopy (str, p, length);
- p += length;
+ p += CHAR_STRING (c, p);
+ force_multibyte = 1;
}
else
{
case '.':
{
-#ifdef LISP_FLOAT_TYPE
- /* If a period is followed by a number, then we should read it
- as a floating point number. Otherwise, it denotes a dotted
- pair. */
int next_char = READCHAR;
UNREAD (next_char);
- if (! (next_char >= '0' && next_char <= '9'))
-#endif
+ if (next_char <= 040)
{
*pch = c;
return Qnil;
while (c > 040
&& !(c == '\"' || c == '\'' || c == ';' || c == '?'
|| c == '(' || c == ')'
-#ifndef LISP_FLOAT_TYPE
- /* If we have floating-point support, then we need
- to allow <digits><dot><digits>. */
- || c =='.'
-#endif /* not LISP_FLOAT_TYPE */
|| c == '[' || c == ']' || c == '#'
))
{
- if (end - p < MAX_LENGTH_OF_MULTI_BYTE_FORM)
+ if (end - p < MAX_MULTIBYTE_LENGTH)
{
register char *new = (char *) xrealloc (read_buffer, read_buffer_size *= 2);
p += new - read_buffer;
}
if (! SINGLE_BYTE_CHAR_P (c))
- {
- unsigned char workbuf[4];
- unsigned char *str = workbuf;
- int length;
-
- length = non_ascii_char_to_string (c, workbuf, &str);
-
- bcopy (str, p, length);
- p += length;
- }
+ p += CHAR_STRING (c, p);
else
*p++ = c;
if (p1 != p)
{
while (p1 != p && (c = *p1) >= '0' && c <= '9') p1++;
-#ifdef LISP_FLOAT_TYPE
/* Integers can have trailing decimal points. */
if (p1 > read_buffer && p1 < p && *p1 == '.') p1++;
-#endif
if (p1 == p)
/* It is an integer. */
{
-#ifdef LISP_FLOAT_TYPE
if (p1[-1] == '.')
p1[-1] = '\0';
-#endif
if (sizeof (int) == sizeof (EMACS_INT))
XSETINT (val, atoi (read_buffer));
else if (sizeof (long) == sizeof (EMACS_INT))
return val;
}
}
-#ifdef LISP_FLOAT_TYPE
if (isfloat_string (read_buffer))
{
/* Compute NaN and infinities using 0.0 in a variable,
return make_float (negative ? - value : value);
}
-#endif
}
if (uninterned_symbol)
case Lisp_Vectorlike:
{
int i;
- int length = Flength(subtree);
+ int length = XINT (Flength(subtree));
for (i = 0; i < length; i++)
{
Lisp_Object idx = make_number (i);
}
\f
-#ifdef LISP_FLOAT_TYPE
-
#define LEAD_INT 1
#define DOT_CHAR 2
#define TRAIL_INT 4
|| state == (LEAD_INT|DOT_CHAR|TRAIL_INT|E_CHAR|EXP_INT)
|| state == (DOT_CHAR|TRAIL_INT|E_CHAR|EXP_INT)));
}
-#endif /* LISP_FLOAT_TYPE */
+
\f
static Lisp_Object
read_vector (readcharfun, bytecodeflag)
DEFUN ("intern-soft", Fintern_soft, Sintern_soft, 1, 2, 0,
"Return the canonical symbol named NAME, or nil if none exists.\n\
-NAME may be a string or a symbol. If it is a symbol, that exact
-symbol is searched for.
+NAME may be a string or a symbol. If it is a symbol, that exact\n\
+symbol is searched for.\n\
A second optional argument specifies the obarray to use;\n\
it defaults to the value of `obarray'.")
(name, obarray)
Qvariable_documentation = intern ("variable-documentation");
staticpro (&Qvariable_documentation);
- read_buffer_size = 100 + MAX_LENGTH_OF_MULTI_BYTE_FORM;
- read_buffer = (char *) malloc (read_buffer_size);
+ read_buffer_size = 100 + MAX_MULTIBYTE_LENGTH;
+ read_buffer = (char *) xmalloc (read_buffer_size);
}
\f
void
staticpro (address);
}
-#ifndef standalone
-
/* Similar but define a variable whose value is the Lisp Object stored in
the current buffer. address is the address of the slot in the buffer
that is current now. */
XMISCTYPE (val) = Lisp_Misc_Buffer_Objfwd;
XBUFFER_OBJFWD (val)->offset = offset;
XSYMBOL (sym)->value = val;
- *(Lisp_Object *)(offset + (char *)&buffer_local_symbols) = sym;
- *(Lisp_Object *)(offset + (char *)&buffer_local_types) = type;
- if (XINT (*(Lisp_Object *)(offset + (char *)&buffer_local_flags)) == 0)
+ PER_BUFFER_SYMBOL (offset) = sym;
+ PER_BUFFER_TYPE (offset) = type;
+
+ if (PER_BUFFER_IDX (offset) == 0)
/* Did a DEFVAR_PER_BUFFER without initializing the corresponding
slot of buffer_local_flags */
abort ();
}
-#endif /* standalone */
/* Similar but define a variable whose value is the Lisp Object stored
at a particular offset in the current kboard object. */
except for one element (optional) that starts with nil and describes\n\
definitions evaluated from buffers not visiting files.\n\
The remaining elements of each list are symbols defined as functions\n\
-or variables, and cons cells `(provide . FEATURE)' and `(require . FEATURE)'.");
+or variables, and cons cells `(provide . FEATURE)', `(require . FEATURE)',\n\
+and `(autoload . SYMBOL)'.");
Vload_history = Qnil;
DEFVAR_LISP ("load-file-name", &Vload_file_name,
Vload_file_name = Qnil;
DEFVAR_LISP ("user-init-file", &Vuser_init_file,
- "File name, including directory, of user's initialization file.");
+ "File name, including directory, of user's initialization file.\n\
+If the file loaded had extension `.elc' and there was a corresponding `.el'\n\
+file, this variable contains the name of the .el file, suitable for use\n\
+by functions like `custom-save-all' which edit the init file.");
Vuser_init_file = Qnil;
DEFVAR_LISP ("current-load-list", &Vcurrent_load_list,
load_force_doc_strings = 0;
DEFVAR_BOOL ("load-convert-to-unibyte", &load_convert_to_unibyte,
- "Non-nil means `load' converts strings to unibyte whenever possible.\n\
-This is normally used in `load-with-code-conversion'\n\
-for loading non-compiled files.");
+ "Non-nil means `read' converts strings to unibyte whenever possible.\n\
+This is normally bound by `load' and `eval-buffer' to control `read',\n\
+and is not meant for users to change.");
load_convert_to_unibyte = 0;
DEFVAR_LISP ("source-directory", &Vsource_directory,
"List of all DEFVAR_BOOL variables, used by the byte code optimizer.");
Vbyte_boolean_vars = Qnil;
+ DEFVAR_BOOL ("load-dangerous-libraries", &load_dangerous_libraries,
+ "Non-nil means load dangerous compiled Lisp files.\n\
+Some versions of XEmacs use different byte codes than Emacs. These\n\
+incompatible byte codes can make Emacs crash when it tries to execute\n\
+them.");
+ load_dangerous_libraries = 0;
+
+ Vbytecomp_version_regexp = build_string ("^;;;.in Emacs version");
+ staticpro (&Vbytecomp_version_regexp);
+
/* Vsource_directory was initialized in init_lread. */
load_descriptor_list = Qnil;