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.

diff --git a/src/ChangeLog b/src/ChangeLog
index be8a95ee26ca8efac164330e2a2b5ab69c22f7fe..02659063c755895964d4b50097a1b2eaa35cf7eb 100644 (file)
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,11 @@
+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>
             Stefan Monnier  <monnier@iro.umontreal.ca>
 

diff --git a/src/bytecode.c b/src/bytecode.c
index c59f75dc78ebf3f685bad2716b35d7ef80596ccc..c53c5acdbb3be505a9cb6292a51887dd07c58100 100644 (file)
--- a/src/bytecode.c
+++ b/src/bytecode.c
@@ -604,7 +604,7 @@ If the third argument is incorrect, Emacs may crash.  */)
            else
              {
                BEFORE_POTENTIAL_GC ();
-               set_internal (sym, val, current_buffer, 0);
+               set_internal (sym, val, Qnil, 0);
                AFTER_POTENTIAL_GC ();
              }
          }

diff --git a/src/data.c b/src/data.c
index e9f2dea522b1eac52908a0324ac8dbfcf21382b4..2d71434cc763bddabedfb766cba8b522378c836f 100644 (file)
--- a/src/data.c
+++ b/src/data.c
@@ -1156,7 +1156,7 @@ DEFUN ("set", Fset, Sset, 2, 2, 0,
      (symbol, newval)
      register Lisp_Object symbol, newval;
 {
-  set_internal (symbol, newval, current_buffer, 0);
+  set_internal (symbol, newval, Qnil, 0);
   return newval;
 }
 
@@ -1196,29 +1196,25 @@ let_shadows_global_binding_p (symbol)
 }
 
 /* Store the value NEWVAL into SYMBOL.
-   If buffer-locality is an issue, BUF specifies which buffer to use.
-   (0 stands for the current buffer.)
+   If buffer/frame-locality is an issue, WHERE specifies which context to use.
+   (nil stands for the current buffer/frame).
 
    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.
    If BINDFLAG is nonzero, we don't do that.  */
 
 void
