[PATCH] (Updated) Run hook when variable is set

[Kelly Dean]

Stefan Monnier wrote:
> Can I have my bikeshed transparent?

Absolutely. I'll untabify all the source code, then rename this variable to the 
tab character, and patch GCC to interpret tab as a variable. ;-)

In the meantime, an updated patch for varhook is attached. Changes from the 
previous version:

Use void-sentinel instead of consing in run_varhook.

Disallow hooking of constants. Duh.

Properly handle a case that was introduced when I added support for 
blocking/overriding the variable setting: if you hook a variable and override 
its setting, then the return value of set, setq, etc should be the override 
value instead of the originally attempted value, so that the override will 
cascade through e.g. (setq x (setq y foo)) and (if (setq z foo) ...). 
Otherwise, during debugging if e.g. you hook foo, and discover that it's nil 
there, but you want to try running that «if» condition, so you override the 
setq and set z to t, it would be annoying if the setq returned nil anyway.

Because of the previous change, I had to remove the handler function's 
capability of setting a variable to void when the setter just attempted to set 
a regular value. This is because otherwise, if x is lexical and y is special 
and hooked, and you override the setting of y by setting it to void, then (setq 
x (setq y foo)) would result in x being set to void, which isn't allowed.

But forcibly voiding a variable when it's set would be a pathological thing to 
do, so I don't think removing that capability is a problem. You can still do 
the opposite thing, i.e. override makunbound by setting a non-void value, and 
of course makunbound still works as normal (even on hooked variables) if you 
don't override it.

Removing that capability has a fortunate side effect: even if a variable is 
hooked, Emacs can now distinguish between setting it to the value of 
void-sentinel (though there's no reason to ever do that) and doing makunbound 
on it.


Any other changes I should make?


--- src/lisp.h
+++ src/lisp.h
@@ -290,6 +290,15 @@
 # define GCALIGNED /* empty */
 #endif
 
+/* These are the masks for the vetted field of Lisp_Symbol.
+   Bit 0 stores the constant field.  Bit 1 stores the hooked field.  */
+#define SYM_CONST 1
+#define SYM_HOOKED 2
+
+# define SYM_CONST_P(sym) (((sym)->vetted) & SYM_CONST)
+# define SYM_HOOKED_P(sym) (((sym)->vetted) & SYM_HOOKED)
+
+
 /* Some operations are so commonly executed that they are implemented
    as macros, not functions, because otherwise runtime performance would
    suffer too much when compiling with GCC without optimization.
@@ -344,7 +353,7 @@
 #define lisp_h_NILP(x) EQ (x, Qnil)
 #define lisp_h_SET_SYMBOL_VAL(sym, v) \
    (eassert ((sym)->redirect == SYMBOL_PLAINVAL), (sym)->val.value = (v))
-#define lisp_h_SYMBOL_CONSTANT_P(sym) (XSYMBOL (sym)->constant)
+#define lisp_h_SYMBOL_CONSTANT_P(sym) (SYM_CONST_P (XSYMBOL (sym)))
 #define lisp_h_SYMBOL_VAL(sym) \
    (eassert ((sym)->redirect == SYMBOL_PLAINVAL), (sym)->val.value)
 #define lisp_h_SYMBOLP(x) (XTYPE (x) == Lisp_Symbol)
@@ -659,10 +668,13 @@
      3 : it's a forwarding variable, the value is in `forward'.  */
   ENUM_BF (symbol_redirect) redirect : 3;
 
-  /* Non-zero means symbol is constant, i.e. changing its value
-     should signal an error.  If the value is 3, then the var
-     can be changed, but only by `defconst'.  */
-  unsigned constant : 2;
+  /* When masked with SYM_CONST, non-zero means symbol is constant,
+     i.e. changing its value should signal an error.
+     When masked with SYM_HOOKED, non-zero means setting symbol will
+     run varhook.  These two fields are combined into one in order
+     to optimize the fast path of non-hooked non-constants by
+     having only one conditional branch for that case.  */
+  unsigned vetted : 2;
 
   /* Interned state of the symbol.  This is an enumerator from
      enum symbol_interned.  */
@@ -3463,6 +3475,15 @@
 }
 
 /* Defined in data.c.  */
