bug#24923: 25.1; Lisp watchpoints

[npostavs@users.sourceforge.net]

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

Eli Zaretskii <eliz@gnu.org> writes:
>
> Our coding conventions put the logical operators at the beginning of a
> line, not at EOL.

Fixed this, and added documentation.  Also, watcher functions are now
listed in describe-variable output.

Does it make sense to mention the use of the `watchers' symbol property
in the manual?  Since I've added a `get-variable-watchers' it's now
possible to ignore the symbol property as an implementation detail.


[-- Attachment #2: patch --]
[-- Type: text/plain, Size: 33460 bytes --]

From c318be2dc401d2f3b958ceb3b48e466a3019091e Mon Sep 17 00:00:00 2001
From: Noam Postavsky <npostavs@gmail.com>
Date: Thu, 19 Nov 2015 19:50:06 -0500
Subject: [PATCH v6 1/6] Add lisp watchpoints

This allows to call a function whenever a symbol-value is changed.

* src/lisp.h (lisp_h_SYMBOL_TRAPPED_WRITE_P):
(SYMBOL_TRAPPED_WRITE_P): New function/macro.
(lisp_h_SYMBOL_CONSTANT_P): Check for SYMBOL_NOWRITE specifically.
(enum symbol_trapped_write): New enumeration.
(struct Lisp_Symbol): Rename field constant to trapped_write.
(make_symbol_constant): New function.

* src/data.c (Fadd_variable_watcher, Fremove_variable_watcher):
(set_symbol_trapped_write, restore_symbol_trapped_write):
(harmonize_variable_watchers, notify_variable_watchers): New functions.

* src/data.c (Fset_default): Call `notify_variable_watchers' for trapped
symbols.
(set_internal): Change bool argument BIND to 3-value enum and call
`notify_variable_watchers' for trapped symbols.

* src/data.c (syms_of_data):
* src/data.c (syms_of_data):
* src/font.c (syms_of_font):
* src/lread.c (intern_sym, init_obarray):
* src/buffer.c (syms_of_buffer): Use make_symbol_constant.

* src/alloc.c (init_symbol):
* src/bytecode.c (exec_byte_code): Use SYMBOL_TRAPPED_WRITE_P.
* src/data.c (Fmake_variable_buffer_local, Fmake_local_variable):
(Fmake_variable_frame_local):
* src/eval.c (Fdefvaralias, specbind): Refer to Lisp_Symbol's
trapped_write instead of constant.
(Ffuncall): Move subr calling code into separate function.
(funcall_subr): New function.
---
 src/alloc.c    |   2 +-
 src/buffer.c   |  22 +++++--
 src/bytecode.c |   4 +-
 src/data.c     | 177 ++++++++++++++++++++++++++++++++++++++++++++++++++++-----
 src/eval.c     | 172 +++++++++++++++++++++++++++++--------------------------
 src/font.c     |   6 +-
 src/lisp.h     |  54 +++++++++++++++---
 src/lread.c    |   6 +-
 8 files changed, 324 insertions(+), 119 deletions(-)

diff --git a/src/alloc.c b/src/alloc.c
index a58dc13..f373f6d 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -3562,7 +3562,7 @@ init_symbol (Lisp_Object val, Lisp_Object name)
   set_symbol_next (val, NULL);
   p->gcmarkbit = false;
   p->interned = SYMBOL_UNINTERNED;
-  p->constant = 0;
+  p->trapped_write = SYMBOL_UNTRAPPED_WRITE;
   p->declared_special = false;
   p->pinned = false;
 }
diff --git a/src/buffer.c b/src/buffer.c
index 3d205bb..cc75cdb 100644
--- a/src/buffer.c
+++ b/src/buffer.c
@@ -984,9 +984,13 @@ reset_buffer_local_variables (struct buffer *b, bool permanent_too)
     bset_local_var_alist (b, Qnil);
   else
     {
-      Lisp_Object tmp, prop, last = Qnil;
+      Lisp_Object tmp, last = Qnil;
       for (tmp = BVAR (b, local_var_alist); CONSP (tmp); tmp = XCDR (tmp))
-	if (!NILP (prop = Fget (XCAR (XCAR (tmp)), Qpermanent_local)))
+        {
+          Lisp_Object local_var = XCAR (XCAR (tmp));
+          Lisp_Object prop = Fget (local_var, Qpermanent_local);
+
+          if (!NILP (prop))
             {
               /* If permanent-local, keep it.  */
               last = tmp;
@@ -1010,7 +1014,12 @@ reset_buffer_local_variables (struct buffer *b, bool permanent_too)
                             || !NILP (Fget (elt, Qpermanent_local_hook)))
                           newlist = Fcons (elt, newlist);
                       }
-		XSETCDR (XCAR (tmp), Fnreverse (newlist));
+                  newlist = Fnreverse (newlist);
+                  if (XSYMBOL (local_var)->trapped_write == SYMBOL_TRAPPED_WRITE)
+                    notify_variable_watchers (local_var, newlist,
+                                              Qmakunbound, Fcurrent_buffer ());
+                  XSETCDR (XCAR (tmp), newlist);
+                  continue; /* Don't do variable write trapping twice.  */
                 }
             }
           /* Delete this local variable.  */
@@ -1018,6 +1027,11 @@ reset_buffer_local_variables (struct buffer *b, bool permanent_too)
             bset_local_var_alist (b, XCDR (tmp));
           else
             XSETCDR (last, XCDR (tmp));
+
+          if (XSYMBOL (local_var)->trapped_write == SYMBOL_TRAPPED_WRITE)
+            notify_variable_watchers (local_var, Qnil,
+                                      Qmakunbound, Fcurrent_buffer ());
+        }
     }
 
   for (i = 0; i < last_per_buffer_idx; ++i)
@@ -5682,7 +5696,7 @@ syms_of_buffer (void)
 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;
+  make_symbol_constant (intern_c_string ("enable-multibyte-characters"));
 
   DEFVAR_PER_BUFFER ("buffer-file-coding-system",
 		     &BVAR (current_buffer, buffer_file_coding_system), Qnil,
diff --git a/src/bytecode.c b/src/bytecode.c
index e2d8ab7..18eaf9f 100644
--- a/src/bytecode.c
+++ b/src/bytecode.c
@@ -569,10 +569,10 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
 	    if (SYMBOLP (sym)
 		&& !EQ (val, Qunbound)
 		&& !XSYMBOL (sym)->redirect
-		&& !SYMBOL_CONSTANT_P (sym))
+                && !SYMBOL_TRAPPED_WRITE_P (sym))
 	      SET_SYMBOL_VAL (XSYMBOL (sym), val);
 	    else
-	      set_internal (sym, val, Qnil, false);
+              set_internal (sym, val, Qnil, SET_INTERNAL_SET);
 	  }
 	  NEXT;
 
diff --git a/src/data.c b/src/data.c
index d221db4..8954b42 100644
--- a/src/data.c
+++ b/src/data.c
@@ -1225,7 +1225,7 @@ 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, SET_INTERNAL_SET);
   return newval;
 }
 
