emacs-devel
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

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


From: Kelly Dean
Subject: [PATCH] (Updated) Run hook when variable is set
Date: Mon, 23 Feb 2015 03:09:17 +0000

Stefan Monnier wrote:
>> You originally objected to my patch slowing down Emacs.  So I looked for
>> optimization opportunities to ensure that my patch paid for its performance
>> costs.  I was successful, and not only did I offset the costs, I even
>> produced a net improvement in speed, and provided benchmarks to prove it.
>
> I'm sorry, but I consider this a form of lying.  It makes it sound like
> "the new var-hook functionality actually speeds things up", even though
> it's not this new functionality but some unrelated (tho bundled) change
> which does it (and which could be applied independently).

I didn't say the varhook functionality speeds things up. I explicitly said it 
has performance costs, and I found optimization opportunities to _pay for_ 
those costs.

And again, I didn't say I eliminated the costs; I said I _offset_ the costs, 
and did better than just break even.

I was completely honest about what I did, and why I did it. And you accuse me 
of lying?

> The issue is not patch size per se, but just keeping the patch focused
> on its core purpose.

The constant-hooked combination is an optimization, not part of the patch's 
core purpose, yet you told me to include it anyway. Varhook works just fine 
without that optimization (and the patch is simpler without it), as shown by 
the varhook-single.patch I submitted on Feb 5th.

The patch could be applied to trunk without that optimization, then the 
optimization applied later, along with all the rest, without affecting the 
functionality of Emacs in general or of the varhook feature in particular.

But I'm leaving it in the patch, just because you asked me to put it there. I 
don't want to bother to take it back out now, and IIUC, you still want me to 
leave it in.

> "unnecessary" and "pathological" are judgments which are actually hard
> to make for such a generic hooking functionality where we don't (want
> to) know what the applications will be.
>
> As a general design principle Emacs doesn't really try to prevent you
> from shooting yourself in the foot.

Fine, but adding the capability of converting setq, etc into makunbound has the 
cost of breaking correctness (because hooking a symbol would change the 
behavior of (setq foo void-sentinel)), not just the cost of enabling user 
errors. Remember, this capability isn't something I'm removing from Emacs; it's 
just an additional capability that varhook could add. The benefit isn't worth 
the cost.


Updated patch attached. Changes, as you requested:
setq, etc return the attempt value instead of the override value.
One bug fixed.
Another bug intentionally added.
The void sentinel value is un-marked as special, and the constant is renamed.
Function names changed yet again. Now they all start with ⌜symbol-hook⌝.
All mention of «advice» banished from the documentation.
The documentation is more explicit about the cases in which each environment is 
affected.
As much as possible without making the documentation incomprehensible, it now 
conflates symbols with global variables.
The field name in Lisp_Symbol changed back to the misleading name, just to 
avoid touching a few lines of code in the patch.
Magic constants added back in to the source code, just to avoid touching a few 
lines of code in the patch.
All optimizations removed, except for the particular one (combining constant 
and hooked) that you told me to include, which happens to be the most invasive 
one, yet with no more benefit than the others.

This version of the patch slows down Emacs.

IIUC, I've made all the changes you requested.

--- src/lisp.h
+++ src/lisp.h
@@ -290,6 +290,17 @@
 # define GCALIGNED /* empty */
 #endif
 
+enum symbol_constant
+{
+  SYM_UNVETTED = 0,
+  SYM_CONST = 1,
+  SYM_HOOKED = 2
+};
+
+# define SYM_CONST_P(sym) (((sym)->constant) == SYM_CONST)
+# define SYM_HOOKED_P(sym) (((sym)->constant) == SYM_HOOKED)
+
+
 /* Some operations are so commonly executed that they are implemented
    as macros, not functions, because otherwise runtime performance would
    suffer too much when compiling with GCC without optimization.
@@ -344,7 +355,7 @@
 #define lisp_h_NILP(x) EQ (x, Qnil)
 #define lisp_h_SET_SYMBOL_VAL(sym, v) \
    (eassert ((sym)->redirect == 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 +670,12 @@
      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;
+  /* SYM_CONST means symbol is constant, i.e. changing its value should signal
+     an error. SYM_HOOKED means setting symbol will run varhook. These two
+     attributes are combined into one field to optimize the fast path of
+     non-hooked non-constants by having only one conditional branch for that
+     case. The name of this field is ⌜constant⌝ for historical reasons.  */
+  ENUM_BF (symbol_constant) constant : 2;
 
   /* Interned state of the symbol.  This is an enumerator from
      enum symbol_interned.  */