+typedef enum
+  { /* See set_internal for a description of these values.  */
+    Dyn_Makvoid = -2,
+    Dyn_Unbind = -1,
+    Dyn_Current = 0,
+    Dyn_Bind = 1,
+    Dyn_Skip = 2,
+    Dyn_Global = 3
+  } Dyn_Bind_Env;
 extern Lisp_Object indirect_function (Lisp_Object);
 extern Lisp_Object find_symbol_value (Lisp_Object);
 enum Arith_Comparison {
@@ -3509,7 +3530,15 @@
 extern _Noreturn void args_out_of_range_3 (Lisp_Object, Lisp_Object,
                                           Lisp_Object);
 extern Lisp_Object do_symval_forwarding (union Lisp_Fwd *);
-extern void set_internal (Lisp_Object, Lisp_Object, Lisp_Object, bool);
+extern Lisp_Object run_varhook (struct Lisp_Symbol*, bool, Dyn_Bind_Env,
+                               Lisp_Object, Lisp_Object);
+extern Lisp_Object set_internal_vetted (Lisp_Object, Lisp_Object, Lisp_Object, 
bool,
+                                        Dyn_Bind_Env, struct Lisp_Symbol *);
+extern Lisp_Object set_internal_localized_or_forwarded (Lisp_Object, 
Lisp_Object,
+                                                Lisp_Object, bool,
+                                                Dyn_Bind_Env,
+                                                struct Lisp_Symbol *);
+extern Lisp_Object set_default_internal (Lisp_Object, Lisp_Object, 
Dyn_Bind_Env);
 extern void syms_of_data (void);
 extern void swap_in_global_binding (struct Lisp_Symbol *);
 
@@ -4776,6 +4805,51 @@
     return false;
 }
 
+/* Store the value NEWVAL into SYMBOL.
+   If buffer/frame-locality is an issue, WHERE specifies which context to use.
+   (nil stands for the current buffer/frame).
+
+   If BINDFLAG is false, then if this symbol is supposed to become
+   local in every buffer where it is set, then we make it local.
+   If BINDFLAG is true, we don't do that.
+
+   ENV indicates the dynamic environment for this function call, i.e. whether
+   this call is due to a variable binding (Dyn_Bind), an unbinding 
(Dyn_Unbind),
+   or neither (Dyn_Current). As special cases, a value of Dyn_Skip is a flag
+   to disable run_varhook so that varhooks aren't run during backtraces, and
+   a value of Dyn_Global is a flag indicating that this function call is due
+   to set_default, which allows run_varhook to distinguish beween the global
+   and the dyn-local binding. And Dyn_Makvoid is a flag indicating that this
+   function call is due to makunbound, which tells run_varhook to allow
+   setting the variable to void.  */
+
+INLINE Lisp_Object
+set_internal (Lisp_Object symbol, Lisp_Object newval, Lisp_Object where,
+             bool bindflag, Dyn_Bind_Env env)
+{
+  struct Lisp_Symbol *sym;
+
+  CHECK_SYMBOL (symbol);
+  sym = XSYMBOL (symbol);
+  if (sym->vetted)
+    return set_internal_vetted (symbol, newval, where, bindflag, env, sym);
+
+ start:
+  switch (sym->redirect)
+    {
+    case SYMBOL_PLAINVAL: SET_SYMBOL_VAL (sym, newval); return newval;
+    case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
+    default: return set_internal_localized_or_forwarded
+       (symbol, newval, where, bindflag, env, sym);
+    }
+}
+
+#define MAYBE_RUN_VARHOOK(result, sym, buf_local, env, oldval, newval) \
+  {                                                                    \
+    if (SYM_HOOKED_P (sym))                                            \
+      (result) = run_varhook (sym, buf_local, env, oldval, newval);    \
+  }
+
 INLINE_HEADER_END
 
 #endif /* EMACS_LISP_H */
--- src/eval.c
+++ src/eval.c
@@ -250,7 +250,7 @@
   max_lisp_eval_depth = XINT (XCDR (data));
 }
 
-static void grow_specpdl (void);
+static inline void grow_specpdl (void);
 
 /* Call the Lisp debugger, giving it argument ARG.  */
 
@@ -530,7 +530,8 @@
                        = Fassq (sym, Vinternal_interpreter_environment)))
            XSETCDR (lex_binding, val); /* SYM is lexically bound.  */
          else
-           Fset (sym, val);    /* SYM is dynamically bound.  */
+           /* SYM is dynamically bound.  */
+           val = set_internal (sym, val, Qnil, false, Dyn_Current);
 
          args_left = Fcdr (XCDR (args_left));
        }
@@ -616,7 +617,7 @@
 
   sym = XSYMBOL (new_alias);
 
-  if (sym->constant)
+  if (SYM_CONST_P (sym))
     /* Not sure why, but why not?  */
     error ("Cannot make a constant an alias");
 
@@ -633,7 +634,7 @@
      so that old-code that affects n_a before the aliasing is setup
      still works.  */
   if (NILP (Fboundp (base_variable)))