-set_internal (symbol, newval, buf, bindflag)
-     register Lisp_Object symbol, newval;
-     struct buffer *buf;
+set_internal (symbol, newval, where, bindflag)
+     register Lisp_Object symbol, newval, where;
      int bindflag;
 {
   int voide = EQ (newval, Qunbound);
   struct Lisp_Symbol *sym;
   Lisp_Object tem1;
 
-  if (buf == 0)
-    buf = current_buffer;
-
   /* If restoring in a dead buffer, do nothing.  */
-  if (NILP (buf->name))
-    return;
+  /* if (BUFFERP (where) && NILP (XBUFFER (where)->name))
+      return; */
 
   CHECK_SYMBOL (symbol);
   if (SYMBOL_CONSTANT_P (symbol))
@@ -1241,15 +1237,19 @@ set_internal (symbol, newval, buf, bindflag)
     case SYMBOL_LOCALIZED:
       {
        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
           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
           the default binding is loaded, the loaded binding may be the
           wrong one.  */
-       if (!EQ (blv->where,
-                blv->frame_local ? selected_frame : tmp)
+       if (!EQ (blv->where, where)
            /* Also unload a global binding (if the var is local_if_set). */
            || (EQ (blv->valcell, blv->defcell)))
          {
@@ -1261,19 +1261,12 @@ set_internal (symbol, newval, buf, bindflag)
              SET_BLV_VALUE (blv, do_symval_forwarding (blv->fwd));
 
            /* Find the new binding.  */
-           {
-             XSETSYMBOL (symbol, sym); /* May have changed via aliasing.  */
-             if (blv->frame_local)
-               {
-                 tem1 = Fassq (symbol, XFRAME (selected_frame)->param_alist);
-                 blv->where = selected_frame;
-               }
-             else
-               {
-                 tem1 = Fassq (symbol, buf->local_var_alist);
-                 blv->where = tmp;
-               }
-           }
+           XSETSYMBOL (symbol, sym); /* May have changed via aliasing.  */
+           tem1 = Fassq (symbol,
+                         (blv->frame_local
+                          ? XFRAME (where)->param_alist
+                          : XBUFFER (where)->local_var_alist));
+           blv->where = where;
            blv->found = 1;
 
            if (NILP (tem1))
@@ -1303,8 +1296,8 @@ set_internal (symbol, newval, buf, bindflag)
                       bindings, not for frame-local bindings.  */
                    eassert (!blv->frame_local);
                    tem1 = Fcons (symbol, XCDR (blv->defcell));
-                   buf->local_var_alist
-                     = Fcons (tem1, buf->local_var_alist);
+                   XBUFFER (where)->local_var_alist
+                     = Fcons (tem1, XBUFFER (where)->local_var_alist);
                  }
              }
 
@@ -1322,12 +1315,16 @@ set_internal (symbol, newval, buf, bindflag)
                 buffer-local indicator, not through Lisp_Objfwd, etc.  */
              blv->fwd = NULL;
            else
-             store_symval_forwarding (blv->fwd, newval, buf);
+             store_symval_forwarding (blv->fwd, newval,
+                                      BUFFERP (where)
+                                      ? XBUFFER (where) : current_buffer);
          }
        break;
       }
     case SYMBOL_FORWARDED:
       {
+       struct buffer *buf
+         = BUFFERP (where) ? XBUFFER (where) : current_buffer;
        union Lisp_Fwd *innercontents = SYMBOL_FWD (sym);
        if (BUFFER_OBJFWDP (innercontents))
          {

diff --git a/src/eval.c b/src/eval.c
index 6d0a844a31ee1b5972d5f96c42b551a11e4543f8..2a0330acc389e7c58dd842cc4c91ebc0458c111e 100644 (file)
--- a/src/eval.c
+++ b/src/eval.c
@@ -26,6 +26,7 @@ along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
 #include "commands.h"
 #include "keyboard.h"
 #include "dispextern.h"
+#include "frame.h"             /* For XFRAME.  */
 
 #if HAVE_X_WINDOWS
 #include "xterm.h"
@@ -786,7 +787,7 @@ The return value is BASE-VARIABLE.  */)
      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);
+    set_internal (base_variable, find_symbol_value (new_alias), Qnil, 1);
 
   {
     struct specbinding *p;
@@ -3335,7 +3336,7 @@ specbind (symbol, value)
          if (!sym->constant)
            SET_SYMBOL_VAL (sym, value);
          else
-           set_internal (symbol, value, 0, 1);
+           set_internal (symbol, value, Qnil, 1);
          break;
        }
     case SYMBOL_LOCALIZED: case SYMBOL_FORWARDED:
@@ -3395,7 +3396,7 @@ specbind (symbol, value)
          specpdl_ptr->symbol = symbol;
 
        specpdl_ptr++;
-       set_internal (symbol, value, 0, 1);
+       set_internal (symbol, value, Qnil, 1);
        break;
       }
     default: abort ();
@@ -3457,27 +3458,26 @@ unbind_to (count, value)
 
          if (NILP (where))
            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))
-           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 (BUFFERP (where)
+                 ? !NILP (Flocal_variable_p (symbol, where))
+                 : !NILP (Fassq (symbol, XFRAME (where)->param_alist)))
+               set_internal (symbol, this_binding.old_value, where, 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
-       {
-         /* 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 (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);
-       }
+       /* NOTE: we only ever come here if make_local_foo was used for
+          the first time on this var within this let.  */
+       Fset_default (this_binding.symbol, this_binding.old_value);
     }
 
   if (NILP (Vquit_flag) && !NILP (quitf))

diff --git a/src/lisp.h b/src/lisp.h
index d9d15c9245dc20f7f2a93d526197ac903abcb2ba..5b59c3e9a348bfe42ab472ca83c1f806096ab93c 100644 (file)
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -2381,7 +2381,7 @@ extern void args_out_of_range_3 P_ ((Lisp_Object, 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 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 init_data P_ ((void));
 extern void swap_in_global_binding P_ ((struct Lisp_Symbol *));