@@ -1233,13 +1233,14 @@ DEFUN ("set", Fset, Sset, 2, 2, 0,
    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.  */
+   If BINDFLAG is SET_INTERNAL_SET, then if this symbol is supposed to
+   become local in every buffer where it is set, then we make it
+   local.  If BINDFLAG is SET_INTERNAL_BIND or SET_INTERNAL_UNBIND, we
+   don't do that.  */
 
 void
 set_internal (Lisp_Object symbol, Lisp_Object newval, Lisp_Object where,
-	      bool bindflag)
+              enum Set_Internal_Bind bindflag)
 {
   bool voide = EQ (newval, Qunbound);
   struct Lisp_Symbol *sym;
@@ -1250,18 +1251,31 @@ set_internal (Lisp_Object symbol, Lisp_Object newval, Lisp_Object where,
       return; */
 
   CHECK_SYMBOL (symbol);
-  if (SYMBOL_CONSTANT_P (symbol))
+  sym = XSYMBOL (symbol);
+  switch (sym->trapped_write)
     {
+    case SYMBOL_NOWRITE:
       if (NILP (Fkeywordp (symbol))
           || !EQ (newval, Fsymbol_value (symbol)))
         xsignal1 (Qsetting_constant, symbol);
       else
         /* Allow setting keywords to their own value.  */
         return;
+
+    case SYMBOL_TRAPPED_WRITE:
+      notify_variable_watchers (symbol, voide? Qnil : newval,
+                                (bindflag == SET_INTERNAL_BIND? Qlet :
+                                 bindflag == SET_INTERNAL_UNBIND? Qunlet :
+                                 voide? Qmakunbound : Qset),
+                                where);
+      /* FALLTHROUGH!  */
+    case SYMBOL_UNTRAPPED_WRITE:
+        break;
+
+    default: emacs_abort ();
     }
 
   maybe_set_redisplay (symbol);
-  sym = XSYMBOL (symbol);
 
  start:
   switch (sym->redirect)
@@ -1386,6 +1400,111 @@ set_internal (Lisp_Object symbol, Lisp_Object newval, Lisp_Object where,
   return;
 }
 
+static void
+set_symbol_trapped_write (Lisp_Object symbol, enum symbol_trapped_write trap)
+{
+  struct Lisp_Symbol* sym = XSYMBOL (symbol);
+  if (sym->trapped_write == SYMBOL_NOWRITE)
+    xsignal1 (Qtrapping_constant, symbol);
+  else if (sym->redirect == SYMBOL_LOCALIZED
+           && SYMBOL_BLV (sym)->frame_local)
+    xsignal1 (Qtrapping_frame_local, symbol);
+  sym->trapped_write = trap;
+}
+
+static void
+restore_symbol_trapped_write (Lisp_Object symbol)
+{
+  set_symbol_trapped_write (symbol, SYMBOL_TRAPPED_WRITE);
+}
+
+static void
+harmonize_variable_watchers (Lisp_Object alias, Lisp_Object base_variable)
+{
+  if (!EQ (base_variable, alias)
+      && EQ (base_variable, Findirect_variable (alias)))
+    set_symbol_trapped_write
+      (alias, XSYMBOL (base_variable)->trapped_write);
+}
+
+DEFUN ("add-variable-watcher", Fadd_variable_watcher, Sadd_variable_watcher,
+       2, 2, 0,
+       doc: /* Cause WATCH-FUNCTION to be called when SYMBOL is set.
+All writes to aliases of SYMBOL will call WATCH-FUNCTION too.  */)
+  (Lisp_Object symbol, Lisp_Object watch_function)
+{
+  symbol = Findirect_variable (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));
+  return Qnil;
+}
+
+DEFUN ("remove-variable-watcher", Fremove_variable_watcher, Sremove_variable_watcher,
+       2, 2, 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)
+{
+  symbol = Findirect_variable (symbol);
+  Lisp_Object watchers = Fget (symbol, Qwatchers);
+  watchers = Fdelete (watch_function, watchers);
+  if (NILP (watchers))
+    {
+      set_symbol_trapped_write (symbol, SYMBOL_UNTRAPPED_WRITE);
+      map_obarray (Vobarray, harmonize_variable_watchers, symbol);
+    }
+  Fput (symbol, Qwatchers, watchers);
+  return Qnil;
+}
+
+void
+notify_variable_watchers (Lisp_Object symbol,
+                          Lisp_Object newval,
+                          Lisp_Object operation,
+                          Lisp_Object where)
+{
+  symbol = Findirect_variable (symbol);
+
+  ptrdiff_t count = SPECPDL_INDEX ();
+  record_unwind_protect (restore_symbol_trapped_write, symbol);
+  /* Avoid recursion.  */
+  set_symbol_trapped_write (symbol, SYMBOL_UNTRAPPED_WRITE);
+
+  if (NILP (where)
+      && !EQ (operation, Qset_default) && !EQ (operation, Qmakunbound)
+      && !NILP (Flocal_variable_if_set_p (symbol, Fcurrent_buffer ())))
+    {
+      XSETBUFFER (where, current_buffer);
+    }
+
+  if (EQ (operation, Qset_default))
+    operation = Qset;
+
+  for (Lisp_Object watchers = Fget (symbol, Qwatchers);
+       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
+        CALLN (Ffuncall, watcher, symbol, newval, operation, where);
+    }
+
+  unbind_to (count, Qnil);
+}
+
+\f
 /* Access or set a buffer-local symbol's default value.  */
 
 /* Return the default value of SYMBOL, but don't check for voidness.
@@ -1471,16 +1590,27 @@ DEFUN ("set-default", Fset_default, Sset_default, 2, 2, 0,
   struct Lisp_Symbol *sym;
 
   CHECK_SYMBOL (symbol);
-  if (SYMBOL_CONSTANT_P (symbol))
+  sym = XSYMBOL (symbol);
+  switch (sym->trapped_write)
     {
+    case SYMBOL_NOWRITE:
       if (NILP (Fkeywordp (symbol))
-	  || !EQ (value, Fdefault_value (symbol)))
+          || !EQ (value, Fsymbol_value (symbol)))
         xsignal1 (Qsetting_constant, symbol);
       else
         /* Allow setting keywords to their own value.  */
         return value;
+
+    case SYMBOL_TRAPPED_WRITE:
+      /* Don't notify here if we're going to call Fset anyway.  */
+      if (sym->redirect != SYMBOL_PLAINVAL)
+        notify_variable_watchers (symbol, value, Qset_default, Qnil);
+      /* FALLTHROUGH!  */
+    case SYMBOL_UNTRAPPED_WRITE:
+        break;
+
+    default: emacs_abort ();
     }
-  sym = XSYMBOL (symbol);
 
  start:
   switch (sym->redirect)
@@ -1651,7 +1781,7 @@ DEFUN ("make-variable-buffer-local", Fmake_variable_buffer_local,
     default: emacs_abort ();
     }
 
-  if (sym->constant)
+  if (SYMBOL_CONSTANT_P (variable))
     error ("Symbol %s may not be buffer-local", SDATA (SYMBOL_NAME (variable)));
 
   if (!blv)
@@ -1726,7 +1856,7 @@ DEFUN ("make-local-variable", Fmake_local_variable, Smake_local_variable,
     default: emacs_abort ();
     }
 
-  if (sym->constant)
+  if (sym->trapped_write == SYMBOL_NOWRITE)
     error ("Symbol %s may not be buffer-local",
 	   SDATA (SYMBOL_NAME (variable)));
 
@@ -1838,6 +1968,9 @@ DEFUN ("kill-local-variable", Fkill_local_variable, Skill_local_variable,
     default: emacs_abort ();
     }
 
+  if (sym->trapped_write == SYMBOL_TRAPPED_WRITE)
+    notify_variable_watchers (variable, Qnil, Qmakunbound, Fcurrent_buffer ());
+
   /* Get rid of this buffer's alist element, if any.  */
   XSETSYMBOL (variable, sym);	/* Propagate variable indirection.  */
   tem = Fassq (variable, BVAR (current_buffer, local_var_alist));
@@ -1920,7 +2053,7 @@ DEFUN ("make-variable-frame-local", Fmake_variable_frame_local, Smake_variable_f
     default: emacs_abort ();
     }
 
-  if (sym->constant)
+  if (SYMBOL_TRAPPED_WRITE_P (variable))
     error ("Symbol %s may not be frame-local", SDATA (SYMBOL_NAME (variable)));
 
   blv = make_blv (sym, forwarded, valcontents);
@@ -3471,6 +3604,8 @@ syms_of_data (void)
   DEFSYM (Qcyclic_variable_indirection, "cyclic-variable-indirection");
   DEFSYM (Qvoid_variable, "void-variable");
   DEFSYM (Qsetting_constant, "setting-constant");
+  DEFSYM (Qtrapping_constant, "trapping-constant");
+  DEFSYM (Qtrapping_frame_local, "trapping-frame-local");
   DEFSYM (Qinvalid_read_syntax, "invalid-read-syntax");
 
   DEFSYM (Qinvalid_function, "invalid-function");