-    set_internal (base_variable, find_symbol_value (new_alias), Qnil, 1);
+    set_internal (base_variable, find_symbol_value (new_alias), Qnil, true, 
Dyn_Current);
 
   {
     union specbinding *p;
@@ -648,7 +649,7 @@
   XSYMBOL (base_variable)->declared_special = 1;
   sym->redirect = SYMBOL_VARALIAS;
   SET_SYMBOL_ALIAS (sym, XSYMBOL (base_variable));
-  sym->constant = SYMBOL_CONSTANT_P (base_variable);
+  sym->vetted = SYMBOL_CONSTANT_P (base_variable);
   LOADHIST_ATTACH (new_alias);
   /* Even if docstring is nil: remove old docstring.  */
   Fput (new_alias, Qvariable_documentation, docstring);
@@ -2006,7 +2007,7 @@
    never-used entry just before the bottom of the stack; sometimes its
    address is taken.  */
 
-static void
+static inline void
 grow_specpdl (void)
 {
   specpdl_ptr++;
@@ -3038,8 +3039,6 @@
  start:
   switch (sym->redirect)
     {
-    case SYMBOL_VARALIAS:
-      sym = indirect_variable (sym); XSETSYMBOL (symbol, sym); goto start;
     case SYMBOL_PLAINVAL:
       /* The most common case is that of a non-constant symbol with a
         trivial value.  Make that as fast as we can.  */
@@ -3047,11 +3046,15 @@
       specpdl_ptr->let.symbol = symbol;
       specpdl_ptr->let.old_value = SYMBOL_VAL (sym);
       grow_specpdl ();
-      if (!sym->constant)
-       SET_SYMBOL_VAL (sym, value);
+      if (!sym->vetted) SET_SYMBOL_VAL (sym, value);
+      else if (SYM_HOOKED_P (sym))
+       SET_SYMBOL_VAL (sym, run_varhook
+                       (sym, false, Dyn_Bind, sym->val.value, value));
       else
-       set_internal (symbol, value, Qnil, 1);
+       set_internal (symbol, value, Qnil, true, Dyn_Bind);
       break;
+    case SYMBOL_VARALIAS:
+      sym = indirect_variable (sym); XSETSYMBOL (symbol, sym); goto start;
     case SYMBOL_LOCALIZED:
       if (SYMBOL_BLV (sym)->frame_local)
        error ("Frame-local vars cannot be let-bound");
@@ -3082,7 +3085,7 @@
              {
                specpdl_ptr->let.kind = SPECPDL_LET_DEFAULT;
                grow_specpdl ();
-               Fset_default (symbol, value);
+               set_default_internal (symbol, value, Dyn_Bind);
                return;
              }
          }
@@ -3090,7 +3093,7 @@
          specpdl_ptr->let.kind = SPECPDL_LET;
 
        grow_specpdl ();
-       set_internal (symbol, value, Qnil, 1);
+       set_internal (symbol, value, Qnil, true, Dyn_Bind);
        break;
       }
     default: emacs_abort ();
@@ -3225,7 +3228,9 @@
            struct Lisp_Symbol *sym = XSYMBOL (specpdl_symbol (specpdl_ptr));
            if (sym->redirect == SYMBOL_PLAINVAL)
              {
-               SET_SYMBOL_VAL (sym, specpdl_old_value (specpdl_ptr));
+               Lisp_Object oldval = specpdl_old_value (specpdl_ptr);
+               MAYBE_RUN_VARHOOK (oldval, sym, false, Dyn_Unbind, 
sym->val.value, oldval);
+               SET_SYMBOL_VAL (sym, oldval);
                break;
              }
            else
@@ -3235,8 +3240,8 @@
              }
          }
        case SPECPDL_LET_DEFAULT:
-         Fset_default (specpdl_symbol (specpdl_ptr),
-                       specpdl_old_value (specpdl_ptr));
+         set_default_internal (specpdl_symbol (specpdl_ptr),
+                               specpdl_old_value (specpdl_ptr), Dyn_Unbind);
          break;
        case SPECPDL_LET_LOCAL:
          {
@@ -3248,7 +3253,7 @@
            /* If this was a local binding, reset the value in the appropriate
               buffer, but only if that buffer's binding still exists.  */
            if (!NILP (Flocal_variable_p (symbol, where)))
-             set_internal (symbol, old_value, where, 1);
+             set_internal (symbol, old_value, where, true, Dyn_Unbind);
          }
          break;
        }
@@ -3454,7 +3459,7 @@
            Lisp_Object sym = specpdl_symbol (tmp);
            Lisp_Object old_value = specpdl_old_value (tmp);
            set_specpdl_old_value (tmp, Fdefault_value (sym));
-           Fset_default (sym, old_value);
+           set_default_internal (sym, old_value, Dyn_Skip);
          }
          break;
        case SPECPDL_LET_LOCAL:
@@ -3470,7 +3475,7 @@
              {
                set_specpdl_old_value
                  (tmp, Fbuffer_local_value (symbol, where));
-               set_internal (symbol, old_value, where, 1);
+               set_internal (symbol, old_value, where, true, Dyn_Skip);
              }
          }
          break;
@@ -3746,6 +3751,66 @@
 still determine whether to handle the particular condition.  */);
   Vdebug_on_signal = Qnil;
 
