"after" variable watchers

[martin rudalics <rudalics@gmx.at>]

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

I'd like to install the attached patch which expands on the existing
variable watching mechanism in the sense that the variable whose value
gets changed has already the new value assigned to within the body of
the watch function.  Such a feature is useful when the watch function
calls already existing functions which act upon the variable's new value
in a possibly deeply nested fashion.

Consider the following example: A user wants to set `right-margin-width'
of a buffer and I want to decide whether that margin really fits.  The
mechanism whether it fits would be nested in a common function that
decides whether any decoration (fringe, scroll bar, margin) fits into
any window showing that buffer based on the minimum sizes of that window
and the sizes of the remaining decorations.  Passing a "this is the
requested new value of the right margin" setting to such a function is
awkward at the very least.

Objections, suggestions, comments?

Thanks, martin

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: after-variable-watchers.diff --]
[-- Type: text/x-patch; name="after-variable-watchers.diff", Size: 19646 bytes --]

diff --git a/doc/lispref/variables.texi b/doc/lispref/variables.texi
index 36abc316cb..8a4ff26c13 100644
--- a/doc/lispref/variables.texi
+++ b/doc/lispref/variables.texi
@@ -842,7 +842,7 @@ Watching Variables
 The following functions may be used to manipulate and query the watch
 functions for a variable.

-@defun add-variable-watcher symbol watch-function
+@defun add-variable-watcher symbol watch-function after
 This function arranges for @var{watch-function} to be called whenever
 @var{symbol} is modified.  Modifications through aliases
 (@pxref{Variable Aliases}) will have the same effect.
@@ -858,16 +858,25 @@ Watching Variables
 @code{unlet}, @code{makunbound}, or @code{defvaralias}.  @var{where}
 is a buffer if the buffer-local value of the variable is being
 changed, @code{nil} otherwise.
+
+If the optional third argument @var{after} is non-@code{nil}, this means
+to call @var{watch-function} after changing the value of @var{symbol}.
+In that case the second argument passed to @var{watch-function} will be
+the value of @var{symbol} before it was set to the current value.
 @end defun

-@defun remove-variable-watcher symbol watch-function
+@defun remove-variable-watcher symbol watch-function after
 This function removes @var{watch-function} from @var{symbol}'s list of
-watchers.
+watchers.  The third argument @var{after} should match the same argument
+used by the previous @code{add-variable-watcher} call.
 @end defun

-@defun get-variable-watchers symbol
+@defun get-variable-watchers symbol after
 This function returns the list of @var{symbol}'s active watcher
-functions.
+functions.  If the optional second argument @var{after} is @code{nil},
+this means to return watchers run before @var{symbol}'s value is set.
+If @var{after} is non-@code{nil}, this means to return watchers run
+after @var{symbol}'s value is set.
 @end defun

 @subsection Limitations
diff --git a/src/alloc.c b/src/alloc.c
index 76d8c7ddd1..a9a67462eb 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -7662,14 +7662,14 @@ syms_of_alloc (void)
        { .a4 = watch_gc_cons_threshold },
        4, 4, "watch_gc_cons_threshold", {0}, 0}};
   XSETSUBR (watcher, &Swatch_gc_cons_threshold.s);
-  Fadd_variable_watcher (Qgc_cons_threshold, watcher);
+  Fadd_variable_watcher (Qgc_cons_threshold, watcher, Qnil);

   static union Aligned_Lisp_Subr Swatch_gc_cons_percentage =
      {{{ PSEUDOVECTOR_FLAG | (PVEC_SUBR << PSEUDOVECTOR_AREA_BITS) },
        { .a4 = watch_gc_cons_percentage },
        4, 4, "watch_gc_cons_percentage", {0}, 0}};
   XSETSUBR (watcher, &Swatch_gc_cons_percentage.s);
-  Fadd_variable_watcher (Qgc_cons_percentage, watcher);
+  Fadd_variable_watcher (Qgc_cons_percentage, watcher, Qnil);
 }

 #ifdef HAVE_X_WINDOWS
diff --git a/src/buffer.c b/src/buffer.c
index df302db0e5..cc1f6414b8 100644
--- a/src/buffer.c
+++ b/src/buffer.c
@@ -1045,10 +1045,9 @@ reset_buffer_local_variables (struct buffer *b, bool permanent_too)
           Lisp_Object prop = Fget (local_var, Qpermanent_local);
           Lisp_Object sym = local_var;

-          /* Watchers are run *before* modifying the var.  */
           if (XSYMBOL (local_var)->u.s.trapped_write == SYMBOL_TRAPPED_WRITE)
-            notify_variable_watchers (local_var, Qnil,
-                                      Qmakunbound, Fcurrent_buffer ());
+            notify_variable_watchers (local_var, Qnil, Qmakunbound,
+				      Fcurrent_buffer (), false);

           eassert (XSYMBOL (sym)->u.s.redirect == SYMBOL_LOCALIZED);
           /* Need not do anything if some other buffer's binding is
@@ -1076,9 +1075,9 @@ reset_buffer_local_variables (struct buffer *b, bool permanent_too)
                     for (newlist = Qnil; CONSP (list); list = XCDR (list))
                       {
                         Lisp_Object elt = XCAR (list);
-                        /* Preserve element ELT if it's t,
-                           if it is a function with a `permanent-local-hook' property,
-                           or if it's not a symbol.  */
+                        /* Preserve element ELT if it's t, if it is a
+                           function with a `permanent-local-hook'
+                           property, or if it's not a symbol.  */
                         if (! SYMBOLP (elt)
                             || EQ (elt, Qt)
                             || !NILP (Fget (elt, Qpermanent_local_hook)))
