procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Restore specbound keyboard-locals in the correct KBOARD

Browse source 
* 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.
This commit is contained in:
Po Lu 2024-05-23 15:19:46 +08:00
parent ad0b9b9ab5
commit 64cced2c37
8 changed files with 114 additions and 42 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
doc/lispref/variables.texi
View file

@ -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

56
src/data.c
View file

@ -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;
}

37
src/eval.c
View file

@ -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:

16
src/keyboard.c
View file

@ -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);
}

1
src/keyboard.h
View file

@ -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;

41
src/lisp.h
View file

@ -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 *);

2
src/thread.c
View file

@ -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;

1
src/thread.h
View file

@ -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 *);