/* Lisp parsing and input streams.
- Copyright (C) 1985, 1986, 1987, 1988, 1989, 1993, 1994, 1995,
- 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
- 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
+
+Copyright (C) 1985, 1986, 1987, 1988, 1989, 1993, 1994, 1995, 1997,
+ 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
+ 2009, 2010 Free Software Foundation, Inc.
This file is part of GNU Emacs.
#include <locale.h>
#endif /* HAVE_SETLOCALE */
-#ifdef HAVE_FCNTL_H
#include <fcntl.h>
-#endif
-#ifndef O_RDONLY
-#define O_RDONLY 0
-#endif
#ifdef HAVE_FSEEKO
#define file_offset off_t
Lisp_Object Qbackquote, Qcomma, Qcomma_at, Qcomma_dot, Qfunction;
Lisp_Object Qinhibit_file_name_operation;
Lisp_Object Qeval_buffer_list, Veval_buffer_list;
+Lisp_Object Qlexical_binding;
Lisp_Object Qfile_truename, Qdo_after_load_evaluation; /* ACM 2006/5/16 */
/* Used instead of Qget_file_char while loading *.elc files compiled
static Lisp_Object Qload_force_doc_strings;
+extern Lisp_Object Qinternal_interpreter_environment;
+
/* non-zero if inside `load' */
int load_in_progress;
static Lisp_Object Qload_in_progress;
/* List of (SYMBOL . POSITION) accumulated so far. */
Lisp_Object Vread_symbol_positions_list;
+/* If non-nil `readevalloop' evaluates code in a lexical environment. */
+Lisp_Object Vlexical_binding;
+
/* List of descriptors now open for Fload. */
static Lisp_Object load_descriptor_list;
static int read_pure;
/* For use within read-from-string (this reader is non-reentrant!!) */
-static int read_from_string_index;
-static int read_from_string_index_byte;
-static int read_from_string_limit;
+static EMACS_INT read_from_string_index;
+static EMACS_INT read_from_string_index_byte;
+static EMACS_INT read_from_string_limit;
/* Number of characters read in the current call to Fread or
Fread_from_string. */
-static int readchar_count;
+static EMACS_INT readchar_count;
/* This contains the last string skipped with #@. */
static char *saved_doc_string;
{
register struct buffer *inbuffer = XBUFFER (readcharfun);
- int pt_byte = BUF_PT_BYTE (inbuffer);
+ EMACS_INT pt_byte = BUF_PT_BYTE (inbuffer);
if (pt_byte >= BUF_ZV_BYTE (inbuffer))
return -1;
{
register struct buffer *inbuffer = XMARKER (readcharfun)->buffer;
- int bytepos = marker_byte_position (readcharfun);
+ EMACS_INT bytepos = marker_byte_position (readcharfun);
if (bytepos >= BUF_ZV_BYTE (inbuffer))
return -1;
else if (BUFFERP (readcharfun))
{
struct buffer *b = XBUFFER (readcharfun);
- int bytepos = BUF_PT_BYTE (b);
+ EMACS_INT bytepos = BUF_PT_BYTE (b);
BUF_PT (b)--;
if (! NILP (b->enable_multibyte_characters))
else if (MARKERP (readcharfun))
{
struct buffer *b = XMARKER (readcharfun)->buffer;
- int bytepos = XMARKER (readcharfun)->bytepos;
+ EMACS_INT bytepos = XMARKER (readcharfun)->bytepos;
XMARKER (readcharfun)->charpos--;
if (! NILP (b->enable_multibyte_characters))
encoded in `emacs-mule' and the first byte is already read in
C. */
-extern char emacs_mule_bytes[256];
-
static int
read_emacs_mule_char (int c, int (*readbyte) (int, Lisp_Object), Lisp_Object readcharfun)
{
if (len == 2)
{
- charset = emacs_mule_charset[buf[0]];
+ charset = CHARSET_FROM_ID (emacs_mule_charset[buf[0]]);
code = buf[1] & 0x7F;
}
else if (len == 3)
if (buf[0] == EMACS_MULE_LEADING_CODE_PRIVATE_11
|| buf[0] == EMACS_MULE_LEADING_CODE_PRIVATE_12)
{
- charset = emacs_mule_charset[buf[1]];
+ charset = CHARSET_FROM_ID (emacs_mule_charset[buf[1]]);
code = buf[2] & 0x7F;
}
else
{
- charset = emacs_mule_charset[buf[0]];
+ charset = CHARSET_FROM_ID (emacs_mule_charset[buf[0]]);
code = ((buf[1] << 8) | buf[2]) & 0x7F7F;
}
}
else
{
- charset = emacs_mule_charset[buf[1]];
+ charset = CHARSET_FROM_ID (emacs_mule_charset[buf[1]]);
code = ((buf[2] << 8) | buf[3]) & 0x7F7F;
}
c = DECODE_CHAR (charset, code);
\f
+
+/* Return true if the lisp code read using READCHARFUN defines a non-nil
+ `lexical-binding' file variable. After returning, the stream is
+ positioned following the first line, if it is a comment, otherwise
+ nothing is read. */
+
+static int
+lisp_file_lexically_bound_p (Lisp_Object readcharfun)
+{
+ int ch = READCHAR;
+ if (ch != ';')
+ /* The first line isn't a comment, just give up. */
+ {
+ UNREAD (ch);
+ return 0;
+ }
+ else
+ /* Look for an appropriate file-variable in the first line. */
+ {
+ int rv = 0;
+ enum {
+ NOMINAL, AFTER_FIRST_DASH, AFTER_ASTERIX,
+ } beg_end_state = NOMINAL;
+ int in_file_vars = 0;
+
+#define UPDATE_BEG_END_STATE(ch) \
+ if (beg_end_state == NOMINAL) \
+ beg_end_state = (ch == '-' ? AFTER_FIRST_DASH : NOMINAL); \
+ else if (beg_end_state == AFTER_FIRST_DASH) \
+ beg_end_state = (ch == '*' ? AFTER_ASTERIX : NOMINAL); \
+ else if (beg_end_state == AFTER_ASTERIX) \
+ { \
+ if (ch == '-') \
+ in_file_vars = !in_file_vars; \
+ beg_end_state = NOMINAL; \
+ }
+
+ /* Skip until we get to the file vars, if any. */
+ do
+ {
+ ch = READCHAR;
+ UPDATE_BEG_END_STATE (ch);
+ }
+ while (!in_file_vars && ch != '\n' && ch != EOF);
+
+ while (in_file_vars)
+ {
+ char var[100], *var_end, val[100], *val_end;
+
+ ch = READCHAR;
+
+ /* Read a variable name. */
+ while (ch == ' ' || ch == '\t')
+ ch = READCHAR;
+
+ var_end = var;
+ while (ch != ':' && ch != '\n' && ch != EOF)
+ {
+ if (var_end < var + sizeof var - 1)
+ *var_end++ = ch;
+ UPDATE_BEG_END_STATE (ch);
+ ch = READCHAR;
+ }
+
+ while (var_end > var
+ && (var_end[-1] == ' ' || var_end[-1] == '\t'))
+ var_end--;
+ *var_end = '\0';
+
+ if (ch == ':')
+ {
+ /* Read a variable value. */
+ ch = READCHAR;
+
+ while (ch == ' ' || ch == '\t')
+ ch = READCHAR;
+
+ val_end = val;
+ while (ch != ';' && ch != '\n' && ch != EOF && in_file_vars)
+ {
+ if (val_end < val + sizeof val - 1)
+ *val_end++ = ch;
+ UPDATE_BEG_END_STATE (ch);
+ ch = READCHAR;
+ }
+ if (! in_file_vars)
+ /* The value was terminated by an end-marker, which
+ remove. */
+ val_end -= 3;
+ while (val_end > val
+ && (val_end[-1] == ' ' || val_end[-1] == '\t'))
+ val_end--;
+ *val_end = '\0';
+
+ if (strcmp (var, "lexical-binding") == 0)
+ /* This is it... */
+ {
+ rv = (strcmp (val, "nil") != 0);
+ break;
+ }
+ }
+ }
+
+ while (ch != '\n' && ch != EOF)
+ ch = READCHAR;
+
+ return rv;
+ }
+}
+
+\f
/* Value is a version number of byte compiled code if the file
associated with file descriptor FD is a compiled Lisp file that's
safe to load. Only files compiled with Emacs are safe to load.
`require' calls, in an element of `load-history' whose
car is the file name loaded. See `load-history'.
+While the file is in the process of being loaded, the variable
+`load-in-progress' is non-nil and the variable `load-file-name'
+is bound to the file's name.
+
Return t if the file exists and loads successfully. */)
(Lisp_Object file, Lisp_Object noerror, Lisp_Object nomessage, Lisp_Object nosuffix, Lisp_Object must_suffix)
{
Vloads_in_progress = Fcons (found, Vloads_in_progress);
}
+ /* All loads are by default dynamic, unless the file itself specifies
+ otherwise using a file-variable in the first line. This is bound here
+ so that it takes effect whether or not we use
+ Vload_source_file_function. */
+ specbind (Qlexical_binding, Qnil);
+
/* Get the name for load-history. */
hist_file_name = (! NILP (Vpurify_flag)
? Fconcat (2, (tmp[0] = Ffile_name_directory (file),
specbind (Qinhibit_file_name_operation, Qnil);
load_descriptor_list
= Fcons (make_number (fileno (stream)), load_descriptor_list);
+
specbind (Qload_in_progress, Qt);
+
+ instream = stream;
+ if (lisp_file_lexically_bound_p (Qget_file_char))
+ Fset (Qlexical_binding, Qt);
+
if (! version || version >= 22)
readevalloop (Qget_file_char, stream, hist_file_name,
Feval, 0, Qnil, Qnil, Qnil, Qnil);
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
struct buffer *b = 0;
int continue_reading_p;
+ Lisp_Object lex_bound;
/* Nonzero if reading an entire buffer. */
int whole_buffer = 0;
/* 1 on the first time around. */
record_unwind_protect (readevalloop_1, load_convert_to_unibyte ? Qt : Qnil);
load_convert_to_unibyte = !NILP (unibyte);
+ /* If lexical binding is active (either because it was specified in
+ the file's header, or via a buffer-local variable), create an empty
+ lexical environment, otherwise, turn off lexical binding. */
+ lex_bound = find_symbol_value (Qlexical_binding);
+ if (NILP (lex_bound) || EQ (lex_bound, Qunbound))
+ specbind (Qinternal_interpreter_environment, Qnil);
+ else
+ specbind (Qinternal_interpreter_environment, Fcons (Qt, Qnil));
+
GCPRO4 (sourcename, readfun, start, end);
/* Try to ensure sourcename is a truename, except whilst preloading. */
specbind (Qeval_buffer_list, Fcons (buf, Veval_buffer_list));
specbind (Qstandard_output, tem);
+ specbind (Qlexical_binding, Qnil);
record_unwind_protect (save_excursion_restore, save_excursion_save ());
BUF_TEMP_SET_PT (XBUFFER (buf), BUF_BEGV (XBUFFER (buf)));
+ if (lisp_file_lexically_bound_p (buf))
+ Fset (Qlexical_binding, Qt);
readevalloop (buf, 0, filename, Feval,
!NILP (printflag), unibyte, Qnil, Qnil, Qnil);
unbind_to (count, Qnil);
if (STRINGP (stream)
|| ((CONSP (stream) && STRINGP (XCAR (stream)))))
{
- int startval, endval;
+ EMACS_INT startval, endval;
Lisp_Object string;
if (STRINGP (stream))
invalid_syntax ("#&...", 5);
}
if (c == '[')
- {
- /* Accept compiled functions at read-time so that we don't have to
- build them using function calls. */
- Lisp_Object tmp;
- tmp = read_vector (readcharfun, 1);
- return Fmake_byte_code (XVECTOR (tmp)->size,
- XVECTOR (tmp)->contents);
- }
+ /* `function vector' objects, including byte-compiled functions. */
+ return read_vector (readcharfun, 1);
if (c == '(')
{
Lisp_Object tmp;
old-style. For Emacs-25, we should completely remove this
first_in_list exception (old-style can still be obtained via
"(\`" anyway). */
- if (first_in_list && next_char == ' ')
+ if (!new_backquote_flag && first_in_list && next_char == ' ')
{
Vold_style_backquotes = Qt;
goto default_label;
}
}
case ',':
- if (new_backquote_flag)
- {
- Lisp_Object comma_type = Qnil;
- Lisp_Object value;
- int ch = READCHAR;
-
- if (ch == '@')
- comma_type = Qcomma_at;
- else if (ch == '.')
- comma_type = Qcomma_dot;
- else
- {
- if (ch >= 0) UNREAD (ch);
- comma_type = Qcomma;
- }
+ {
+ int next_char = READCHAR;
+ UNREAD (next_char);
+ /* Transition from old-style to new-style:
+ It used to be impossible to have a new-style , other than within
+ a new-style `. This is sufficient when ` and , are used in the
+ normal way, but ` and , can also appear in args to macros that
+ will not interpret them in the usual way, in which case , may be
+ used without any ` anywhere near.
+ So we now use the same heuristic as for backquote: old-style
+ unquotes are only recognized when first on a list, and when
+ followed by a space.
+ Because it's more difficult to peak 2 chars ahead, a new-style
+ ,@ can still not be used outside of a `, unless it's in the middle
+ of a list. */
+ if (new_backquote_flag
+ || !first_in_list
+ || (next_char != ' ' && next_char != '@'))
+ {
+ Lisp_Object comma_type = Qnil;
+ Lisp_Object value;
+ int ch = READCHAR;
- new_backquote_flag--;
- value = read0 (readcharfun);
- new_backquote_flag++;
- return Fcons (comma_type, Fcons (value, Qnil));
- }
- else
- {
- Vold_style_backquotes = Qt;
- goto default_label;
- }
+ if (ch == '@')
+ comma_type = Qcomma_at;
+ else if (ch == '.')
+ comma_type = Qcomma_dot;
+ else
+ {
+ if (ch >= 0) UNREAD (ch);
+ comma_type = Qcomma;
+ }
+ value = read0 (readcharfun);
+ return Fcons (comma_type, Fcons (value, Qnil));
+ }
+ else
+ {
+ Vold_style_backquotes = Qt;
+ goto default_label;
+ }
+ }
case '?':
{
int modifiers;
c |= modifiers;
next_char = READCHAR;
- if (next_char == '.')
- {
- /* Only a dotted-pair dot is valid after a char constant. */
- int next_next_char = READCHAR;
- UNREAD (next_next_char);
-
- ok = (next_next_char <= 040
- || (next_next_char < 0200
- && (strchr ("\"';([#?", next_next_char)
- || (!first_in_list && next_next_char == '`')
- || (new_backquote_flag && next_next_char == ','))));
- }
- else
- {
- ok = (next_char <= 040
- || (next_char < 0200
- && (strchr ("\"';()[]#?", next_char)
- || (!first_in_list && next_char == '`')
- || (new_backquote_flag && next_char == ','))));
- }
+ ok = (next_char <= 040
+ || (next_char < 0200
+ && (strchr ("\"';()[]#?`,.", next_char))));
UNREAD (next_char);
if (ok)
return make_number (c);
if (next_char <= 040
|| (next_char < 0200
- && (strchr ("\"';([#?", next_char)
- || (!first_in_list && next_char == '`')
- || (new_backquote_flag && next_char == ','))))
+ && (strchr ("\"';([#?`,", next_char))))
{
*pch = c;
return Qnil;
while (c > 040
&& c != 0x8a0 /* NBSP */
&& (c >= 0200
- || (!strchr ("\"';()[]#", c)
- && !(!first_in_list && c == '`')
- && !(new_backquote_flag && c == ','))))
+ || !(strchr ("\"';()[]#`,", c))))
{
if (end - p < MAX_MULTIBYTE_LENGTH)
{
\f
static Lisp_Object
-read_vector (Lisp_Object readcharfun, int bytecodeflag)
+read_vector (Lisp_Object readcharfun, int read_funvec)
{
register int i;
register int size;
register Lisp_Object tem, item, vector;
register struct Lisp_Cons *otem;
Lisp_Object len;
+ /* If we're reading a funvec object we start out assuming it's also a
+ byte-code object (a subset of funvecs), so we can do any special
+ processing needed. If it's just an ordinary funvec object, we'll
+ realize that as soon as we've read the first element. */
+ int read_bytecode = read_funvec;
tem = read_list (1, readcharfun);
len = Flength (tem);
for (i = 0; i < size; i++)
{
item = Fcar (tem);
+
+ /* If READ_BYTECODE is set, check whether this is really a byte-code
+ object, or just an ordinary `funvec' object -- non-byte-code
+ funvec objects use the same reader syntax. We can tell from the
+ first element which one it is. */
+ if (read_bytecode && i == 0 && ! FUNVEC_COMPILED_TAG_P (item))
+ read_bytecode = 0; /* Nope. */
+
/* If `load-force-doc-strings' is t when reading a lazily-loaded
bytecode object, the docstring containing the bytecode and
constants values must be treated as unibyte and passed to
Fread, to get the actual bytecode string and constants vector. */
- if (bytecodeflag && load_force_doc_strings)
+ if (read_bytecode && load_force_doc_strings)
{
if (i == COMPILED_BYTECODE)
{
tem = Fcdr (tem);
free_cons (otem);
}
+
+ if (read_bytecode && size >= 4)
+ /* Convert this vector to a bytecode object. */
+ vector = Fmake_byte_code (size, XVECTOR (vector)->contents);
+ else if (read_funvec && size >= 1)
+ /* Convert this vector to an ordinary funvec object. */
+ XSETFUNVEC (vector, XVECTOR (vector));
+
return vector;
}
Also store the bucket number in oblookup_last_bucket_number. */
Lisp_Object
-oblookup (Lisp_Object obarray, register const char *ptr, int size, int size_byte)
+oblookup (Lisp_Object obarray, register const char *ptr, EMACS_INT size, EMACS_INT size_byte)
{
int hash;
int obsize;
}
#endif /* NOTDEF */
-/* Define an "integer variable"; a symbol whose value is forwarded
- to a C variable of type int. Sample call:
- DEFVAR_INT ("emacs-priority", &emacs_priority, "Documentation"); */
+/* Define an "integer variable"; a symbol whose value is forwarded to a
+ C variable of type int. Sample call (munged w "xx" to fool make-docfile):
+ DEFxxVAR_INT ("emacs-priority", &emacs_priority, "Documentation"); */
void
defvar_int (struct Lisp_Intfwd *i_fwd,
const char *namestring, EMACS_INT *address)
sym = intern_c_string (namestring);
i_fwd->type = Lisp_Fwd_Int;
i_fwd->intvar = address;
+ XSYMBOL (sym)->declared_special = 1;
XSYMBOL (sym)->redirect = SYMBOL_FORWARDED;
SET_SYMBOL_FWD (XSYMBOL (sym), (union Lisp_Fwd *)i_fwd);
}
sym = intern_c_string (namestring);
b_fwd->type = Lisp_Fwd_Bool;
b_fwd->boolvar = address;
+ XSYMBOL (sym)->declared_special = 1;
XSYMBOL (sym)->redirect = SYMBOL_FORWARDED;
SET_SYMBOL_FWD (XSYMBOL (sym), (union Lisp_Fwd *)b_fwd);
Vbyte_boolean_vars = Fcons (sym, Vbyte_boolean_vars);
sym = intern_c_string (namestring);
o_fwd->type = Lisp_Fwd_Obj;
o_fwd->objvar = address;
+ XSYMBOL (sym)->declared_special = 1;
XSYMBOL (sym)->redirect = SYMBOL_FORWARDED;
SET_SYMBOL_FWD (XSYMBOL (sym), (union Lisp_Fwd *)o_fwd);
}
staticpro (address);
}
+
/* Similar but define a variable whose value is the Lisp Object stored
at a particular offset in the current kboard object. */
sym = intern_c_string (namestring);
ko_fwd->type = Lisp_Fwd_Kboard_Obj;
ko_fwd->offset = offset;
+ XSYMBOL (sym)->declared_special = 1;
XSYMBOL (sym)->redirect = SYMBOL_FORWARDED;
SET_SYMBOL_FWD (XSYMBOL (sym), (union Lisp_Fwd *)ko_fwd);
}
Vbytecomp_version_regexp
= make_pure_c_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
+ Qlexical_binding = intern ("lexical-binding");
+ staticpro (&Qlexical_binding);
+ DEFVAR_LISP ("lexical-binding", &Vlexical_binding,
+ doc: /* If non-nil, use lexical binding when evaluating code.
+This only applies to code evaluated by `eval-buffer' and `eval-region'.
+This variable is automatically set from the file variables of an interpreted
+ lisp file read using `load'. */);
+ Fmake_variable_buffer_local (Qlexical_binding);
+
DEFVAR_LISP ("eval-buffer-list", &Veval_buffer_list,
doc: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'. */);
Veval_buffer_list = Qnil;
staticpro (&Qrehash_threshold);
}
-/* arch-tag: a0d02733-0f96-4844-a659-9fd53c4f414d
- (do not change this comment) */
HCoop / bpt / emacs.git / blobdiff