+  DEFSYM (Qvoid_sentinel, "void-sentinel");
+  DEFVAR_LISP ("void-sentinel", Vvoid_sentinel,
+              doc: /* Representation of voidness for hooked variables.
+The value of this constant is an uninterned Lisp symbol that represents void
+when passed to or returned from `symbol-setter-function'.  */);
+  Vvoid_sentinel = Fmake_symbol (build_string ("::void::"));
+  XSYMBOL (Vvoid_sentinel)->declared_special = true;
+  XSYMBOL (Vvoid_sentinel)->vetted = SYM_CONST;
+  XSYMBOL (Qvoid_sentinel)->declared_special = true;
+  XSYMBOL (Qvoid_sentinel)->vetted = SYM_CONST;
+
+  DEFVAR_LISP ("symbol-setter-function", Vsymbol_setter_function,
+       doc: /* This function is called whenever a hooked variable is set.
+It takes four arguments: SYMBOL, ENV, OLDVAL, NEWVAL. By default, it just
+returns NEWVAL unchanged.
+
+SYMBOL is the symbol being set. ENV is the environment is which it's being
+set. OLDVAL is the current value, or if the current value is void, then OLDVAL
+is the value of `void-sentinel'. NEWVAL is the new value to which the setter,
+i.e. the caller of a function such as `setq', is attempting to set the
+variable, or the value of void-sentinel if the setter called `makunbound'.
+The actual new value to which the variable will be set is return value of
+this function, unless the setter called makunbound and this function returns
+the value of void-sentinel, in which case the variable will be set to void.
+The return value is NEWVAL if this function lacks advice that overrides it.
+
+The possible values of ENV are these symbols, with these meanings:
+global: The global environment.
+buf-local: The setter's buffer-local environment.
+dyn-local: The innermost dynamic environment in which SYMBOL is bound.
+dyn-bind: A new dynamic environment, such as creatable using `let'.
+dyn-unbind: The next-outer dynamic environment in which SYMBOL is still bound,
+unshadowed due to destruction of the setter's current dynamic environment,
+such as due to exit of a `let' form, or the buffer-local environment if SYMBOL
+is not bound in any dynamic environment, or the global environment is SYMBOL
+is not in the buffer-local environment.
+
+If you use overriding advice, your advice must return the value to which to
+set the variable. To avoid overriding the setter's attempt to set the variable
+to NEWVAL, return NEWVAL. To block the attempt, and leave the variable
+unchanged, return OLDVAL. If ENV is dyn-bind or dyn-unbind, you can block
+the change of value, but you can't prevent the corresponding creation or
+destruction of a dynamic environment. Therefore, blocking when ENV is
+dyn-bind will set SYMBOL in the new environment to its value in the outer
+environment, and blocking when ENV is dyn-unbind will set SYMBOL in the
+outer environment to its value in the environment being destroyed. If OLDVAL
+is the value of void-sentinel but NEWVAL is not, you can override the new
+value, but you can't prevent the variable from being set to a non-void value.
+
+Don't set the variable in your advice; that would cause a recursive call
+to this function, and even if you terminate the recursion, your setting
+would be overridden by the return value of this function. Instead, if your
+advice needs to set the variable, use `add-function' with overriding advice.
+
+To hook all variables of a symbol, use `symbol-hook'. To unhook them,
+use `symbol-unhook'. If you only want to watch or override some variables
+of a symbol, then filter according to ENV, and if you use overriding advice,
+simply return NEWVAL for the ones you don't want to process.  */);
+  Vsymbol_setter_function = Qnil; /* Set in subr.el */
+
   /* When lexical binding is being used,
    Vinternal_interpreter_environment is non-nil, and contains an alist
    of lexically-bound variable, or (t), indicating an empty
--- src/data.c
+++ src/data.c
@@ -574,6 +574,20 @@
 
 /* Extract and set components of symbols.  */
 
