Restore specbound keyboard-locals in the correct KBOARD

* doc/lispref/variables.texi (Intro to Buffer-Local): Fix typo
in documentation.

* src/data.c (KBOARD_OBJFWDP): Move to lisp.h.
(kboard_for_bindings): New variable.
(do_symval_forwarding, store_symval_forwarding): Call
kboard_for_bindings rather than retrieving this value directly.
(set_default_internal): New argument WHERE; if valcontents be a
Lisp_Kboard_Objfwd and WHERE be specified, save the binding
there.  All callers changed.

* src/eval.c (specpdl_where): Adjust for changes in structure
layout.
(specpdl_kboard): New function.
(do_specbind): Clear let->where.kbd in ordinary SPECPDL_LETs,
and set it to the kboard where the binding will be installed if
binding keyboard forwards.
(specbind, do_one_unbind, specpdl_unrewind): Provide
specpdl_kboard in invocation of set_default_internal.

* src/keyboard.c (delete_kboard): Clean thread specpdls of
references to kboards.

* src/keyboard.h (KBOARD_OBJFWDP): Move from data.c.

* src/lisp.h (union specbinding) <let.where>: Convert into
union of KBOARD and Lisp_Object.

* src/thread.c (all_threads): Export.

* src/thread.h: Adjust correspondingly.

(cherry picked from commit 64cced2c37a9926fe6ff1c6ad9b9540abd47e21c)

diff --git a/doc/lispref/variables.texi b/doc/lispref/variables.texi
index 16b6b52e5f176f42da916dc5ebef447f27fa8580..e05d3bb0f8116b0b005f963c0e29ab3df04f216c 100644 (file)
--- a/doc/lispref/variables.texi
+++ b/doc/lispref/variables.texi
@@ -1523,7 +1523,7 @@ buffer-local binding of buffer @samp{b}.
 values when you visit the file.  @xref{File Variables,,, emacs, The
 GNU Emacs Manual}.
 
-  A buffer-local variable cannot be made terminal-local
+  A terminal-local variable cannot be made buffer-local
 (@pxref{Multiple Terminals}).
 
 @node Creating Buffer-Local

diff --git a/src/data.c b/src/data.c
index 30d8eab7359591b98b3f9a6b56efdaffdaa61a6d..be7ae023d8d2c4af26dc8217501e17cf6fcef390 100644 (file)
--- a/src/data.c
+++ b/src/data.c
@@ -49,11 +49,6 @@ INTFWDP (lispfwd a)
   return XFWDTYPE (a) == Lisp_Fwd_Int;
 }
 static bool
-KBOARD_OBJFWDP (lispfwd a)
-{
-  return XFWDTYPE (a) == Lisp_Fwd_Kboard_Obj;
-}
-static bool
 OBJFWDP (lispfwd a)
 {
   return XFWDTYPE (a) == Lisp_Fwd_Obj;
@@ -1304,6 +1299,26 @@ If OBJECT is not a symbol, just return it.  */)
   return object;
 }
 