@@ -3549,6 +3684,10 @@ syms_of_data (void)
   PUT_ERROR (Qvoid_variable, error_tail, "Symbol's value as variable is void");
   PUT_ERROR (Qsetting_constant, error_tail,
 	     "Attempt to set a constant symbol");
+  PUT_ERROR (Qtrapping_constant, error_tail,
+             "Attempt to trap writes to a constant symbol");
+  PUT_ERROR (Qtrapping_frame_local, error_tail,
+             "Attempt to trap writes to a frame local variable");
   PUT_ERROR (Qinvalid_read_syntax, error_tail, "Invalid read syntax");
   PUT_ERROR (Qinvalid_function, error_tail, "Invalid function");
   PUT_ERROR (Qwrong_number_of_arguments, error_tail,
@@ -3727,10 +3866,18 @@ syms_of_data (void)
   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;
+  make_symbol_constant (intern_c_string ("most-positive-fixnum"));
 
   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;
+  make_symbol_constant (intern_c_string ("most-negative-fixnum"));
+
+  DEFSYM (Qwatchers, "watchers");
+  DEFSYM (Qmakunbound, "makunbound");
+  DEFSYM (Qunlet, "unlet");
+  DEFSYM (Qset, "set");
+  DEFSYM (Qset_default, "set-default");
+  defsubr (&Sadd_variable_watcher);
+  defsubr (&Sremove_variable_watcher);
 }
