/* Evaluator for GNU Emacs Lisp interpreter.
Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995, 1999, 2000, 2001,
- 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009
+ 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
Free Software Foundation, Inc.
This file is part of GNU Emacs.
CHECK_SYMBOL (new_alias);
CHECK_SYMBOL (base_variable);
- if (SYMBOL_CONSTANT_P (new_alias))
- error ("Cannot make a constant an alias");
-
sym = XSYMBOL (new_alias);
+
+ if (sym->constant)
+ if (sym->redirect == SYMBOL_VARALIAS)
+ sym->constant = 0; /* Reset. */
+ else
+ /* Not sure why. */
+ error ("Cannot make a constant an alias");
+
+ switch (sym->redirect)
+ {
+ case SYMBOL_FORWARDED:
+ error ("Cannot make an internal variable an alias");
+ case SYMBOL_LOCALIZED:
+ error ("Don't know how to make a localized variable an alias");
+ }
+
/* http://lists.gnu.org/archive/html/emacs-devel/2008-04/msg00834.html
- If n_a is bound, but b_v is not, set the value of b_v to n_a.
- This is for the sake of define-obsolete-variable-alias and user
- customizations. */
- if (NILP (Fboundp (base_variable)) && !NILP (Fboundp (new_alias)))
- XSYMBOL(base_variable)->value = sym->value;
- sym->indirect_variable = 1;
- sym->value = base_variable;
+ If n_a is bound, but b_v is not, set the value of b_v to n_a,
+ so that old-code that affects n_a before the aliasing is setup
+ still works. */
+ if (NILP (Fboundp (base_variable)))
+ set_internal (base_variable, find_symbol_value (new_alias), NULL, 1);
+
+ {
+ struct specbinding *p;
+
+ for (p = specpdl_ptr - 1; p >= specpdl; p--)
+ if (p->func == NULL
+ && (EQ (new_alias,
+ CONSP (p->symbol) ? XCAR (p->symbol) : p->symbol)))
+ error ("Don't know how to make a let-bound variable an alias");
+ }
+
+ sym->redirect = SYMBOL_VARALIAS;
+ SET_SYMBOL_ALIAS (sym, XSYMBOL (base_variable));
sym->constant = SYMBOL_CONSTANT_P (base_variable);
LOADHIST_ATTACH (new_alias);
- if (!NILP (docstring))
- Fput (new_alias, Qvariable_documentation, docstring);
- else
- Fput (new_alias, Qvariable_documentation, Qnil);
+ /* Even if docstring is nil: remove old docstring. */
+ Fput (new_alias, Qvariable_documentation, docstring);
return base_variable;
}
return Qnil;
/* If indirect and there's an alias loop, don't check anything else. */
- if (XSYMBOL (variable)->indirect_variable
+ if (XSYMBOL (variable)->redirect == SYMBOL_VARALIAS
&& NILP (internal_condition_case_1 (lisp_indirect_variable, variable,
Qt, user_variable_p_eh)))
return Qnil;
|| (!NILP (Fget (variable, intern ("custom-autoload")))))
return Qt;
- if (!XSYMBOL (variable)->indirect_variable)
+ if (!(XSYMBOL (variable)->redirect == SYMBOL_VARALIAS))
return Qnil;
/* An indirect variable? Let's follow the chain. */
- variable = XSYMBOL (variable)->value;
+ XSETSYMBOL (variable, SYMBOL_ALIAS (XSYMBOL (variable)));
}
}
\f
/* Only add entries after dumping, because the ones before are
not useful and else we get loads of them from the loaddefs.el. */
LOADHIST_ATTACH (Fcons (Qautoload, function));
-
- if (NILP (Vpurify_flag))
- args[0] = file;
else
- args[0] = Fpurecopy (file);
- args[1] = docstring;
- args[2] = interactive;
- args[3] = type;
-
- return Ffset (function, Fcons (Qautoload, Flist (4, &args[0])));
+ /* We don't want the docstring in purespace (instead,
+ Snarf-documentation should (hopefully) overwrite it). */
+ docstring = make_number (0);
+ return Ffset (function,
+ Fpurecopy (list5 (Qautoload, file, docstring,
+ interactive, type)));
}
Lisp_Object
enum run_hooks_condition cond;
{
Lisp_Object sym, val, ret;
- Lisp_Object globals;
struct gcpro gcpro1, gcpro2, gcpro3;
/* If we are dying or still initializing,
}
else
{
- globals = Qnil;
+ Lisp_Object globals = Qnil;
GCPRO3 (sym, val, globals);
for (;
{
/* t indicates this hook has a local binding;
it means to run the global binding too. */
+ globals = Fdefault_value (sym);
+ if (NILP (globals)) continue;
- for (globals = Fdefault_value (sym);
- CONSP (globals) && ((cond == to_completion)
- || (cond == until_success ? NILP (ret)
- : !NILP (ret)));
- globals = XCDR (globals))
+ if (!CONSP (globals) || EQ (XCAR (globals), Qlambda))
{
- args[0] = XCAR (globals);
- /* In a global value, t should not occur. If it does, we
- must ignore it to avoid an endless loop. */
- if (!EQ (args[0], Qt))
- ret = Ffuncall (nargs, args);
+ args[0] = globals;
+ ret = Ffuncall (nargs, args);
+ }
+ else
+ {
+ for (;
+ CONSP (globals) && ((cond == to_completion)
+ || (cond == until_success ? NILP (ret)
+ : !NILP (ret)));
+ globals = XCDR (globals))
+ {
+ args[0] = XCAR (globals);
+ /* In a global value, t should not occur. If it does, we
+ must ignore it to avoid an endless loop. */
+ if (!EQ (args[0], Qt))
+ ret = Ffuncall (nargs, args);
+ }
}
}
else
specbind (symbol, value)
Lisp_Object symbol, value;
{
- Lisp_Object valcontents;
+ struct Lisp_Symbol *sym;
+
+ eassert (!handling_signal);
CHECK_SYMBOL (symbol);
+ sym = XSYMBOL (symbol);
if (specpdl_ptr == specpdl + specpdl_size)
grow_specpdl ();
- /* The most common case is that of a non-constant symbol with a
- trivial value. Make that as fast as we can. */
- valcontents = SYMBOL_VALUE (symbol);
- if (!MISCP (valcontents) && !SYMBOL_CONSTANT_P (symbol))
- {
- specpdl_ptr->symbol = symbol;
- specpdl_ptr->old_value = valcontents;
- specpdl_ptr->func = NULL;
- ++specpdl_ptr;
- SET_SYMBOL_VALUE (symbol, value);
- }
- else
- {
- Lisp_Object ovalue = find_symbol_value (symbol);
- specpdl_ptr->func = 0;
- specpdl_ptr->old_value = ovalue;
-
- valcontents = XSYMBOL (symbol)->value;
-
- if (BUFFER_LOCAL_VALUEP (valcontents)
- || BUFFER_OBJFWDP (valcontents))
- {
- Lisp_Object where, current_buffer;
-
- current_buffer = Fcurrent_buffer ();
-
- /* For a local variable, record both the symbol and which
- buffer's or frame's value we are saving. */
- if (!NILP (Flocal_variable_p (symbol, Qnil)))
- where = current_buffer;
- else if (BUFFER_LOCAL_VALUEP (valcontents)
- && XBUFFER_LOCAL_VALUE (valcontents)->found_for_frame)
- where = XBUFFER_LOCAL_VALUE (valcontents)->frame;
+ start:
+ switch (sym->redirect)
+ {
+ case SYMBOL_VARALIAS:
+ sym = indirect_variable (sym); XSETSYMBOL (symbol, sym); goto start;
+ case SYMBOL_PLAINVAL:
+ { /* The most common case is that of a non-constant symbol with a
+ trivial value. Make that as fast as we can. */
+ specpdl_ptr->symbol = symbol;
+ specpdl_ptr->old_value = SYMBOL_VAL (sym);
+ specpdl_ptr->func = NULL;
+ ++specpdl_ptr;
+ if (!sym->constant)
+ SET_SYMBOL_VAL (sym, value);
else
- where = Qnil;
-
- /* We're not using the `unused' slot in the specbinding
- structure because this would mean we have to do more
- work for simple variables. */
- specpdl_ptr->symbol = Fcons (symbol, Fcons (where, current_buffer));
-
- /* If SYMBOL is a per-buffer variable which doesn't have a
- buffer-local value here, make the `let' change the global
- value by changing the value of SYMBOL in all buffers not
- having their own value. This is consistent with what
- happens with other buffer-local variables. */
- if (NILP (where)
- && BUFFER_OBJFWDP (valcontents))
- {
- ++specpdl_ptr;
- Fset_default (symbol, value);
- return;
- }
+ set_internal (symbol, value, 0, 1);
+ break;
}
- else
- specpdl_ptr->symbol = symbol;
-
- specpdl_ptr++;
- /* We used to do
- if (BUFFER_OBJFWDP (ovalue) || KBOARD_OBJFWDP (ovalue))
- store_symval_forwarding (symbol, ovalue, value, NULL);
- else
- but ovalue comes from find_symbol_value which should never return
- such an internal value. */
- eassert (!(BUFFER_OBJFWDP (ovalue) || KBOARD_OBJFWDP (ovalue)));
- set_internal (symbol, value, 0, 1);
+ case SYMBOL_LOCALIZED: case SYMBOL_FORWARDED:
+ {
+ Lisp_Object ovalue = find_symbol_value (symbol);
+ specpdl_ptr->func = 0;
+ specpdl_ptr->old_value = ovalue;
+
+ eassert (sym->redirect != SYMBOL_LOCALIZED
+ || (EQ (SYMBOL_BLV (sym)->where,
+ SYMBOL_BLV (sym)->frame_local ?
+ Fselected_frame () : Fcurrent_buffer ())));
+
+ if (sym->redirect == SYMBOL_LOCALIZED
+ || BUFFER_OBJFWDP (SYMBOL_FWD (sym)))
+ {
+ Lisp_Object where, cur_buf = Fcurrent_buffer ();
+
+ /* For a local variable, record both the symbol and which
+ buffer's or frame's value we are saving. */
+ if (!NILP (Flocal_variable_p (symbol, Qnil)))
+ {
+ eassert (sym->redirect != SYMBOL_LOCALIZED
+ || (BLV_FOUND (SYMBOL_BLV (sym))
+ && EQ (cur_buf, SYMBOL_BLV (sym)->where)));
+ where = cur_buf;
+ }
+ else if (sym->redirect == SYMBOL_LOCALIZED
+ && BLV_FOUND (SYMBOL_BLV (sym)))
+ where = SYMBOL_BLV (sym)->where;
+ else
+ where = Qnil;
+
+ /* We're not using the `unused' slot in the specbinding
+ structure because this would mean we have to do more
+ work for simple variables. */
+ /* FIXME: The third value `current_buffer' is only used in
+ let_shadows_buffer_binding_p which is itself only used
+ in set_internal for local_if_set. */
+ specpdl_ptr->symbol = Fcons (symbol, Fcons (where, cur_buf));
+
+ /* If SYMBOL is a per-buffer variable which doesn't have a
+ buffer-local value here, make the `let' change the global
+ value by changing the value of SYMBOL in all buffers not
+ having their own value. This is consistent with what
+ happens with other buffer-local variables. */
+ if (NILP (where)
+ && sym->redirect == SYMBOL_FORWARDED)
+ {
+ eassert (BUFFER_OBJFWDP (SYMBOL_FWD (sym)));
+ ++specpdl_ptr;
+ Fset_default (symbol, value);
+ return;
+ }
+ }
+ else
+ specpdl_ptr->symbol = symbol;
+
+ specpdl_ptr++;
+ set_internal (symbol, value, 0, 1);
+ break;
+ }
+ default: abort ();
}
}
if (NILP (where))
Fset_default (symbol, this_binding.old_value);
else if (BUFFERP (where))
- set_internal (symbol, this_binding.old_value, XBUFFER (where), 1);
+ if (!NILP (Flocal_variable_p (symbol, where)))
+ set_internal (symbol, this_binding.old_value, XBUFFER (where), 1);
+ /* else if (!NILP (Fbuffer_live_p (where)))
+ error ("Unbinding local %s to global!", symbol); */
+ else
+ ;
else
set_internal (symbol, this_binding.old_value, NULL, 1);
}
/* If variable has a trivial value (no forwarding), we can
just set it. No need to check for constant symbols here,
since that was already done by specbind. */
- if (!MISCP (SYMBOL_VALUE (this_binding.symbol)))
- SET_SYMBOL_VALUE (this_binding.symbol, this_binding.old_value);
+ if (XSYMBOL (this_binding.symbol)->redirect == SYMBOL_PLAINVAL)
+ SET_SYMBOL_VAL (XSYMBOL (this_binding.symbol),
+ this_binding.old_value);
else
set_internal (this_binding.symbol, this_binding.old_value, 0, 1);
}
before making `inhibit-quit' nil. */);
Vinhibit_quit = Qnil;
- Qinhibit_quit = intern ("inhibit-quit");
+ Qinhibit_quit = intern_c_string ("inhibit-quit");
staticpro (&Qinhibit_quit);
- Qautoload = intern ("autoload");
+ Qautoload = intern_c_string ("autoload");
staticpro (&Qautoload);
- Qdebug_on_error = intern ("debug-on-error");
+ Qdebug_on_error = intern_c_string ("debug-on-error");
staticpro (&Qdebug_on_error);
- Qmacro = intern ("macro");
+ Qmacro = intern_c_string ("macro");
staticpro (&Qmacro);
- Qdeclare = intern ("declare");
+ Qdeclare = intern_c_string ("declare");
staticpro (&Qdeclare);
/* Note that the process handling also uses Qexit, but we don't want
to staticpro it twice, so we just do it here. */
- Qexit = intern ("exit");
+ Qexit = intern_c_string ("exit");
staticpro (&Qexit);
- Qinteractive = intern ("interactive");
+ Qinteractive = intern_c_string ("interactive");
staticpro (&Qinteractive);
- Qcommandp = intern ("commandp");
+ Qcommandp = intern_c_string ("commandp");
staticpro (&Qcommandp);
- Qdefun = intern ("defun");
+ Qdefun = intern_c_string ("defun");
staticpro (&Qdefun);
- Qand_rest = intern ("&rest");
+ Qand_rest = intern_c_string ("&rest");
staticpro (&Qand_rest);
- Qand_optional = intern ("&optional");
+ Qand_optional = intern_c_string ("&optional");
staticpro (&Qand_optional);
- Qdebug = intern ("debug");
+ Qdebug = intern_c_string ("debug");
staticpro (&Qdebug);
DEFVAR_LISP ("stack-trace-on-error", &Vstack_trace_on_error,
The value the function returns is not used. */);
Vmacro_declaration_function = Qnil;
- Vrun_hooks = intern ("run-hooks");
+ Vrun_hooks = intern_c_string ("run-hooks");
staticpro (&Vrun_hooks);
staticpro (&Vautoload_queue);
HCoop / bpt / emacs.git / blobdiff