+/* Return the KBOARD to which bindings currently established and values
+   set should apply.  */
+
+KBOARD *
+kboard_for_bindings (void)
+{
+  /* We used to simply use current_kboard here, but from Lisp code, its
+     value is often unexpected.  It seems nicer to allow constructions
+     like this to work as intuitively expected:
+
+     (with-selected-frame frame
+     (define-key local-function-map "\eOP" [f1]))
+
+     On the other hand, this affects the semantics of last-command and
+     real-last-command, and people may rely on that.  I took a quick
+     look at the Lisp codebase, and I don't think anything will break.
+     --lorentey */
+
+  return FRAME_KBOARD (SELECTED_FRAME ());
+}
 
 /* Given the raw contents of a symbol value cell,
    return the Lisp value of the symbol.
@@ -1329,19 +1344,8 @@ do_symval_forwarding (lispfwd valcontents)
                               XBUFFER_OBJFWD (valcontents)->offset);
 
     case Lisp_Fwd_Kboard_Obj:
-      /* We used to simply use current_kboard here, but from Lisp
-        code, its value is often unexpected.  It seems nicer to
-        allow constructions like this to work as intuitively expected:
-
-        (with-selected-frame frame
-        (define-key local-function-map "\eOP" [f1]))
-
-        On the other hand, this affects the semantics of
-        last-command and real-last-command, and people may rely on
-        that.  I took a quick look at the Lisp codebase, and I
-        don't think anything will break.  --lorentey  */
-      return *(Lisp_Object *)(XKBOARD_OBJFWD (valcontents)->offset
-                             + (char *)FRAME_KBOARD (SELECTED_FRAME ()));
+      return *(Lisp_Object *) (XKBOARD_OBJFWD (valcontents)->offset
+                              + (char *) kboard_for_bindings ());
     default: emacs_abort ();
     }
 }
@@ -1489,7 +1493,7 @@ store_symval_forwarding (lispfwd valcontents, Lisp_Object newval,
 
     case Lisp_Fwd_Kboard_Obj:
       {
-       char *base = (char *) FRAME_KBOARD (SELECTED_FRAME ());
+       char *base = (char *) kboard_for_bindings ();
        char *p = base + XKBOARD_OBJFWD (valcontents)->offset;
        *(Lisp_Object *) p = newval;
       }
@@ -1768,7 +1772,8 @@ set_internal (Lisp_Object symbol, Lisp_Object newval, Lisp_Object where,
                && !PER_BUFFER_VALUE_P (buf, idx))
              {
                if (let_shadows_buffer_binding_p (sym))
-                 set_default_internal (symbol, newval, bindflag);
+                 set_default_internal (symbol, newval, bindflag,
+                                       NULL);
                else
                  SET_PER_BUFFER_VALUE_P (buf, idx, 1);
              }
@@ -1991,7 +1996,7 @@ local bindings in certain buffers.  */)
 
 void
 set_default_internal (Lisp_Object symbol, Lisp_Object value,
-                      enum Set_Internal_Bind bindflag)
+                      enum Set_Internal_Bind bindflag, KBOARD *where)
 {
   CHECK_SYMBOL (symbol);
   struct Lisp_Symbol *sym = XSYMBOL (symbol);
@@ -2071,6 +2076,13 @@ set_default_internal (Lisp_Object symbol, Lisp_Object value,
                  }
              }
          }
+       else if (KBOARD_OBJFWDP (valcontents))
+         {
+           char *base = (char *) (where ? where
+                                  : kboard_for_bindings ());
+           char *p = base + XKBOARD_OBJFWD (valcontents)->offset;
+           *(Lisp_Object *) p = value;
+         }
        else
           set_internal (symbol, value, Qnil, bindflag);
         return;
@@ -2085,7 +2097,7 @@ The default value is seen in buffers that do not have their own values
 for this variable.  */)
   (Lisp_Object symbol, Lisp_Object value)
 {
-  set_default_internal (symbol, value, SET_INTERNAL_SET);
+  set_default_internal (symbol, value, SET_INTERNAL_SET, NULL);
   return value;
 }
 \f

diff --git a/src/eval.c b/src/eval.c
index 637c874871de880f8a4294c50f92c609f8d3128d..8cabe2d2cc723d7e8b2e94a59dffef51cda8ff3b 100644 (file)
--- a/src/eval.c
+++ b/src/eval.c
@@ -100,7 +100,14 @@ static Lisp_Object
 specpdl_where (union specbinding *pdl)
 {
   eassert (pdl->kind > SPECPDL_LET);
-  return pdl->let.where;
+  return pdl->let.where.buf;
+}
+
+static KBOARD *
+specpdl_kboard (union specbinding *pdl)
+{
+  eassert (pdl->kind == SPECPDL_LET);
+  return pdl->let.where.kbd;
 }
 
 static Lisp_Object
