Commit 94b612ad authored by Stefan Monnier's avatar Stefan Monnier

Try and fix unbind_to when localness of binding has changed

* eval.c (unbind_to): Don't unbind a local binding into the global
binding when the local binding disappeared.  Inversely, don't unbind
a global binding into a newly created local binding.
* data.c (set_internal): Make its `buf' arg into a `where' arg so we
can specify the frame to use, when applicable.  Adjust callers.
parent 15e12598
2010-05-07 Stefan Monnier <monnier@iro.umontreal.ca>
* eval.c (unbind_to): Don't unbind a local binding into the global
binding when the local binding disappeared. Inversely, don't unbind
a global binding into a newly created local binding.
* data.c (set_internal): Make its `buf' arg into a `where' arg so we
can specify the frame to use, when applicable. Adjust callers.
2010-05-07 Vincent Belaïche <vincent.belaiche@gmail.com> 2010-05-07 Vincent Belaïche <vincent.belaiche@gmail.com>
Stefan Monnier <monnier@iro.umontreal.ca> Stefan Monnier <monnier@iro.umontreal.ca>
......
...@@ -604,7 +604,7 @@ If the third argument is incorrect, Emacs may crash. */) ...@@ -604,7 +604,7 @@ If the third argument is incorrect, Emacs may crash. */)
else else
{ {
BEFORE_POTENTIAL_GC (); BEFORE_POTENTIAL_GC ();
set_internal (sym, val, current_buffer, 0); set_internal (sym, val, Qnil, 0);
AFTER_POTENTIAL_GC (); AFTER_POTENTIAL_GC ();
} }
} }
......
...@@ -1156,7 +1156,7 @@ DEFUN ("set", Fset, Sset, 2, 2, 0, ...@@ -1156,7 +1156,7 @@ DEFUN ("set", Fset, Sset, 2, 2, 0,
(symbol, newval) (symbol, newval)
register Lisp_Object symbol, newval; register Lisp_Object symbol, newval;
{ {
set_internal (symbol, newval, current_buffer, 0); set_internal (symbol, newval, Qnil, 0);
return newval; return newval;
} }
...@@ -1196,29 +1196,25 @@ let_shadows_global_binding_p (symbol) ...@@ -1196,29 +1196,25 @@ let_shadows_global_binding_p (symbol)
} }
/* Store the value NEWVAL into SYMBOL. /* Store the value NEWVAL into SYMBOL.
If buffer-locality is an issue, BUF specifies which buffer to use. If buffer/frame-locality is an issue, WHERE specifies which context to use.
(0 stands for the current buffer.) (nil stands for the current buffer/frame).
If BINDFLAG is zero, then if this symbol is supposed to become If BINDFLAG is zero, then if this symbol is supposed to become
local in every buffer where it is set, then we make it local. local in every buffer where it is set, then we make it local.
If BINDFLAG is nonzero, we don't do that. */ If BINDFLAG is nonzero, we don't do that. */
void void
set_internal (symbol, newval, buf, bindflag) set_internal (symbol, newval, where, bindflag)
register Lisp_Object symbol, newval; register Lisp_Object symbol, newval, where;
struct buffer *buf;
int bindflag; int bindflag;
{ {
int voide = EQ (newval, Qunbound); int voide = EQ (newval, Qunbound);
struct Lisp_Symbol *sym; struct Lisp_Symbol *sym;
Lisp_Object tem1; Lisp_Object tem1;
if (buf == 0)
buf = current_buffer;
/* If restoring in a dead buffer, do nothing. */ /* If restoring in a dead buffer, do nothing. */
if (NILP (buf->name)) /* if (BUFFERP (where) && NILP (XBUFFER (where)->name))
return; return; */
CHECK_SYMBOL (symbol); CHECK_SYMBOL (symbol);
if (SYMBOL_CONSTANT_P (symbol)) if (SYMBOL_CONSTANT_P (symbol))
...@@ -1241,15 +1237,19 @@ set_internal (symbol, newval, buf, bindflag) ...@@ -1241,15 +1237,19 @@ set_internal (symbol, newval, buf, bindflag)
case SYMBOL_LOCALIZED: case SYMBOL_LOCALIZED:
{ {
struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (sym); struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (sym);
Lisp_Object tmp; XSETBUFFER (tmp, buf); if (NILP (where))
{
if (blv->frame_local)
where = selected_frame;
else
XSETBUFFER (where, current_buffer);
}
/* If the current buffer is not the buffer whose binding is /* If the current buffer is not the buffer whose binding is
loaded, or if there may be frame-local bindings and the frame loaded, or if there may be frame-local bindings and the frame
isn't the right one, or if it's a Lisp_Buffer_Local_Value and isn't the right one, or if it's a Lisp_Buffer_Local_Value and
the default binding is loaded, the loaded binding may be the the default binding is loaded, the loaded binding may be the
wrong one. */ wrong one. */
if (!EQ (blv->where, if (!EQ (blv->where, where)
blv->frame_local ? selected_frame : tmp)
/* Also unload a global binding (if the var is local_if_set). */ /* Also unload a global binding (if the var is local_if_set). */
|| (EQ (blv->valcell, blv->defcell))) || (EQ (blv->valcell, blv->defcell)))
{ {
...@@ -1261,19 +1261,12 @@ set_internal (symbol, newval, buf, bindflag) ...@@ -1261,19 +1261,12 @@ set_internal (symbol, newval, buf, bindflag)
SET_BLV_VALUE (blv, do_symval_forwarding (blv->fwd)); SET_BLV_VALUE (blv, do_symval_forwarding (blv->fwd));
/* Find the new binding. */ /* Find the new binding. */
{ XSETSYMBOL (symbol, sym); /* May have changed via aliasing. */
XSETSYMBOL (symbol, sym); /* May have changed via aliasing. */ tem1 = Fassq (symbol,
if (blv->frame_local) (blv->frame_local
{ ? XFRAME (where)->param_alist
tem1 = Fassq (symbol, XFRAME (selected_frame)->param_alist); : XBUFFER (where)->local_var_alist));
blv->where = selected_frame; blv->where = where;
}
else
{
tem1 = Fassq (symbol, buf->local_var_alist);
blv->where = tmp;
}
}
blv->found = 1; blv->found = 1;
if (NILP (tem1)) if (NILP (tem1))
...@@ -1303,8 +1296,8 @@ set_internal (symbol, newval, buf, bindflag) ...@@ -1303,8 +1296,8 @@ set_internal (symbol, newval, buf, bindflag)
bindings, not for frame-local bindings. */ bindings, not for frame-local bindings. */
eassert (!blv->frame_local); eassert (!blv->frame_local);
tem1 = Fcons (symbol, XCDR (blv->defcell)); tem1 = Fcons (symbol, XCDR (blv->defcell));
buf->local_var_alist XBUFFER (where)->local_var_alist
= Fcons (tem1, buf->local_var_alist); = Fcons (tem1, XBUFFER (where)->local_var_alist);
} }
} }
...@@ -1322,12 +1315,16 @@ set_internal (symbol, newval, buf, bindflag) ...@@ -1322,12 +1315,16 @@ set_internal (symbol, newval, buf, bindflag)
buffer-local indicator, not through Lisp_Objfwd, etc. */ buffer-local indicator, not through Lisp_Objfwd, etc. */
blv->fwd = NULL; blv->fwd = NULL;
else else
store_symval_forwarding (blv->fwd, newval, buf); store_symval_forwarding (blv->fwd, newval,
BUFFERP (where)
? XBUFFER (where) : current_buffer);
} }
break; break;
} }
case SYMBOL_FORWARDED: case SYMBOL_FORWARDED:
{ {
struct buffer *buf
= BUFFERP (where) ? XBUFFER (where) : current_buffer;
union Lisp_Fwd *innercontents = SYMBOL_FWD (sym); union Lisp_Fwd *innercontents = SYMBOL_FWD (sym);
if (BUFFER_OBJFWDP (innercontents)) if (BUFFER_OBJFWDP (innercontents))
{ {
......
...@@ -26,6 +26,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ ...@@ -26,6 +26,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "commands.h" #include "commands.h"
#include "keyboard.h" #include "keyboard.h"
#include "dispextern.h" #include "dispextern.h"
#include "frame.h" /* For XFRAME. */
#if HAVE_X_WINDOWS #if HAVE_X_WINDOWS
#include "xterm.h" #include "xterm.h"
...@@ -786,7 +787,7 @@ The return value is BASE-VARIABLE. */) ...@@ -786,7 +787,7 @@ The return value is BASE-VARIABLE. */)
so that old-code that affects n_a before the aliasing is setup so that old-code that affects n_a before the aliasing is setup
still works. */ still works. */
if (NILP (Fboundp (base_variable))) if (NILP (Fboundp (base_variable)))
set_internal (base_variable, find_symbol_value (new_alias), NULL, 1); set_internal (base_variable, find_symbol_value (new_alias), Qnil, 1);
{ {
struct specbinding *p; struct specbinding *p;
...@@ -3335,7 +3336,7 @@ specbind (symbol, value) ...@@ -3335,7 +3336,7 @@ specbind (symbol, value)
if (!sym->constant) if (!sym->constant)
SET_SYMBOL_VAL (sym, value); SET_SYMBOL_VAL (sym, value);
else else
set_internal (symbol, value, 0, 1); set_internal (symbol, value, Qnil, 1);
break; break;
} }
case SYMBOL_LOCALIZED: case SYMBOL_FORWARDED: case SYMBOL_LOCALIZED: case SYMBOL_FORWARDED:
...@@ -3395,7 +3396,7 @@ specbind (symbol, value) ...@@ -3395,7 +3396,7 @@ specbind (symbol, value)
specpdl_ptr->symbol = symbol; specpdl_ptr->symbol = symbol;
specpdl_ptr++; specpdl_ptr++;
set_internal (symbol, value, 0, 1); set_internal (symbol, value, Qnil, 1);
break; break;
} }
default: abort (); default: abort ();
...@@ -3457,27 +3458,26 @@ unbind_to (count, value) ...@@ -3457,27 +3458,26 @@ unbind_to (count, value)
if (NILP (where)) if (NILP (where))
Fset_default (symbol, this_binding.old_value); Fset_default (symbol, this_binding.old_value);
/* If `where' is non-nil, reset the value in the appropriate
local binding, but only if that binding still exists. */
else if (BUFFERP (where)) else if (BUFFERP (where))
if (!NILP (Flocal_variable_p (symbol, where))) {
set_internal (symbol, this_binding.old_value, XBUFFER (where), 1); if (BUFFERP (where)
/* else if (!NILP (Fbuffer_live_p (where))) ? !NILP (Flocal_variable_p (symbol, where))
error ("Unbinding local %s to global!", symbol); */ : !NILP (Fassq (symbol, XFRAME (where)->param_alist)))
else set_internal (symbol, this_binding.old_value, where, 1);
; }
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. */
else if (XSYMBOL (this_binding.symbol)->redirect == SYMBOL_PLAINVAL)
SET_SYMBOL_VAL (XSYMBOL (this_binding.symbol),
this_binding.old_value);
else else
{ /* NOTE: we only ever come here if make_local_foo was used for
/* If variable has a trivial value (no forwarding), we can the first time on this var within this let. */
just set it. No need to check for constant symbols here, Fset_default (this_binding.symbol, this_binding.old_value);
since that was already done by specbind. */
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);
}
} }
if (NILP (Vquit_flag) && !NILP (quitf)) if (NILP (Vquit_flag) && !NILP (quitf))
......
...@@ -2381,7 +2381,7 @@ extern void args_out_of_range_3 P_ ((Lisp_Object, Lisp_Object, ...@@ -2381,7 +2381,7 @@ extern void args_out_of_range_3 P_ ((Lisp_Object, Lisp_Object,
Lisp_Object)) NO_RETURN; Lisp_Object)) NO_RETURN;
extern Lisp_Object wrong_type_argument P_ ((Lisp_Object, Lisp_Object)) NO_RETURN; extern Lisp_Object wrong_type_argument P_ ((Lisp_Object, Lisp_Object)) NO_RETURN;
extern Lisp_Object do_symval_forwarding (union Lisp_Fwd *); extern Lisp_Object do_symval_forwarding (union Lisp_Fwd *);
extern void set_internal (Lisp_Object, Lisp_Object, struct buffer *, int); extern void set_internal (Lisp_Object, Lisp_Object, Lisp_Object, int);
extern void syms_of_data P_ ((void)); extern void syms_of_data P_ ((void));
extern void init_data P_ ((void)); extern void init_data P_ ((void));
extern void swap_in_global_binding P_ ((struct Lisp_Symbol *)); extern void swap_in_global_binding P_ ((struct Lisp_Symbol *));
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment