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, 13 Feb 2015 23:08:21 +0000 Message-ID: References: NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: ger.gmane.org 1423869016 14977 80.91.229.3 (13 Feb 2015 23:10:16 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Fri, 13 Feb 2015 23:10:16 +0000 (UTC) Cc: emacs-devel@gnu.org To: Stefan Monnier Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Sat Feb 14 00:10:05 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 1YMPN7-00044D-0w for ged-emacs-devel@m.gmane.org; Sat, 14 Feb 2015 00:10:05 +0100 Original-Received: from localhost ([::1]:57848 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1YMPN6-0003yg-5T for ged-emacs-devel@m.gmane.org; Fri, 13 Feb 2015 18:10:04 -0500 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:37842) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1YMPMy-0003x7-WC for emacs-devel@gnu.org; Fri, 13 Feb 2015 18:10:01 -0500 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1YMPMt-0006LJ-Mu for emacs-devel@gnu.org; Fri, 13 Feb 2015 18:09:56 -0500 Original-Received: from relay4-d.mail.gandi.net ([2001:4b98:c:538::196]:36986) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1YMPMt-0006L5-98 for emacs-devel@gnu.org; Fri, 13 Feb 2015 18:09:51 -0500 Original-Received: from mfilter17-d.gandi.net (mfilter17-d.gandi.net [217.70.178.145]) by relay4-d.mail.gandi.net (Postfix) with ESMTP id CBB00172080; Sat, 14 Feb 2015 00:09:46 +0100 (CET) X-Virus-Scanned: Debian amavisd-new at mfilter17-d.gandi.net Original-Received: from relay4-d.mail.gandi.net ([217.70.183.196]) by mfilter17-d.gandi.net (mfilter17-d.gandi.net [10.0.15.180]) (amavisd-new, port 10024) with ESMTP id pBx1z6njPCkH; Sat, 14 Feb 2015 00:09:44 +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 6AA9717207C; Sat, 14 Feb 2015 00:09:32 +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:183034 Archived-At: --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable Stefan Monnier wrote: > We don't want to install this in emacs-24, so only the trunk (aka > "master") code is important in this respect. Understood. Last time I included the 24.4 patch just to ensure you could = reproduce my benchmark results. (Due to some logistical issues, I can't r= un trunk on a system that has stable performance, so I can't reliably ben= chmark it.) >> +typedef enum >> + { >> + Dyn_Unbind =3D -1, >> + Dyn_Current =3D 0, >> + Dyn_Bind =3D 1, >> + Dyn_Skip =3D 2, >> + Dyn_Global =3D 3 >> + } Dyn_Bind_Direction; > > In which sense is this a "direction"? Originally I had just the first three values, and it was a direction in t= he sense of movement up or down the dynamic-binding stack. Later I discov= ered that I needed the last two values too. I've changed it to a more app= ropriate name. > That's a good idea, to circumvent the question of how to not-trigger th= e > hooked-p check recursively when the hook function calls the setter (tho > the question partly remains, in case the hook function *accidentally* > sets one of the hooked variables). The docstring for symbol-setter-function says lexical binding is required= for the hook function, which means its local variables won't trigger var= hook. If the hook function does set a dynamic variable that's hooked, and= has no terminating condition for the recursion, you'll immediately find = out when it exceeds max-lisp-eval-depth. So, don't do that. ;-) > It does mean that the hooks can't redirect the assignment elsewhere, bu= t > maybe it's a good thing anyway. They still can. Just temporarily unhook the destination variable before s= etting it. But yes, it would be easy to introduce bugs by doing that, so = I guess the documentation should discourage it. >> + if (shadowed) env =3D Qdyn_local; >> + else if (buf_local) env =3D Qbuf_local; >> + else env =3D Qglobal; > > Why does the hook need to know about those different cases? So the user can notice, during debugging, if setq is setting the symbol i= n a different environment than the one he intended, e.g. due to an unexpe= cted buffer-local variable or due to a missing buffer-local variable, or = due to an unexpected dynamic binding of a global variable in code that ca= lls code that uses setq with the assumption that the global (not a dynami= c local) variable will be set. Also, this enables detailed profiling of g= lobals vs. buffer-locals vs. dynamic bindings. And it lets your hook func= tion filter out the cases you want to ignore, e.g. if you only want to wa= tch global settings, not buffer-local or let-local. >> +DEFUN ("symbol-setter-function", Fsymbol_setter_function, Ssymbol_set= ter_function, 4, 4, 0, > > Hmm, no symbol-setter-function should be a variable (holding > a function), modified via add-function/remove-function. I don't see why; the only difference is using add-function with an unquot= ed variable name vs. using advice-add with a quoted function name. It als= o makes the hook run a bit slower. And it results in the help page for th= e function exposing the advice mechanism's internal representation of the= advice, rather than cleanly showing e.g. =E2=8C=9C:before advice: `mywat= cher'=E2=8C=9D. That seems like a bad idea. But anyway I changed it to what you want, IIUC. I hope I misunderstood. > Also the docstring should not recommend :override (which should be > a rather rare case, the more useful cases are probably :before > and :around) The docstring already says to use :before if you just need to watch varia= bles, but not block or override attempts to set them. And :around is the = same as :override in this case, since all the standard function does is r= eturn newval, which is overridden by either :around or :override; the sta= ndard function doesn't do any processing. Unless maybe you want to have m= ultiple pieces of advice wrapped around each other, all blocking/overridi= ng attempts to set variables? Anyway I changed the docstring to recommend :around instead of :override. I also made the other changes you wanted. And I cleaned up the patch a bi= t, consolidating set_internal and set_internal_1, so the extra name isn't= needed anymore. (This is just a cosmetic change; it doesn't affect the c= ompiled code, since one was just a wrapper for the other and both were in= lined.) And I fixed a bug: it was reporting the wrong environment for set= q-default if you do: (setq-local foo 'bar) (let ((foo 'baz)) (setq-default foo 'biz)) Updated patch attached. --=-=-= Content-Type: text/x-diff Content-Disposition: inline; filename=varhook-advice-1.patch --- src/lisp.h +++ src/lisp.h @@ -305,6 +305,17 @@ #endif +/* These are the masks for the constant_or_hooked field of Lisp_Symbol. + Bit 0 stores the constant field. Bit 1 stores the hooked field. */ +#define SYMBOL_CONSTANT_MASK 1 +#define SYMBOL_HOOKED_MASK 2 + +# define SYM_CONSTANT_P(sym) (((sym)->constant_or_hooked) \ + & SYMBOL_CONSTANT_MASK) +# define SYM_HOOKED_P(sym) (((sym)->constant_or_hooked) \ + & SYMBOL_HOOKED_MASK) + + /* 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_CONSTANT_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 SYMBOL_CONSTANT_MASK, non-zero means symbol is + constant, i.e. changing its value should signal an error. + When masked with SYMBOL_HOOKED_MASK, non-zero means setting + symbol will run varhook. These two fields are combined into one + in order to optimize the fast path of unhooked non-constants by + having only one conditional branch for that case. */ + unsigned constant_or_hooked : 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,16 @@ 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_with_varhook (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 +4627,65 @@ 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->constant_or_hooked) + { + if (SYM_HOOKED_P (sym)) + { + set_internal_with_varhook (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; + } + + 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 +268,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. */ @@ -601,6 +602,63 @@ return quoted; } +DEFUN ("void-p", Fvoid_p, Svoid_p, 1, UNEVALLED, 0, + doc: /* Return t if ARG has no value. +If ARG is a non-lexical variable, this is equivalent to +(not (boundp (quote ARG))). + +Unlike `boundp', this function can also test a lexical variable. + +See also `void'. +usage: (void-p ARG) */) + (Lisp_Object args) +{ + register Lisp_Object val; + struct gcpro gcpro1; + GCPRO1 (args); + if (CONSP (XCDR (args))) + xsignal2 (Qwrong_number_of_arguments, Qvoid_p, Flength (args)); + + val = XCAR (args); + + if (SYMBOLP (val)) + { /* This block is derived from the first block of eval_sub */ + Lisp_Object lex_binding + = !NILP (Vinternal_interpreter_environment) + ? Fassq (val, Vinternal_interpreter_environment) + : Qnil; + if (CONSP (lex_binding)) + val = XCDR (lex_binding); + else + val = find_symbol_value (val); /* Avoid signaling error if unbound */ + } + else + val = eval_sub (val); + + val = EQ (val, Qunbound) ? Qt : Qnil; + UNGCPRO; + return val; +} + + +DEFUN ("void", Fvoid, Svoid, 0, 0, 0, + doc: /* Return nothing. +This is the only built-in Elisp function that does not return a value. +Returning the result of this function enables any other function +to avoid returning a value. + +Setting a variable to the result of this function will unbind the variable. +For example, (setq foo (void)) is equivalent to (makunbound 'foo), if +foo is a non-lexical variable. + +Unlike `makunbound', this function can also be used to unbind a +lexical variable. + +See also `void-p'. */) + () +{ + return Qunbound; +} DEFUN ("defvaralias", Fdefvaralias, Sdefvaralias, 2, 3, 0, doc: /* Make NEW-ALIAS a variable alias for symbol BASE-VARIABLE. @@ -620,7 +678,7 @@ sym = XSYMBOL (new_alias); - if (sym->constant) + if (SYM_CONSTANT_P (sym)) /* Not sure why, but why not? */ error ("Cannot make a constant an alias"); @@ -637,7 +695,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, 1, Dyn_Current); { union specbinding *p; @@ -652,7 +710,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->constant_or_hooked = 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 +2065,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 +3190,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 +3197,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->constant_or_hooked) 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, 1, 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 +3236,7 @@ { specpdl_ptr->let.kind = SPECPDL_LET_DEFAULT; grow_specpdl (); - Fset_default (symbol, value); + set_default_internal (symbol, value, Dyn_Bind); return; } } @@ -3184,7 +3244,7 @@ specpdl_ptr->let.kind = SPECPDL_LET; grow_specpdl (); - set_internal (symbol, value, Qnil, 1); + set_internal (symbol, value, Qnil, 1, Dyn_Bind); break; } default: emacs_abort (); @@ -3319,7 +3379,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 +3391,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 +3404,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, 1, Dyn_Unbind); } break; } @@ -3537,7 +3599,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 +3615,7 @@ { set_specpdl_old_value (tmp, Fbuffer_local_value (symbol, where)); - set_internal (symbol, old_value, where, 1); + set_internal (symbol, old_value, where, 1, Dyn_Skip); } } break; @@ -3754,6 +3816,11 @@ DEFSYM (Qinhibit_debugger, "inhibit-debugger"); DEFSYM (Qmacro, "macro"); DEFSYM (Qdeclare, "declare"); + DEFSYM (Qvoid_p, "void-p"); + DEFSYM (Qsym, "sym"); + DEFSYM (Qenv, "env"); + DEFSYM (Qoldval, "oldval"); + DEFSYM (Qnewval, "newval"); /* Note that the process handling also uses Qexit, but we don't want to staticpro it twice, so we just do it here. */ @@ -3828,6 +3895,67 @@ 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 the current value. 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. The actual new value to which the variable will be set is the +return value of this function, which is NEWVAL if this function does not +have 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, +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. + +To watch hooked variables, advise this function using `add-function' with +:before as the WHERE argument. + +To watch hooked variables and optionally override the attempts to set them, +advise this function with advice that overrides the return value, such as +by using :override or (preferably) :around as the WHERE argument. + +At the time the definition of your advice function is evaluated, +`lexical-binding' must be t, i.e. your advice must be a closure (even if +its lexical environment is empty). + +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 the variable is currently void, OLDVAL will be void. If the setter +is attempting to unbind the variable, NEWVAL will be void. Test for this +using `void-p'. If you use overriding advice, OLDVAL is void, and you return +it, the variable will remain void. If NEWVAL is void, and you return it, the +setter's attempt to unbind the variable succeeds. If neither is void, you +can still unbind the variable by returning the result of the function `void'. + +Don't set the variable in your advice. 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 = + list4 (Qclosure, list1 (Qt), list4 (Qsym, Qenv, Qoldval, Qnewval), Qnewval); + /* 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 @@ -3902,4 +4030,6 @@ defsubr (&Sbacktrace__locals); defsubr (&Sspecial_variable_p); defsubr (&Sfunctionp); + defsubr (&Svoid); + defsubr (&Svoid_p); } --- 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->constant_or_hooked |= SYMBOL_HOOKED_MASK; + while (sym->redirect == SYMBOL_VARALIAS) + { + sym = indirect_variable (sym); + sym->constant_or_hooked |= SYMBOL_HOOKED_MASK; + } + 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->constant_or_hooked &= (SYMBOL_HOOKED_MASK ^ -1); + while (sym->redirect == SYMBOL_VARALIAS) + { + sym = indirect_variable (sym); + sym->constant_or_hooked &= (SYMBOL_HOOKED_MASK ^ -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,97 @@ 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. + + Return the 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) /* Resolve Dyn_Current and disambiguate 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 (); + } + return call4 (Vsymbol_setter_function, symbol, env, oldval, 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, 0, 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. */ + +/* Split from set_internal just to avoid an extra conditional branch on the fast + path for non-hooked variables. */ void -set_internal (Lisp_Object symbol, Lisp_Object newval, Lisp_Object where, - bool bindflag) +set_internal_with_varhook (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)) + start: + switch (sym->redirect) { - if (NILP (Fkeywordp (symbol)) - || !EQ (newval, Fsymbol_value (symbol))) - xsignal1 (Qsetting_constant, symbol); - else - /* Allow setting keywords to their own value. */ + 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); + } +} - sym = XSYMBOL (symbol); +/* Split from set_internal to avoid code duplication, because both set_internal and + set_internal_with_varhook 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 +1356,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 +1384,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 +1418,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 +1454,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 +1520,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 +1541,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 +1580,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 +1594,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 +1728,7 @@ default: emacs_abort (); } - if (sym->constant) + if (SYM_CONSTANT_P (sym)) error ("Symbol %s may not be buffer-local", SDATA (SYMBOL_NAME (variable))); if (!blv) @@ -1672,7 +1801,7 @@ default: emacs_abort (); } - if (sym->constant) + if (SYM_CONSTANT_P (sym)) error ("Symbol %s may not be buffer-local", SDATA (SYMBOL_NAME (variable))); @@ -1861,7 +1990,7 @@ default: emacs_abort (); } - if (sym->constant) + if (SYM_CONSTANT_P (sym)) error ("Symbol %s may not be frame-local", SDATA (SYMBOL_NAME (variable))); blv = make_blv (sym, forwarded, valcontents); @@ -3470,6 +3599,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 +3744,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 +3816,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"))->constant_or_hooked = 1; 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"))->constant_or_hooked = 1; } --- 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->constant_or_hooked = 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)->constant_or_hooked = 1; 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)->constant_or_hooked = 1; 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)->constant_or_hooked = 1; 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"))->constant_or_hooked = 1; 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, 0, 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"))->constant_or_hooked = 1; 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"))->constant_or_hooked = 1; 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"))->constant_or_hooked = 1; staticpro (&font_style_table); font_style_table = make_uninit_vector (3); --=-=-=--