@@ -3463,6 +3476,14 @@
 }
 
 /* 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 {
@@ -3509,7 +3530,16 @@
 extern _Noreturn void args_out_of_range_3 (Lisp_Object, Lisp_Object,
                                           Lisp_Object);
 extern Lisp_Object do_symval_forwarding (union Lisp_Fwd *);
-extern void set_internal (Lisp_Object, Lisp_Object, Lisp_Object, bool);
+extern void set_internal (Lisp_Object, Lisp_Object, Lisp_Object, bool, 
Dyn_Bind_Env);
+extern Lisp_Object run_varhook (struct Lisp_Symbol*, bool, Dyn_Bind_Env,
+                               Lisp_Object, Lisp_Object);
+extern void set_internal_vetted (Lisp_Object, Lisp_Object, Lisp_Object, bool,
+                                        Dyn_Bind_Env, struct Lisp_Symbol *);
+extern void set_internal_localized_or_forwarded (Lisp_Object, Lisp_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 *);
 
@@ -4776,6 +4806,12 @@
     return false;
 }
 
+#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
@@ -616,7 +616,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 +633,7 @@
      so that old-code that affects n_a before the aliasing is setup
      still works.  */
   if (NILP (Fboundp (base_variable)))
-    set_internal (base_variable, find_symbol_value (new_alias), Qnil, 1);
+    set_internal (base_variable, find_symbol_value (new_alias), Qnil, true, 
Dyn_Current);
 
   {
     union specbinding *p;
@@ -3049,8 +3049,11 @@
       grow_specpdl ();
       if (!sym->constant)
        SET_SYMBOL_VAL (sym, value);
+      else if (SYM_HOOKED_P (sym))
+       SET_SYMBOL_VAL (sym, run_varhook
+                       (sym, false, Dyn_Bind, sym->val.value, value));
       else
-       set_internal (symbol, value, Qnil, 1);
+       set_internal (symbol, value, Qnil, true, Dyn_Bind);
       break;
     case SYMBOL_LOCALIZED:
       if (SYMBOL_BLV (sym)->frame_local)
@@ -3082,7 +3085,7 @@
              {
                specpdl_ptr->let.kind = 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,63 @@
 still determine whether to handle the particular condition.  */);
   Vdebug_on_signal = Qnil;
 
+  DEFSYM (Qsymbol_hook_void_value, "symbol-hook-void-value");
+  DEFVAR_LISP ("symbol-hook-void-value", Vsymbol_hook_void_value,
+              doc: /* Representation of voidness for hooked variables.
+The value of this constant is an uninterned Lisp symbol that represents void
+when passed to or returned from `symbol-hook-function'.  */);
+  Vsymbol_hook_void_value = Fmake_symbol (build_string ("::void::"));
+  XSYMBOL (Vsymbol_hook_void_value)->constant = SYM_CONST;
+  XSYMBOL (Qsymbol_hook_void_value)->declared_special = true;
+  XSYMBOL (Qsymbol_hook_void_value)->constant = SYM_CONST;
+
+  DEFVAR_LISP ("symbol-hook-function", Vsymbol_hook_function,
+       doc: /* This function is called whenever a hooked variable is set.
+It takes four arguments: SYMBOL, ENV, OLDVAL, NEWVAL. By default, it 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 `symbol-hook-void-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, or the value of symbol-hook-void-value 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 symbol-hook-void-value, in which case the variable will be set to 
void.
+
+The possible values of ENV are these symbols, with these meanings:
+global: The global environment.
+buf-local: The setter's buffer-local environment. ENV is this value if the
+setter sets the buffer-local variable.
+dyn-local: The innermost dynamic environment in which SYMBOL is bound. ENV
+is this value if the setter sets a dynamic local variable.
+dyn-bind: A new dynamic environment. ENV is this value if the setter creates
+a new dynamic environment, such as by using `let'.
+dyn-unbind: The next-outer dynamic environment in which SYMBOL is still bound,
+unshadowed due to destruction of the setter's current dynamic 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.
+
+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 symbol-hook-void-value 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 this function; 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 you
+need to set the variable, return the value from this function.
+
+See also `symbol-hook-set' and `symbol-hook-unset'.  */);
+  Vsymbol_hook_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-hook-p", Fsymbol_hook_p, Ssymbol_hook_p, 1, 1, 0,
+       doc: /* Return t if SYMBOL is hooked.
+To hook and unhook it, use `symbol-hook-set' and `symbol-hook-unset'.
+When hooked, setting SYMBOL will run `symbol-hook-function'.  */)
+  (register Lisp_Object symbol)
+{
+  struct Lisp_Symbol *sym;
+  CHECK_SYMBOL (symbol);
+  sym = 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,50 @@
   return NILP (XSYMBOL (symbol)->function) ? Qnil : Qt;
 }
 
