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

[Kelly Dean]

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 run 
trunk on a system that has stable performance, so I can't reliably benchmark 
it.)

>> +typedef enum
>> +  {
>> +    Dyn_Unbind = -1,
>> +    Dyn_Current = 0,
>> +    Dyn_Bind = 1,
>> +    Dyn_Skip = 2,
>> +    Dyn_Global = 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 the 
sense of movement up or down the dynamic-binding stack. Later I discovered that 
I needed the last two values too. I've changed it to a more appropriate name.

> That's a good idea, to circumvent the question of how to not-trigger the
> 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 varhook. 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, but
> maybe it's a good thing anyway.

They still can. Just temporarily unhook the destination variable before setting 
it. But yes, it would be easy to introduce bugs by doing that, so I guess the 
documentation should discourage it.

>> +    if (shadowed) env = Qdyn_local;
>> +    else if (buf_local) env = Qbuf_local;
>> +    else env = 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 in a 
different environment than the one he intended, e.g. due to an unexpected 
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 calls code that 
uses setq with the assumption that the global (not a dynamic local) variable 
will be set. Also, this enables detailed profiling of globals vs. buffer-locals 
vs. dynamic bindings. And it lets your hook function filter out the cases you 
want to ignore, e.g. if you only want to watch global settings, not 
buffer-local or let-local.

>> +DEFUN ("symbol-setter-function", Fsymbol_setter_function, 
>> Ssymbol_setter_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 unquoted 
variable name vs. using advice-add with a quoted function name. It also makes 
the hook run a bit slower. And it results in the help page for the function 
exposing the advice mechanism's internal representation of the advice, rather 
than cleanly showing e.g. ⌜:before advice: `mywatcher'⌝. 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 variables, 
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 return newval, 
which is overridden by either :around or :override; the standard function 
doesn't do any processing. Unless maybe you want to have multiple pieces of 
advice wrapped around each other, all blocking/overriding 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 bit, 
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 compiled code, 
since one was just a wrapper for the other and both were inlined.) And I fixed 
a bug: it was reporting the wrong environment for setq-default if you do:
(setq-local foo 'bar)
(let ((foo 'baz)) (setq-default foo 'biz))

Updated patch attached.

--- 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);