+DEFUN ("symbol-hooked-p", Fsymbol_hooked_p, Ssymbol_hooked_p, 1, 1, 0,
+       doc: /* Return t if SYMBOL is hooked.
+To hook and unhook it, use `symbol-hook' and `symbol-unhook'.
+When hooked, setting SYMBOL will run `symbol-setter-function'.  */)
+  (register Lisp_Object symbol)
+{
+  struct Lisp_Symbol *sym;
+  CHECK_SYMBOL (symbol);
+  sym = XSYMBOL (symbol);
+  while (sym->redirect == SYMBOL_VARALIAS)
+    sym = indirect_variable (sym);
+  return SYM_HOOKED_P (sym) ? Qt : Qnil;
+}
+
 DEFUN ("boundp", Fboundp, Sboundp, 1, 1, 0,
        doc: /* Return t if SYMBOL's value is not void.
 Note that if `lexical-binding' is in effect, this refers to the
@@ -623,6 +637,48 @@
   return NILP (XSYMBOL (symbol)->function) ? Qnil : Qt;
 }
 
+DEFUN ("symbol-hook", Fsymbol_hook, Ssymbol_hook, 1, 1, 0,
+       doc: /* Hook SYMBOL.
+When hooked, setting it will run `symbol-setter-function'.
+To unhook it, use `symbol-unhook'.
+To test whether it's hooked, use `symbol-hooked-p'.
+Return SYMBOL.  */)
+  (register Lisp_Object symbol)
+{
+  struct Lisp_Symbol *sym;
+  CHECK_SYMBOL (symbol);
+  if (SYMBOL_CONSTANT_P (symbol))
+    xsignal1 (Qsetting_constant, symbol);
+  sym = XSYMBOL (symbol);
+  sym->vetted |= SYM_HOOKED;
+  while (sym->redirect == SYMBOL_VARALIAS)
+    {
+      sym = indirect_variable (sym);
+      sym->vetted |= SYM_HOOKED;
+    }
+  return symbol;
+}
+
+DEFUN ("symbol-unhook", Fsymbol_unhook, Ssymbol_unhook, 1, 1, 0,
+       doc: /* Unhook SYMBOL.
+When unhooked, setting it will not run `symbol-setter-function'.
+To hook it, use `symbol-hook'.
+To test whether it's hooked, use `symbol-hooked-p'.
+Return SYMBOL.  */)
+  (register Lisp_Object symbol)
+{
+  struct Lisp_Symbol *sym;
+  CHECK_SYMBOL (symbol);
+  sym = XSYMBOL (symbol);
+  sym->vetted &= (SYM_HOOKED ^ -1);
+  while (sym->redirect == SYMBOL_VARALIAS)
+    {
+      sym = indirect_variable (sym);
+      sym->vetted &= (SYM_HOOKED ^ -1);
+    }
+  return symbol;
+}
+
 DEFUN ("makunbound", Fmakunbound, Smakunbound, 1, 1, 0,
        doc: /* Make SYMBOL's value be void.
 Return SYMBOL.  */)
@@ -631,7 +685,7 @@
   CHECK_SYMBOL (symbol);
   if (SYMBOL_CONSTANT_P (symbol))
     xsignal1 (Qsetting_constant, symbol);
-  Fset (symbol, Qunbound);
+  set_internal (symbol, Qunbound, Qnil, false, Dyn_Makvoid);
   return symbol;
 }
 