diff --git a/src/eval.c b/src/eval.c
index a9bad24..c5c6fa9 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -593,12 +593,12 @@ DEFUN ("defvaralias", Fdefvaralias, Sdefvaralias, 2, 3, 0,
   CHECK_SYMBOL (new_alias);
   CHECK_SYMBOL (base_variable);
 
-  sym = XSYMBOL (new_alias);
-
-  if (sym->constant)
-    /* Not sure why, but why not?  */
+  if (SYMBOL_CONSTANT_P (new_alias))
+    /* Making it an alias effectively changes its value.  */
     error ("Cannot make a constant an alias");
 
+  sym = XSYMBOL (new_alias);
+
   switch (sym->redirect)
     {
     case SYMBOL_FORWARDED:
@@ -617,8 +617,8 @@ DEFUN ("defvaralias", Fdefvaralias, Sdefvaralias, 2, 3, 0,
      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, SET_INTERNAL_BIND);
   {
     union specbinding *p;
 
@@ -628,11 +628,14 @@ DEFUN ("defvaralias", Fdefvaralias, Sdefvaralias, 2, 3, 0,
 	error ("Don't know how to make a let-bound variable an alias");
   }
 
+  if (sym->trapped_write == SYMBOL_TRAPPED_WRITE)
+    notify_variable_watchers (new_alias, base_variable, Qdefvaralias, Qnil);
+
   sym->declared_special = 1;
   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->trapped_write = XSYMBOL (base_variable)->trapped_write;
   LOADHIST_ATTACH (new_alias);
   /* Even if docstring is nil: remove old docstring.  */
   Fput (new_alias, Qvariable_documentation, docstring);
@@ -2644,9 +2647,7 @@ DEFUN ("funcall", Ffuncall, Sfuncall, 1, MANY, 0,
   Lisp_Object fun, original_fun;
   Lisp_Object funcar;
   ptrdiff_t numargs = nargs - 1;
-  Lisp_Object lisp_numargs;
   Lisp_Object val;
-  Lisp_Object *internal_args;
   ptrdiff_t count;
 
   QUIT;
@@ -2679,76 +2680,110 @@ DEFUN ("funcall", Ffuncall, Sfuncall, 1, MANY, 0,
     fun = indirect_function (fun);
 
   if (SUBRP (fun))
+    val = funcall_subr (XSUBR (fun), numargs, args + 1);
+  else if (COMPILEDP (fun))
+    val = funcall_lambda (fun, numargs, args + 1);
+  else
     {
-      if (numargs < XSUBR (fun)->min_args
-	  || (XSUBR (fun)->max_args >= 0 && XSUBR (fun)->max_args < numargs))
+      if (NILP (fun))
+	xsignal1 (Qvoid_function, original_fun);
+      if (!CONSP (fun))
+	xsignal1 (Qinvalid_function, original_fun);
+      funcar = XCAR (fun);
+      if (!SYMBOLP (funcar))
+	xsignal1 (Qinvalid_function, original_fun);
+      if (EQ (funcar, Qlambda)
+	  || EQ (funcar, Qclosure))
+	val = funcall_lambda (fun, numargs, args + 1);
+      else if (EQ (funcar, Qautoload))
 	{
-	  XSETFASTINT (lisp_numargs, numargs);
-	  xsignal2 (Qwrong_number_of_arguments, original_fun, lisp_numargs);
+	  Fautoload_do_load (fun, original_fun, Qnil);
+	  check_cons_list ();
+	  goto retry;
 	}
-
-      else if (XSUBR (fun)->max_args == UNEVALLED)
+      else
 	xsignal1 (Qinvalid_function, original_fun);
+    }
+  check_cons_list ();
+  lisp_eval_depth--;
+  if (backtrace_debug_on_exit (specpdl + count))
+    val = call_debugger (list2 (Qexit, val));
+  specpdl_ptr--;
+  return val;
+}
 \f
-      else if (XSUBR (fun)->max_args == MANY)
-	val = (XSUBR (fun)->function.aMANY) (numargs, args + 1);
+
+/* Apply a C subroutine SUBR to the NUMARGS evaluated arguments in ARG_VECTOR
+   and return the result of evaluation.  */
+
+Lisp_Object
+funcall_subr (struct Lisp_Subr *subr, ptrdiff_t numargs, Lisp_Object *args)
+{
+  if (numargs < subr->min_args
+      || (subr->max_args >= 0 && subr->max_args < numargs))
+    {
+      Lisp_Object fun;
+      XSETSUBR (fun, subr);
+      xsignal2 (Qwrong_number_of_arguments, fun, make_number (numargs));
+    }
+
+  else if (subr->max_args == UNEVALLED)
+    {
+      Lisp_Object fun;
+      XSETSUBR (fun, subr);
+      xsignal1 (Qinvalid_function, fun);
+    }
+
+  else if (subr->max_args == MANY)
+    return (subr->function.aMANY) (numargs, args);
   else
     {
       Lisp_Object internal_argbuf[8];
-	  if (XSUBR (fun)->max_args > numargs)
+      Lisp_Object *internal_args;
+      if (subr->max_args > numargs)
         {
-	      eassert (XSUBR (fun)->max_args <= ARRAYELTS (internal_argbuf));
+          eassert (subr->max_args <= ARRAYELTS (internal_argbuf));
           internal_args = internal_argbuf;
-	      memcpy (internal_args, args + 1, numargs * word_size);
+          memcpy (internal_args, args, numargs * word_size);
           memclear (internal_args + numargs,
-			(XSUBR (fun)->max_args - numargs) * word_size);
+                    (subr->max_args - numargs) * word_size);
         }
       else
-	    internal_args = args + 1;
-	  switch (XSUBR (fun)->max_args)
+        internal_args = args;
+      switch (subr->max_args)
         {
         case 0:
-	      val = (XSUBR (fun)->function.a0 ());
-	      break;
+          return (subr->function.a0 ());
         case 1:
-	      val = (XSUBR (fun)->function.a1 (internal_args[0]));
-	      break;
+          return (subr->function.a1 (internal_args[0]));
         case 2:
-	      val = (XSUBR (fun)->function.a2
+          return (subr->function.a2
                   (internal_args[0], internal_args[1]));
-	      break;
         case 3:
-	      val = (XSUBR (fun)->function.a3
+          return (subr->function.a3
                   (internal_args[0], internal_args[1], internal_args[2]));
-	      break;
         case 4:
-	      val = (XSUBR (fun)->function.a4
+          return (subr->function.a4
                   (internal_args[0], internal_args[1], internal_args[2],
                    internal_args[3]));
-	      break;
         case 5:
-	      val = (XSUBR (fun)->function.a5
+          return (subr->function.a5
                   (internal_args[0], internal_args[1], internal_args[2],
                    internal_args[3], internal_args[4]));
-	      break;
         case 6:
-	      val = (XSUBR (fun)->function.a6
+          return (subr->function.a6
                   (internal_args[0], internal_args[1], internal_args[2],
                    internal_args[3], internal_args[4], internal_args[5]));
-	      break;
         case 7:
-	      val = (XSUBR (fun)->function.a7
+          return (subr->function.a7
                   (internal_args[0], internal_args[1], internal_args[2],
                    internal_args[3], internal_args[4], internal_args[5],
                    internal_args[6]));
-	      break;
-
         case 8:
-	      val = (XSUBR (fun)->function.a8
+          return (subr->function.a8
                   (internal_args[0], internal_args[1], internal_args[2],
                    internal_args[3], internal_args[4], internal_args[5],
                    internal_args[6], internal_args[7]));
-	      break;
 
         default:
 
@@ -2759,36 +2794,6 @@ DEFUN ("funcall", Ffuncall, Sfuncall, 1, MANY, 0,
         }
     }
 }
-  else if (COMPILEDP (fun))
-    val = funcall_lambda (fun, numargs, args + 1);
-  else
-    {
-      if (NILP (fun))
-	xsignal1 (Qvoid_function, original_fun);
-      if (!CONSP (fun))
-	xsignal1 (Qinvalid_function, original_fun);
-      funcar = XCAR (fun);
-      if (!SYMBOLP (funcar))
-	xsignal1 (Qinvalid_function, original_fun);
-      if (EQ (funcar, Qlambda)
-	  || EQ (funcar, Qclosure))
-	val = funcall_lambda (fun, numargs, args + 1);
-      else if (EQ (funcar, Qautoload))
-	{
-	  Fautoload_do_load (fun, original_fun, Qnil);
-	  check_cons_list ();
-	  goto retry;
-	}
-      else
-	xsignal1 (Qinvalid_function, original_fun);
-    }
-  check_cons_list ();
-  lisp_eval_depth--;
-  if (backtrace_debug_on_exit (specpdl + count))
-    val = call_debugger (list2 (Qexit, val));
-  specpdl_ptr--;
-  return val;
-}
 
 static Lisp_Object
 apply_lambda (Lisp_Object fun, Lisp_Object args, ptrdiff_t count)
@@ -3158,10 +3163,10 @@ specbind (Lisp_Object symbol, Lisp_Object value)
       specpdl_ptr->let.symbol = symbol;
       specpdl_ptr->let.old_value = SYMBOL_VAL (sym);
       grow_specpdl ();
-      if (!sym->constant)
+      if (!sym->trapped_write)
 	SET_SYMBOL_VAL (sym, value);
       else
-	set_internal (symbol, value, Qnil, 1);
+	set_internal (symbol, value, Qnil, SET_INTERNAL_BIND);
       break;
     case SYMBOL_LOCALIZED:
       if (SYMBOL_BLV (sym)->frame_local)
@@ -3201,7 +3206,7 @@ specbind (Lisp_Object symbol, Lisp_Object value)
 	  specpdl_ptr->let.kind = SPECPDL_LET;
 
 	grow_specpdl ();
-	set_internal (symbol, value, Qnil, 1);
+        set_internal (symbol, value, Qnil, SET_INTERNAL_BIND);
 	break;
       }
     default: emacs_abort ();
@@ -3328,14 +3333,16 @@ unbind_to (ptrdiff_t count, Lisp_Object value)
 	case SPECPDL_BACKTRACE:
 	  break;
 	case SPECPDL_LET:
-	  { /* If variable has a trivial value (no forwarding), we can
-	       just set it.  No need to check for constant symbols here,
-	       since that was already done by specbind.  */
+          { /* If variable has a trivial value (no forwarding), and
+               isn't trapped, we can just set it.  */
 	    Lisp_Object sym = specpdl_symbol (specpdl_ptr);
 	    if (SYMBOLP (sym) && XSYMBOL (sym)->redirect == SYMBOL_PLAINVAL)
 	      {
-		SET_SYMBOL_VAL (XSYMBOL (sym),
-				specpdl_old_value (specpdl_ptr));
+                if (XSYMBOL (sym)->trapped_write == SYMBOL_UNTRAPPED_WRITE)
+                  SET_SYMBOL_VAL (XSYMBOL (sym), specpdl_old_value (specpdl_ptr));
+                else
+                  set_internal (sym, specpdl_old_value (specpdl_ptr),
+                                Qnil, SET_INTERNAL_UNBIND);
 		break;
 	      }
 	    else
@@ -3358,7 +3365,7 @@ unbind_to (ptrdiff_t count, Lisp_Object value)
 	    /* 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, SET_INTERNAL_UNBIND);
 	  }
 	  break;
 	}
@@ -3583,7 +3590,7 @@ backtrace_eval_unrewind (int distance)
 	      {
 		set_specpdl_old_value
 		  (tmp, Fbuffer_local_value (symbol, where));
-		set_internal (symbol, old_value, where, 1);
+                set_internal (symbol, old_value, where, SET_INTERNAL_UNBIND);
 	      }
 	  }
 	  break;
@@ -3927,6 +3934,7 @@ syms_of_eval (void)
   defsubr (&Sset_default_toplevel_value);
   defsubr (&Sdefvar);
   defsubr (&Sdefvaralias);
+  DEFSYM (Qdefvaralias, "defvaralias");
   defsubr (&Sdefconst);
   defsubr (&Smake_var_non_special);
   defsubr (&Slet);
diff --git a/src/font.c b/src/font.c
index ce63233..3b821a4 100644
--- a/src/font.c
+++ b/src/font.c
@@ -5417,19 +5417,19 @@ syms_of_font (void)
     [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;
+  make_symbol_constant (intern_c_string ("font-weight-table"));
 
   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;
+  make_symbol_constant (intern_c_string ("font-slant-table"));
 
   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;
+  make_symbol_constant (intern_c_string ("font-width-table"));
 
   staticpro (&font_style_table);
   font_style_table = make_uninit_vector (3);
diff --git a/src/lisp.h b/src/lisp.h
index 2e46592..701ee9c 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -320,7 +320,8 @@ DEFINE_GDB_SYMBOL_END (USE_LSB_TAG)
 #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) (XSYMBOL (sym)->trapped_write == SYMBOL_NOWRITE)
+#define lisp_h_SYMBOL_TRAPPED_WRITE_P(sym) (XSYMBOL (sym)->trapped_write)
 #define lisp_h_SYMBOL_VAL(sym) \
    (eassert ((sym)->redirect == SYMBOL_PLAINVAL), (sym)->val.value)
 #define lisp_h_SYMBOLP(x) (XTYPE (x) == Lisp_Symbol)
@@ -375,6 +376,7 @@ DEFINE_GDB_SYMBOL_END (USE_LSB_TAG)
 # define NILP(x) lisp_h_NILP (x)
 # define SET_SYMBOL_VAL(sym, v) lisp_h_SET_SYMBOL_VAL (sym, v)
 # define SYMBOL_CONSTANT_P(sym) lisp_h_SYMBOL_CONSTANT_P (sym)
+# define SYMBOL_TRAPPED_WRITE_P(sym) lisp_h_SYMBOL_TRAPPED_WRITE_P (sym)
 # define SYMBOL_VAL(sym) lisp_h_SYMBOL_VAL (sym)
 # define SYMBOLP(x) lisp_h_SYMBOLP (x)
 # define VECTORLIKEP(x) lisp_h_VECTORLIKEP (x)
@@ -602,6 +604,9 @@ INLINE bool (VECTORLIKEP) (Lisp_Object);
 /* Defined in data.c.  */
 extern _Noreturn Lisp_Object wrong_type_argument (Lisp_Object, Lisp_Object);
 extern _Noreturn void wrong_choice (Lisp_Object, Lisp_Object);
+extern void notify_variable_watchers (Lisp_Object symbol, Lisp_Object newval,
+                                      Lisp_Object operation, Lisp_Object where);
+
 
 /* Defined in emacs.c.  */
 #ifdef DOUG_LEA_MALLOC
@@ -632,6 +637,13 @@ INLINE bool (VECTORLIKEP) (Lisp_Object);
   SYMBOL_FORWARDED = 3
 };
 
+enum symbol_trapped_write
+{
+  SYMBOL_UNTRAPPED_WRITE = 0,
+  SYMBOL_NOWRITE = 1,
+  SYMBOL_TRAPPED_WRITE = 2
+};
+
 struct Lisp_Symbol
 {
   bool_bf gcmarkbit : 1;
@@ -643,10 +655,10 @@ INLINE bool (VECTORLIKEP) (Lisp_Object);
      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;
+  /* 0 : normal case, just set the value
+     1 : constant, cannot set, e.g. nil, t, :keywords.
+     2 : trap the write, call watcher functions.  */
+  ENUM_BF (symbol_trapped_write) trapped_write : 2;
 
   /* Interned state of the symbol.  This is an enumerator from
      enum symbol_interned.  */
@@ -1850,9 +1862,20 @@ SYMBOL_INTERNED_IN_INITIAL_OBARRAY_P (Lisp_Object sym)
   return XSYMBOL (sym)->interned == SYMBOL_INTERNED_IN_INITIAL_OBARRAY;
 }
 
-/* Value is non-zero if symbol is considered a constant, i.e. its
-   value cannot be changed (there is an exception for keyword symbols,
-   whose value can be set to the keyword symbol itself).  */
+/* Value is non-zero if symbol cannot be changed through a simple set,
+   i.e. it's a constant (e.g. nil, t, :keywords), or it has some
+   watching functions.  */
+
+INLINE int
+(SYMBOL_TRAPPED_WRITE_P) (Lisp_Object sym)
+{
+  return lisp_h_SYMBOL_TRAPPED_WRITE_P (sym);
+}
+
+/* Value is non-zero if symbol cannot be changed at all, i.e. it's a
+   constant (e.g. nil, t, :keywords).  Code that actually wants to
+   write to SYM, should also check whether there are any watching
+   functions.  */
 
 INLINE int
 (SYMBOL_CONSTANT_P) (Lisp_Object sym)
@@ -3289,6 +3312,12 @@ set_symbol_next (Lisp_Object sym, struct Lisp_Symbol *next)
   XSYMBOL (sym)->next = next;
 }
 
+INLINE void
+make_symbol_constant (Lisp_Object sym)
+{
+  XSYMBOL (sym)->trapped_write = SYMBOL_NOWRITE;
+}
+
 /* Buffer-local (also frame-local) variable access functions.  */
 
 INLINE int
@@ -3397,7 +3426,13 @@ set_sub_char_table_contents (Lisp_Object table, ptrdiff_t idx, Lisp_Object val)
 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);
+enum Set_Internal_Bind {
+  SET_INTERNAL_SET,
+  SET_INTERNAL_BIND,
+  SET_INTERNAL_UNBIND
+};
+extern void set_internal (Lisp_Object, Lisp_Object, Lisp_Object,
+                          enum Set_Internal_Bind);
 extern void syms_of_data (void);
 extern void swap_in_global_binding (struct Lisp_Symbol *);
 
@@ -3880,6 +3915,7 @@ xsignal (Lisp_Object error_symbol, Lisp_Object data)
 extern _Noreturn void xsignal3 (Lisp_Object, Lisp_Object, Lisp_Object,
 				Lisp_Object);
 extern _Noreturn void signal_error (const char *, Lisp_Object);
+extern Lisp_Object funcall_subr (struct Lisp_Subr *subr, ptrdiff_t numargs, Lisp_Object *arg_vector);
 extern Lisp_Object eval_sub (Lisp_Object form);
 extern Lisp_Object apply1 (Lisp_Object, Lisp_Object);
 extern Lisp_Object call0 (Lisp_Object);
diff --git a/src/lread.c b/src/lread.c
index 58d518c..7e74703 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -3833,7 +3833,7 @@ intern_sym (Lisp_Object sym, Lisp_Object obarray, Lisp_Object index)
 
   if (SREF (SYMBOL_NAME (sym), 0) == ':' && EQ (obarray, initial_obarray))
     {
-      XSYMBOL (sym)->constant = 1;
+      make_symbol_constant (sym);
       XSYMBOL (sym)->redirect = SYMBOL_PLAINVAL;
       SET_SYMBOL_VAL (XSYMBOL (sym), sym);
     }
@@ -4120,12 +4120,12 @@ init_obarray (void)
 
   DEFSYM (Qnil, "nil");
   SET_SYMBOL_VAL (XSYMBOL (Qnil), Qnil);
-  XSYMBOL (Qnil)->constant = 1;
+  make_symbol_constant (Qnil);
   XSYMBOL (Qnil)->declared_special = true;
 
   DEFSYM (Qt, "t");
   SET_SYMBOL_VAL (XSYMBOL (Qt), Qt);
-  XSYMBOL (Qt)->constant = 1;
+  make_symbol_constant (Qt);
   XSYMBOL (Qt)->declared_special = true;
 
   /* Qt is correct even if CANNOT_DUMP.  loadup.el will set to nil at end.  */
-- 
2.9.3


[-- Attachment #3: patch --]
[-- Type: text/plain, Size: 2267 bytes --]

From dda5dc2280e77c664e7f479eb9bd84e2db2024f0 Mon Sep 17 00:00:00 2001
From: Noam Postavsky <npostavs@gmail.com>
Date: Sat, 19 Nov 2016 16:50:34 -0500
Subject: [PATCH v6 2/6] Show watchpoints when describing variables

* src/data.c (Fget_variable_watchers): New function.
* lisp/help-fns.el (describe-variable): Use it to detect watching
functions.
---
 lisp/help-fns.el |  7 +++++++
 src/data.c       | 11 +++++++++++
 2 files changed, 18 insertions(+)

diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index 87e7d8f..23dec89 100644
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -918,6 +918,7 @@ describe-variable
                               (indirect-variable variable)
                             (error variable)))
                    (obsolete (get variable 'byte-obsolete-variable))
+                   (watchpoints (get-variable-watchers variable))
 		   (use (car obsolete))
 		   (safe-var (get variable 'safe-local-variable))
                    (doc (or (documentation-property
@@ -967,6 +968,12 @@ describe-variable
 			     (t ".")))
                 (terpri))
 
+              (when watchpoints
+                (setq extra-line t)
+                (princ "  Calls these functions when changed: ")
+                (princ watchpoints)
+                (terpri))
+
 	      (when (member (cons variable val)
                             (with-current-buffer buffer
                               file-local-variables-alist))
diff --git a/src/data.c b/src/data.c
index 8954b42..911789f 100644
--- a/src/data.c
+++ b/src/data.c
@@ -1463,6 +1463,16 @@ SYMBOL (or its aliases) are set.  */)
   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)
+{
+  return (SYMBOL_TRAPPED_WRITE_P (symbol) == SYMBOL_TRAPPED_WRITE)
+    ? Fget (Findirect_variable (symbol), Qwatchers)
+    : Qnil;
+}
+
 void
 notify_variable_watchers (Lisp_Object symbol,
                           Lisp_Object newval,
@@ -3880,4 +3890,5 @@ syms_of_data (void)
   DEFSYM (Qset_default, "set-default");
   defsubr (&Sadd_variable_watcher);
   defsubr (&Sremove_variable_watcher);
+  defsubr (&Sget_variable_watchers);
 }
-- 
2.9.3


[-- Attachment #4: patch --]
[-- Type: text/plain, Size: 4926 bytes --]

From 68b3861097e1b6ea8e353e89aa339a59645d6a37 Mon Sep 17 00:00:00 2001
From: Noam Postavsky <npostavs@gmail.com>
Date: Sat, 21 Nov 2015 16:03:06 -0500
Subject: [PATCH v6 3/6] Add function to trigger debugger on variable write

* lisp/emacs-lisp/debug.el (debug-on-variable-change):
(debug--variable-list):
(cancel-debug-on-variable-change): New functions.
(debugger-setup-buffer): Add watchpoint clause.
---
 lisp/emacs-lisp/debug.el | 91 ++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 91 insertions(+)

diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el
index 7d27380..0fefc54 100644
--- a/lisp/emacs-lisp/debug.el
+++ b/lisp/emacs-lisp/debug.el
@@ -306,6 +306,24 @@ debugger-setup-buffer
        (delete-char 1)
        (insert ? )
        (beginning-of-line))
+      ;; Watchpoint triggered.
+      ((and `watchpoint (let `(,symbol ,newval . ,details) (cdr args)))
+       (insert
+        "--"
+        (pcase details
+          (`(makunbound nil) (format "making %s void" symbol))
+          (`(makunbound ,buffer) (format "killing local value of %s in buffer %s"
+                                         symbol buffer))
+          (`(defvaralias ,_) (format "aliasing %s to %s" symbol newval))
+          (`(let ,_) (format "let-binding %s to %S" symbol newval))
+          (`(unlet ,_) (format "ending let-binding of %s" symbol))
+          (`(set nil) (format "setting %s to %S" symbol newval))
+          (`(set ,buffer) (format "setting %s in buffer %s to %S"
+                                  symbol buffer newval))
+          (_ (error "unrecognized watchpoint triggered %S" (cdr args))))
+        ": ")
+       (setq pos (point))
+       (insert ?\n))
       ;; Debugger entered for an error.
       (`error
        (insert "--Lisp error: ")
@@ -850,6 +868,79 @@ debugger-list-functions
           (princ "Note: if you have redefined a function, then it may no longer\n")
           (princ "be set to debug on entry, even if it is in the list."))))))
 
+(defun debug--implement-debug-watch (symbol newval op where)
+  "Conditionally call the debugger.
+This function is called when SYMBOL's value is modified."
+  (if (or inhibit-debug-on-entry debugger-jumping-flag)
+      nil
+    (let ((inhibit-debug-on-entry t))
+      (funcall debugger 'watchpoint symbol newval op where))))
+
+;;;###autoload
+(defun debug-on-variable-change (variable)
+  "Trigger a debugger invocation when VARIABLE is changed.
+
+When called interactively, prompt for VARIABLE in the minibuffer.
+
+This works by calling `add-variable-watch' on VARIABLE.  If you
+quit from the debugger, this will abort the change (unless the
+change is caused by the termination of a let-binding).
+
+The watchpoint may be circumvented by C code that changes the
+variable directly (i.e., not via `set').  Changing the value of
+the variable (e.g., `setcar' on a list variable) will not trigger
+watchpoint.
+
+Use \\[cancel-debug-on-variable-change] to cancel the effect of
+this command.  Uninterning VARIABLE or making it an alias of
+another symbol also cancels it."
+  (interactive
+   (let* ((var-at-point (variable-at-point))
+          (var (and (symbolp var-at-point) var-at-point))
+          (val (completing-read
+                (concat "Debug when setting variable"
+                        (if var (format " (default %s): " var) ": "))
+                obarray #'boundp
+                t nil nil (and var (symbol-name var)))))
+     (list (if (equal val "") var (intern val)))))
+  (add-variable-watcher variable #'debug--implement-debug-watch))
+
+;;;###autoload
+(defalias 'debug-watch #'debug-on-variable-change)
+
+
+(defun debug--variable-list ()
+  "List of variables currently set for debug on set."
+  (let ((vars '()))
+    (mapatoms
+     (lambda (s)
+       (when (memq #'debug--implement-debug-watch
+                   (get s 'watchers))
+         (push s vars))))
+    vars))
+
+;;;###autoload
+(defun cancel-debug-on-variable-change (&optional variable)
+  "Undo effect of \\[debug-on-entry] on VARIABLE.
+If VARIABLE is nil, cancel debug-on-variable-change for all variables.
+When called interactively, prompt for VARIABLE in the minibuffer.
+To specify a nil argument interactively, exit with an empty minibuffer."
+  (interactive
+   (list (let ((name
+                (completing-read
+                 "Cancel debug on set for variable (default all variables): "
+                 (mapcar #'symbol-name (debug--variable-list)) nil t)))
+           (when name
+             (unless (string= name "")
+               (intern name))))))
+  (if variable
+      (remove-variable-watcher variable #'debug--implement-debug-watch)
+    (message "Canceling debug-watch for all variables")
+    (mapc #'cancel-debug-watch (debug--variable-list))))
+
+;;;###autoload
+(defalias 'cancel-debug-watch #'cancel-debug-on-variable-change)
+
 (provide 'debug)
 
 ;;; debug.el ends here
-- 
2.9.3


[-- Attachment #5: patch --]
[-- Type: text/plain, Size: 3909 bytes --]

From 5d87668684319bb165ed0f31f637c44cda5716a6 Mon Sep 17 00:00:00 2001
From: Noam Postavsky <npostavs@gmail.com>
Date: Sat, 21 Nov 2015 17:02:42 -0500
Subject: [PATCH v6 4/6] Ensure redisplay using variable watcher

Instead of looking up the variable name in redisplay--variables when
setting.

* lisp/frame.el: Replace redisplay--variables with add-variable-watcher
calls.
* src/xdisp.c (Fset_buffer_redisplay): Rename from maybe_set_redisplay,
set the redisplay flag unconditionally.
(Vredisplay__variables): Remove it.
* src/data.c (set_internal): Remove maybe_set_redisplay call.
---
 lisp/frame.el |  3 +--
 src/data.c    |  2 --
 src/window.h  |  1 -
 src/xdisp.c   | 17 +++++++----------
 4 files changed, 8 insertions(+), 15 deletions(-)

diff --git a/lisp/frame.el b/lisp/frame.el
index a584567..1dffc6c 100644
--- a/lisp/frame.el
+++ b/lisp/frame.el
@@ -2249,9 +2249,8 @@ 'automatic-hscrolling
  'window-system-version "it does not give useful information." "24.3")
 
 ;; Variables which should trigger redisplay of the current buffer.
-(setq redisplay--variables (make-hash-table :test 'eq :size 10))
 (mapc (lambda (var)
-        (puthash var 1 redisplay--variables))
+        (add-variable-watcher var (symbol-function 'set-buffer-redisplay)))
       '(line-spacing
         overline-margin
         line-prefix
diff --git a/src/data.c b/src/data.c
index 911789f..ff35315 100644
--- a/src/data.c
+++ b/src/data.c
@@ -1275,8 +1275,6 @@ set_internal (Lisp_Object symbol, Lisp_Object newval, Lisp_Object where,
     default: emacs_abort ();
     }
 
-  maybe_set_redisplay (symbol);
-
  start:
   switch (sym->redirect)
     {
diff --git a/src/window.h b/src/window.h
index a124b33..4a102f2 100644
--- a/src/window.h
+++ b/src/window.h
@@ -1063,7 +1063,6 @@ void set_window_buffer (Lisp_Object window, Lisp_Object buffer,
 extern void fset_redisplay (struct frame *f);
 extern void bset_redisplay (struct buffer *b);
 extern void bset_update_mode_line (struct buffer *b);
-extern void maybe_set_redisplay (Lisp_Object);
 /* Call this to tell redisplay to look for other windows than selected-window
    that need to be redisplayed.  Calling one of the *set_redisplay functions
    above already does it, so it's only needed in unusual cases.  */
diff --git a/src/xdisp.c b/src/xdisp.c
index 6e8af8a..9d36ab6 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -622,15 +622,15 @@ bset_update_mode_line (struct buffer *b)
   b->text->redisplay = true;
 }
 
-void
-maybe_set_redisplay (Lisp_Object symbol)
-{
-  if (HASH_TABLE_P (Vredisplay__variables)
-      && hash_lookup (XHASH_TABLE (Vredisplay__variables), symbol, NULL) >= 0)
+DEFUN ("set-buffer-redisplay", Fset_buffer_redisplay,
+       Sset_buffer_redisplay, 4, 4, 0,
+       doc: /* Mark the current buffer for redisplay.
+This function may be passed to `add-variable-watcher'.  */)
+  (Lisp_Object symbol, Lisp_Object newval, Lisp_Object op, Lisp_Object where)
 {
   bset_update_mode_line (current_buffer);
   current_buffer->prevent_redisplay_optimizations_p = true;
-    }
+  return Qnil;
 }
 
 #ifdef GLYPH_DEBUG
@@ -31319,6 +31319,7 @@ syms_of_xdisp (void)
   message_dolog_marker3 = Fmake_marker ();
   staticpro (&message_dolog_marker3);
 
+  defsubr (&Sset_buffer_redisplay);
 #ifdef GLYPH_DEBUG
   defsubr (&Sdump_frame_glyph_matrix);
   defsubr (&Sdump_glyph_matrix);
@@ -31988,10 +31989,6 @@ or t (meaning all windows).  */);
 	       doc: /*  */);
   Vredisplay__mode_lines_cause = Fmake_hash_table (0, NULL);
 
-  DEFVAR_LISP ("redisplay--variables", Vredisplay__variables,
-     doc: /* A hash-table of variables changing which triggers a thorough redisplay.  */);
-  Vredisplay__variables = Qnil;
-
   DEFVAR_BOOL ("redisplay--inhibit-bidi", redisplay__inhibit_bidi,
      doc: /* Non-nil means it is not safe to attempt bidi reordering for display.  */);
   /* Initialize to t, since we need to disable reordering until
-- 
2.9.3


[-- Attachment #6: patch --]
[-- Type: text/plain, Size: 6296 bytes --]

From 10d324a797981a3f89e890ed3806a9f470f3b7bf Mon Sep 17 00:00:00 2001
From: Noam Postavsky <npostavs@gmail.com>
Date: Sat, 12 Dec 2015 23:10:15 -0500
Subject: [PATCH v6 5/6] Add tests for watchpoints

* test/src/data-tests.el (data-tests-variable-watchers):
(data-tests-local-variable-watchers): New tests.
---
 test/src/data-tests.el | 115 +++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 115 insertions(+)

diff --git a/test/src/data-tests.el b/test/src/data-tests.el
index 0a29233..4c2ea54 100644
--- a/test/src/data-tests.el
+++ b/test/src/data-tests.el
@@ -255,3 +255,118 @@ test-bool-vector-binop
          (v2 (test-bool-vector-bv-from-hex-string "0000C"))
          (v3 (bool-vector-not v1)))
     (should (equal v2 v3))))
+
+(ert-deftest data-tests-variable-watchers ()
+  (defvar data-tests-var 0)
+  (let* ((watch-data nil)
+         (collect-watch-data
+          (lambda (&rest args) (push args watch-data))))
+    (cl-flet ((should-have-watch-data (data)
+                                      (should (equal (pop watch-data) data))
+                                      (should (null watch-data))))
+      (add-variable-watcher 'data-tests-var collect-watch-data)
+      (setq data-tests-var 1)
+      (should-have-watch-data '(data-tests-var 1 set nil))
+      (let ((data-tests-var 2))
+        (should-have-watch-data '(data-tests-var 2 let nil))
+        (setq data-tests-var 3)
+        (should-have-watch-data '(data-tests-var 3 set nil)))
+      (should-have-watch-data '(data-tests-var 1 unlet nil))
+      ;; `setq-default' on non-local variable is same as `setq'.
+      (setq-default data-tests-var 4)
+      (should-have-watch-data '(data-tests-var 4 set nil))
+      (makunbound 'data-tests-var)
+      (should-have-watch-data '(data-tests-var nil makunbound nil))
+      (setq data-tests-var 5)
+      (should-have-watch-data '(data-tests-var 5 set nil))
+      (remove-variable-watcher 'data-tests-var collect-watch-data)
+      (setq data-tests-var 6)
+      (should (null watch-data)))))
+
+(ert-deftest data-tests-varalias-watchers ()
+  (defvar data-tests-var0 0)
+  (defvar data-tests-var1 0)
+  (defvar data-tests-var2 0)
+  (defvar data-tests-var3 0)
+  (let* ((watch-data nil)
+         (collect-watch-data
+          (lambda (&rest args) (push args watch-data))))
+    (cl-flet ((should-have-watch-data (data)
+                                      (should (equal (pop watch-data) data))
+                                      (should (null watch-data))))
+      ;; Watch var0, then alias it.
+      (add-variable-watcher 'data-tests-var0 collect-watch-data)
+      (defvaralias 'data-tests-var0-alias 'data-tests-var0)
+      (setq data-tests-var0 1)
+      (should-have-watch-data '(data-tests-var0 1 set nil))
+      (setq data-tests-var0-alias 2)
+      (should-have-watch-data '(data-tests-var0 2 set nil))
+      ;; Alias var1, then watch var1-alias.
+      (defvaralias 'data-tests-var1-alias 'data-tests-var1)
+      (add-variable-watcher 'data-tests-var1-alias collect-watch-data)
+      (setq data-tests-var1 1)
+      (should-have-watch-data '(data-tests-var1 1 set nil))
+      (setq data-tests-var1-alias 2)
+      (should-have-watch-data '(data-tests-var1 2 set nil))
+      ;; Alias var2, then watch it.
+      (defvaralias 'data-tests-var2-alias 'data-tests-var2)
+      (add-variable-watcher 'data-tests-var2 collect-watch-data)
+      (setq data-tests-var2 1)
+      (should-have-watch-data '(data-tests-var2 1 set nil))
+      (setq data-tests-var2-alias 2)
+      (should-have-watch-data '(data-tests-var2 2 set nil))
+      ;; Watch var3-alias, then make it alias var3 (this removes the
+      ;; watcher flag).
+      (defvar data-tests-var3-alias 0)
+      (add-variable-watcher 'data-tests-var3-alias collect-watch-data)
+      (defvaralias 'data-tests-var3-alias 'data-tests-var3)
+      (should-have-watch-data '(data-tests-var3-alias
+                                data-tests-var3 defvaralias nil))
+      (setq data-tests-var3 1)
+      (setq data-tests-var3-alias 2)
+      (should (null watch-data)))))
+
+(ert-deftest data-tests-local-variable-watchers ()
+  (defvar-local data-tests-lvar 0)
+  (let* ((buf1 (current-buffer))
+         (buf2 nil)
+         (watch-data nil)
+         (collect-watch-data
+          (lambda (&rest args) (push args watch-data))))
+    (cl-flet ((should-have-watch-data (data)
+                                      (should (equal (pop watch-data) data))
+                                      (should (null watch-data))))
+      (add-variable-watcher 'data-tests-lvar collect-watch-data)
+      (setq data-tests-lvar 1)
+      (should-have-watch-data `(data-tests-lvar 1 set ,buf1))
+      (let ((data-tests-lvar 2))
+        (should-have-watch-data `(data-tests-lvar 2 let ,buf1))
+        (setq data-tests-lvar 3)
+        (should-have-watch-data `(data-tests-lvar 3 set ,buf1)))
+      (should-have-watch-data `(data-tests-lvar 1 unlet ,buf1))
+      (setq-default data-tests-lvar 4)
+      (should-have-watch-data `(data-tests-lvar 4 set nil))
+      (with-temp-buffer
+        (setq buf2 (current-buffer))
+        (setq data-tests-lvar 1)
+        (should-have-watch-data `(data-tests-lvar 1 set ,buf2))
+        (let ((data-tests-lvar 2))
+          (should-have-watch-data `(data-tests-lvar 2 let ,buf2))
+          (setq data-tests-lvar 3)
+          (should-have-watch-data `(data-tests-lvar 3 set ,buf2)))
+        (should-have-watch-data `(data-tests-lvar 1 unlet ,buf2))
+        (kill-local-variable 'data-tests-lvar)
+        (should-have-watch-data `(data-tests-lvar nil makunbound ,buf2))
+        (setq data-tests-lvar 3.5)
+        (should-have-watch-data `(data-tests-lvar 3.5 set ,buf2))
+        (kill-all-local-variables)
+        (should-have-watch-data `(data-tests-lvar nil makunbound ,buf2)))
+      (setq-default data-tests-lvar 4)
+      (should-have-watch-data `(data-tests-lvar 4 set nil))
+      (makunbound 'data-tests-lvar)
+      (should-have-watch-data '(data-tests-lvar nil makunbound nil))
+      (setq data-tests-lvar 5)
+      (should-have-watch-data `(data-tests-lvar 5 set ,buf1))
+      (remove-variable-watcher 'data-tests-lvar collect-watch-data)
+      (setq data-tests-lvar 6)
+      (should (null watch-data)))))
-- 
2.9.3


[-- Attachment #7: patch --]
[-- Type: text/plain, Size: 7764 bytes --]

From 984109b9b204c82ce2e6482210425a70b7b7e867 Mon Sep 17 00:00:00 2001
From: Noam Postavsky <npostavs@gmail.com>
Date: Sun, 13 Dec 2015 14:47:58 -0500
Subject: [PATCH v6 6/6] Document watchpoints

* doc/lispref/debugging.texi (Variable Debugging):
* doc/lispref/variables.texi (Watching Variables): New section.
* etc/NEWS: Add entry for watchpoints
---
 doc/lispref/debugging.texi | 32 +++++++++++++++++++++++
 doc/lispref/variables.texi | 63 ++++++++++++++++++++++++++++++++++++++++++++++
 etc/NEWS                   |  5 ++++
 src/data.c                 |  9 +++++++
 4 files changed, 109 insertions(+)

diff --git a/doc/lispref/debugging.texi b/doc/lispref/debugging.texi
index 6c0908a..8cae203 100644
--- a/doc/lispref/debugging.texi
+++ b/doc/lispref/debugging.texi
@@ -69,6 +69,7 @@ Debugger
 * Error Debugging::       Entering the debugger when an error happens.
 * Infinite Loops::        Stopping and debugging a program that doesn't exit.
 * Function Debugging::    Entering it when a certain function is called.
+* Variable Debugging::    Entering it when a variable is modified.
 * Explicit Debug::        Entering it at a certain point in the program.
 * Using Debugger::        What the debugger does; what you see while in it.
 * Debugger Commands::     Commands used while in the debugger.
@@ -290,6 +291,37 @@ Function Debugging
 not currently set up to break on entry.
 @end deffn
 
+@node Variable Debugging
+@subsection Entering the debugger when a variable is modified
+@cindex variable write debugging
+@cindex debugging changes to variables
+
+Sometimes a problem with a function is due to a wrong setting of a
+variable.  Setting up the debugger to trigger whenever the variable is
+changed is quick way to find the origin of the setting.
+
+@deffn Command debug-on-variable-change variable
+This function arranges causes the debugger to be called whenever
+@var{variable} is modified.
+
+It is implemented using the watchpoint mechanism, so it inherits the
+same characteristics and limitations: all aliases of @var{variable}
+will be watched together, only dynamic variables can be watched, and
+changes to the objects referenced by variables are not detected.  For
+details, see @xref{Watching Variables}.
+
+@end deffn
+
+@deffn Command cancel-debug-on-variable-change &optional variable
+This function undoes the effect of @code{debug-on-variable-change} on
+@var{variable}.  When called interactively, it prompts for
+@var{variable} in the minibuffer.  If @var{variable} is omitted or
+@code{nil}, it cancels break-on-change for all variables.  Calling
+@code{cancel-debug-on-variable-change} does nothing to a variable
+which is not currently set up to break on change.
+@end deffn
+
+
 @node Explicit Debug
 @subsection Explicit Entry to the Debugger
 @cindex debugger, explicit entry
diff --git a/doc/lispref/variables.texi b/doc/lispref/variables.texi
index 418a416..07f787c 100644
--- a/doc/lispref/variables.texi
+++ b/doc/lispref/variables.texi
@@ -34,6 +34,7 @@ Variables
 * Accessing Variables::         Examining values of variables whose names
                             are known only at run time.
 * Setting Variables::           Storing new values in variables.
+* Watching Variables::          Running a function when a variable is changed.
 * Variable Scoping::            How Lisp chooses among local and global values.
 * Buffer-Local Variables::      Variable values in effect only in one buffer.
 * File Local Variables::        Handling local variable lists in files.
@@ -765,6 +766,68 @@ Setting Variables
 @end example
 @end defun
 
+@node Watching Variables
+@section Running a function when a variable is changed.
+@cindex variable watchpoints
+
+It is sometimes useful to take some action when a variable changes its
+value.  The watchpoint facility provides the means to do so.  Some
+possible uses for this feature include keeping display in sync with
+variable settings, and invoking the debugger to track down unexpected
+changes to variables @pxref{Variable Debugging}.
+
+Each variable has a list of watch functions stored in its
+@code{watchers} symbol property, @xref{Symbol Properties}.  However,
+for efficiency reasons, the list is only consulted if symbol is marked
+as watched.  Therefore, the watch function list should only be
+manipulated by the following functions, which take care of the
+symbol's watched status in addition to the property value.
+
+@defun add-variable-watcher symbol watch-function
+This function arranges for @var{watch-function} to be called whenever
+@var{symbol} (or any of its aliases @pxref{Variable Aliases}) are
+modified.
+
+It will be called with 4 arguments: (@var{symbol} @var{newval}
+@var{operation} @var{where}).
+
+@var{symbol} is the variable being changed.
+@var{newval} is the value it will be changed to.
+@var{operation} is a symbol representing the kind of change, one of:
+`set', `let', `unlet', `makunbound', and `defvaralias'.
+@var{where} is a buffer if the buffer-local value of the variable
+being changed, nil otherwise.
+@end defun
+
+@defun remove-variable-watch symbol watch-function
+This function removes @var{watch-function} from @var{symbol}'s list of
+watchers.
+@end defun
+
+@defun get-variable-watchers symbol
+This function returns the list of active watcher functions.
+@end defun
+
+@subsection Limitations
+
+There are a couple of ways in which a variable could be modifed (or at
+least appear to be modified) without triggering a watchpoint.
+
+Since the watchpoint are attached to symbols, modification to the
+objects contained within variables (e.g., by a list modification
+function @pxref{Modifying Lists}) is not caught by this mechanism.
+
+Additionally, C code can modify the value of variables directly,
+bypassing the watchpoint mechanism.
+
+A minor limitation of this feature, again because it targets symbols,
+is that only variables of dynamic scope may be watched.  This poses
+little difficulty, since modifications to lexical variables can be
+discovered easily by inspecting the code within the scope of the
+variable (unlike dynamic variables which can be modified by any code
+at all, @pxref{Variable Scoping}).
+
+
 @node Variable Scoping
 @section Scoping Rules for Variable Bindings
 @cindex scoping rule
diff --git a/etc/NEWS b/etc/NEWS
index e29dfe2..fcbbb44 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -627,6 +627,11 @@ consistency with the new functions.  For compatibility, 'sxhash'
 remains as an alias to 'sxhash-equal'.
 
 +++
+** New function `add-variable-watcher' can be used to call a function
+when a symbol's value is changed.  This is used to implement the new
+debugger command `debug-on-variable-change'.
+
++++
 ** Time conversion functions that accept a time zone rule argument now
 allow it to be OFFSET or a list (OFFSET ABBR), where the integer
 OFFSET is a count of seconds east of Universal Time, and the string
diff --git a/src/data.c b/src/data.c
index ff35315..ef6b48b 100644
--- a/src/data.c
+++ b/src/data.c
@@ -1428,6 +1428,15 @@ harmonize_variable_watchers (Lisp_Object alias, Lisp_Object base_variable)
 DEFUN ("add-variable-watcher", Fadd_variable_watcher, Sadd_variable_watcher,
        2, 2, 0,
        doc: /* Cause WATCH-FUNCTION to be called when SYMBOL is set.
+
+It will be called with 4 arguments: (SYMBOL NEWVAL OPERATION WHERE).
+SYMBOL is the variable being changed.
+NEWVAL is the value it will be changed to.
+OPERATION is a symbol representing the kind of change, one of: `set',
+`let', `unlet', `makunbound', and `defvaralias'.
+WHERE is a buffer if the buffer-local value of the variable being
+changed, nil otherwise.
+
 All writes to aliases of SYMBOL will call WATCH-FUNCTION too.  */)
   (Lisp_Object symbol, Lisp_Object watch_function)
 {
-- 
2.9.3