From: Po Lu Date: Thu, 23 May 2024 07:19:46 +0000 (+0800) Subject: Restore specbound keyboard-locals in the correct KBOARD X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=b3e8ab70f6085f568b5b83f8b679d0959ac9e912;p=emacs.git 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) : 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 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 *);