From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Kelly Dean Newsgroups: gmane.emacs.devel Subject: [PATCH] (Updated) Run hook when variable is set Date: Fri, 20 Feb 2015 06:48:42 +0000 Message-ID: References: NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: ger.gmane.org 1424415034 10222 80.91.229.3 (20 Feb 2015 06:50:34 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Fri, 20 Feb 2015 06:50:34 +0000 (UTC) Cc: emacs-devel@gnu.org To: Stefan Monnier Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Fri Feb 20 07:50:23 2015 Return-path: Envelope-to: ged-emacs-devel@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by plane.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1YOhPo-00060f-Ga for ged-emacs-devel@m.gmane.org; Fri, 20 Feb 2015 07:50:20 +0100 Original-Received: from localhost ([::1]:59275 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1YOhPn-0007SP-Qh for ged-emacs-devel@m.gmane.org; Fri, 20 Feb 2015 01:50:19 -0500 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:46298) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1YOhPf-0007O3-0b for emacs-devel@gnu.org; Fri, 20 Feb 2015 01:50:15 -0500 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1YOhPZ-0000us-Rp for emacs-devel@gnu.org; Fri, 20 Feb 2015 01:50:10 -0500 Original-Received: from relay3-d.mail.gandi.net ([2001:4b98:c:538::195]:35636) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1YOhPZ-0000s4-FK for emacs-devel@gnu.org; Fri, 20 Feb 2015 01:50:05 -0500 Original-Received: from mfilter20-d.gandi.net (mfilter20-d.gandi.net [217.70.178.148]) by relay3-d.mail.gandi.net (Postfix) with ESMTP id 77D61A80B6; Fri, 20 Feb 2015 07:50:04 +0100 (CET) X-Virus-Scanned: Debian amavisd-new at mfilter20-d.gandi.net Original-Received: from relay3-d.mail.gandi.net ([217.70.183.195]) by mfilter20-d.gandi.net (mfilter20-d.gandi.net [10.0.15.180]) (amavisd-new, port 10024) with ESMTP id 5pkPoVzj0uLK; Fri, 20 Feb 2015 07:50:01 +0100 (CET) X-Originating-IP: 66.220.3.179 Original-Received: from localhost (gm179.geneticmail.com [66.220.3.179]) (Authenticated sender: kelly@prtime.org) by relay3-d.mail.gandi.net (Postfix) with ESMTPSA id EA389A80AC; Fri, 20 Feb 2015 07:49:58 +0100 (CET) In-Reply-To: X-detected-operating-system: by eggs.gnu.org: Error: Malformed IPv6 address (bad octet value). X-Received-From: 2001:4b98:c:538::195 X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.14 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Original-Sender: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Xref: news.gmane.org gmane.emacs.devel:183316 Archived-At: --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable Stefan Monnier wrote: > Can I have my bikeshed transparent? Absolutely. I'll untabify all the source code, then rename this variable = to the tab character, and patch GCC to interpret tab as a variable. ;-) In the meantime, an updated patch for varhook is attached. Changes from t= he previous version: Use void-sentinel instead of consing in run_varhook. Disallow hooking of constants. Duh. Properly handle a case that was introduced when I added support for block= ing/overriding the variable setting: if you hook a variable and override = its setting, then the return value of set, setq, etc should be the overri= de value instead of the originally attempted value, so that the override = will cascade through e.g. (setq x (setq y foo)) and (if (setq z foo) ...)= . Otherwise, during debugging if e.g. you hook foo, and discover that it'= s nil there, but you want to try running that =C2=ABif=C2=BB condition, s= o you override the setq and set z to t, it would be annoying if the setq = returned nil anyway. Because of the previous change, I had to remove the handler function's ca= pability of setting a variable to void when the setter just attempted to = set a regular value. This is because otherwise, if x is lexical and y is = special and hooked, and you override the setting of y by setting it to vo= id, then (setq x (setq y foo)) would result in x being set to void, which= isn't allowed. But forcibly voiding a variable when it's set would be a pathological thi= ng to do, so I don't think removing that capability is a problem. You can= still do the opposite thing, i.e. override makunbound by setting a non-v= oid value, and of course makunbound still works as normal (even on hooked= variables) if you don't override it. Removing that capability has a fortunate side effect: even if a variable = is hooked, Emacs can now distinguish between setting it to the value of v= oid-sentinel (though there's no reason to ever do that) and doing makunbo= und on it. Any other changes I should make? --=-=-= Content-Type: text/x-diff Content-Disposition: inline; filename=varhook-advice-3.patch --- src/lisp.h +++ src/lisp.h @@ -290,6 +290,15 @@ # define GCALIGNED /* empty */ #endif +/* These are the masks for the vetted field of Lisp_Symbol. + Bit 0 stores the constant field. Bit 1 stores the hooked field. */ +#define SYM_CONST 1 +#define SYM_HOOKED 2 + +# define SYM_CONST_P(sym) (((sym)->vetted) & SYM_CONST) +# define SYM_HOOKED_P(sym) (((sym)->vetted) & SYM_HOOKED) + + /* Some operations are so commonly executed that they are implemented as macros, not functions, because otherwise runtime performance would suffer too much when compiling with GCC without optimization. @@ -344,7 +353,7 @@ #define lisp_h_NILP(x) EQ (x, Qnil) #define lisp_h_SET_SYMBOL_VAL(sym, v) \ (eassert ((sym)->redirect == SYMBOL_PLAINVAL), (sym)->val.value = (v)) -#define lisp_h_SYMBOL_CONSTANT_P(sym) (XSYMBOL (sym)->constant) +#define lisp_h_SYMBOL_CONSTANT_P(sym) (SYM_CONST_P (XSYMBOL (sym))) #define lisp_h_SYMBOL_VAL(sym) \ (eassert ((sym)->redirect == SYMBOL_PLAINVAL), (sym)->val.value) #define lisp_h_SYMBOLP(x) (XTYPE (x) == Lisp_Symbol) @@ -659,10 +668,13 @@ 3 : it's a forwarding variable, the value is in `forward'. */ ENUM_BF (symbol_redirect) redirect : 3; - /* Non-zero means symbol is constant, i.e. changing its value - should signal an error. If the value is 3, then the var - can be changed, but only by `defconst'. */ - unsigned constant : 2; + /* When masked with SYM_CONST, non-zero means symbol is constant, + i.e. changing its value should signal an error. + When masked with SYM_HOOKED, non-zero means setting symbol will + run varhook. These two fields are combined into one in order + to optimize the fast path of non-hooked non-constants by + having only one conditional branch for that case. */ + unsigned vetted : 2; /* Interned state of the symbol. This is an enumerator from enum symbol_interned. */ @@ -3463,6 +3475,15 @@ } /* Defined in data.c. */ +typedef enum + { /* See set_internal for a description of these values. */ + Dyn_Makvoid = -2, + Dyn_Unbind = -1, + Dyn_Current = 0, + Dyn_Bind = 1, + Dyn_Skip = 2, + Dyn_Global = 3 + } Dyn_Bind_Env; extern Lisp_Object indirect_function (Lisp_Object); extern Lisp_Object find_symbol_value (Lisp_Object); enum Arith_Comparison { @@ -3509,7 +3530,15 @@ extern _Noreturn void args_out_of_range_3 (Lisp_Object, Lisp_Object, Lisp_Object); extern Lisp_Object do_symval_forwarding (union Lisp_Fwd *); -extern void set_internal (Lisp_Object, Lisp_Object, Lisp_Object, bool); +extern Lisp_Object run_varhook (struct Lisp_Symbol*, bool, Dyn_Bind_Env, + Lisp_Object, Lisp_Object); +extern Lisp_Object set_internal_vetted (Lisp_Object, Lisp_Object, Lisp_Object, bool, + Dyn_Bind_Env, struct Lisp_Symbol *); +extern Lisp_Object set_internal_localized_or_forwarded (Lisp_Object, Lisp_Object, + Lisp_Object, bool, + Dyn_Bind_Env, + struct Lisp_Symbol *); +extern Lisp_Object set_default_internal (Lisp_Object, Lisp_Object, Dyn_Bind_Env); extern void syms_of_data (void); extern void swap_in_global_binding (struct Lisp_Symbol *); @@ -4776,6 +4805,51 @@ return false; } +/* Store the value NEWVAL into SYMBOL. + If buffer/frame-locality is an issue, WHERE specifies which context to use. + (nil stands for the current buffer/frame). + + If BINDFLAG is false, then if this symbol is supposed to become + local in every buffer where it is set, then we make it local. + If BINDFLAG is true, we don't do that. + + ENV indicates the dynamic environment for this function call, i.e. whether + this call is due to a variable binding (Dyn_Bind), an unbinding (Dyn_Unbind), + or neither (Dyn_Current). As special cases, a value of Dyn_Skip is a flag + to disable run_varhook so that varhooks aren't run during backtraces, and + a value of Dyn_Global is a flag indicating that this function call is due + to set_default, which allows run_varhook to distinguish beween the global + and the dyn-local binding. And Dyn_Makvoid is a flag indicating that this + function call is due to makunbound, which tells run_varhook to allow + setting the variable to void. */ + +INLINE Lisp_Object +set_internal (Lisp_Object symbol, Lisp_Object newval, Lisp_Object where, + bool bindflag, Dyn_Bind_Env env) +{ + struct Lisp_Symbol *sym; + + CHECK_SYMBOL (symbol); + sym = XSYMBOL (symbol); + if (sym->vetted) + return set_internal_vetted (symbol, newval, where, bindflag, env, sym); + + start: + switch (sym->redirect) + { + case SYMBOL_PLAINVAL: SET_SYMBOL_VAL (sym, newval); return newval; + case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start; + default: return set_internal_localized_or_forwarded + (symbol, newval, where, bindflag, env, sym); + } +} + +#define MAYBE_RUN_VARHOOK(result, sym, buf_local, env, oldval, newval) \ + { \ + if (SYM_HOOKED_P (sym)) \ + (result) = run_varhook (sym, buf_local, env, oldval, newval); \ + } + INLINE_HEADER_END #endif /* EMACS_LISP_H */ --- src/eval.c +++ src/eval.c @@ -250,7 +250,7 @@ max_lisp_eval_depth = XINT (XCDR (data)); } -static void grow_specpdl (void); +static inline void grow_specpdl (void); /* Call the Lisp debugger, giving it argument ARG. */ @@ -530,7 +530,8 @@ = Fassq (sym, Vinternal_interpreter_environment))) XSETCDR (lex_binding, val); /* SYM is lexically bound. */ else - Fset (sym, val); /* SYM is dynamically bound. */ + /* SYM is dynamically bound. */ + val = set_internal (sym, val, Qnil, false, Dyn_Current); args_left = Fcdr (XCDR (args_left)); } @@ -616,7 +617,7 @@ sym = XSYMBOL (new_alias); - if (sym->constant) + if (SYM_CONST_P (sym)) /* Not sure why, but why not? */ error ("Cannot make a constant an alias"); @@ -633,7 +634,7 @@ 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), Qnil, 1); + set_internal (base_variable, find_symbol_value (new_alias), Qnil, true, Dyn_Current); { union specbinding *p; @@ -648,7 +649,7 @@ XSYMBOL (base_variable)->declared_special = 1; sym->redirect = SYMBOL_VARALIAS; SET_SYMBOL_ALIAS (sym, XSYMBOL (base_variable)); - sym->constant = SYMBOL_CONSTANT_P (base_variable); + sym->vetted = SYMBOL_CONSTANT_P (base_variable); LOADHIST_ATTACH (new_alias); /* Even if docstring is nil: remove old docstring. */ Fput (new_alias, Qvariable_documentation, docstring); @@ -2006,7 +2007,7 @@ never-used entry just before the bottom of the stack; sometimes its address is taken. */ -static void +static inline void grow_specpdl (void) { specpdl_ptr++; @@ -3038,8 +3039,6 @@ start: switch (sym->redirect) { - case SYMBOL_VARALIAS: - sym = indirect_variable (sym); XSETSYMBOL (symbol, sym); goto start; case SYMBOL_PLAINVAL: /* The most common case is that of a non-constant symbol with a trivial value. Make that as fast as we can. */ @@ -3047,11 +3046,15 @@ specpdl_ptr->let.symbol = symbol; specpdl_ptr->let.old_value = SYMBOL_VAL (sym); grow_specpdl (); - if (!sym->constant) - SET_SYMBOL_VAL (sym, value); + if (!sym->vetted) SET_SYMBOL_VAL (sym, value); + else if (SYM_HOOKED_P (sym)) + SET_SYMBOL_VAL (sym, run_varhook + (sym, false, Dyn_Bind, sym->val.value, value)); else - set_internal (symbol, value, Qnil, 1); + set_internal (symbol, value, Qnil, true, Dyn_Bind); break; + case SYMBOL_VARALIAS: + sym = indirect_variable (sym); XSETSYMBOL (symbol, sym); goto start; case SYMBOL_LOCALIZED: if (SYMBOL_BLV (sym)->frame_local) error ("Frame-local vars cannot be let-bound"); @@ -3082,7 +3085,7 @@ { specpdl_ptr->let.kind = SPECPDL_LET_DEFAULT; grow_specpdl (); - Fset_default (symbol, value); + set_default_internal (symbol, value, Dyn_Bind); return; } } @@ -3090,7 +3093,7 @@ specpdl_ptr->let.kind = SPECPDL_LET; grow_specpdl (); - set_internal (symbol, value, Qnil, 1); + set_internal (symbol, value, Qnil, true, Dyn_Bind); break; } default: emacs_abort (); @@ -3225,7 +3228,9 @@ struct Lisp_Symbol *sym = XSYMBOL (specpdl_symbol (specpdl_ptr)); if (sym->redirect == SYMBOL_PLAINVAL) { - SET_SYMBOL_VAL (sym, specpdl_old_value (specpdl_ptr)); + Lisp_Object oldval = specpdl_old_value (specpdl_ptr); + MAYBE_RUN_VARHOOK (oldval, sym, false, Dyn_Unbind, sym->val.value, oldval); + SET_SYMBOL_VAL (sym, oldval); break; } else @@ -3235,8 +3240,8 @@ } } case SPECPDL_LET_DEFAULT: - Fset_default (specpdl_symbol (specpdl_ptr), - specpdl_old_value (specpdl_ptr)); + set_default_internal (specpdl_symbol (specpdl_ptr), + specpdl_old_value (specpdl_ptr), Dyn_Unbind); break; case SPECPDL_LET_LOCAL: { @@ -3248,7 +3253,7 @@ /* If this was a local binding, reset the value in the appropriate buffer, but only if that buffer's binding still exists. */ if (!NILP (Flocal_variable_p (symbol, where))) - set_internal (symbol, old_value, where, 1); + set_internal (symbol, old_value, where, true, Dyn_Unbind); } break; } @@ -3454,7 +3459,7 @@ Lisp_Object sym = specpdl_symbol (tmp); Lisp_Object old_value = specpdl_old_value (tmp); set_specpdl_old_value (tmp, Fdefault_value (sym)); - Fset_default (sym, old_value); + set_default_internal (sym, old_value, Dyn_Skip); } break; case SPECPDL_LET_LOCAL: @@ -3470,7 +3475,7 @@ { set_specpdl_old_value (tmp, Fbuffer_local_value (symbol, where)); - set_internal (symbol, old_value, where, 1); + set_internal (symbol, old_value, where, true, Dyn_Skip); } } break; @@ -3746,6 +3751,66 @@ still determine whether to handle the particular condition. */); Vdebug_on_signal = Qnil; + DEFSYM (Qvoid_sentinel, "void-sentinel"); + DEFVAR_LISP ("void-sentinel", Vvoid_sentinel, + doc: /* Representation of voidness for hooked variables. +The value of this constant is an uninterned Lisp symbol that represents void +when passed to or returned from `symbol-setter-function'. */); + Vvoid_sentinel = Fmake_symbol (build_string ("::void::")); + XSYMBOL (Vvoid_sentinel)->declared_special = true; + XSYMBOL (Vvoid_sentinel)->vetted = SYM_CONST; + XSYMBOL (Qvoid_sentinel)->declared_special = true; + XSYMBOL (Qvoid_sentinel)->vetted = SYM_CONST; + + DEFVAR_LISP ("symbol-setter-function", Vsymbol_setter_function, + doc: /* This function is called whenever a hooked variable is set. +It takes four arguments: SYMBOL, ENV, OLDVAL, NEWVAL. By default, it just +returns NEWVAL unchanged. + +SYMBOL is the symbol being set. ENV is the environment is which it's being +set. OLDVAL is the current value, or if the current value is void, then OLDVAL +is the value of `void-sentinel'. NEWVAL is the new value to which the setter, +i.e. the caller of a function such as `setq', is attempting to set the +variable, or the value of void-sentinel if the setter called `makunbound'. +The actual new value to which the variable will be set is return value of +this function, unless the setter called makunbound and this function returns +the value of void-sentinel, in which case the variable will be set to void. +The return value is NEWVAL if this function lacks advice that overrides it. + +The possible values of ENV are these symbols, with these meanings: +global: The global environment. +buf-local: The setter's buffer-local environment. +dyn-local: The innermost dynamic environment in which SYMBOL is bound. +dyn-bind: A new dynamic environment, such as creatable using `let'. +dyn-unbind: The next-outer dynamic environment in which SYMBOL is still bound, +unshadowed due to destruction of the setter's current dynamic environment, +such as due to exit of a `let' form, or the buffer-local environment if SYMBOL +is not bound in any dynamic environment, or the global environment is SYMBOL +is not in the buffer-local environment. + +If you use overriding advice, your advice must return the value to which to +set the variable. To avoid overriding the setter's attempt to set the variable +to NEWVAL, return NEWVAL. To block the attempt, and leave the variable +unchanged, return OLDVAL. If ENV is dyn-bind or dyn-unbind, you can block +the change of value, but you can't prevent the corresponding creation or +destruction of a dynamic environment. Therefore, blocking when ENV is +dyn-bind will set SYMBOL in the new environment to its value in the outer +environment, and blocking when ENV is dyn-unbind will set SYMBOL in the +outer environment to its value in the environment being destroyed. If OLDVAL +is the value of void-sentinel but NEWVAL is not, you can override the new +value, but you can't prevent the variable from being set to a non-void value. + +Don't set the variable in your advice; that would cause a recursive call +to this function, and even if you terminate the recursion, your setting +would be overridden by the return value of this function. Instead, if your +advice needs to set the variable, use `add-function' with overriding advice. + +To hook all variables of a symbol, use `symbol-hook'. To unhook them, +use `symbol-unhook'. If you only want to watch or override some variables +of a symbol, then filter according to ENV, and if you use overriding advice, +simply return NEWVAL for the ones you don't want to process. */); + Vsymbol_setter_function = Qnil; /* Set in subr.el */ + /* When lexical binding is being used, Vinternal_interpreter_environment is non-nil, and contains an alist of lexically-bound variable, or (t), indicating an empty --- src/data.c +++ src/data.c @@ -574,6 +574,20 @@ /* Extract and set components of symbols. */ +DEFUN ("symbol-hooked-p", Fsymbol_hooked_p, Ssymbol_hooked_p, 1, 1, 0, + doc: /* Return t if SYMBOL is hooked. +To hook and unhook it, use `symbol-hook' and `symbol-unhook'. +When hooked, setting SYMBOL will run `symbol-setter-function'. */) + (register Lisp_Object symbol) +{ + struct Lisp_Symbol *sym; + CHECK_SYMBOL (symbol); + sym = XSYMBOL (symbol); + while (sym->redirect == SYMBOL_VARALIAS) + sym = indirect_variable (sym); + return SYM_HOOKED_P (sym) ? Qt : Qnil; +} + DEFUN ("boundp", Fboundp, Sboundp, 1, 1, 0, doc: /* Return t if SYMBOL's value is not void. Note that if `lexical-binding' is in effect, this refers to the @@ -623,6 +637,48 @@ return NILP (XSYMBOL (symbol)->function) ? Qnil : Qt; } +DEFUN ("symbol-hook", Fsymbol_hook, Ssymbol_hook, 1, 1, 0, + doc: /* Hook SYMBOL. +When hooked, setting it will run `symbol-setter-function'. +To unhook it, use `symbol-unhook'. +To test whether it's hooked, use `symbol-hooked-p'. +Return SYMBOL. */) + (register Lisp_Object symbol) +{ + struct Lisp_Symbol *sym; + CHECK_SYMBOL (symbol); + if (SYMBOL_CONSTANT_P (symbol)) + xsignal1 (Qsetting_constant, symbol); + sym = XSYMBOL (symbol); + sym->vetted |= SYM_HOOKED; + while (sym->redirect == SYMBOL_VARALIAS) + { + sym = indirect_variable (sym); + sym->vetted |= SYM_HOOKED; + } + return symbol; +} + +DEFUN ("symbol-unhook", Fsymbol_unhook, Ssymbol_unhook, 1, 1, 0, + doc: /* Unhook SYMBOL. +When unhooked, setting it will not run `symbol-setter-function'. +To hook it, use `symbol-hook'. +To test whether it's hooked, use `symbol-hooked-p'. +Return SYMBOL. */) + (register Lisp_Object symbol) +{ + struct Lisp_Symbol *sym; + CHECK_SYMBOL (symbol); + sym = XSYMBOL (symbol); + sym->vetted &= (SYM_HOOKED ^ -1); + while (sym->redirect == SYMBOL_VARALIAS) + { + sym = indirect_variable (sym); + sym->vetted &= (SYM_HOOKED ^ -1); + } + return symbol; +} + DEFUN ("makunbound", Fmakunbound, Smakunbound, 1, 1, 0, doc: /* Make SYMBOL's value be void. Return SYMBOL. */) @@ -631,7 +685,7 @@ CHECK_SYMBOL (symbol); if (SYMBOL_CONSTANT_P (symbol)) xsignal1 (Qsetting_constant, symbol); - Fset (symbol, Qunbound); + set_internal (symbol, Qunbound, Qnil, false, Dyn_Makvoid); return symbol; } @@ -1171,8 +1225,8 @@ start: switch (sym->redirect) { - case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start; case SYMBOL_PLAINVAL: return SYMBOL_VAL (sym); + case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start; case SYMBOL_LOCALIZED: { struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (sym); @@ -1201,54 +1255,116 @@ xsignal1 (Qvoid_variable, symbol); } +/* For the symbol S being set, run symbol-setter-function with these arguments: + 0. S + 1. A symbol indicating the environment in which S is being set. + 2. The current value of S in that environment. + 3. The value to which the setter is attempting to set the variable. + + If argument #2 or #3 is Qunbound, it's replaced by the value of + Vvoid_sentinel. + + Return the result of symbol-setter-function, or if it's the value of + Vvoid_sentinel and RAWENV is Dyn_Makvoid, return Qunbound; this avoids + blocking the setter's call to makunbound. The variable will be set + (by code that calls run_varhook) to that return value, overriding + the value to which the setter attempted to set the variable. */ + +Lisp_Object +run_varhook (struct Lisp_Symbol* sym, bool buf_local, Dyn_Bind_Env rawenv, + Lisp_Object oldval, Lisp_Object newval) +{ + Lisp_Object symbol; + Lisp_Object env; + if (rawenv == Dyn_Skip) /* From backtrace_eval_unrewind */ + return newval; + XSETSYMBOL (symbol, sym); + switch (rawenv) /* Disambiguate Dyn_Current and Dyn_Global */ + { + case Dyn_Makvoid: + case Dyn_Current: + { + bool shadowed = (buf_local ? let_shadows_buffer_binding_p (sym) + : let_shadows_global_binding_p (symbol)); + if (shadowed) env = Qdyn_local; + else if (buf_local) env = Qbuf_local; + else env = Qglobal; + break; + } + case Dyn_Global: + { + /* let_shadows_buffer_binding_p doesn't disambiguate this case */ + if (let_shadows_global_binding_p (symbol) && + NILP (Flocal_variable_p (symbol, Qnil))) + env = Qdyn_local; + else env = Qglobal; + break; + } + case Dyn_Bind: env = Qdyn_bind; break; + case Dyn_Unbind: env = Qdyn_unbind; break; + default: emacs_abort (); + } + oldval = EQ (oldval, Qunbound) ? Vvoid_sentinel : oldval; + newval = EQ (newval, Qunbound) ? Vvoid_sentinel : newval; + newval = call4 (Vsymbol_setter_function, symbol, env, oldval, newval); + if (rawenv == Dyn_Makvoid && EQ (newval, Vvoid_sentinel)) + return Qunbound; /* Converting setq, etc to makunbound is prohibited. */ + return newval; /* So void_sentinel is ignored except for makunbound. */ +} + DEFUN ("set", Fset, Sset, 2, 2, 0, doc: /* Set SYMBOL's value to NEWVAL, and return NEWVAL. */) (register Lisp_Object symbol, Lisp_Object newval) { - set_internal (symbol, newval, Qnil, 0); - return newval; + return set_internal (symbol, newval, Qnil, false, Dyn_Current); } -/* Store the value NEWVAL into SYMBOL. - If buffer/frame-locality is an issue, WHERE specifies which context to use. - (nil stands for the current buffer/frame). - - If BINDFLAG is false, then if this symbol is supposed to become - local in every buffer where it is set, then we make it local. - If BINDFLAG is true, we don't do that. */ +/* set_internal is in lisp.h due to being inlined. */ -void -set_internal (Lisp_Object symbol, Lisp_Object newval, Lisp_Object where, - bool bindflag) -{ - bool voide = EQ (newval, Qunbound); - struct Lisp_Symbol *sym; - Lisp_Object tem1; +/* Factored out from set_internal to avoid inlining the non-hotpath. */ - /* If restoring in a dead buffer, do nothing. */ - /* if (BUFFERP (where) && NILP (XBUFFER (where)->name)) - return; */ - - CHECK_SYMBOL (symbol); - if (SYMBOL_CONSTANT_P (symbol)) +Lisp_Object +set_internal_vetted (Lisp_Object symbol, Lisp_Object newval, Lisp_Object where, + bool bindflag, Dyn_Bind_Env env, struct Lisp_Symbol *sym) +{ + if (SYM_HOOKED_P (sym)) { + start: + switch (sym->redirect) + { + case SYMBOL_PLAINVAL: + newval = run_varhook (sym, false, env, sym->val.value, newval); + SET_SYMBOL_VAL (sym, newval); + return newval; + case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start; + default: + return set_internal_localized_or_forwarded + (symbol, newval, where, bindflag, env, sym); + } + } if (NILP (Fkeywordp (symbol)) || !EQ (newval, Fsymbol_value (symbol))) xsignal1 (Qsetting_constant, symbol); else /* Allow setting keywords to their own value. */ - return; - } + return newval; +} - sym = XSYMBOL (symbol); +/* Split from set_internal to avoid code duplication, because both set_internal and + set_internal_vetted must call this function. */ - start: +Lisp_Object +set_internal_localized_or_forwarded (Lisp_Object symbol, Lisp_Object newval, + Lisp_Object where, bool bindflag, + Dyn_Bind_Env env, struct Lisp_Symbol *sym) +{ + bool voide; + Lisp_Object tem1; switch (sym->redirect) { - case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start; - case SYMBOL_PLAINVAL: SET_SYMBOL_VAL (sym , newval); return; case SYMBOL_LOCALIZED: { + bool buf_local = true; struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (sym); if (NILP (where)) { @@ -1292,6 +1408,7 @@ indicating that we're seeing the default value. Likewise if the variable has been let-bound in the current buffer. */ + buf_local = false; if (bindflag || !blv->local_if_set || let_shadows_buffer_binding_p (sym)) { @@ -1319,6 +1436,9 @@ set_blv_valcell (blv, tem1); } + MAYBE_RUN_VARHOOK (newval, sym, buf_local, env, blv_value (blv), newval); + voide = EQ (newval, Qunbound); + /* Store the new value in the cons cell. */ set_blv_value (blv, newval); @@ -1350,6 +1470,11 @@ SET_PER_BUFFER_VALUE_P (buf, idx, 1); } + MAYBE_RUN_VARHOOK (newval, sym, + (XFWDTYPE (innercontents)) == Lisp_Fwd_Buffer_Obj, + env, do_symval_forwarding (innercontents), newval); + voide = EQ (newval, Qunbound); + if (voide) { /* If storing void (making the symbol void), forward only through buffer-local indicator, not through Lisp_Objfwd, etc. */ @@ -1362,7 +1487,7 @@ } default: emacs_abort (); } - return; + return newval; } /* Access or set a buffer-local symbol's default value. */ @@ -1381,8 +1506,8 @@ start: switch (sym->redirect) { - case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start; case SYMBOL_PLAINVAL: return SYMBOL_VAL (sym); + case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start; case SYMBOL_LOCALIZED: { /* If var is set up for a buffer that lacks a local value for it, @@ -1447,6 +1572,16 @@ for this variable. */) (Lisp_Object symbol, Lisp_Object value) { + return set_default_internal (symbol, value, Dyn_Global); +} + +/* Like Fset_default, but with ENV argument. See set_internal for + a description of this argument. */ + +Lisp_Object +set_default_internal (Lisp_Object symbol, Lisp_Object value, + Dyn_Bind_Env env) +{ struct Lisp_Symbol *sym; CHECK_SYMBOL (symbol); @@ -1464,12 +1599,17 @@ start: switch (sym->redirect) { + case SYMBOL_PLAINVAL: + { + return set_internal (symbol, value, Qnil, false, env); + } case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start; - case SYMBOL_PLAINVAL: return Fset (symbol, value); case SYMBOL_LOCALIZED: { struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (sym); + MAYBE_RUN_VARHOOK (value, sym, false, env, XCDR (blv->defcell), value); + /* Store new value into the DEFAULT-VALUE slot. */ XSETCDR (blv->defcell, value); @@ -1490,6 +1630,8 @@ int offset = XBUFFER_OBJFWD (valcontents)->offset; int idx = PER_BUFFER_IDX (offset); + MAYBE_RUN_VARHOOK (value, sym, false, env, per_buffer_default (offset), value); + set_per_buffer_default (offset, value); /* If this variable is not always local in all buffers, @@ -1504,8 +1646,7 @@ } return value; } - else - return Fset (symbol, value); + else return set_internal (symbol, value, Qnil, false, env); } default: emacs_abort (); } @@ -1536,7 +1677,7 @@ { val = eval_sub (Fcar (XCDR (args_left))); symbol = XCAR (args_left); - Fset_default (symbol, val); + val = Fset_default (symbol, val); args_left = Fcdr (XCDR (args_left)); } @@ -1633,7 +1774,7 @@ default: emacs_abort (); } - if (sym->constant) + if (SYM_CONST_P (sym)) error ("Symbol %s may not be buffer-local", SDATA (SYMBOL_NAME (variable))); if (!blv) @@ -1706,7 +1847,7 @@ default: emacs_abort (); } - if (sym->constant) + if (SYM_CONST_P (sym)) error ("Symbol %s may not be buffer-local", SDATA (SYMBOL_NAME (variable))); @@ -1895,7 +2036,7 @@ default: emacs_abort (); } - if (sym->constant) + if (SYM_CONST_P (sym)) error ("Symbol %s may not be frame-local", SDATA (SYMBOL_NAME (variable))); blv = make_blv (sym, forwarded, valcontents); @@ -3474,6 +3615,12 @@ DEFSYM (Qad_advice_info, "ad-advice-info"); DEFSYM (Qad_activate_internal, "ad-activate-internal"); + DEFSYM (Qglobal, "global"); + DEFSYM (Qbuf_local, "buf-local"); + DEFSYM (Qdyn_local, "dyn-local"); + DEFSYM (Qdyn_bind, "dyn-bind"); + DEFSYM (Qdyn_unbind, "dyn-unbind"); + error_tail = pure_cons (Qerror, Qnil); /* ERROR is used as a signaler for random errors for which nothing else is @@ -3609,8 +3756,11 @@ defsubr (&Sindirect_function); defsubr (&Ssymbol_plist); defsubr (&Ssymbol_name); + defsubr (&Ssymbol_hook); + defsubr (&Ssymbol_unhook); defsubr (&Smakunbound); defsubr (&Sfmakunbound); + defsubr (&Ssymbol_hooked_p); defsubr (&Sboundp); defsubr (&Sfboundp); defsubr (&Sfset); @@ -3677,10 +3827,10 @@ DEFVAR_LISP ("most-positive-fixnum", Vmost_positive_fixnum, doc: /* The largest value that is representable in a Lisp integer. */); Vmost_positive_fixnum = make_number (MOST_POSITIVE_FIXNUM); - XSYMBOL (intern_c_string ("most-positive-fixnum"))->constant = 1; + XSYMBOL (intern_c_string ("most-positive-fixnum"))->vetted = SYM_CONST; DEFVAR_LISP ("most-negative-fixnum", Vmost_negative_fixnum, doc: /* The smallest value that is representable in a Lisp integer. */); Vmost_negative_fixnum = make_number (MOST_NEGATIVE_FIXNUM); - XSYMBOL (intern_c_string ("most-negative-fixnum"))->constant = 1; + XSYMBOL (intern_c_string ("most-negative-fixnum"))->vetted = SYM_CONST; } --- src/alloc.c +++ src/alloc.c @@ -3350,7 +3350,7 @@ set_symbol_next (val, NULL); p->gcmarkbit = false; p->interned = SYMBOL_UNINTERNED; - p->constant = 0; + p->vetted = 0; p->declared_special = false; p->pinned = false; } --- src/lread.c +++ src/lread.c @@ -3755,7 +3755,7 @@ if (SREF (SYMBOL_NAME (sym), 0) == ':' && EQ (obarray, initial_obarray)) { - XSYMBOL (sym)->constant = 1; + XSYMBOL (sym)->vetted = SYM_CONST; XSYMBOL (sym)->redirect = SYMBOL_PLAINVAL; SET_SYMBOL_VAL (XSYMBOL (sym), sym); } @@ -4041,12 +4041,12 @@ DEFSYM (Qnil, "nil"); SET_SYMBOL_VAL (XSYMBOL (Qnil), Qnil); - XSYMBOL (Qnil)->constant = 1; + XSYMBOL (Qnil)->vetted = SYM_CONST; XSYMBOL (Qnil)->declared_special = true; DEFSYM (Qt, "t"); SET_SYMBOL_VAL (XSYMBOL (Qt), Qt); - XSYMBOL (Qt)->constant = 1; + XSYMBOL (Qt)->vetted = SYM_CONST; XSYMBOL (Qt)->declared_special = true; /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */ --- src/buffer.c +++ src/buffer.c @@ -5690,7 +5690,7 @@ This variable is buffer-local but you cannot set it directly; use the function `set-buffer-multibyte' to change a buffer's representation. See also Info node `(elisp)Text Representations'. */); - XSYMBOL (intern_c_string ("enable-multibyte-characters"))->constant = 1; + XSYMBOL (intern_c_string ("enable-multibyte-characters"))->vetted = SYM_CONST; DEFVAR_PER_BUFFER ("buffer-file-coding-system", &BVAR (current_buffer, buffer_file_coding_system), Qnil, --- src/bytecode.c +++ src/bytecode.c @@ -843,7 +843,7 @@ else { BEFORE_POTENTIAL_GC (); - set_internal (sym, val, Qnil, 0); + set_internal (sym, val, Qnil, false, Dyn_Current); AFTER_POTENTIAL_GC (); } } --- src/font.c +++ src/font.c @@ -5249,19 +5249,19 @@ [NUMERIC-VALUE SYMBOLIC-NAME ALIAS-NAME ...] NUMERIC-VALUE is an integer, and SYMBOLIC-NAME and ALIAS-NAME are symbols. */); Vfont_weight_table = BUILD_STYLE_TABLE (weight_table); - XSYMBOL (intern_c_string ("font-weight-table"))->constant = 1; + XSYMBOL (intern_c_string ("font-weight-table"))->vetted = SYM_CONST; DEFVAR_LISP_NOPRO ("font-slant-table", Vfont_slant_table, doc: /* Vector of font slant symbols vs the corresponding numeric values. See `font-weight-table' for the format of the vector. */); Vfont_slant_table = BUILD_STYLE_TABLE (slant_table); - XSYMBOL (intern_c_string ("font-slant-table"))->constant = 1; + XSYMBOL (intern_c_string ("font-slant-table"))->vetted = SYM_CONST; DEFVAR_LISP_NOPRO ("font-width-table", Vfont_width_table, doc: /* Alist of font width symbols vs the corresponding numeric values. See `font-weight-table' for the format of the vector. */); Vfont_width_table = BUILD_STYLE_TABLE (width_table); - XSYMBOL (intern_c_string ("font-width-table"))->constant = 1; + XSYMBOL (intern_c_string ("font-width-table"))->vetted = SYM_CONST; staticpro (&font_style_table); font_style_table = make_uninit_vector (3); --- lisp/subr.el +++ lisp/subr.el @@ -2546,6 +2546,9 @@ Note that this should end with a directory separator. See also `locate-user-emacs-file'.") +(setq symbol-setter-function ; Defined in eval.c + (lambda (_sym _env _oldval newval) newval)) + ;;;; Misc. useful functions. (defsubst buffer-narrowed-p () --=-=-=--