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: Tue, 17 Feb 2015 02:22:54 +0000 Message-ID: References: NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: ger.gmane.org 1424139903 31290 80.91.229.3 (17 Feb 2015 02:25:03 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Tue, 17 Feb 2015 02:25:03 +0000 (UTC) Cc: emacs-devel@gnu.org To: Stefan Monnier Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Tue Feb 17 03:24:48 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 1YNXqA-0006C7-P1 for ged-emacs-devel@m.gmane.org; Tue, 17 Feb 2015 03:24:47 +0100 Original-Received: from localhost ([::1]:43538 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1YNXq9-00044P-RY for ged-emacs-devel@m.gmane.org; Mon, 16 Feb 2015 21:24:45 -0500 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:41339) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1YNXpq-00043U-KK for emacs-devel@gnu.org; Mon, 16 Feb 2015 21:24:30 -0500 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1YNXpk-0003UM-9t for emacs-devel@gnu.org; Mon, 16 Feb 2015 21:24:26 -0500 Original-Received: from relay4-d.mail.gandi.net ([2001:4b98:c:538::196]:33358) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1YNXpj-0003Tz-Qr for emacs-devel@gnu.org; Mon, 16 Feb 2015 21:24:20 -0500 Original-Received: from mfilter21-d.gandi.net (mfilter21-d.gandi.net [217.70.178.149]) by relay4-d.mail.gandi.net (Postfix) with ESMTP id 05ABA172071; Tue, 17 Feb 2015 03:24:19 +0100 (CET) X-Virus-Scanned: Debian amavisd-new at mfilter21-d.gandi.net Original-Received: from relay4-d.mail.gandi.net ([217.70.183.196]) by mfilter21-d.gandi.net (mfilter21-d.gandi.net [10.0.15.180]) (amavisd-new, port 10024) with ESMTP id 2X4FxsdWuFPT; Tue, 17 Feb 2015 03:24:16 +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 relay4-d.mail.gandi.net (Postfix) with ESMTPSA id 85830172070; Tue, 17 Feb 2015 03:24:12 +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::196 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:183184 Archived-At: --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable Stefan Monnier wrote: >> I've removed =C2=ABvoid=C2=BB. I recommend making makunbound stop work= ing on >> non-globals too. > > `let' on dynamically-scoped variables doesn't make them non-local. > > Or rather, whether it does or not is a philosophical question (does > `let' create a new variable which shadows the outer one, or does it jus= t > temporarily change the value of the variable?). Saying there's only a global variable doesn't remove the absurdity of mak= unbound within the extent of a =C2=ABlet=C2=BB. Suppose foo is currently = unbound. Then: (defvar foo 0) ; Now foo is bound to 0 (let ((foo 1)) ; Now it's bound to 1 (makunbound 'foo)) ; Now it's bound to unboundedness ;; Now it's unbound from unboundedness, and thereby rebound to 0 You can't just say that makunbound in that case unbinds foo, because then= the question arises, from what is foo unbound when the let-binding form = exits? If foo were already unbound by makunbound, then there would be not= hing left to unbind it from when =C2=ABlet=C2=BB exits. Surely you can't say with a straight face that binding to unboundedness i= s not an absurd concept. Yet that's the alternative to the interpretation= that Qunbound escapes as a special second-class value into the Lisp worl= d. Either way, the behavior of makunbound is wrong. >>> - OLDVAL is either a list of one element containing the old value, or >>> nil (when that old value is Qunbound). >> Then run_varhook must cons. That'll generate a lot of garbage if you u= se it >> for profiling, or for debugging in a way where you don't just pause to >> inspect every hooked variable. Is that ok? > > I think it's OK, yes. This seems to be the least-bad option, so I did it this way, even though = it makes the API a bit gross. Unfortunately, when you do: (require 'cl) (setq x 0) (symbol-hook 'x) (benchmark-run-compiled 100000 (incf x)) it now spends half the time doing garbage collection. That's a high price= to pay to cater to the brain-dead misbehavior of makunbound. >> Or to avoid needing to cons in run_varhook, it could specbind somethin= g like >> Qsymbol_newval_void (to t if the new value is Qunbound), so the hook > > Yuck. That's even worse than using a value that is hopefully never > used elsewhere, like `::value--unbound::'. Then you'll probably also say =E2=80=9Fyuck=E2=80=9D to my xref-push-mark= patch that I posted to emacs-devel just now, since it uses that tactic. >> Would =E2=8C=9Cconst_hooked=E2=8C=9D be ok? > > How 'bout `writable' with values yes/no/thrufunction? That would make sense, but the meaning is inverted from how the code is w= ritten, e.g. the code has: if (constant) a...; else b...; so to account for the inversion, it would have to change to: if (!writeable) a...; else b...; which introduces an extra =C2=ABnot=C2=BB operator. To avoid the extra op= erator, it would have to change to: if (writeable) b...; else a...; Usually the =C2=ABa=C2=BB ends with return, error, or xsignal1, which mea= ns no =C2=ABelse=C2=BB is needed for =C2=ABb=C2=BB, so changing the order= to avoid the extra =C2=ABnot=C2=BB operator would make the code more awk= ward. Since you think of variables as =E2=80=9Fvetted=E2=80=9D if they might no= t be freely writeable, and the meaning of that term isn't inverted, I thi= nk =E2=8C=9Cvetted=E2=8C=9D is the least-bad short name to replace =E2=8C= =9Cconstant=E2=8C=9D in the places where it's used to mean =C2=ABconstant= or hooked=C2=BB. (Where it means specifically =C2=ABconstant=C2=BB, i.e.= the vetting is hardcoded to disallow writing, it still is called =E2=80=9F= constant=E2=80=9D, e.g. in the standard macro SYMBOL_CONSTANT_P). Updated patch attached. BTW, I accidentally inlined a little too much for set_internal last time.= This time I've factored out the part that doesn't need to be inline. Thi= s has no speed impact on the hot path, but it reduces the size of the exe= cutable by a few kB, and makes the source code a bit clearer too. --=-=-= Content-Type: text/x-diff Content-Disposition: inline; filename=varhook-advice-2.patch --- src/lisp.h +++ src/lisp.h @@ -305,6 +305,15 @@ #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. @@ -359,7 +370,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) @@ -1597,10 +1608,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. */ @@ -3391,6 +3405,14 @@ EXFUN (Fbyteorder, 0) ATTRIBUTE_CONST; /* Defined in data.c. */ +typedef enum + { /* See set_internal for a description of these values. */ + 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 { @@ -3438,7 +3460,15 @@ Lisp_Object); extern _Noreturn Lisp_Object wrong_type_argument (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 void set_internal_vetted (Lisp_Object, Lisp_Object, Lisp_Object, bool, + Dyn_Bind_Env, struct Lisp_Symbol *); +extern void set_internal_localized_or_forwarded (Lisp_Object, Lisp_Object, + Lisp_Object, bool, + Dyn_Bind_Env, + struct Lisp_Symbol *); +extern void 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 *); @@ -4595,6 +4626,56 @@ 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. */ + +INLINE void +set_internal (Lisp_Object symbol, Lisp_Object newval, Lisp_Object where, + bool bindflag, Dyn_Bind_Env env) +{ + struct Lisp_Symbol *sym; + + /* If restoring in a dead buffer, do nothing. */ + /* if (BUFFERP (where) && NILP (XBUFFER (where)->name)) + return; */ + + CHECK_SYMBOL (symbol); + sym = XSYMBOL (symbol); + if (sym->vetted) + { + set_internal_vetted (symbol, newval, where, bindflag, env, sym); + return; + } + + start: + switch (sym->redirect) + { + case SYMBOL_PLAINVAL: SET_SYMBOL_VAL (sym, newval); return; + case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start; + default: 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 @@ -267,7 +267,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. */ @@ -547,7 +547,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. */ + set_internal (sym, val, Qnil, false, Dyn_Current); args_left = Fcdr (XCDR (args_left)); } @@ -620,7 +620,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"); @@ -637,7 +637,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; @@ -652,7 +652,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); @@ -2007,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++; @@ -3132,8 +3132,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. */ @@ -3141,11 +3139,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"); @@ -3176,7 +3178,7 @@ { specpdl_ptr->let.kind = SPECPDL_LET_DEFAULT; grow_specpdl (); - Fset_default (symbol, value); + set_default_internal (symbol, value, Dyn_Bind); return; } } @@ -3184,7 +3186,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 (); @@ -3319,7 +3321,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 @@ -3329,8 +3333,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: { @@ -3342,7 +3346,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; } @@ -3537,7 +3541,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: @@ -3553,7 +3557,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; @@ -3828,6 +3832,51 @@ still determine whether to handle the particular condition. */); Vdebug_on_signal = Qnil; + 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 a singleton list wrapping the current value, or nil if unbound. +NEWVAL is a singleton list wrapping the new value to which the setter, +i.e. the caller of a function such as `setq', is attempting to set the +variable, or nil if the setter called `makunbound'. The actual new value to +which the variable will be set is the `car' of the return value of this +function. The return value is NEWVAL if this function doesn't have advice that +overrides it. If the return value is nil, then the variable will be unbound. + +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, +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, unshadowed due to destruction of the setter's current +dynamic environment, such as due to exit of a `let' form. + +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. + +Don't set the variable in your advice; that would cause a recursive call +to 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 @@ -612,6 +613,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 @@ -661,6 +676,46 @@ 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); + 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. */) @@ -1137,8 +1192,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); @@ -1167,54 +1222,112 @@ 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. + + Arguments #2 and #3 are wrapped into singleton lists, unless they're + Qunbound, in which case they're replaced by nil. + + Return the unwrapped result of symbol-setter-function. The variable will be + set (by code that calls run_varhook) to that result, overriding the value + to which the setter is attempting 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_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) ? Qnil : list1 (oldval); + newval = EQ (newval, Qunbound) ? Qnil : list1 (newval); + newval = call4 (Vsymbol_setter_function, symbol, env, oldval, newval); + CHECK_LIST (newval); + return EQ (newval, Qnil) ? Qunbound : XCAR (newval); +} + 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); + set_internal (symbol, newval, Qnil, false, Dyn_Current); return newval; } -/* 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. */ + +/* Factored out from set_internal to avoid inlining the non-hotpath. */ void -set_internal (Lisp_Object symbol, Lisp_Object newval, Lisp_Object where, - bool bindflag) +set_internal_vetted (Lisp_Object symbol, Lisp_Object newval, Lisp_Object where, + bool bindflag, Dyn_Bind_Env env, struct Lisp_Symbol *sym) { - bool voide = EQ (newval, Qunbound); - struct Lisp_Symbol *sym; - Lisp_Object tem1; - - /* If restoring in a dead buffer, do nothing. */ - /* if (BUFFERP (where) && NILP (XBUFFER (where)->name)) - return; */ - - CHECK_SYMBOL (symbol); - if (SYMBOL_CONSTANT_P (symbol)) + if (SYM_HOOKED_P (sym)) { + start: + switch (sym->redirect) + { + case SYMBOL_PLAINVAL: + SET_SYMBOL_VAL (sym, run_varhook (sym, false, env, sym->val.value, newval)); + return; + case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start; + default: + set_internal_localized_or_forwarded (symbol, newval, where, bindflag, env, sym); + return; + } + } if (NILP (Fkeywordp (symbol)) || !EQ (newval, Fsymbol_value (symbol))) xsignal1 (Qsetting_constant, symbol); else /* Allow setting keywords to their own value. */ return; - } +} - sym = XSYMBOL (symbol); +/* Split from set_internal to avoid code duplication, because both set_internal and + set_internal_vetted must call this function. */ - start: +void +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)) { @@ -1258,6 +1371,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)) { @@ -1285,6 +1399,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); @@ -1316,6 +1433,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. */ @@ -1347,8 +1469,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, @@ -1413,6 +1535,17 @@ for this variable. */) (Lisp_Object symbol, Lisp_Object value) { + set_default_internal (symbol, value, Dyn_Global); + return value; +} + +/* Like Fset_default, but with ENV argument. See set_internal for + a description of this argument. */ + +void +set_default_internal (Lisp_Object symbol, Lisp_Object value, + Dyn_Bind_Env env) +{ struct Lisp_Symbol *sym; CHECK_SYMBOL (symbol); @@ -1423,26 +1556,32 @@ xsignal1 (Qsetting_constant, symbol); else /* Allow setting keywords to their own value. */ - return value; + return; } sym = XSYMBOL (symbol); start: switch (sym->redirect) { + case SYMBOL_PLAINVAL: + { + set_internal (symbol, value, Qnil, false, env); + return; + } 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); /* If the default binding is now loaded, set the REALVALUE slot too. */ if (blv->fwd && EQ (blv->defcell, blv->valcell)) store_symval_forwarding (blv->fwd, value, NULL); - return value; + return; } case SYMBOL_FORWARDED: { @@ -1456,6 +1595,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, @@ -1468,10 +1609,13 @@ if (!PER_BUFFER_VALUE_P (b, idx)) set_per_buffer_value (b, offset, value); } - return value; + return; } else - return Fset (symbol, value); + { + set_internal (symbol, value, Qnil, false, env); + return; + } } default: emacs_abort (); } @@ -1599,7 +1743,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) @@ -1672,7 +1816,7 @@ default: emacs_abort (); } - if (sym->constant) + if (SYM_CONST_P (sym)) error ("Symbol %s may not be buffer-local", SDATA (SYMBOL_NAME (variable))); @@ -1861,7 +2005,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); @@ -3470,6 +3614,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 +3759,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); @@ -3678,10 +3831,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 @@ -3390,7 +3390,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; consing_since_gc += sizeof (struct Lisp_Symbol); --- src/lread.c +++ src/lread.c @@ -3821,7 +3821,7 @@ if ((SREF (string, 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); } @@ -4042,7 +4042,7 @@ set_symbol_function (Qunbound, Qnil); set_symbol_plist (Qunbound, Qnil); SET_SYMBOL_VAL (XSYMBOL (Qnil), Qnil); - XSYMBOL (Qnil)->constant = 1; + XSYMBOL (Qnil)->vetted = SYM_CONST; XSYMBOL (Qnil)->declared_special = true; set_symbol_plist (Qnil, Qnil); set_symbol_function (Qnil, Qnil); @@ -4050,7 +4050,7 @@ Qt = intern_c_string ("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 @@ -5753,7 +5753,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 @@ -840,7 +840,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 @@ -5197,19 +5197,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 @@ -2507,6 +2507,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 () --=-=-=--