+DEFUN ("symbol-hook-set", Fsymbol_hook_set, Ssymbol_hook_set, 1, 1, 0,
+       doc: /* Hook SYMBOL.
+When hooked, setting it will run `symbol-hook-function'.
+To unhook it, use `symbol-hook-unset'.
+To test whether it's hooked, use `symbol-hook-p'.
+Return SYMBOL.  */)
+  (register Lisp_Object symbol)
+{
+  struct Lisp_Symbol *sym;
+  CHECK_SYMBOL (symbol);
+  if (SYMBOL_CONSTANT_P (symbol))
+    xsignal1 (Qsetting_constant, symbol);
+  sym = XSYMBOL (symbol);
+  sym->constant = SYM_HOOKED;
+  while (sym->redirect == SYMBOL_VARALIAS)
+    {
+      sym = indirect_variable (sym);
+      sym->constant = SYM_HOOKED;
+    }
+  return symbol;
+}
+
+DEFUN ("symbol-hook-unset", Fsymbol_hook_unset, Ssymbol_hook_unset, 1, 1, 0,
+       doc: /* Unhook SYMBOL.
+When unhooked, setting it will not run `symbol-hook-function'.
+To hook it, use `symbol-hook-set'.
+To test whether it's hooked, use `symbol-hook-p'.
+Return SYMBOL.  */)
+  (register Lisp_Object symbol)
+{
+  struct Lisp_Symbol *sym;
+  CHECK_SYMBOL (symbol);
+  if (SYMBOL_CONSTANT_P (symbol))
+    return symbol; /* Unhooking a constant is a harmless no-op. */
+  sym = XSYMBOL (symbol);
+  sym->constant = SYM_UNVETTED;
+  while (sym->redirect == SYMBOL_VARALIAS)
+    {
+      sym = indirect_variable (sym);
+      sym->constant = SYM_UNVETTED;
+    }
+  return symbol;
+}
+
 DEFUN ("makunbound", Fmakunbound, Smakunbound, 1, 1, 0,
        doc: /* Make SYMBOL's value be void.
 Return SYMBOL.  */)
@@ -1201,11 +1259,65 @@
   xsignal1 (Qvoid_variable, symbol);
 }
 
+/* For the symbol S being set, run symbol-hook-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
+   Vsymbol_hook_void_value.
+
+   Return the result of symbol-hook-function, or if it's the value of
+   Vsymbol_hook_void_value and ATTEMPTED_VAL is Qunbound, return Qunbound. 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 attempted_val)
+{
+  Lisp_Object symbol, env, newval;
+  if (rawenv == Dyn_Skip) /* From backtrace_eval_unrewind */
+    return attempted_val;
+  XSETSYMBOL (symbol, sym);
+  switch (rawenv) /* Disambiguate Dyn_Current and Dyn_Global */
+    {
+    case Dyn_Current:
+      {
+       bool shadowed = (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) ? Vsymbol_hook_void_value : oldval;
+  newval = EQ (attempted_val, Qunbound) ? Vsymbol_hook_void_value : 
attempted_val;
+  newval = call4 (Vsymbol_hook_function, symbol, env, oldval, newval);
+  if (attempted_val == Qunbound && EQ (newval, Vsymbol_hook_void_value))
+    return Qunbound; /* Converting setq, etc to makunbound is prohibited. */
+  return newval; /* So symbol_hook_void_value is ignored if Qunbound wasn't 
attempted. */
+}
+
 DEFUN ("set", Fset, Sset, 2, 2, 0,
        doc: /* Set SYMBOL's value to NEWVAL, and return NEWVAL.  */)
   (register Lisp_Object symbol, Lisp_Object newval)
 {
-  set_internal (symbol, newval, Qnil, 0);
+  set_internal (symbol, newval, Qnil, false, Dyn_Current);
   return newval;
 }
 
@@ -1215,40 +1327,85 @@
 
    If BINDFLAG is false, then if this symbol is supposed to become
    local in every buffer where it is set, then we make it local.
-   If BINDFLAG is true, we don't do that.  */
+   If BINDFLAG is true, we don't do that.
+
+   ENV indicates the dynamic environment for this function call, i.e. 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.  */
 
 void
 set_internal (Lisp_Object symbol, Lisp_Object newval, Lisp_Object where,
-             bool bindflag)
+             bool bindflag, Dyn_Bind_Env env)
 {
-  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))
+  sym = XSYMBOL (symbol);
+  if (sym->constant)
     {
+      set_internal_vetted (symbol, newval, where, bindflag, env, sym);
+      return;
+    }
+
+ start:
+  switch (sym->redirect)
+    {
+    case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
+    case SYMBOL_PLAINVAL: SET_SYMBOL_VAL (sym, newval); return;
+    default: set_internal_localized_or_forwarded
+       (symbol, newval, where, bindflag, env, sym);
+    }
+}
+
+void
+set_internal_vetted (Lisp_Object symbol, Lisp_Object newval, Lisp_Object where,
+                            bool bindflag, Dyn_Bind_Env env, struct 
Lisp_Symbol *sym)
+{
+  if (SYM_HOOKED_P (sym))
+    {
+    start:
+      switch (sym->redirect)
+       {
+       case SYMBOL_PLAINVAL:
+         newval = run_varhook (sym, false, env, sym->val.value, newval);
+         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);
+           return;
+         }
+       }
+    }
       if (NILP (Fkeywordp (symbol))
          || !EQ (newval, Fsymbol_value (symbol)))
        xsignal1 (Qsetting_constant, symbol);
       else
        /* Allow setting keywords to their own value.  */
        return;