@@ -1087,8 +1086,8 @@ reset_buffer_local_variables (struct buffer *b, bool permanent_too)
                   newlist = Fnreverse (newlist);
                   if (XSYMBOL (local_var)->u.s.trapped_write
 		      == SYMBOL_TRAPPED_WRITE)
-                    notify_variable_watchers (local_var, newlist,
-                                              Qmakunbound, Fcurrent_buffer ());
+                    notify_variable_watchers (local_var, newlist, Qmakunbound,
+					      Fcurrent_buffer (), true);
                   XSETCDR (XCAR (tmp), newlist);
                   continue; /* Don't do variable write trapping twice.  */
                 }
@@ -1112,7 +1111,24 @@ reset_buffer_local_variables (struct buffer *b, bool permanent_too)
       if ((idx > 0
 	   && (permanent_too
 	       || buffer_permanent_local_flags[idx] == 0)))
-	set_per_buffer_value (b, offset, per_buffer_default (offset));
+	{
+	  Lisp_Object symbol = PER_BUFFER_SYMBOL (offset);
+	  Lisp_Object old_value = ((idx == -1 || PER_BUFFER_VALUE_P (b, idx))
+				   ? per_buffer_value (b, offset)
+				   : Qnil);
+
+	  if (SYMBOLP (symbol)
+	      && XSYMBOL (symbol)->u.s.trapped_write == SYMBOL_TRAPPED_WRITE)
+	    notify_variable_watchers (symbol, old_value, Qmakunbound,
+				      Fcurrent_buffer (), false);
+
+	  set_per_buffer_value (b, offset, per_buffer_default (offset));
+
+	  if (SYMBOLP (symbol)
+	      && XSYMBOL (symbol)->u.s.trapped_write == SYMBOL_TRAPPED_WRITE)
+	    notify_variable_watchers (symbol, old_value, Qmakunbound,
+				      Fcurrent_buffer (), true);
+	}
     }
 }

