#ifndef standalone
#include "buffer.h"
#include "keyboard.h"
+#include "frame.h"
#endif
#include "syssignal.h"
extern double atof ();
#endif /* !atof */
+/* Nonzero means it is an error to set a symbol whose name starts with
+ colon. */
+int keyword_symbols_constant_flag;
+
Lisp_Object Qnil, Qt, Qquote, Qlambda, Qsubr, Qunbound;
Lisp_Object Qerror_conditions, Qerror_message, Qtop_level;
Lisp_Object Qerror, Qquit, Qwrong_type_argument, Qargs_out_of_range;
return value;
}
+void
pure_write_error ()
{
error ("Attempt to modify read-only object");
register Lisp_Object symbol;
{
CHECK_SYMBOL (symbol, 0);
- if (NILP (symbol) || EQ (symbol, Qt))
+ if (NILP (symbol) || EQ (symbol, Qt)
+ || (XSYMBOL (symbol)->name->data[0] == ':'
+ && EQ (XSYMBOL (symbol)->obarray, initial_obarray)
+ && keyword_symbols_constant_flag))
return Fsignal (Qsetting_constant, Fcons (symbol, Qnil));
Fset (symbol, Qunbound);
return symbol;
valcontents = XSYMBOL (symbol)->value;
if (BUFFER_LOCAL_VALUEP (valcontents)
|| SOME_BUFFER_LOCAL_VALUEP (valcontents))
- XBUFFER_LOCAL_VALUE (valcontents)->car = newval;
+ XBUFFER_LOCAL_VALUE (valcontents)->realvalue = newval;
else
XSYMBOL (symbol)->value = newval;
}
Note that REALVALUE can be a forwarding pointer. */
register Lisp_Object tem1;
- tem1 = XCONS (XBUFFER_LOCAL_VALUE (valcontents)->cdr)->car;
+ tem1 = XBUFFER_LOCAL_VALUE (valcontents)->buffer;
- if (NILP (tem1) || current_buffer != XBUFFER (tem1))
+ if (NILP (tem1) || current_buffer != XBUFFER (tem1)
+ || selected_frame != XFRAME (XBUFFER_LOCAL_VALUE (valcontents)->frame))
{
- tem1 = XCONS (XCONS (XBUFFER_LOCAL_VALUE (valcontents)->cdr)->cdr)->car;
+ tem1 = XCONS (XBUFFER_LOCAL_VALUE (valcontents)->cdr)->car;
Fsetcdr (tem1,
- do_symval_forwarding (XBUFFER_LOCAL_VALUE (valcontents)->car));
+ do_symval_forwarding (XBUFFER_LOCAL_VALUE (valcontents)->realvalue));
tem1 = assq_no_quit (symbol, current_buffer->local_var_alist);
+ XBUFFER_LOCAL_VALUE (valcontents)->found_for_frame = 0;
+ XBUFFER_LOCAL_VALUE (valcontents)->found_for_buffer = 0;
if (NILP (tem1))
- tem1 = XCONS (XBUFFER_LOCAL_VALUE (valcontents)->cdr)->cdr;
- XCONS (XCONS (XBUFFER_LOCAL_VALUE (valcontents)->cdr)->cdr)->car = tem1;
- XSETBUFFER (XCONS (XBUFFER_LOCAL_VALUE (valcontents)->cdr)->car,
- current_buffer);
- store_symval_forwarding (symbol, XBUFFER_LOCAL_VALUE (valcontents)->car,
+ {
+ if (XBUFFER_LOCAL_VALUE (valcontents)->check_frame)
+ tem1 = assq_no_quit (symbol, selected_frame->param_alist);
+ if (! NILP (tem1))
+ XBUFFER_LOCAL_VALUE (valcontents)->found_for_frame = 1;
+ else
+ tem1 = XBUFFER_LOCAL_VALUE (valcontents)->cdr;
+ }
+ else
+ XBUFFER_LOCAL_VALUE (valcontents)->found_for_buffer = 1;
+
+ XCONS (XBUFFER_LOCAL_VALUE (valcontents)->cdr)->car = tem1;
+ XSETBUFFER (XBUFFER_LOCAL_VALUE (valcontents)->buffer, current_buffer);
+ XSETFRAME (XBUFFER_LOCAL_VALUE (valcontents)->frame, selected_frame);
+ store_symval_forwarding (symbol,
+ XBUFFER_LOCAL_VALUE (valcontents)->realvalue,
Fcdr (tem1));
}
- return XBUFFER_LOCAL_VALUE (valcontents)->car;
+ return XBUFFER_LOCAL_VALUE (valcontents)->realvalue;
}
\f
/* Find the value of a symbol, returning Qunbound if it's not bound.
register Lisp_Object valcontents, tem1, current_alist_element;
CHECK_SYMBOL (symbol, 0);
- if (NILP (symbol) || EQ (symbol, Qt))
+ if (NILP (symbol) || EQ (symbol, Qt)
+ || (XSYMBOL (symbol)->name->data[0] == ':'
+ && EQ (XSYMBOL (symbol)->obarray, initial_obarray)
+ && keyword_symbols_constant_flag && ! EQ (newval, symbol)))
return Fsignal (Qsetting_constant, Fcons (symbol, Qnil));
valcontents = XSYMBOL (symbol)->value;
it is examined or set, forwarding must be done. */
/* What value are we caching right now? */
- current_alist_element =
- XCONS (XCONS (XBUFFER_LOCAL_VALUE (valcontents)->cdr)->cdr)->car;
+ current_alist_element
+ = XCONS (XBUFFER_LOCAL_VALUE (valcontents)->cdr)->car;
/* If the current buffer is not the buffer whose binding is
currently cached, or if it's a Lisp_Buffer_Local_Value and
we're looking at the default value, the cache is invalid; we
need to write it out, and find the new CURRENT-ALIST-ELEMENT. */
- if ((current_buffer
- != XBUFFER (XCONS (XBUFFER_LOCAL_VALUE (valcontents)->cdr)->car))
+ if (current_buffer != XBUFFER (XBUFFER_LOCAL_VALUE (valcontents)->buffer)
+ ||
+ selected_frame != XFRAME (XBUFFER_LOCAL_VALUE (valcontents)->frame)
|| (BUFFER_LOCAL_VALUEP (valcontents)
&& EQ (XCONS (current_alist_element)->car,
current_alist_element)))
back to its alist element. This works if the current
buffer only sees the default value, too. */
Fsetcdr (current_alist_element,
- do_symval_forwarding (XBUFFER_LOCAL_VALUE (valcontents)->car));
+ do_symval_forwarding (XBUFFER_LOCAL_VALUE (valcontents)->realvalue));
/* Find the new value for CURRENT-ALIST-ELEMENT. */
tem1 = Fassq (symbol, current_buffer->local_var_alist);
+ XBUFFER_LOCAL_VALUE (valcontents)->found_for_buffer = 1;
+ XBUFFER_LOCAL_VALUE (valcontents)->found_for_frame = 0;
+
if (NILP (tem1))
{
/* This buffer still sees the default value. */
make CURRENT-ALIST-ELEMENT point to itself,
indicating that we're seeing the default value. */
if (bindflag || SOME_BUFFER_LOCAL_VALUEP (valcontents))
- tem1 = XCONS (XBUFFER_LOCAL_VALUE (valcontents)->cdr)->cdr;
+ {
+ XBUFFER_LOCAL_VALUE (valcontents)->found_for_buffer = 0;
+
+ if (XBUFFER_LOCAL_VALUE (valcontents)->check_frame)
+ tem1 = Fassq (symbol, selected_frame->param_alist);
+ if (! NILP (tem1))
+ XBUFFER_LOCAL_VALUE (valcontents)->found_for_frame = 1;
+ else
+ tem1 = XBUFFER_LOCAL_VALUE (valcontents)->cdr;
+ }
/* If it's a Lisp_Buffer_Local_Value, being set not bound,
give this buffer a new assoc for a local value and set
CURRENT-ALIST-ELEMENT to point to that. */
else
{
tem1 = Fcons (symbol, Fcdr (current_alist_element));
- current_buffer->local_var_alist =
- Fcons (tem1, current_buffer->local_var_alist);
+ current_buffer->local_var_alist
+ = Fcons (tem1, current_buffer->local_var_alist);
}
}
+
/* Cache the new buffer's assoc in CURRENT-ALIST-ELEMENT. */
- XCONS (XCONS (XBUFFER_LOCAL_VALUE (valcontents)->cdr)->cdr)->car
+ XCONS (XBUFFER_LOCAL_VALUE (valcontents)->cdr)->car
= tem1;
- /* Set BUFFER, now that CURRENT-ALIST-ELEMENT is accurate. */
- XSETBUFFER (XCONS (XBUFFER_LOCAL_VALUE (valcontents)->cdr)->car,
+ /* Set BUFFER and FRAME for binding now loaded. */
+ XSETBUFFER (XBUFFER_LOCAL_VALUE (valcontents)->buffer,
current_buffer);
+ XSETFRAME (XBUFFER_LOCAL_VALUE (valcontents)->frame,
+ selected_frame);
}
- valcontents = XBUFFER_LOCAL_VALUE (valcontents)->car;
+ valcontents = XBUFFER_LOCAL_VALUE (valcontents)->realvalue;
}
/* If storing void (making the symbol void), forward only through
ordinary setq stores just that slot. So use that. */
Lisp_Object current_alist_element, alist_element_car;
current_alist_element
- = XCONS (XCONS (XBUFFER_LOCAL_VALUE (valcontents)->cdr)->cdr)->car;
+ = XCONS (XBUFFER_LOCAL_VALUE (valcontents)->cdr)->car;
alist_element_car = XCONS (current_alist_element)->car;
if (EQ (alist_element_car, current_alist_element))
- return do_symval_forwarding (XBUFFER_LOCAL_VALUE (valcontents)->car);
+ return do_symval_forwarding (XBUFFER_LOCAL_VALUE (valcontents)->realvalue);
else
- return XCONS (XCONS (XBUFFER_LOCAL_VALUE (valcontents)->cdr)->cdr)->cdr;
+ return XCONS (XBUFFER_LOCAL_VALUE (valcontents)->cdr)->cdr;
}
/* For other variables, get the current value. */
return do_symval_forwarding (valcontents);
return Fset (symbol, value);
/* Store new value into the DEFAULT-VALUE slot */
- XCONS (XCONS (XBUFFER_LOCAL_VALUE (valcontents)->cdr)->cdr)->cdr = value;
+ XCONS (XBUFFER_LOCAL_VALUE (valcontents)->cdr)->cdr = value;
/* If that slot is current, we must set the REALVALUE slot too */
current_alist_element
- = XCONS (XCONS (XBUFFER_LOCAL_VALUE (valcontents)->cdr)->cdr)->car;
+ = XCONS (XBUFFER_LOCAL_VALUE (valcontents)->cdr)->car;
alist_element_buffer = Fcar (current_alist_element);
if (EQ (alist_element_buffer, current_alist_element))
- store_symval_forwarding (symbol, XBUFFER_LOCAL_VALUE (valcontents)->car,
+ store_symval_forwarding (symbol, XBUFFER_LOCAL_VALUE (valcontents)->realvalue,
value);
return value;
XCONS (tem)->car = tem;
newval = allocate_misc ();
XMISCTYPE (newval) = Lisp_Misc_Buffer_Local_Value;
- XBUFFER_LOCAL_VALUE (newval)->car = XSYMBOL (variable)->value;
- XBUFFER_LOCAL_VALUE (newval)->cdr = Fcons (Fcurrent_buffer (), tem);
+ XBUFFER_LOCAL_VALUE (newval)->realvalue = XSYMBOL (variable)->value;
+ XBUFFER_LOCAL_VALUE (newval)->buffer = Fcurrent_buffer ();
+ XBUFFER_LOCAL_VALUE (newval)->frame = Qnil;
+ XBUFFER_LOCAL_VALUE (newval)->found_for_buffer = 1;
+ XBUFFER_LOCAL_VALUE (newval)->found_for_frame = 0;
+ XBUFFER_LOCAL_VALUE (newval)->check_frame = 0;
+ XBUFFER_LOCAL_VALUE (newval)->cdr = tem;
XSYMBOL (variable)->value = newval;
return variable;
}
XCONS (tem)->car = tem;
newval = allocate_misc ();
XMISCTYPE (newval) = Lisp_Misc_Some_Buffer_Local_Value;
- XBUFFER_LOCAL_VALUE (newval)->car = XSYMBOL (variable)->value;
- XBUFFER_LOCAL_VALUE (newval)->cdr = Fcons (Qnil, tem);
+ XBUFFER_LOCAL_VALUE (newval)->realvalue = XSYMBOL (variable)->value;
+ XBUFFER_LOCAL_VALUE (newval)->buffer = Qnil;
+ XBUFFER_LOCAL_VALUE (newval)->frame = Qnil;
+ XBUFFER_LOCAL_VALUE (newval)->found_for_buffer = 0;
+ XBUFFER_LOCAL_VALUE (newval)->found_for_frame = 0;
+ XBUFFER_LOCAL_VALUE (newval)->check_frame = 0;
+ XBUFFER_LOCAL_VALUE (newval)->cdr = tem;
XSYMBOL (variable)->value = newval;
}
/* Make sure this buffer has its own value of symbol */
find_symbol_value (variable);
current_buffer->local_var_alist
- = Fcons (Fcons (variable, XCONS (XCONS (XBUFFER_LOCAL_VALUE (XSYMBOL (variable)->value)->cdr)->cdr)->cdr),
+ = Fcons (Fcons (variable, XCONS (XBUFFER_LOCAL_VALUE (XSYMBOL (variable)->value)->cdr)->cdr),
current_buffer->local_var_alist);
/* Make sure symbol does not think it is set up for this buffer;
valcontents = XSYMBOL (variable)->value;
- pvalbuf = &XCONS (XBUFFER_LOCAL_VALUE (valcontents)->cdr)->car;
+ pvalbuf = &XBUFFER_LOCAL_VALUE (valcontents)->buffer;
if (current_buffer == XBUFFER (*pvalbuf))
*pvalbuf = Qnil;
+ XBUFFER_LOCAL_VALUE (valcontents)->found_for_buffer = 0;
}
}
variable for this buffer immediately. If C code modifies the
variable before we swap in, then that new value will clobber the
default value the next time we swap. */
- valcontents = XBUFFER_LOCAL_VALUE (XSYMBOL (variable)->value)->car;
+ valcontents = XBUFFER_LOCAL_VALUE (XSYMBOL (variable)->value)->realvalue;
if (INTFWDP (valcontents) || BOOLFWDP (valcontents) || OBJFWDP (valcontents))
swap_in_symval_forwarding (variable, XSYMBOL (variable)->value);
{
Lisp_Object *pvalbuf;
valcontents = XSYMBOL (variable)->value;
- pvalbuf = &XCONS (XBUFFER_LOCAL_VALUE (valcontents)->cdr)->car;
+ pvalbuf = &XBUFFER_LOCAL_VALUE (valcontents)->buffer;
if (current_buffer == XBUFFER (*pvalbuf))
{
*pvalbuf = Qnil;
+ XBUFFER_LOCAL_VALUE (valcontents)->found_for_buffer = 0;
find_symbol_value (variable);
}
}
return variable;
}
+/* Lisp functions for creating and removing buffer-local variables. */
+
+DEFUN ("make-variable-frame-local", Fmake_variable_frame_local, Smake_variable_frame_local,
+ 1, 1, "vMake Variable Frame Local: ",
+ "Enable VARIABLE to have frame-local bindings.\n\
+When a frame-local binding exists in the current frame,\n\
+it is in effect whenever the current buffer has no buffer-local binding.\n\
+A frame-local binding is actual a frame parameter value;\n\
+thus, any given frame has a local binding for VARIABLE\n\
+if it has a value for the frame parameter named VARIABLE.\n\
+See `modify-frame-parameters'.")
+ (variable)
+ register Lisp_Object variable;
+{
+ register Lisp_Object tem, valcontents, newval;
+
+ CHECK_SYMBOL (variable, 0);
+
+ valcontents = XSYMBOL (variable)->value;
+ if (EQ (variable, Qnil) || EQ (variable, Qt) || KBOARD_OBJFWDP (valcontents)
+ || BUFFER_OBJFWDP (valcontents))
+ error ("Symbol %s may not be frame-local", XSYMBOL (variable)->name->data);
+
+ if (BUFFER_LOCAL_VALUEP (valcontents)
+ || SOME_BUFFER_LOCAL_VALUEP (valcontents))
+ return variable;
+
+ if (EQ (valcontents, Qunbound))
+ XSYMBOL (variable)->value = Qnil;
+ tem = Fcons (Qnil, Fsymbol_value (variable));
+ XCONS (tem)->car = tem;
+ newval = allocate_misc ();
+ XMISCTYPE (newval) = Lisp_Misc_Some_Buffer_Local_Value;
+ XBUFFER_LOCAL_VALUE (newval)->realvalue = XSYMBOL (variable)->value;
+ XBUFFER_LOCAL_VALUE (newval)->buffer = Qnil;
+ XBUFFER_LOCAL_VALUE (newval)->frame = Qnil;
+ XBUFFER_LOCAL_VALUE (newval)->found_for_buffer = 0;
+ XBUFFER_LOCAL_VALUE (newval)->found_for_frame = 0;
+ XBUFFER_LOCAL_VALUE (newval)->check_frame = 1;
+ XBUFFER_LOCAL_VALUE (newval)->cdr = tem;
+ XSYMBOL (variable)->value = newval;
+ return variable;
+}
+
DEFUN ("local-variable-p", Flocal_variable_p, Slocal_variable_p,
1, 2, 0,
"Non-nil if VARIABLE has a local binding in buffer BUFFER.\n\
idxval_byte = string_char_to_byte (array, idxval);
c = STRING_CHAR (&XSTRING (array)->data[idxval_byte],
- XSTRING (array)->size_byte - idxval_byte);
+ STRING_BYTES (XSTRING (array)) - idxval_byte);
return make_number (c);
}
else if (BOOL_VECTOR_P (array))
p = &XSTRING (array)->data[idxval_byte];
actual_len
- = MULTIBYTE_FORM_LENGTH (p, XSTRING (array)->size_byte - idxval_byte);
+ = MULTIBYTE_FORM_LENGTH (p, STRING_BYTES (XSTRING (array)) - idxval_byte);
new_len = Fchar_bytes (newelt);
if (actual_len != XINT (new_len))
error ("Attempt to change byte length of a string");
CHECK_NUMBER (value, 0);
CHECK_NUMBER (count, 1);
- if (XINT (count) > 0)
+ if (XINT (count) >= BITS_PER_EMACS_INT)
+ XSETINT (val, 0);
+ else if (XINT (count) > 0)
XSETINT (val, XINT (value) << XFASTINT (count));
+ else if (XINT (count) <= -BITS_PER_EMACS_INT)
+ XSETINT (val, XINT (value) < 0 ? -1 : 0);
else
XSETINT (val, XINT (value) >> -XINT (count));
return val;
CHECK_NUMBER (value, 0);
CHECK_NUMBER (count, 1);
- if (XINT (count) > 0)
+ if (XINT (count) >= BITS_PER_EMACS_INT)
+ XSETINT (val, 0);
+ else if (XINT (count) > 0)
XSETINT (val, (EMACS_UINT) XUINT (value) << XFASTINT (count));
+ else if (XINT (count) <= -BITS_PER_EMACS_INT)
+ XSETINT (val, 0);
else
XSETINT (val, (EMACS_UINT) XUINT (value) >> -XINT (count));
return val;
staticpro (&Qchar_table);
staticpro (&Qbool_vector);
+ DEFVAR_BOOL ("keyword-symbols-constant-flag", &keyword_symbols_constant_flag,
+ "Non-nil means it is an error to set a keyword symbol.\n\
+A keyword symbol is a symbol whose name starts with a colon (`:').");
+ keyword_symbols_constant_flag = 1;
+
defsubr (&Seq);
defsubr (&Snull);
defsubr (&Stype_of);
defsubr (&Smake_variable_buffer_local);
defsubr (&Smake_local_variable);
defsubr (&Skill_local_variable);
+ defsubr (&Smake_variable_frame_local);
defsubr (&Slocal_variable_p);
defsubr (&Slocal_variable_if_set_p);
defsubr (&Saref);
Fsignal (Qarith_error, Qnil);
}
+void
init_data ()
{
/* Don't do this if just dumping out.