@@ -1171,8 +1225,8 @@
  start:
   switch (sym->redirect)
     {
-    case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
     case SYMBOL_PLAINVAL: return SYMBOL_VAL (sym);
+    case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
     case SYMBOL_LOCALIZED:
       {
        struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (sym);
@@ -1201,54 +1255,116 @@
   xsignal1 (Qvoid_variable, symbol);
 }
 
+/* For the symbol S being set, run symbol-setter-function with these arguments:
+   0. S
+   1. A symbol indicating the environment in which S is being set.
+   2. The current value of S in that environment.
+   3. The value to which the setter is attempting to set the variable.
+
+   If argument #2 or #3 is Qunbound, it's replaced by the value of
+   Vvoid_sentinel.
+
+   Return the result of symbol-setter-function, or if it's the value of
+   Vvoid_sentinel and RAWENV is Dyn_Makvoid, return Qunbound; this avoids
+   blocking the setter's call to makunbound. The variable will be set
+   (by code that calls run_varhook) to that return value, overriding
+   the value to which the setter attempted to set the variable.  */
+
+Lisp_Object
+run_varhook (struct Lisp_Symbol* sym, bool buf_local, Dyn_Bind_Env rawenv,
+            Lisp_Object oldval, Lisp_Object newval)
+{
+  Lisp_Object symbol;
+  Lisp_Object env;
+  if (rawenv == Dyn_Skip) /* From backtrace_eval_unrewind */
+    return newval;
+  XSETSYMBOL (symbol, sym);
+  switch (rawenv) /* Disambiguate Dyn_Current and Dyn_Global */
+    {
+    case Dyn_Makvoid:
+    case Dyn_Current:
+      {
+       bool shadowed = (buf_local ? let_shadows_buffer_binding_p (sym)
+                         : let_shadows_global_binding_p (symbol));
+       if (shadowed) env = Qdyn_local;
+       else if (buf_local) env = Qbuf_local;
+       else env = Qglobal;
+       break;
+      }
+    case Dyn_Global:
+      {
+       /* let_shadows_buffer_binding_p doesn't disambiguate this case */
+       if (let_shadows_global_binding_p (symbol) &&
+           NILP (Flocal_variable_p (symbol, Qnil)))
+         env = Qdyn_local;
+       else env = Qglobal;
+       break;
+      }
+    case Dyn_Bind: env = Qdyn_bind; break;
+    case Dyn_Unbind: env = Qdyn_unbind; break;
+    default: emacs_abort ();
+    }
+  oldval = EQ (oldval, Qunbound) ? Vvoid_sentinel : oldval;
+  newval = EQ (newval, Qunbound) ? Vvoid_sentinel : newval;
+  newval = call4 (Vsymbol_setter_function, symbol, env, oldval, newval);
+  if (rawenv == Dyn_Makvoid && EQ (newval, Vvoid_sentinel))
+    return Qunbound; /* Converting setq, etc to makunbound is prohibited. */
+  return newval; /* So void_sentinel is ignored except for makunbound. */
+}
+
 DEFUN ("set", Fset, Sset, 2, 2, 0,
        doc: /* Set SYMBOL's value to NEWVAL, and return NEWVAL.  */)
   (register Lisp_Object symbol, Lisp_Object newval)
 {
-  set_internal (symbol, newval, Qnil, 0);
-  return newval;
+  return set_internal (symbol, newval, Qnil, false, Dyn_Current);
 }
 
-/* Store the value NEWVAL into SYMBOL.
-   If buffer/frame-locality is an issue, WHERE specifies which context to use.
-   (nil stands for the current buffer/frame).
-
-   If BINDFLAG is false, then if this symbol is supposed to become
-   local in every buffer where it is set, then we make it local.
-   If BINDFLAG is true, we don't do that.  */
+/* set_internal is in lisp.h due to being inlined.  */
 
-void
-set_internal (Lisp_Object symbol, Lisp_Object newval, Lisp_Object where,
-             bool bindflag)
-{
-  bool voide = EQ (newval, Qunbound);
-  struct Lisp_Symbol *sym;
-  Lisp_Object tem1;
+/* Factored out from set_internal to avoid inlining the non-hotpath.  */
 
-  /* If restoring in a dead buffer, do nothing.  */
-  /* if (BUFFERP (where) && NILP (XBUFFER (where)->name))
-      return; */
-
-  CHECK_SYMBOL (symbol);
-  if (SYMBOL_CONSTANT_P (symbol))
+Lisp_Object
+set_internal_vetted (Lisp_Object symbol, Lisp_Object newval, Lisp_Object where,
+                            bool bindflag, Dyn_Bind_Env env, struct 
Lisp_Symbol *sym)
+{
+  if (SYM_HOOKED_P (sym))
     {
+    start:
+      switch (sym->redirect)
+       {
+       case SYMBOL_PLAINVAL:
+         newval = run_varhook (sym, false, env, sym->val.value, newval);
+         SET_SYMBOL_VAL (sym, newval);
+         return newval;
+       case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
+       default:
+         return set_internal_localized_or_forwarded
+           (symbol, newval, where, bindflag, env, sym);
+       }
+    }
       if (NILP (Fkeywordp (symbol))
          || !EQ (newval, Fsymbol_value (symbol)))
        xsignal1 (Qsetting_constant, symbol);
       else
        /* Allow setting keywords to their own value.  */
-       return;
-    }
+       return newval;
+}
 
-  sym = XSYMBOL (symbol);
+/* Split from set_internal to avoid code duplication, because both 
set_internal and
+   set_internal_vetted must call this function.  */
 
- start:
+Lisp_Object
+set_internal_localized_or_forwarded (Lisp_Object symbol, Lisp_Object newval,
+                                    Lisp_Object where, bool bindflag,
+                                    Dyn_Bind_Env env, struct Lisp_Symbol *sym)
+{
+  bool voide;
+  Lisp_Object tem1;
   switch (sym->redirect)
     {
-    case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
-    case SYMBOL_PLAINVAL: SET_SYMBOL_VAL (sym , newval); return;
     case SYMBOL_LOCALIZED:
       {
+       bool buf_local = true;
        struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (sym);
        if (NILP (where))
          {
@@ -1292,6 +1408,7 @@
                   indicating that we're seeing the default value.
                   Likewise if the variable has been let-bound
                   in the current buffer.  */
+               buf_local = false;
                if (bindflag || !blv->local_if_set
                    || let_shadows_buffer_binding_p (sym))
                  {
@@ -1319,6 +1436,9 @@
            set_blv_valcell (blv, tem1);
          }
 
+       MAYBE_RUN_VARHOOK (newval, sym, buf_local, env, blv_value (blv), 
newval);
+       voide = EQ (newval, Qunbound);
+
        /* Store the new value in the cons cell.  */
        set_blv_value (blv, newval);
 
@@ -1350,6 +1470,11 @@
              SET_PER_BUFFER_VALUE_P (buf, idx, 1);
          }
 
+       MAYBE_RUN_VARHOOK (newval, sym,
+                          (XFWDTYPE (innercontents)) == Lisp_Fwd_Buffer_Obj,
+                          env, do_symval_forwarding (innercontents), newval);
+       voide = EQ (newval, Qunbound);
+
        if (voide)
          { /* If storing void (making the symbol void), forward only through
               buffer-local indicator, not through Lisp_Objfwd, etc.  */
@@ -1362,7 +1487,7 @@
       }
     default: emacs_abort ();
     }
-  return;
+  return newval;
 }
 
 /* Access or set a buffer-local symbol's default value.  */
@@ -1381,8 +1506,8 @@
  start:
   switch (sym->redirect)
     {
-    case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
     case SYMBOL_PLAINVAL: return SYMBOL_VAL (sym);
+    case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
     case SYMBOL_LOCALIZED:
       {
        /* If var is set up for a buffer that lacks a local value for it,
@@ -1447,6 +1572,16 @@
 for this variable.  */)
   (Lisp_Object symbol, Lisp_Object value)
 {
+  return set_default_internal (symbol, value, Dyn_Global);
+}
+
+/* Like Fset_default, but with ENV argument. See set_internal for
+   a description of this argument. */
+
+Lisp_Object
+set_default_internal (Lisp_Object symbol, Lisp_Object value,
+                     Dyn_Bind_Env env)
+{
   struct Lisp_Symbol *sym;
 
   CHECK_SYMBOL (symbol);
@@ -1464,12 +1599,17 @@
  start:
   switch (sym->redirect)
     {
+    case SYMBOL_PLAINVAL:
+      {
+       return set_internal (symbol, value, Qnil, false, env);
+      }
     case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
-    case SYMBOL_PLAINVAL: return Fset (symbol, value);
     case SYMBOL_LOCALIZED:
       {
        struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (sym);
 
+       MAYBE_RUN_VARHOOK (value, sym, false, env, XCDR (blv->defcell), value);
+
        /* Store new value into the DEFAULT-VALUE slot.  */
        XSETCDR (blv->defcell, value);
 
@@ -1490,6 +1630,8 @@
            int offset = XBUFFER_OBJFWD (valcontents)->offset;
            int idx = PER_BUFFER_IDX (offset);
 
+           MAYBE_RUN_VARHOOK (value, sym, false, env, per_buffer_default 
(offset), value);
+
            set_per_buffer_default (offset, value);
 
            /* If this variable is not always local in all buffers,
@@ -1504,8 +1646,7 @@
              }
            return value;
          }
-       else
-         return Fset (symbol, value);
+       else return set_internal (symbol, value, Qnil, false, env);
       }
     default: emacs_abort ();
     }
@@ -1536,7 +1677,7 @@
     {
       val = eval_sub (Fcar (XCDR (args_left)));
       symbol = XCAR (args_left);
-      Fset_default (symbol, val);
+      val = Fset_default (symbol, val);
       args_left = Fcdr (XCDR (args_left));
     }
 
@@ -1633,7 +1774,7 @@
     default: emacs_abort ();
     }
 
-  if (sym->constant)
+  if (SYM_CONST_P (sym))
     error ("Symbol %s may not be buffer-local", SDATA (SYMBOL_NAME 
(variable)));
 
   if (!blv)
@@ -1706,7 +1847,7 @@
     default: emacs_abort ();
     }
 
-  if (sym->constant)
+  if (SYM_CONST_P (sym))
     error ("Symbol %s may not be buffer-local",
           SDATA (SYMBOL_NAME (variable)));
 
@@ -1895,7 +2036,7 @@
     default: emacs_abort ();
     }
 
-  if (sym->constant)
+  if (SYM_CONST_P (sym))
     error ("Symbol %s may not be frame-local", SDATA (SYMBOL_NAME (variable)));
 
   blv = make_blv (sym, forwarded, valcontents);
@@ -3474,6 +3615,12 @@
   DEFSYM (Qad_advice_info, "ad-advice-info");
   DEFSYM (Qad_activate_internal, "ad-activate-internal");
 
+  DEFSYM (Qglobal, "global");
+  DEFSYM (Qbuf_local, "buf-local");
+  DEFSYM (Qdyn_local, "dyn-local");
+  DEFSYM (Qdyn_bind, "dyn-bind");
+  DEFSYM (Qdyn_unbind, "dyn-unbind");
+
   error_tail = pure_cons (Qerror, Qnil);
 
   /* ERROR is used as a signaler for random errors for which nothing else is
@@ -3609,8 +3756,11 @@
   defsubr (&Sindirect_function);
   defsubr (&Ssymbol_plist);
   defsubr (&Ssymbol_name);
+  defsubr (&Ssymbol_hook);
+  defsubr (&Ssymbol_unhook);
   defsubr (&Smakunbound);
   defsubr (&Sfmakunbound);
+  defsubr (&Ssymbol_hooked_p);
   defsubr (&Sboundp);
   defsubr (&Sfboundp);
   defsubr (&Sfset);
@@ -3677,10 +3827,10 @@
   DEFVAR_LISP ("most-positive-fixnum", Vmost_positive_fixnum,
               doc: /* The largest value that is representable in a Lisp 
integer.  */);
   Vmost_positive_fixnum = make_number (MOST_POSITIVE_FIXNUM);
-  XSYMBOL (intern_c_string ("most-positive-fixnum"))->constant = 1;
+  XSYMBOL (intern_c_string ("most-positive-fixnum"))->vetted = SYM_CONST;
 
   DEFVAR_LISP ("most-negative-fixnum", Vmost_negative_fixnum,
               doc: /* The smallest value that is representable in a Lisp 
integer.  */);
   Vmost_negative_fixnum = make_number (MOST_NEGATIVE_FIXNUM);
-  XSYMBOL (intern_c_string ("most-negative-fixnum"))->constant = 1;
+  XSYMBOL (intern_c_string ("most-negative-fixnum"))->vetted = SYM_CONST;
 }
--- src/alloc.c
+++ src/alloc.c
@@ -3350,7 +3350,7 @@
   set_symbol_next (val, NULL);
   p->gcmarkbit = false;
   p->interned = SYMBOL_UNINTERNED;
-  p->constant = 0;
+  p->vetted = 0;
   p->declared_special = false;
   p->pinned = false;
 }
--- src/lread.c
+++ src/lread.c
@@ -3755,7 +3755,7 @@
 
   if (SREF (SYMBOL_NAME (sym), 0) == ':' && EQ (obarray, initial_obarray))
     {
-      XSYMBOL (sym)->constant = 1;
+      XSYMBOL (sym)->vetted = SYM_CONST;
       XSYMBOL (sym)->redirect = SYMBOL_PLAINVAL;
       SET_SYMBOL_VAL (XSYMBOL (sym), sym);
     }
@@ -4041,12 +4041,12 @@
 
   DEFSYM (Qnil, "nil");
   SET_SYMBOL_VAL (XSYMBOL (Qnil), Qnil);
-  XSYMBOL (Qnil)->constant = 1;
+  XSYMBOL (Qnil)->vetted = SYM_CONST;
   XSYMBOL (Qnil)->declared_special = true;
 
   DEFSYM (Qt, "t");
   SET_SYMBOL_VAL (XSYMBOL (Qt), Qt);
-  XSYMBOL (Qt)->constant = 1;
+  XSYMBOL (Qt)->vetted = SYM_CONST;
   XSYMBOL (Qt)->declared_special = true;
 
   /* Qt is correct even if CANNOT_DUMP.  loadup.el will set to nil at end.  */
--- src/buffer.c
+++ src/buffer.c
@@ -5690,7 +5690,7 @@
 This variable is buffer-local but you cannot set it directly;
 use the function `set-buffer-multibyte' to change a buffer's representation.
 See also Info node `(elisp)Text Representations'.  */);
-  XSYMBOL (intern_c_string ("enable-multibyte-characters"))->constant = 1;
+  XSYMBOL (intern_c_string ("enable-multibyte-characters"))->vetted = 
SYM_CONST;
 
   DEFVAR_PER_BUFFER ("buffer-file-coding-system",
                     &BVAR (current_buffer, buffer_file_coding_system), Qnil,
--- src/bytecode.c
+++ src/bytecode.c
@@ -843,7 +843,7 @@
            else
              {
                BEFORE_POTENTIAL_GC ();
-               set_internal (sym, val, Qnil, 0);
+               set_internal (sym, val, Qnil, false, Dyn_Current);
                AFTER_POTENTIAL_GC ();
              }
          }
--- src/font.c
+++ src/font.c
@@ -5249,19 +5249,19 @@
     [NUMERIC-VALUE SYMBOLIC-NAME ALIAS-NAME ...]
 NUMERIC-VALUE is an integer, and SYMBOLIC-NAME and ALIAS-NAME are symbols. */);
   Vfont_weight_table = BUILD_STYLE_TABLE (weight_table);
-  XSYMBOL (intern_c_string ("font-weight-table"))->constant = 1;
+  XSYMBOL (intern_c_string ("font-weight-table"))->vetted = SYM_CONST;
 
   DEFVAR_LISP_NOPRO ("font-slant-table", Vfont_slant_table,
               doc: /*  Vector of font slant symbols vs the corresponding 
numeric values.
 See `font-weight-table' for the format of the vector. */);
   Vfont_slant_table = BUILD_STYLE_TABLE (slant_table);
-  XSYMBOL (intern_c_string ("font-slant-table"))->constant = 1;
+  XSYMBOL (intern_c_string ("font-slant-table"))->vetted = SYM_CONST;
 
   DEFVAR_LISP_NOPRO ("font-width-table", Vfont_width_table,
               doc: /*  Alist of font width symbols vs the corresponding 
numeric values.
 See `font-weight-table' for the format of the vector. */);
   Vfont_width_table = BUILD_STYLE_TABLE (width_table);
-  XSYMBOL (intern_c_string ("font-width-table"))->constant = 1;
+  XSYMBOL (intern_c_string ("font-width-table"))->vetted = SYM_CONST;
 
   staticpro (&font_style_table);
   font_style_table = make_uninit_vector (3);
--- lisp/subr.el
+++ lisp/subr.el
@@ -2546,6 +2546,9 @@
 Note that this should end with a directory separator.
 See also `locate-user-emacs-file'.")
 
+(setq symbol-setter-function ; Defined in eval.c
+      (lambda (_sym _env _oldval newval) newval))
+
 ;;;; Misc. useful functions.
 
 (defsubst buffer-narrowed-p ()