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 {