summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--doc/lispref/variables.texi2
-rw-r--r--src/data.c56
-rw-r--r--src/eval.c37
-rw-r--r--src/keyboard.c16
-rw-r--r--src/keyboard.h1
-rw-r--r--src/lisp.h41
-rw-r--r--src/thread.c2
-rw-r--r--src/thread.h1
8 files changed, 114 insertions, 42 deletions
diff --git a/doc/lispref/variables.texi b/doc/lispref/variables.texi
index 16b6b52e5f1..e05d3bb0f81 100644
--- 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 30d8eab7359..be7ae023d8d 100644
--- 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;
}
diff --git a/src/eval.c b/src/eval.c
index 637c874871d..8cabe2d2cc7 100644
--- 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 d5892115e4b..3551a77a9c9 100644
--- 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 42637ca1cf7..c7ae1f7f0fa 100644
--- 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 4b4ff2a2c60..534a36499f1 100644
--- 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;
+}
+
/* 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 2f5d7a08838..dd4ef870026 100644
--- 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 1844cf03967..eaa7b265168 100644
--- 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 *);
generated by cgit v1.2.3 (git 2.39.1) at 2025-07-16 02:46:47 +0000