diff --git a/src/data.c b/src/data.c
index d547f5da5e..bf0722bc65 100644
--- a/src/data.c
+++ b/src/data.c
@@ -1478,6 +1478,8 @@ set_internal (Lisp_Object symbol, Lisp_Object newval, Lisp_Object where,

   CHECK_SYMBOL (symbol);
   struct Lisp_Symbol *sym = XSYMBOL (symbol);
+  Lisp_Object old_value = Qunbound;
+
   switch (sym->u.s.trapped_write)
     {
     case SYMBOL_NOWRITE:
@@ -1489,13 +1491,13 @@ set_internal (Lisp_Object symbol, Lisp_Object newval, Lisp_Object where,
         return;

     case SYMBOL_TRAPPED_WRITE:
+      old_value = find_symbol_value (symbol);
       /* Setting due to thread-switching doesn't count.  */
       if (bindflag != SET_INTERNAL_THREAD_SWITCH)
-        notify_variable_watchers (symbol, voide? Qnil : newval,
-                                  (bindflag == SET_INTERNAL_BIND? Qlet :
-                                   bindflag == SET_INTERNAL_UNBIND? Qunlet :
-                                   voide? Qmakunbound : Qset),
-                                  where);
+        notify_variable_watchers (symbol, voide ? Qnil : newval,
+				  ((bindflag == SET_INTERNAL_BIND) ? Qlet :
+				   (bindflag == SET_INTERNAL_UNBIND) ? Qunlet :
+				   voide ? Qmakunbound : Qset), where, false);
       break;

     case SYMBOL_UNTRAPPED_WRITE:
@@ -1508,7 +1510,7 @@ set_internal (Lisp_Object symbol, Lisp_Object newval, Lisp_Object where,
   switch (sym->u.s.redirect)
     {
     case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
-    case SYMBOL_PLAINVAL: SET_SYMBOL_VAL (sym , newval); return;
+    case SYMBOL_PLAINVAL: SET_SYMBOL_VAL (sym, newval); goto stop;
     case SYMBOL_LOCALIZED:
       {
 	struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (sym);
@@ -1619,6 +1621,15 @@ set_internal (Lisp_Object symbol, Lisp_Object newval, Lisp_Object where,
       }
     default: emacs_abort ();
     }
+
+ stop:
+  if (sym->u.s.trapped_write == SYMBOL_TRAPPED_WRITE
+      && bindflag != SET_INTERNAL_THREAD_SWITCH)
+    notify_variable_watchers (symbol, EQ (old_value, Qunbound) ? Qnil : old_value,
+			      ((bindflag == SET_INTERNAL_BIND) ? Qlet :
+			       (bindflag == SET_INTERNAL_UNBIND) ? Qunlet :
+			       voide ? Qmakunbound : Qset),
+			      where, true);
   return;
 }

@@ -1626,6 +1637,7 @@ set_internal (Lisp_Object symbol, Lisp_Object newval, Lisp_Object where,
 set_symbol_trapped_write (Lisp_Object symbol, enum symbol_trapped_write trap)
 {
   struct Lisp_Symbol *sym = XSYMBOL (symbol);
+
   if (sym->u.s.trapped_write == SYMBOL_NOWRITE)
     xsignal1 (Qtrapping_constant, symbol);
   sym->u.s.trapped_write = trap;
@@ -1647,7 +1659,7 @@ harmonize_variable_watchers (Lisp_Object alias, Lisp_Object base_variable)
 }

 DEFUN ("add-variable-watcher", Fadd_variable_watcher, Sadd_variable_watcher,
-       2, 2, 0,
+       2, 3, 0,
        doc: /* Cause WATCH-FUNCTION to be called when SYMBOL is about to be set.

 It will be called with 4 arguments: (SYMBOL NEWVAL OPERATION WHERE).
@@ -1659,55 +1671,86 @@ DEFUN ("add-variable-watcher", Fadd_variable_watcher, Sadd_variable_watcher,
 WHERE is a buffer if the buffer-local value of the variable is being
 changed, nil otherwise.

+Third argument AFTER, if non-nil, means to call WATCH-FUNCTION after
+SYMBOL has been set.  In that case, the second argument for
+WATCH-FUNCTION will be the value of SYMBOL before it was set to the
+current value.
+
 All writes to aliases of SYMBOL will call WATCH-FUNCTION too.  */)
-  (Lisp_Object symbol, Lisp_Object watch_function)
+  (Lisp_Object symbol, Lisp_Object watch_function, Lisp_Object after)
 {
+  CHECK_SYMBOL (symbol);
+
   symbol = Findirect_variable (symbol);
   CHECK_SYMBOL (symbol);
   set_symbol_trapped_write (symbol, SYMBOL_TRAPPED_WRITE);
   map_obarray (Vobarray, harmonize_variable_watchers, symbol);

-  Lisp_Object watchers = Fget (symbol, Qwatchers);
-  Lisp_Object member = Fmember (watch_function, watchers);
-  if (NILP (member))
-    Fput (symbol, Qwatchers, Fcons (watch_function, watchers));
+  if (NILP (after))
+    {
+      Lisp_Object watchers = Fget (symbol, Qwatchers_before);
+
+      if (NILP (Fmember (watch_function, watchers)))
+	Fput (symbol, Qwatchers_before, Fcons (watch_function, watchers));
+    }
+  else
+    {
+      Lisp_Object watchers = Fget (symbol, Qwatchers_after);
+
+      if (NILP (Fmember (watch_function, watchers)))
+	Fput (symbol, Qwatchers_after, Fcons (watch_function, watchers));
+    }
+
   return Qnil;
 }

 DEFUN ("remove-variable-watcher", Fremove_variable_watcher, Sremove_variable_watcher,
-       2, 2, 0,
+       2, 3, 0,
        doc: /* Undo the effect of `add-variable-watcher'.
 Remove WATCH-FUNCTION from the list of functions to be called when
 SYMBOL (or its aliases) are set.  */)
-  (Lisp_Object symbol, Lisp_Object watch_function)
+  (Lisp_Object symbol, Lisp_Object watch_function, Lisp_Object after)
 {
   symbol = Findirect_variable (symbol);
-  Lisp_Object watchers = Fget (symbol, Qwatchers);
-  watchers = Fdelete (watch_function, watchers);
-  if (NILP (watchers))
+
+  Lisp_Object watchers_before = Fget (symbol, Qwatchers_before);
+  Lisp_Object watchers_after = Fget (symbol, Qwatchers_after);
+
+  if (NILP (after))
+    {
+      watchers_before = Fdelete (watch_function, watchers_before);
+      Fput (symbol, Qwatchers_before, watchers_before);
+    }
+  else
+    {
+      watchers_after = Fdelete (watch_function, watchers_after);
+      Fput (symbol, Qwatchers_after, watchers_after);
+    }
+
+  if (NILP (watchers_before) && NILP (watchers_after))
     {
       set_symbol_trapped_write (symbol, SYMBOL_UNTRAPPED_WRITE);
       map_obarray (Vobarray, harmonize_variable_watchers, symbol);
     }
-  Fput (symbol, Qwatchers, watchers);
+
   return Qnil;
 }

 DEFUN ("get-variable-watchers", Fget_variable_watchers, Sget_variable_watchers,
-       1, 1, 0,
-       doc: /* Return a list of SYMBOL's active watchers.  */)
-  (Lisp_Object symbol)
+       1, 2, 0,
+       doc: /* Return a list of SYMBOL's active watchers.
+Optional second argument AFTER nil means to return watchers run before
+SYMBOL's value is set.  AFTER non-nil means to return watchers run after
+SYMBOL's value is set.  */)
+  (Lisp_Object symbol, Lisp_Object after)
 {
-  return (SYMBOL_TRAPPED_WRITE_P (symbol) == SYMBOL_TRAPPED_WRITE)
-    ? Fget (Findirect_variable (symbol), Qwatchers)
-    : Qnil;
+  return (Fget (Findirect_variable (symbol),
+		NILP (after) ? Qwatchers_before : Qwatchers_after));
 }

 void
-notify_variable_watchers (Lisp_Object symbol,
-                          Lisp_Object newval,
-                          Lisp_Object operation,
-                          Lisp_Object where)
+notify_variable_watchers (Lisp_Object symbol, Lisp_Object newval,
+			  Lisp_Object operation, Lisp_Object where, bool after)
 {
   symbol = Findirect_variable (symbol);

@@ -1719,22 +1762,23 @@ notify_variable_watchers (Lisp_Object symbol,
   if (NILP (where)
       && !EQ (operation, Qset_default) && !EQ (operation, Qmakunbound)
       && !NILP (Flocal_variable_if_set_p (symbol, Fcurrent_buffer ())))
-    {
-      XSETBUFFER (where, current_buffer);
-    }
+    XSETBUFFER (where, current_buffer);

   if (EQ (operation, Qset_default))
     operation = Qset;

-  for (Lisp_Object watchers = Fget (symbol, Qwatchers);
+  for (Lisp_Object watchers
+	 = Fget (symbol, after ? Qwatchers_after : Qwatchers_before);
        CONSP (watchers);
        watchers = XCDR (watchers))
     {
       Lisp_Object watcher = XCAR (watchers);
+
       /* Call subr directly to avoid gc.  */
       if (SUBRP (watcher))
         {
           Lisp_Object args[] = { symbol, newval, operation, where };
+
           funcall_subr (XSUBR (watcher), ARRAYELTS (args), args);
         }
       else
@@ -1828,6 +1872,8 @@ set_default_internal (Lisp_Object symbol, Lisp_Object value,
 {
   CHECK_SYMBOL (symbol);
   struct Lisp_Symbol *sym = XSYMBOL (symbol);
+  Lisp_Object old_value = Qunbound;;
+
   switch (sym->u.s.trapped_write)
     {
     case SYMBOL_NOWRITE:
@@ -1839,11 +1885,12 @@ set_default_internal (Lisp_Object symbol, Lisp_Object value,
         return;

     case SYMBOL_TRAPPED_WRITE:
+      old_value = find_symbol_value (symbol);
       /* Don't notify here if we're going to call Fset anyway.  */
       if (sym->u.s.redirect != SYMBOL_PLAINVAL
           /* Setting due to thread switching doesn't count.  */
           && bindflag != SET_INTERNAL_THREAD_SWITCH)
-        notify_variable_watchers (symbol, value, Qset_default, Qnil);
+        notify_variable_watchers (symbol, value, Qset_default, Qnil, false);
       break;

     case SYMBOL_UNTRAPPED_WRITE:
@@ -1867,7 +1914,7 @@ set_default_internal (Lisp_Object symbol, Lisp_Object value,
 	/* If the default binding is now loaded, set the REALVALUE slot too.  */
 	if (blv->fwd.fwdptr && EQ (blv->defcell, blv->valcell))
 	  store_symval_forwarding (blv->fwd, value, NULL);
-        return;
+        goto stop;
       }
     case SYMBOL_FORWARDED:
       {
@@ -1906,10 +1953,16 @@ set_default_internal (Lisp_Object symbol, Lisp_Object value,
 	  }
 	else
           set_internal (symbol, value, Qnil, bindflag);
-        return;
+        goto stop;
       }
     default: emacs_abort ();
     }
+
+ stop:
+  if (sym->u.s.trapped_write == SYMBOL_TRAPPED_WRITE
+      && sym->u.s.redirect != SYMBOL_PLAINVAL
+      && bindflag != SET_INTERNAL_THREAD_SWITCH)
+    notify_variable_watchers (symbol, old_value, Qset_default, Qnil, true);
 }

 DEFUN ("set-default", Fset_default, Sset_default, 2, 2, 0,
@@ -2142,6 +2195,9 @@ DEFUN ("kill-local-variable", Fkill_local_variable, Skill_local_variable,
   struct Lisp_Symbol *sym;

   CHECK_SYMBOL (variable);
+
+  Lisp_Object old_value = find_symbol_value (variable);
+
   sym = XSYMBOL (variable);

  start:
@@ -2173,7 +2229,8 @@ DEFUN ("kill-local-variable", Fkill_local_variable, Skill_local_variable,
     }

   if (sym->u.s.trapped_write == SYMBOL_TRAPPED_WRITE)
-    notify_variable_watchers (variable, Qnil, Qmakunbound, Fcurrent_buffer ());
+    notify_variable_watchers (variable, Qnil, Qmakunbound,
+			      Fcurrent_buffer (), false);

   /* Get rid of this buffer's alist element, if any.  */
   XSETSYMBOL (variable, sym);	/* Propagate variable indirection.  */
@@ -2192,6 +2249,10 @@ DEFUN ("kill-local-variable", Fkill_local_variable, Skill_local_variable,
       swap_in_global_binding (sym);
   }

+  if (sym->u.s.trapped_write == SYMBOL_TRAPPED_WRITE)
+    notify_variable_watchers (variable, old_value, Qmakunbound,
+			      Fcurrent_buffer (), true);
+
   return variable;
 }

@@ -4195,7 +4256,8 @@ #define PUT_ERROR(sym, tail, msg)			\
   Vmost_negative_fixnum = make_fixnum (MOST_NEGATIVE_FIXNUM);
   make_symbol_constant (intern_c_string ("most-negative-fixnum"));

-  DEFSYM (Qwatchers, "watchers");
+  DEFSYM (Qwatchers_before, "watchers-before");
+  DEFSYM (Qwatchers_after, "watchers-after");
   DEFSYM (Qmakunbound, "makunbound");
   DEFSYM (Qunlet, "unlet");
   DEFSYM (Qset, "set");
diff --git a/src/eval.c b/src/eval.c
index aeedcc50cc..6d69d54ef2 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -603,6 +603,7 @@ DEFUN ("defvaralias", Fdefvaralias, Sdefvaralias, 2, 3, 0,
   (Lisp_Object new_alias, Lisp_Object base_variable, Lisp_Object docstring)
 {
   struct Lisp_Symbol *sym;
+  Lisp_Object old_value = Qnil;

   CHECK_SYMBOL (new_alias);
   CHECK_SYMBOL (base_variable);
@@ -634,7 +635,7 @@ DEFUN ("defvaralias", Fdefvaralias, Sdefvaralias, 2, 3, 0,
     set_internal (base_variable, find_symbol_value (new_alias),
                   Qnil, SET_INTERNAL_BIND);
   else if (!NILP (Fboundp (new_alias))
-           && !EQ (find_symbol_value (new_alias),
+           && !EQ (old_value = find_symbol_value (new_alias),
                    find_symbol_value (base_variable)))
     call2 (intern ("display-warning"),
            list3 (Qdefvaralias, intern ("losing-value"), new_alias),
@@ -653,8 +654,8 @@ DEFUN ("defvaralias", Fdefvaralias, Sdefvaralias, 2, 3, 0,
   }

   if (sym->u.s.trapped_write == SYMBOL_TRAPPED_WRITE)
-    notify_variable_watchers (new_alias, base_variable, Qdefvaralias, Qnil);
-
+    notify_variable_watchers (new_alias, base_variable,
+			      Qdefvaralias, Qnil, false);
   sym->u.s.declared_special = true;
   XSYMBOL (base_variable)->u.s.declared_special = true;
   sym->u.s.redirect = SYMBOL_VARALIAS;
@@ -664,6 +665,9 @@ DEFUN ("defvaralias", Fdefvaralias, Sdefvaralias, 2, 3, 0,
   /* Even if docstring is nil: remove old docstring.  */
   Fput (new_alias, Qvariable_documentation, docstring);

+  if (sym->u.s.trapped_write == SYMBOL_TRAPPED_WRITE)
+    notify_variable_watchers (new_alias, old_value, Qdefvaralias, Qnil, true);
+
   return base_variable;
 }

diff --git a/src/lisp.h b/src/lisp.h
index f83c55f827..ba7edb86a3 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -3535,7 +3535,7 @@ modiff_to_integer (modiff_count a)
 /* Defined in data.c.  */
 extern AVOID wrong_choice (Lisp_Object, Lisp_Object);
 extern void notify_variable_watchers (Lisp_Object, Lisp_Object,
-				      Lisp_Object, Lisp_Object);
+				      Lisp_Object, Lisp_Object, bool);
 extern Lisp_Object indirect_function (Lisp_Object);
 extern Lisp_Object find_symbol_value (Lisp_Object);
 enum Arith_Comparison {