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: Mon, 23 Feb 2015 03:09:17 +0000 Message-ID: References: NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: ger.gmane.org 1424661093 2220 80.91.229.3 (23 Feb 2015 03:11:33 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Mon, 23 Feb 2015 03:11:33 +0000 (UTC) Cc: emacs-devel@gnu.org To: Stefan Monnier Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Mon Feb 23 04:11:22 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 1YPjQX-0003tJ-LJ for ged-emacs-devel@m.gmane.org; Mon, 23 Feb 2015 04:11:22 +0100 Original-Received: from localhost ([::1]:41858 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1YPjQW-0001ju-Jo for ged-emacs-devel@m.gmane.org; Sun, 22 Feb 2015 22:11:20 -0500 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:36237) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1YPjQE-0001ir-Ee for emacs-devel@gnu.org; Sun, 22 Feb 2015 22:11:05 -0500 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1YPjQA-0005ir-9l for emacs-devel@gnu.org; Sun, 22 Feb 2015 22:11:02 -0500 Original-Received: from relay6-d.mail.gandi.net ([2001:4b98:c:538::198]:58979) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1YPjQ9-0005if-Sp for emacs-devel@gnu.org; Sun, 22 Feb 2015 22:10:58 -0500 Original-Received: from mfilter34-d.gandi.net (mfilter34-d.gandi.net [217.70.178.165]) by relay6-d.mail.gandi.net (Postfix) with ESMTP id 0C21CFB86E; Mon, 23 Feb 2015 04:10:53 +0100 (CET) X-Virus-Scanned: Debian amavisd-new at mfilter34-d.gandi.net Original-Received: from relay6-d.mail.gandi.net ([217.70.183.198]) by mfilter34-d.gandi.net (mfilter34-d.gandi.net [10.0.15.180]) (amavisd-new, port 10024) with ESMTP id KfjvXdpisBmS; Mon, 23 Feb 2015 04:10:50 +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 relay6-d.mail.gandi.net (Postfix) with ESMTPSA id 2E151FB882; Mon, 23 Feb 2015 04:10:43 +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::198 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:183409 Archived-At: --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable Stefan Monnier wrote: >> You originally objected to my patch slowing down Emacs. So I looked f= or >> optimization opportunities to ensure that my patch paid for its perfor= mance >> costs. I was successful, and not only did I offset the costs, I even >> produced a net improvement in speed, and provided benchmarks to prove = it. > > I'm sorry, but I consider this a form of lying. It makes it sound like > "the new var-hook functionality actually speeds things up", even though > it's not this new functionality but some unrelated (tho bundled) change > which does it (and which could be applied independently). I didn't say the varhook functionality speeds things up. I explicitly sai= d it has performance costs, and I found optimization opportunities to _pa= y for_ those costs. And again, I didn't say I eliminated the costs; I said I _offset_ the cos= ts, and did better than just break even. I was completely honest about what I did, and why I did it. And you accus= e me of lying? > The issue is not patch size per se, but just keeping the patch focused > on its core purpose. The constant-hooked combination is an optimization, not part of the patch= 's core purpose, yet you told me to include it anyway. Varhook works just= fine without that optimization (and the patch is simpler without it), as= shown by the varhook-single.patch I submitted on Feb 5th. The patch could be applied to trunk without that optimization, then the o= ptimization applied later, along with all the rest, without affecting the= functionality of Emacs in general or of the varhook feature in particula= r. But I'm leaving it in the patch, just because you asked me to put it ther= e. I don't want to bother to take it back out now, and IIUC, you still wa= nt me to leave it in. > "unnecessary" and "pathological" are judgments which are actually hard > to make for such a generic hooking functionality where we don't (want > to) know what the applications will be. > > As a general design principle Emacs doesn't really try to prevent you > from shooting yourself in the foot. Fine, but adding the capability of converting setq, etc into makunbound h= as the cost of breaking correctness (because hooking a symbol would chang= e the behavior of (setq foo void-sentinel)), not just the cost of enablin= g user errors. Remember, this capability isn't something I'm removing fro= m Emacs; it's just an additional capability that varhook could add. The b= enefit isn't worth the cost. Updated patch attached. Changes, as you requested: setq, etc return the attempt value instead of the override value. One bug fixed. Another bug intentionally added. The void sentinel value is un-marked as special, and the constant is rena= med. Function names changed yet again. Now they all start with =E2=8C=9Csymbol= -hook=E2=8C=9D. All mention of =C2=ABadvice=C2=BB banished from the documentation. The documentation is more explicit about the cases in which each environm= ent is affected. As much as possible without making the documentation incomprehensible, it= now conflates symbols with global variables. The field name in Lisp_Symbol changed back to the misleading name, just t= o avoid touching a few lines of code in the patch. Magic constants added back in to the source code, just to avoid touching = a few lines of code in the patch. All optimizations removed, except for the particular one (combining const= ant and hooked) that you told me to include, which happens to be the most= invasive one, yet with no more benefit than the others. This version of the patch slows down Emacs. IIUC, I've made all the changes you requested. --=-=-= Content-Type: text/x-diff; charset=utf-8 Content-Disposition: inline; filename=varhook-bikeshedded.patch Content-Transfer-Encoding: quoted-printable --- src/lisp.h +++ src/lisp.h @@ -290,6 +290,17 @@ # define GCALIGNED /* empty */ #endif =20 +enum symbol_constant +{ + SYM_UNVETTED =3D 0, + SYM_CONST =3D 1, + SYM_HOOKED =3D 2 +}; + +# define SYM_CONST_P(sym) (((sym)->constant) =3D=3D SYM_CONST) +# define SYM_HOOKED_P(sym) (((sym)->constant) =3D=3D 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 +355,7 @@ #define lisp_h_NILP(x) EQ (x, Qnil) #define lisp_h_SET_SYMBOL_VAL(sym, v) \ (eassert ((sym)->redirect =3D=3D SYMBOL_PLAINVAL), (sym)->val.value =3D= (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 =3D=3D SYMBOL_PLAINVAL), (sym)->val.value) #define lisp_h_SYMBOLP(x) (XTYPE (x) =3D=3D Lisp_Symbol) @@ -659,10 +670,12 @@ 3 : it's a forwarding variable, the value is in `forward'. */ ENUM_BF (symbol_redirect) redirect : 3; =20 - /* 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; + /* SYM_CONST means symbol is constant, i.e. changing its value should = signal + an error. SYM_HOOKED means setting symbol will run varhook. These t= wo + attributes are combined into one field to optimize the fast path of + non-hooked non-constants by having only one conditional branch for = that + case. The name of this field is =E2=8C=9Cconstant=E2=8C=9D for hist= orical reasons. */ + ENUM_BF (symbol_constant) constant : 2; =20 /* Interned state of the symbol. This is an enumerator from enum symbol_interned. */ @@ -3463,6 +3476,14 @@ } =20 /* Defined in data.c. */ +typedef enum + { /* See set_internal for a description of these values. */ + Dyn_Unbind =3D -1, + Dyn_Current =3D 0, + Dyn_Bind =3D 1, + Dyn_Skip =3D 2, + Dyn_Global =3D 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,16 @@ 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 void set_internal (Lisp_Object, Lisp_Object, Lisp_Object, bool, D= yn_Bind_Env); +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_Objec= t, + 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 *); =20 @@ -4776,6 +4806,12 @@ return false; } =20 +#define MAYBE_RUN_VARHOOK(result, sym, buf_local, env, oldval, newval) \ + { \ + if (SYM_HOOKED_P (sym)) \ + (result) =3D run_varhook (sym, buf_local, env, oldval, newval); \ + } + INLINE_HEADER_END =20 #endif /* EMACS_LISP_H */ --- src/eval.c +++ src/eval.c @@ -616,7 +616,7 @@ =20 sym =3D XSYMBOL (new_alias); =20 - if (sym->constant) + if (SYM_CONST_P (sym)) /* Not sure why, but why not? */ error ("Cannot make a constant an alias"); =20 @@ -633,7 +633,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, tr= ue, Dyn_Current); =20 { union specbinding *p; @@ -3049,8 +3049,11 @@ grow_specpdl (); if (!sym->constant) 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_LOCALIZED: if (SYMBOL_BLV (sym)->frame_local) @@ -3082,7 +3085,7 @@ { specpdl_ptr->let.kind =3D 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 =3D SPECPDL_LET; =20 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 =3D XSYMBOL (specpdl_symbol (specpdl_ptr)); if (sym->redirect =3D=3D SYMBOL_PLAINVAL) { - SET_SYMBOL_VAL (sym, specpdl_old_value (specpdl_ptr)); + Lisp_Object oldval =3D specpdl_old_value (specpdl_ptr); + MAYBE_RUN_VARHOOK (oldval, sym, false, Dyn_Unbind, sym->val.value, old= val); + 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 =3D specpdl_symbol (tmp); Lisp_Object old_value =3D 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,63 @@ still determine whether to handle the particular condition. */); Vdebug_on_signal =3D Qnil; =20 + DEFSYM (Qsymbol_hook_void_value, "symbol-hook-void-value"); + DEFVAR_LISP ("symbol-hook-void-value", Vsymbol_hook_void_value, + 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-hook-function'. */); + Vsymbol_hook_void_value =3D Fmake_symbol (build_string ("::void::")); + XSYMBOL (Vsymbol_hook_void_value)->constant =3D SYM_CONST; + XSYMBOL (Qsymbol_hook_void_value)->declared_special =3D true; + XSYMBOL (Qsymbol_hook_void_value)->constant =3D SYM_CONST; + + DEFVAR_LISP ("symbol-hook-function", Vsymbol_hook_function, + doc: /* This function is called whenever a hooked variable is set= . +It takes four arguments: SYMBOL, ENV, OLDVAL, NEWVAL. By default, it jus= t +returns NEWVAL unchanged. + +SYMBOL is the symbol being set. ENV is the environment is which it's bei= ng +set. OLDVAL is the current value, or if the current value is void, then = OLDVAL +is the value of `symbol-hook-void-value'. NEWVAL is the new value to whi= ch the setter, +i.e. the caller of a function such as `setq', is attempting to set the +variable, or the value of symbol-hook-void-value if the setter called `m= akunbound'. +The actual new value to which the variable will be set is return value o= f +this function, unless the setter called makunbound and this function ret= urns +the value of symbol-hook-void-value, in which case the variable will be = set to void. + +The possible values of ENV are these symbols, with these meanings: +global: The global environment. +buf-local: The setter's buffer-local environment. ENV is this value if t= he +setter sets the buffer-local variable. +dyn-local: The innermost dynamic environment in which SYMBOL is bound. E= NV +is this value if the setter sets a dynamic local variable. +dyn-bind: A new dynamic environment. ENV is this value if the setter cre= ates +a new dynamic environment, such as by 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 environmen= t, +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 SY= MBOL +is not in the buffer-local environment. + +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 bloc= k +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 oute= r +environment, and blocking when ENV is dyn-unbind will set SYMBOL in the +outer environment to its value in the environment being destroyed. If OL= DVAL +is the value of symbol-hook-void-value but NEWVAL is not, you can overri= de the new +value, but you can't prevent the variable from being set to a non-void v= alue. + +Don't set the variable in this function; that would cause a recursive ca= ll +to this function, and even if you terminate the recursion, your setting +would be overridden by the return value of this function. Instead, if yo= u +need to set the variable, return the value from this function. + +See also `symbol-hook-set' and `symbol-hook-unset'. */); + Vsymbol_hook_function =3D 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 @@ =0C /* Extract and set components of symbols. */ =20 +DEFUN ("symbol-hook-p", Fsymbol_hook_p, Ssymbol_hook_p, 1, 1, 0, + doc: /* Return t if SYMBOL is hooked. +To hook and unhook it, use `symbol-hook-set' and `symbol-hook-unset'. +When hooked, setting SYMBOL will run `symbol-hook-function'. */) + (register Lisp_Object symbol) +{ + struct Lisp_Symbol *sym; + CHECK_SYMBOL (symbol); + sym =3D XSYMBOL (symbol); + while (sym->redirect =3D=3D SYMBOL_VARALIAS) + sym =3D 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,50 @@ return NILP (XSYMBOL (symbol)->function) ? Qnil : Qt; } =20 +DEFUN ("symbol-hook-set", Fsymbol_hook_set, Ssymbol_hook_set, 1, 1, 0, + doc: /* Hook SYMBOL. +When hooked, setting it will run `symbol-hook-function'. +To unhook it, use `symbol-hook-unset'. +To test whether it's hooked, use `symbol-hook-p'. +Return SYMBOL. */) + (register Lisp_Object symbol) +{ + struct Lisp_Symbol *sym; + CHECK_SYMBOL (symbol); + if (SYMBOL_CONSTANT_P (symbol)) + xsignal1 (Qsetting_constant, symbol); + sym =3D XSYMBOL (symbol); + sym->constant =3D SYM_HOOKED; + while (sym->redirect =3D=3D SYMBOL_VARALIAS) + { + sym =3D indirect_variable (sym); + sym->constant =3D SYM_HOOKED; + } + return symbol; +} + +DEFUN ("symbol-hook-unset", Fsymbol_hook_unset, Ssymbol_hook_unset, 1, 1= , 0, + doc: /* Unhook SYMBOL. +When unhooked, setting it will not run `symbol-hook-function'. +To hook it, use `symbol-hook-set'. +To test whether it's hooked, use `symbol-hook-p'. +Return SYMBOL. */) + (register Lisp_Object symbol) +{ + struct Lisp_Symbol *sym; + CHECK_SYMBOL (symbol); + if (SYMBOL_CONSTANT_P (symbol)) + return symbol; /* Unhooking a constant is a harmless no-op. */ + sym =3D XSYMBOL (symbol); + sym->constant =3D SYM_UNVETTED; + while (sym->redirect =3D=3D SYMBOL_VARALIAS) + { + sym =3D indirect_variable (sym); + sym->constant =3D SYM_UNVETTED; + } + return symbol; +} + DEFUN ("makunbound", Fmakunbound, Smakunbound, 1, 1, 0, doc: /* Make SYMBOL's value be void. Return SYMBOL. */) @@ -1201,11 +1259,65 @@ xsignal1 (Qvoid_variable, symbol); } =20 +/* For the symbol S being set, run symbol-hook-function with these argum= ents: + 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 + Vsymbol_hook_void_value. + + Return the result of symbol-hook-function, or if it's the value of + Vsymbol_hook_void_value and ATTEMPTED_VAL is Qunbound, return Qunboun= d. 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 variabl= e. */ + +Lisp_Object +run_varhook (struct Lisp_Symbol* sym, bool buf_local, Dyn_Bind_Env rawen= v, + Lisp_Object oldval, Lisp_Object attempted_val) +{ + Lisp_Object symbol, env, newval; + if (rawenv =3D=3D Dyn_Skip) /* From backtrace_eval_unrewind */ + return attempted_val; + XSETSYMBOL (symbol, sym); + switch (rawenv) /* Disambiguate Dyn_Current and Dyn_Global */ + { + case Dyn_Current: + { + bool shadowed =3D (buf_local ? let_shadows_buffer_binding_p (sym) + : let_shadows_global_binding_p (symbol)); + if (shadowed) env =3D Qdyn_local; + else if (buf_local) env =3D Qbuf_local; + else env =3D 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 =3D Qdyn_local; + else env =3D Qglobal; + break; + } + case Dyn_Bind: env =3D Qdyn_bind; break; + case Dyn_Unbind: env =3D Qdyn_unbind; break; + default: emacs_abort (); + } + oldval =3D EQ (oldval, Qunbound) ? Vsymbol_hook_void_value : oldval; + newval =3D EQ (attempted_val, Qunbound) ? Vsymbol_hook_void_value : at= tempted_val; + newval =3D call4 (Vsymbol_hook_function, symbol, env, oldval, newval); + if (attempted_val =3D=3D Qunbound && EQ (newval, Vsymbol_hook_void_val= ue)) + return Qunbound; /* Converting setq, etc to makunbound is prohibited= . */ + return newval; /* So symbol_hook_void_value is ignored if Qunbound was= n't attempted. */ +} + 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; } =20 @@ -1215,40 +1327,85 @@ =20 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. */ + If BINDFLAG is true, we don't do that. + + ENV indicates the dynamic environment for this function call, i.e. wh= ether + 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 gl= obal + and the dyn-local binding. */ =20 void set_internal (Lisp_Object symbol, Lisp_Object newval, Lisp_Object where, - bool bindflag) + bool bindflag, Dyn_Bind_Env env) { - bool voide =3D 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; */ =20 CHECK_SYMBOL (symbol); - if (SYMBOL_CONSTANT_P (symbol)) + sym =3D XSYMBOL (symbol); + if (sym->constant) { + set_internal_vetted (symbol, newval, where, bindflag, env, sym); + return; + } + + start: + switch (sym->redirect) + { + case SYMBOL_VARALIAS: sym =3D indirect_variable (sym); goto start; + case SYMBOL_PLAINVAL: SET_SYMBOL_VAL (sym, newval); return; + default: set_internal_localized_or_forwarded + (symbol, newval, where, bindflag, env, sym); + } +} + +void +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 =3D run_varhook (sym, false, env, sym->val.value, newval); + SET_SYMBOL_VAL (sym, newval); + return; + case SYMBOL_VARALIAS: sym =3D 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; - } +} =20 - sym =3D XSYMBOL (symbol); +/* Split from set_internal to avoid code duplication, because both set_i= nternal and + set_internal_vetted must call this function. */ =20 - start: +void +set_internal_localized_or_forwarded (Lisp_Object symbol, Lisp_Object new= val, + 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 =3D indirect_variable (sym); goto start; - case SYMBOL_PLAINVAL: SET_SYMBOL_VAL (sym , newval); return; case SYMBOL_LOCALIZED: { + bool buf_local =3D true; struct Lisp_Buffer_Local_Value *blv =3D SYMBOL_BLV (sym); if (NILP (where)) { @@ -1292,6 +1449,7 @@ indicating that we're seeing the default value. Likewise if the variable has been let-bound in the current buffer. */ + buf_local =3D false; if (bindflag || !blv->local_if_set || let_shadows_buffer_binding_p (sym)) { @@ -1319,6 +1477,9 @@ set_blv_valcell (blv, tem1); } =20 + MAYBE_RUN_VARHOOK (newval, sym, buf_local, env, blv_value (blv), newval= ); + voide =3D EQ (newval, Qunbound); + /* Store the new value in the cons cell. */ set_blv_value (blv, newval); =20 @@ -1350,6 +1511,11 @@ SET_PER_BUFFER_VALUE_P (buf, idx, 1); } =20 + MAYBE_RUN_VARHOOK (newval, sym, + (XFWDTYPE (innercontents)) =3D=3D Lisp_Fwd_Buffer_Obj, + env, do_symval_forwarding (innercontents), newval); + voide =3D EQ (newval, Qunbound); + if (voide) { /* If storing void (making the symbol void), forward only through buffer-local indicator, not through Lisp_Objfwd, etc. */ @@ -1447,6 +1613,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; =20 CHECK_SYMBOL (symbol); @@ -1457,7 +1634,7 @@ xsignal1 (Qsetting_constant, symbol); else /* Allow setting keywords to their own value. */ - return value; + return; } sym =3D XSYMBOL (symbol); =20 @@ -1465,18 +1642,24 @@ switch (sym->redirect) { case SYMBOL_VARALIAS: sym =3D indirect_variable (sym); goto start; - case SYMBOL_PLAINVAL: return Fset (symbol, value); + case SYMBOL_PLAINVAL: + { + set_internal (symbol, value, Qnil, false, env); + return; + } case SYMBOL_LOCALIZED: { struct Lisp_Buffer_Local_Value *blv =3D SYMBOL_BLV (sym); =20 + MAYBE_RUN_VARHOOK (value, sym, false, env, XCDR (blv->defcell), value); + /* Store new value into the DEFAULT-VALUE slot. */ XSETCDR (blv->defcell, value); =20 /* 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: { @@ -1490,6 +1673,8 @@ int offset =3D XBUFFER_OBJFWD (valcontents)->offset; int idx =3D PER_BUFFER_IDX (offset); =20 + MAYBE_RUN_VARHOOK (value, sym, false, env, per_buffer_default (offs= et), value); + set_per_buffer_default (offset, value); =20 /* If this variable is not always local in all buffers, @@ -1502,10 +1687,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 (); } @@ -1633,7 +1821,7 @@ default: emacs_abort (); } =20 - if (sym->constant) + if (SYM_CONST_P (sym)) error ("Symbol %s may not be buffer-local", SDATA (SYMBOL_NAME (vari= able))); =20 if (!blv) @@ -1706,7 +1894,7 @@ default: emacs_abort (); } =20 - if (sym->constant) + if (SYM_CONST_P (sym)) error ("Symbol %s may not be buffer-local", SDATA (SYMBOL_NAME (variable))); =20 @@ -1895,7 +2083,8 @@ default: emacs_abort (); } =20 - if (sym->constant) + /* Intentional bug, at Stefan's insistence. */ + if (sym->constant) /* This should be: if (SYM_CONST_P (sym)) */ error ("Symbol %s may not be frame-local", SDATA (SYMBOL_NAME (varia= ble))); =20 blv =3D make_blv (sym, forwarded, valcontents); @@ -3474,6 +3663,12 @@ DEFSYM (Qad_advice_info, "ad-advice-info"); DEFSYM (Qad_activate_internal, "ad-activate-internal"); =20 + 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 =3D pure_cons (Qerror, Qnil); =20 /* ERROR is used as a signaler for random errors for which nothing els= e is @@ -3609,8 +3804,11 @@ defsubr (&Sindirect_function); defsubr (&Ssymbol_plist); defsubr (&Ssymbol_name); + defsubr (&Ssymbol_hook_set); + defsubr (&Ssymbol_hook_unset); defsubr (&Smakunbound); defsubr (&Sfmakunbound); + defsubr (&Ssymbol_hook_p); defsubr (&Sboundp); defsubr (&Sfboundp); defsubr (&Sfset); --- 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 (); } } --- 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'.") =0C +(setq symbol-hook-function ; Defined in eval.c + (lambda (_sym _env _oldval newval) newval)) +=0C ;;;; Misc. useful functions. =20 (defsubst buffer-narrowed-p () --=-=-=--