-    }
+}
 
-  sym = XSYMBOL (symbol);
+/* Split from set_internal to avoid code duplication, because both 
set_internal and
+   set_internal_vetted 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))
          {
@@ -1292,6 +1449,7 @@
                   indicating that we're seeing the default value.
                   Likewise if the variable has been let-bound
                   in the current buffer.  */
+               buf_local = false;
                if (bindflag || !blv->local_if_set
                    || let_shadows_buffer_binding_p (sym))
                  {
@@ -1319,6 +1477,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 +1511,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.  */
@@ -1447,6 +1613,17 @@
 for this variable.  */)
   (Lisp_Object symbol, Lisp_Object value)
 {
+  set_default_internal (symbol, value, Dyn_Global);
+  return value;
+}
+
+/* Like Fset_default, but with ENV argument. See set_internal for
+   a description of this argument. */
+
+void
+set_default_internal (Lisp_Object symbol, Lisp_Object value,
+                     Dyn_Bind_Env env)
+{
   struct Lisp_Symbol *sym;
 
   CHECK_SYMBOL (symbol);
@@ -1457,7 +1634,7 @@
        xsignal1 (Qsetting_constant, symbol);
       else
        /* Allow setting keywords to their own value.  */
-       return value;
+       return;
     }
   sym = XSYMBOL (symbol);
 
@@ -1465,18 +1642,24 @@
   switch (sym->redirect)
     {
     case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
-    case SYMBOL_PLAINVAL: return Fset (symbol, value);
+    case SYMBOL_PLAINVAL:
+      {
+       set_internal (symbol, value, Qnil, false, env);
+       return;
+      }
     case SYMBOL_LOCALIZED:
       {
        struct Lisp_Buffer_Local_Value *blv = 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:
       {
@@ -1490,6 +1673,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,
@@ -1502,10 +1687,13 @@
                  if (!PER_BUFFER_VALUE_P (b, idx))
                    set_per_buffer_value (b, offset, value);
              }
-           return value;
+           return;
          }
        else
-         return Fset (symbol, value);
+         {
+           set_internal (symbol, value, Qnil, false, env);
+           return;
+         }
       }
     default: emacs_abort ();
     }
@@ -1633,7 +1821,7 @@
     default: emacs_abort ();
     }
 
-  if (sym->constant)
+  if (SYM_CONST_P (sym))
     error ("Symbol %s may not be buffer-local", SDATA (SYMBOL_NAME 
(variable)));
 
   if (!blv)
@@ -1706,7 +1894,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 +2083,8 @@
     default: emacs_abort ();
     }
 
-  if (sym->constant)
+  /* Intentional bug, at Stefan's insistence. */
+  if (sym->constant) /* This should be: if (SYM_CONST_P (sym)) */
     error ("Symbol %s may not be frame-local", SDATA (SYMBOL_NAME (variable)));
 
   blv = make_blv (sym, forwarded, valcontents);
@@ -3474,6 +3663,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 +3804,11 @@
   defsubr (&Sindirect_function);
   defsubr (&Ssymbol_plist);
   defsubr (&Ssymbol_name);
+  defsubr (&Ssymbol_hook_set);
+  defsubr (&Ssymbol_hook_unset);
   defsubr (&Smakunbound);
   defsubr (&Sfmakunbound);
+  defsubr (&Ssymbol_hook_p);
   defsubr (&Sboundp);
   defsubr (&Sfboundp);
   defsubr (&Sfset);
--- src/bytecode.c
+++ src/bytecode.c
@@ -843,7 +843,7 @@
            else
              {
                BEFORE_POTENTIAL_GC ();
-               set_internal (sym, val, Qnil, 0);
+               set_internal (sym, val, Qnil, false, Dyn_Current);
                AFTER_POTENTIAL_GC ();
              }
          }
--- lisp/subr.el
+++ lisp/subr.el
@@ -2546,6 +2546,9 @@
 Note that this should end with a directory separator.
 See also `locate-user-emacs-file'.")
 
+(setq symbol-hook-function ; Defined in eval.c
+      (lambda (_sym _env _oldval newval) newval))
+
 ;;;; Misc. useful functions.
 
 (defsubst buffer-narrowed-p ()

reply via email to

[Prev in Thread] Current Thread [Next in Thread]