@@ -3483,7 +3490,8 @@ do_specbind (struct Lisp_Symbol *sym, union specbinding *bind,
       if (BUFFER_OBJFWDP (SYMBOL_FWD (sym))
          && specpdl_kind (bind) == SPECPDL_LET_DEFAULT)
        {
-          set_default_internal (specpdl_symbol (bind), value, bindflag);
+          set_default_internal (specpdl_symbol (bind), value, bindflag,
+                               NULL);
          return;
        }
       FALLTHROUGH;
@@ -3525,6 +3533,7 @@ specbind (Lisp_Object symbol, Lisp_Object value)
       specpdl_ptr->let.kind = SPECPDL_LET;
       specpdl_ptr->let.symbol = symbol;
       specpdl_ptr->let.old_value = SYMBOL_VAL (sym);
+      specpdl_ptr->let.where.kbd = NULL;
       break;
     case SYMBOL_LOCALIZED:
     case SYMBOL_FORWARDED:
@@ -3533,7 +3542,7 @@ specbind (Lisp_Object symbol, Lisp_Object value)
        specpdl_ptr->let.kind = SPECPDL_LET_LOCAL;
        specpdl_ptr->let.symbol = symbol;
        specpdl_ptr->let.old_value = ovalue;
-       specpdl_ptr->let.where = Fcurrent_buffer ();
+       specpdl_ptr->let.where.buf = Fcurrent_buffer ();
 
        eassert (sym->u.s.redirect != SYMBOL_LOCALIZED
                 || (BASE_EQ (SYMBOL_BLV (sym)->where, Fcurrent_buffer ())));
@@ -3553,6 +3562,11 @@ specbind (Lisp_Object symbol, Lisp_Object value)
            if (NILP (Flocal_variable_p (symbol, Qnil)))
              specpdl_ptr->let.kind = SPECPDL_LET_DEFAULT;
          }
+       else if (KBOARD_OBJFWDP (SYMBOL_FWD (sym)))
+         {
+           specpdl_ptr->let.where.kbd = kboard_for_bindings ();
+           specpdl_ptr->let.kind = SPECPDL_LET;
+         }
        else
          specpdl_ptr->let.kind = SPECPDL_LET;
 
