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

[Kelly Dean <kelly@prtime.org>]

[-- Attachment #1: Type: text/plain, Size: 4470 bytes --]

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.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: varhook-advice-1.patch --]
[-- Type: text/x-diff, Size: 31656 bytes --]

--- 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 @@
 \f
 /* 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);