@@ -3656,6 +3670,8 @@ static void
 do_one_unbind (union specbinding *this_binding, bool unwinding,
                enum Set_Internal_Bind bindflag)
 {
+  KBOARD *kbdwhere = NULL;
+
   eassert (unwinding || this_binding->kind >= SPECPDL_LET);
   switch (this_binding->kind)
     {
@@ -3708,12 +3724,13 @@ do_one_unbind (union specbinding *this_binding, bool unwinding,
          }
       }
       /* Come here only if make_local_foo was used for the first time
-        on this var within this let.  */
+        on this var within this let or the symbol is not a plainval.  */
+      kbdwhere = specpdl_kboard (this_binding);
       FALLTHROUGH;
     case SPECPDL_LET_DEFAULT:
       set_default_internal (specpdl_symbol (this_binding),
                             specpdl_old_value (this_binding),
-                            bindflag);
+                            bindflag, kbdwhere);
       break;
     case SPECPDL_LET_LOCAL:
       {
@@ -3982,6 +3999,8 @@ specpdl_unrewind (union specbinding *pdl, int distance, bool vars_only)
 {
   union specbinding *tmp = pdl;
   int step = -1;
+  KBOARD *kbdwhere;
+
   if (distance < 0)
     { /* It's a rewind rather than unwind.  */
       tmp += distance - 1;
@@ -3992,6 +4011,8 @@ specpdl_unrewind (union specbinding *pdl, int distance, bool vars_only)
   for (; distance > 0; distance--)
     {
       tmp += step;
+      kbdwhere = NULL;
+
       switch (tmp->kind)
        {
          /* FIXME: Ideally we'd like to "temporarily unwind" (some of) those
@@ -4032,14 +4053,16 @@ specpdl_unrewind (union specbinding *pdl, int distance, bool vars_only)
              }
          }
          /* Come here only if make_local_foo was used for the first
-            time on this var within this let.  */
+            time on this var within this let or the symbol is forwarded.  */
+         kbdwhere = specpdl_kboard (tmp);
          FALLTHROUGH;
        case SPECPDL_LET_DEFAULT:
          {
            Lisp_Object sym = specpdl_symbol (tmp);
            Lisp_Object old_value = specpdl_old_value (tmp);
            set_specpdl_old_value (tmp, default_value (sym));
-           set_default_internal (sym, old_value, SET_INTERNAL_THREAD_SWITCH);
+           set_default_internal (sym, old_value, SET_INTERNAL_THREAD_SWITCH,
+                                 kbdwhere);
          }
          break;
        case SPECPDL_LET_LOCAL:

diff --git a/src/keyboard.c b/src/keyboard.c
index d5892115e4b246a88f46c14d35b125d66f466dba..3551a77a9c939d6f6db1f192774b2dc8d6c09754 100644 (file)
--- a/src/keyboard.c
+++ b/src/keyboard.c
@@ -12612,6 +12612,7 @@ void
 delete_kboard (KBOARD *kb)
 {
   KBOARD **kbp;
+  struct thread_state *thread;
 
   for (kbp = &all_kboards; *kbp != kb; kbp = &(*kbp)->next_kboard)
     if (*kbp == NULL)
@@ -12629,6 +12630,21 @@ delete_kboard (KBOARD *kb)
        emacs_abort ();
     }
 
+  /* Clean thread specpdls of references to this KBOARD.  */
+  for (thread = all_threads; thread; thread = thread->next_thread)
+    {
+      union specbinding *p;
+
+      for (p = thread->m_specpdl_ptr; p > thread->m_specpdl;)
+       {
+         p -= 1;
+
+         if (p->kind == SPECPDL_LET
+             && p->let.where.kbd == kb)
+           p->let.where.kbd = NULL;
+       }
+    }
+
   wipe_kboard (kb);
   xfree (kb);
 }

diff --git a/src/keyboard.h b/src/keyboard.h
index 42637ca1cf78684473e1ffa19a0f80696bf74e14..c7ae1f7f0fa6195de5a800a3d82fe4bf3fc324ea 100644 (file)
--- a/src/keyboard.h
+++ b/src/keyboard.h
@@ -78,7 +78,6 @@ INLINE_HEADER_BEGIN
    When Emacs goes back to the any-kboard state, it looks at all the KBOARDs
    to find those; and it tries processing their input right away.  */
 
-typedef struct kboard KBOARD;
 struct kboard
   {
     KBOARD *next_kboard;

diff --git a/src/lisp.h b/src/lisp.h
index 4b4ff2a2c60f1edfba01fb253940c4b65450ddcb..534a36499f1f9a687a5b8a15dab5ed1dbb817e03 100644 (file)
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -3184,6 +3184,13 @@ XBUFFER_OBJFWD (lispfwd a)
   eassert (BUFFER_OBJFWDP (a));
   return a.fwdptr;
 }
+
+INLINE bool
+KBOARD_OBJFWDP (lispfwd a)
+{
+  return XFWDTYPE (a) == Lisp_Fwd_Kboard_Obj;
+}
+
 \f
 /* Lisp floating point type.  */
 struct Lisp_Float
@@ -3597,13 +3604,16 @@ enum specbind_tag {
 #ifdef HAVE_MODULES
   SPECPDL_MODULE_RUNTIME,       /* A live module runtime.  */
   SPECPDL_MODULE_ENVIRONMENT,   /* A live module environment.  */
-#endif
+#endif /* !HAVE_MODULES */
   SPECPDL_LET,                 /* A plain and simple dynamic let-binding.  */
   /* Tags greater than SPECPDL_LET must be "subkinds" of LET.  */
   SPECPDL_LET_LOCAL,           /* A buffer-local let-binding.  */
   SPECPDL_LET_DEFAULT          /* A global binding for a localized var.  */
 };
 
+/* struct kboard is defined in keyboard.h.  */
+typedef struct kboard KBOARD;
+
 union specbinding
   {
     /* Aligning similar members consistently might help efficiency slightly
@@ -3646,8 +3656,17 @@ union specbinding
     } unwind_void;
     struct {
       ENUM_BF (specbind_tag) kind : CHAR_BIT;
-      /* `where' is not used in the case of SPECPDL_LET.  */
-      Lisp_Object symbol, old_value, where;
+      /* `where' is not used in the case of SPECPDL_LET,
+        unless the symbol is forwarded to a KBOARD.  */
+      Lisp_Object symbol, old_value;
+      union {
+       /* KBOARD object to which SYMBOL forwards, in the case of
+          SPECPDL_LET.  */
+       KBOARD *kbd;
+
+       /* Buffer otherwise.  */
+       Lisp_Object buf;
+      } where;
     } let;
     struct {
       ENUM_BF (specbind_tag) kind : CHAR_BIT;
@@ -4216,17 +4235,19 @@ extern uintmax_t cons_to_unsigned (Lisp_Object, uintmax_t);
 
 extern AVOID args_out_of_range (Lisp_Object, Lisp_Object);
 extern AVOID circular_list (Lisp_Object);
+extern KBOARD *kboard_for_bindings (void);
 extern Lisp_Object do_symval_forwarding (lispfwd);
-enum Set_Internal_Bind {
-  SET_INTERNAL_SET,
-  SET_INTERNAL_BIND,
-  SET_INTERNAL_UNBIND,
-  SET_INTERNAL_THREAD_SWITCH
-};
+enum Set_Internal_Bind
+  {
+    SET_INTERNAL_SET,
+    SET_INTERNAL_BIND,
+    SET_INTERNAL_UNBIND,
+    SET_INTERNAL_THREAD_SWITCH,
+  };
 extern void set_internal (Lisp_Object, Lisp_Object, Lisp_Object,
                           enum Set_Internal_Bind);
 extern void set_default_internal (Lisp_Object, Lisp_Object,
-                                  enum Set_Internal_Bind bindflag);
+                                  enum Set_Internal_Bind, KBOARD *);
 extern Lisp_Object expt_integer (Lisp_Object, Lisp_Object);
 extern void syms_of_data (void);
 extern void swap_in_global_binding (struct Lisp_Symbol *);

diff --git a/src/thread.c b/src/thread.c
index 2f5d7a088382684e69e420ec7da1e3da7abbb81b..dd4ef870026d646b84405cff450bb6839e1aee26 100644 (file)
--- a/src/thread.c
+++ b/src/thread.c
@@ -63,7 +63,7 @@ static union aligned_thread_state main_thread
 
 struct thread_state *current_thread = &main_thread.s;
 
-static struct thread_state *all_threads = &main_thread.s;
+struct thread_state *all_threads = &main_thread.s;
 
 static sys_mutex_t global_lock;
 

diff --git a/src/thread.h b/src/thread.h
index 1844cf0396778b2b61293e909fe52d8a2099208f..eaa7b2651680d01d7f13a69a6d48c3ef2259a7e0 100644 (file)
--- a/src/thread.h
+++ b/src/thread.h
@@ -317,6 +317,7 @@ XCONDVAR (Lisp_Object a)
 }
 
 extern struct thread_state *current_thread;
+extern struct thread_state *all_threads;
 
 extern void finalize_one_thread (struct thread_state *state);
 extern void finalize_one_mutex (struct Lisp_Mutex *);