* bug#24923: 25.1; Lisp watchpoints
@ 2016-11-11 3:10 npostavs
2016-11-11 10:02 ` Eli Zaretskii
0 siblings, 1 reply; 22+ messages in thread
From: npostavs @ 2016-11-11 3:10 UTC (permalink / raw)
To: 24923
[-- Attachment #1: Type: text/plain, Size: 611 bytes --]
severity: wishlist
tags: patch
Continuing from
https://lists.nongnu.org/archive/html/emacs-devel/2015-11/msg01437.html,
main code difference since then is that I use a subr instead of indexing
into a table of C functions (the reason for using an index was to avoid
GC on Ffuncall; instead I did that by checking if the function is SUBRP
and doing funcall_subr on it (a new function extracted from Ffuncall)).
I've also added tests, which turned up some interesting corner cases
regarding aliases, and also that I had completely missed
kill-local-variables.
I still need to write something up in the manual.
[-- Attachment #2: v4-0001-Add-lisp-watchpoints.patch --]
[-- Type: text/plain, Size: 35172 bytes --]
From 0507854b885681c2e57bb1c6cb97f898417bd99c Mon Sep 17 00:00:00 2001
From: Noam Postavsky <npostavs@gmail.com>
Date: Thu, 19 Nov 2015 19:50:06 -0500
Subject: [PATCH v4 1/5] Add lisp watchpoints
This allows to call a function whenever a symbol-value is changed.
* src/lisp.h (lisp_h_SYMBOL_TRAPPED_WRITE_P): Rename from
lisp_h_SYMBOL_CONSTANT_P.
(SYMBOL_TRAPPED_WRITE_P): Rename from SYMBOL_CONSTANT_P.
(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, reset_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 | 82 +++++++++++++----------
src/bytecode.c | 4 +-
src/data.c | 192 +++++++++++++++++++++++++++++++++++++++++++++++-------
src/eval.c | 202 ++++++++++++++++++++++++++++++---------------------------
src/font.c | 6 +-
src/lisp.h | 47 ++++++++++----
src/lread.c | 6 +-
8 files changed, 365 insertions(+), 176 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,40 +984,54 @@ 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)))
- {
- /* If permanent-local, keep it. */
- last = tmp;
- if (EQ (prop, Qpermanent_local_hook))
- {
- /* This is a partially permanent hook variable.
- Preserve only the elements that want to be preserved. */
- Lisp_Object list, newlist;
- list = XCDR (XCAR (tmp));
- if (!CONSP (list))
- newlist = list;
- else
- 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. */
- if (! SYMBOLP (elt)
- || EQ (elt, Qt)
- || !NILP (Fget (elt, Qpermanent_local_hook)))
- newlist = Fcons (elt, newlist);
- }
- XSETCDR (XCAR (tmp), Fnreverse (newlist));
- }
- }
- /* Delete this local variable. */
- else if (NILP (last))
- bset_local_var_alist (b, XCDR (tmp));
- else
- XSETCDR (last, XCDR (tmp));
+ {
+ 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;
+ if (EQ (prop, Qpermanent_local_hook))
+ {
+ /* This is a partially permanent hook variable.
+ Preserve only the elements that want to be preserved. */
+ Lisp_Object list, newlist;
+ list = XCDR (XCAR (tmp));
+ if (!CONSP (list))
+ newlist = list;
+ else
+ 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. */
+ if (! SYMBOLP (elt)
+ || EQ (elt, Qt)
+ || !NILP (Fget (elt, Qpermanent_local_hook)))
+ newlist = Fcons (elt, 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. */
+ else if (NILP (last))
+ 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..edfc9c5 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..44a08e6 100644
--- a/src/data.c
+++ b/src/data.c
@@ -649,9 +649,10 @@ DEFUN ("makunbound", Fmakunbound, Smakunbound, 1, 1, 0,
(register Lisp_Object symbol)
{
CHECK_SYMBOL (symbol);
- if (SYMBOL_CONSTANT_P (symbol))
+ if (XSYMBOL (symbol)->trapped_write == SYMBOL_NOWRITE)
xsignal1 (Qsetting_constant, symbol);
- Fset (symbol, Qunbound);
+ else
+ Fset (symbol, Qunbound);
return symbol;
}
@@ -1225,7 +1226,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 +1234,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 +1252,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);
+ || !EQ (newval, Fsymbol_value (symbol)))
+ xsignal1 (Qsetting_constant, symbol);
else
- /* Allow setting keywords to their own value. */
- return;
+ /* 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)
@@ -1385,6 +1400,107 @@ 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
+reset_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. */)
+ (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'. */)
+ (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);
+ /* Avoid recursion. */
+ set_symbol_trapped_write (symbol, SYMBOL_UNTRAPPED_WRITE);
+ ptrdiff_t count = SPECPDL_INDEX ();
+ record_unwind_protect (reset_symbol_trapped_write, symbol);
+
+ 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. */
@@ -1471,16 +1587,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)))
- xsignal1 (Qsetting_constant, symbol);
+ || !EQ (value, Fsymbol_value (symbol)))
+ xsignal1 (Qsetting_constant, symbol);
else
- /* Allow setting keywords to their own value. */
- return value;
+ /* 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 +1778,7 @@ DEFUN ("make-variable-buffer-local", Fmake_variable_buffer_local,
default: emacs_abort ();
}
- if (sym->constant)
+ if (sym->trapped_write == SYMBOL_NOWRITE)
error ("Symbol %s may not be buffer-local", SDATA (SYMBOL_NAME (variable)));
if (!blv)
@@ -1726,7 +1853,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 +1965,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 +2050,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 +3601,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 +3681,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 +3863,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..7c66a46 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -595,8 +595,8 @@ DEFUN ("defvaralias", Fdefvaralias, Sdefvaralias, 2, 3, 0,
sym = XSYMBOL (new_alias);
- if (sym->constant)
- /* Not sure why, but why not? */
+ if (sym->trapped_write == SYMBOL_NOWRITE)
+ /* Making it an alias effectively changes its value. */
error ("Cannot make a constant an alias");
switch (sym->redirect)
@@ -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,86 +2680,7 @@ DEFUN ("funcall", Ffuncall, Sfuncall, 1, MANY, 0,
fun = indirect_function (fun);
if (SUBRP (fun))
- {
- if (numargs < XSUBR (fun)->min_args
- || (XSUBR (fun)->max_args >= 0 && XSUBR (fun)->max_args < numargs))
- {
- XSETFASTINT (lisp_numargs, numargs);
- xsignal2 (Qwrong_number_of_arguments, original_fun, lisp_numargs);
- }
-
- else if (XSUBR (fun)->max_args == UNEVALLED)
- xsignal1 (Qinvalid_function, original_fun);
-
- else if (XSUBR (fun)->max_args == MANY)
- val = (XSUBR (fun)->function.aMANY) (numargs, args + 1);
- else
- {
- Lisp_Object internal_argbuf[8];
- if (XSUBR (fun)->max_args > numargs)
- {
- eassert (XSUBR (fun)->max_args <= ARRAYELTS (internal_argbuf));
- internal_args = internal_argbuf;
- memcpy (internal_args, args + 1, numargs * word_size);
- memclear (internal_args + numargs,
- (XSUBR (fun)->max_args - numargs) * word_size);
- }
- else
- internal_args = args + 1;
- switch (XSUBR (fun)->max_args)
- {
- case 0:
- val = (XSUBR (fun)->function.a0 ());
- break;
- case 1:
- val = (XSUBR (fun)->function.a1 (internal_args[0]));
- break;
- case 2:
- val = (XSUBR (fun)->function.a2
- (internal_args[0], internal_args[1]));
- break;
- case 3:
- val = (XSUBR (fun)->function.a3
- (internal_args[0], internal_args[1], internal_args[2]));
- break;
- case 4:
- val = (XSUBR (fun)->function.a4
- (internal_args[0], internal_args[1], internal_args[2],
- internal_args[3]));
- break;
- case 5:
- val = (XSUBR (fun)->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
- (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
- (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
- (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:
-
- /* If a subr takes more than 8 arguments without using MANY
- or UNEVALLED, we need to extend this function to support it.
- Until this is done, there is no way to call the function. */
- emacs_abort ();
- }
- }
- }
+ val = funcall_subr (XSUBR (fun), numargs, args + 1);
else if (COMPILEDP (fun))
val = funcall_lambda (fun, numargs, args + 1);
else
@@ -2790,6 +2712,89 @@ DEFUN ("funcall", Ffuncall, Sfuncall, 1, MANY, 0,
return val;
}
\f
+
+/* 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];
+ Lisp_Object *internal_args;
+ if (subr->max_args > numargs)
+ {
+ eassert (subr->max_args <= ARRAYELTS (internal_argbuf));
+ internal_args = internal_argbuf;
+ memcpy (internal_args, args, numargs * word_size);
+ memclear (internal_args + numargs,
+ (subr->max_args - numargs) * word_size);
+ }
+ else
+ internal_args = args;
+ switch (subr->max_args)
+ {
+ case 0:
+ return (subr->function.a0 ());
+ case 1:
+ return (subr->function.a1 (internal_args[0]));
+ case 2:
+ return (subr->function.a2
+ (internal_args[0], internal_args[1]));
+ case 3:
+ return (subr->function.a3
+ (internal_args[0], internal_args[1], internal_args[2]));
+ case 4:
+ return (subr->function.a4
+ (internal_args[0], internal_args[1], internal_args[2],
+ internal_args[3]));
+ case 5:
+ return (subr->function.a5
+ (internal_args[0], internal_args[1], internal_args[2],
+ internal_args[3], internal_args[4]));
+ case 6:
+ return (subr->function.a6
+ (internal_args[0], internal_args[1], internal_args[2],
+ internal_args[3], internal_args[4], internal_args[5]));
+ case 7:
+ 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]));
+ case 8:
+ 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]));
+
+ default:
+
+ /* If a subr takes more than 8 arguments without using MANY
+ or UNEVALLED, we need to extend this function to support it.
+ Until this is done, there is no way to call the function. */
+ emacs_abort ();
+ }
+ }
+}
+
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..c1483fa 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -320,7 +320,7 @@ 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_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)
@@ -374,7 +374,7 @@ DEFINE_GDB_SYMBOL_END (USE_LSB_TAG)
# define MISCP(x) lisp_h_MISCP (x)
# 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 +602,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 +635,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 +653,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,14 +1860,14 @@ 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_CONSTANT_P) (Lisp_Object sym)
+(SYMBOL_TRAPPED_WRITE_P) (Lisp_Object sym)
{
- return lisp_h_SYMBOL_CONSTANT_P (sym);
+ return lisp_h_SYMBOL_TRAPPED_WRITE_P (sym);
}
/* Placeholder for make-docfile to process. The actual symbol
@@ -3289,6 +3299,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 +3413,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 +3902,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: v4-0001-Add-lisp-watchpoints.patch --]
[-- Type: text/plain, Size: 35172 bytes --]
From 0507854b885681c2e57bb1c6cb97f898417bd99c Mon Sep 17 00:00:00 2001
From: Noam Postavsky <npostavs@gmail.com>
Date: Thu, 19 Nov 2015 19:50:06 -0500
Subject: [PATCH v4 1/5] Add lisp watchpoints
This allows to call a function whenever a symbol-value is changed.
* src/lisp.h (lisp_h_SYMBOL_TRAPPED_WRITE_P): Rename from
lisp_h_SYMBOL_CONSTANT_P.
(SYMBOL_TRAPPED_WRITE_P): Rename from SYMBOL_CONSTANT_P.
(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, reset_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 | 82 +++++++++++++----------
src/bytecode.c | 4 +-
src/data.c | 192 +++++++++++++++++++++++++++++++++++++++++++++++-------
src/eval.c | 202 ++++++++++++++++++++++++++++++---------------------------
src/font.c | 6 +-
src/lisp.h | 47 ++++++++++----
src/lread.c | 6 +-
8 files changed, 365 insertions(+), 176 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,40 +984,54 @@ 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)))
- {
- /* If permanent-local, keep it. */
- last = tmp;
- if (EQ (prop, Qpermanent_local_hook))
- {
- /* This is a partially permanent hook variable.
- Preserve only the elements that want to be preserved. */
- Lisp_Object list, newlist;
- list = XCDR (XCAR (tmp));
- if (!CONSP (list))
- newlist = list;
- else
- 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. */
- if (! SYMBOLP (elt)
- || EQ (elt, Qt)
- || !NILP (Fget (elt, Qpermanent_local_hook)))
- newlist = Fcons (elt, newlist);
- }
- XSETCDR (XCAR (tmp), Fnreverse (newlist));
- }
- }
- /* Delete this local variable. */
- else if (NILP (last))
- bset_local_var_alist (b, XCDR (tmp));
- else
- XSETCDR (last, XCDR (tmp));
+ {
+ 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;
+ if (EQ (prop, Qpermanent_local_hook))
+ {
+ /* This is a partially permanent hook variable.
+ Preserve only the elements that want to be preserved. */
+ Lisp_Object list, newlist;
+ list = XCDR (XCAR (tmp));
+ if (!CONSP (list))
+ newlist = list;
+ else
+ 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. */
+ if (! SYMBOLP (elt)
+ || EQ (elt, Qt)
+ || !NILP (Fget (elt, Qpermanent_local_hook)))
+ newlist = Fcons (elt, 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. */
+ else if (NILP (last))
+ 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..edfc9c5 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..44a08e6 100644
--- a/src/data.c
+++ b/src/data.c
@@ -649,9 +649,10 @@ DEFUN ("makunbound", Fmakunbound, Smakunbound, 1, 1, 0,
(register Lisp_Object symbol)
{
CHECK_SYMBOL (symbol);
- if (SYMBOL_CONSTANT_P (symbol))
+ if (XSYMBOL (symbol)->trapped_write == SYMBOL_NOWRITE)
xsignal1 (Qsetting_constant, symbol);
- Fset (symbol, Qunbound);
+ else
+ Fset (symbol, Qunbound);
return symbol;
}
@@ -1225,7 +1226,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 +1234,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 +1252,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);
+ || !EQ (newval, Fsymbol_value (symbol)))
+ xsignal1 (Qsetting_constant, symbol);
else
- /* Allow setting keywords to their own value. */
- return;
+ /* 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)
@@ -1385,6 +1400,107 @@ 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
+reset_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. */)
+ (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'. */)
+ (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);
+ /* Avoid recursion. */
+ set_symbol_trapped_write (symbol, SYMBOL_UNTRAPPED_WRITE);
+ ptrdiff_t count = SPECPDL_INDEX ();
+ record_unwind_protect (reset_symbol_trapped_write, symbol);
+
+ 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. */
@@ -1471,16 +1587,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)))
- xsignal1 (Qsetting_constant, symbol);
+ || !EQ (value, Fsymbol_value (symbol)))
+ xsignal1 (Qsetting_constant, symbol);
else
- /* Allow setting keywords to their own value. */
- return value;
+ /* 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 +1778,7 @@ DEFUN ("make-variable-buffer-local", Fmake_variable_buffer_local,
default: emacs_abort ();
}
- if (sym->constant)
+ if (sym->trapped_write == SYMBOL_NOWRITE)
error ("Symbol %s may not be buffer-local", SDATA (SYMBOL_NAME (variable)));
if (!blv)
@@ -1726,7 +1853,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 +1965,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 +2050,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 +3601,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 +3681,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 +3863,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..7c66a46 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -595,8 +595,8 @@ DEFUN ("defvaralias", Fdefvaralias, Sdefvaralias, 2, 3, 0,
sym = XSYMBOL (new_alias);
- if (sym->constant)
- /* Not sure why, but why not? */
+ if (sym->trapped_write == SYMBOL_NOWRITE)
+ /* Making it an alias effectively changes its value. */
error ("Cannot make a constant an alias");
switch (sym->redirect)
@@ -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,86 +2680,7 @@ DEFUN ("funcall", Ffuncall, Sfuncall, 1, MANY, 0,
fun = indirect_function (fun);
if (SUBRP (fun))
- {
- if (numargs < XSUBR (fun)->min_args
- || (XSUBR (fun)->max_args >= 0 && XSUBR (fun)->max_args < numargs))
- {
- XSETFASTINT (lisp_numargs, numargs);
- xsignal2 (Qwrong_number_of_arguments, original_fun, lisp_numargs);
- }
-
- else if (XSUBR (fun)->max_args == UNEVALLED)
- xsignal1 (Qinvalid_function, original_fun);
-
- else if (XSUBR (fun)->max_args == MANY)
- val = (XSUBR (fun)->function.aMANY) (numargs, args + 1);
- else
- {
- Lisp_Object internal_argbuf[8];
- if (XSUBR (fun)->max_args > numargs)
- {
- eassert (XSUBR (fun)->max_args <= ARRAYELTS (internal_argbuf));
- internal_args = internal_argbuf;
- memcpy (internal_args, args + 1, numargs * word_size);
- memclear (internal_args + numargs,
- (XSUBR (fun)->max_args - numargs) * word_size);
- }
- else
- internal_args = args + 1;
- switch (XSUBR (fun)->max_args)
- {
- case 0:
- val = (XSUBR (fun)->function.a0 ());
- break;
- case 1:
- val = (XSUBR (fun)->function.a1 (internal_args[0]));
- break;
- case 2:
- val = (XSUBR (fun)->function.a2
- (internal_args[0], internal_args[1]));
- break;
- case 3:
- val = (XSUBR (fun)->function.a3
- (internal_args[0], internal_args[1], internal_args[2]));
- break;
- case 4:
- val = (XSUBR (fun)->function.a4
- (internal_args[0], internal_args[1], internal_args[2],
- internal_args[3]));
- break;
- case 5:
- val = (XSUBR (fun)->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
- (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
- (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
- (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:
-
- /* If a subr takes more than 8 arguments without using MANY
- or UNEVALLED, we need to extend this function to support it.
- Until this is done, there is no way to call the function. */
- emacs_abort ();
- }
- }
- }
+ val = funcall_subr (XSUBR (fun), numargs, args + 1);
else if (COMPILEDP (fun))
val = funcall_lambda (fun, numargs, args + 1);
else
@@ -2790,6 +2712,89 @@ DEFUN ("funcall", Ffuncall, Sfuncall, 1, MANY, 0,
return val;
}
\f
+
+/* 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];
+ Lisp_Object *internal_args;
+ if (subr->max_args > numargs)
+ {
+ eassert (subr->max_args <= ARRAYELTS (internal_argbuf));
+ internal_args = internal_argbuf;
+ memcpy (internal_args, args, numargs * word_size);
+ memclear (internal_args + numargs,
+ (subr->max_args - numargs) * word_size);
+ }
+ else
+ internal_args = args;
+ switch (subr->max_args)
+ {
+ case 0:
+ return (subr->function.a0 ());
+ case 1:
+ return (subr->function.a1 (internal_args[0]));
+ case 2:
+ return (subr->function.a2
+ (internal_args[0], internal_args[1]));
+ case 3:
+ return (subr->function.a3
+ (internal_args[0], internal_args[1], internal_args[2]));
+ case 4:
+ return (subr->function.a4
+ (internal_args[0], internal_args[1], internal_args[2],
+ internal_args[3]));
+ case 5:
+ return (subr->function.a5
+ (internal_args[0], internal_args[1], internal_args[2],
+ internal_args[3], internal_args[4]));
+ case 6:
+ return (subr->function.a6
+ (internal_args[0], internal_args[1], internal_args[2],
+ internal_args[3], internal_args[4], internal_args[5]));
+ case 7:
+ 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]));
+ case 8:
+ 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]));
+
+ default:
+
+ /* If a subr takes more than 8 arguments without using MANY
+ or UNEVALLED, we need to extend this function to support it.
+ Until this is done, there is no way to call the function. */
+ emacs_abort ();
+ }
+ }
+}
+
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..c1483fa 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -320,7 +320,7 @@ 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_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)
@@ -374,7 +374,7 @@ DEFINE_GDB_SYMBOL_END (USE_LSB_TAG)
# define MISCP(x) lisp_h_MISCP (x)
# 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 +602,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 +635,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 +653,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,14 +1860,14 @@ 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_CONSTANT_P) (Lisp_Object sym)
+(SYMBOL_TRAPPED_WRITE_P) (Lisp_Object sym)
{
- return lisp_h_SYMBOL_CONSTANT_P (sym);
+ return lisp_h_SYMBOL_TRAPPED_WRITE_P (sym);
}
/* Placeholder for make-docfile to process. The actual symbol
@@ -3289,6 +3299,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 +3413,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 +3902,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 #4: v4-0002-Add-function-to-trigger-debugger-on-variable-writ.patch --]
[-- Type: text/plain, Size: 3548 bytes --]
From 08b87d9912c190dca57fb6c07dc97d294c6984dc Mon Sep 17 00:00:00 2001
From: Noam Postavsky <npostavs@gmail.com>
Date: Sat, 21 Nov 2015 16:03:06 -0500
Subject: [PATCH v4 2/5] Add function to trigger debugger on variable write
* lisp/emacs-lisp/debug.el (debug-watchpoint):
(debug--variable-list):
(cancel-debug-watchpoint): New functions.
(debugger-setup-buffer): Add watchpoint clause.
---
lisp/emacs-lisp/debug.el | 62 ++++++++++++++++++++++++++++++++++++++++++++++++
1 file changed, 62 insertions(+)
diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el
index 7d27380..48b3543 100644
--- a/lisp/emacs-lisp/debug.el
+++ b/lisp/emacs-lisp/debug.el
@@ -306,6 +306,21 @@ debugger-setup-buffer
(delete-char 1)
(insert ? )
(beginning-of-line))
+ ;; Watchpoint triggered.
+ ((and `watchpoint (let `(,symbol ,newval . ,details) (cdr args)))
+ (insert
+ "--"
+ (pcase details
+ (`(makunbound ,_) (format "Making %s void" symbol))
+ (`(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 %s to %S"
+ symbol buffer newval))
+ (_ (format "watchpoint triggered %S" (cdr args))))
+ ": ")
+ (setq pos (point))
+ (insert ?\n))
;; Debugger entered for an error.
(`error
(insert "--Lisp error: ")
@@ -850,6 +865,53 @@ 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-watch (variable)
+ (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))
+
+
+(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-watch (&optional variable)
+ (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))))
+
(provide 'debug)
;;; debug.el ends here
--
2.9.3
[-- Attachment #5: v4-0003-Ensure-redisplay-using-variable-watcher.patch --]
[-- Type: text/plain, Size: 4035 bytes --]
From 908d6b2bd1597ce69e99db404202c51e2292a40a Mon Sep 17 00:00:00 2001
From: Noam Postavsky <npostavs@gmail.com>
Date: Sat, 21 Nov 2015 17:02:42 -0500
Subject: [PATCH v4 3/5] 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 | 23 ++++++++++-------------
4 files changed, 11 insertions(+), 18 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 44a08e6..27aac09 100644
--- a/src/data.c
+++ b/src/data.c
@@ -1276,8 +1276,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)
- {
- bset_update_mode_line (current_buffer);
- current_buffer->prevent_redisplay_optimizations_p = true;
- }
+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: v4-0004-Add-tests-for-watchpoints.patch --]
[-- Type: text/plain, Size: 6296 bytes --]
From bf239f14dbff006ba7a86d2c657cdf94122ba5d0 Mon Sep 17 00:00:00 2001
From: Noam Postavsky <npostavs@gmail.com>
Date: Sat, 12 Dec 2015 23:10:15 -0500
Subject: [PATCH v4 4/5] 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: v4-0005-etc-NEWS-Add-entry-for-watchpoints.patch --]
[-- Type: text/plain, Size: 881 bytes --]
From bc3dd88273a987c4b9d54b1b6161a3eb399a93eb Mon Sep 17 00:00:00 2001
From: Noam Postavsky <npostavs@gmail.com>
Date: Sun, 13 Dec 2015 14:47:58 -0500
Subject: [PATCH v4 5/5] * etc/NEWS: Add entry for watchpoints
---
etc/NEWS | 4 ++++
1 file changed, 4 insertions(+)
diff --git a/etc/NEWS b/etc/NEWS
index e29dfe2..7c5a592 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -626,6 +626,10 @@ two objects are 'eq' ('eql'), then the result of 'sxhash-eq'
consistency with the new functions. For compatibility, 'sxhash'
remains as an alias to 'sxhash-equal'.
+** New function `add-variable-watcher' can be used to execute code
+when a symbol's value is changed. This is used to implement the new
+debugger command `debug-watch'.
+
+++
** Time conversion functions that accept a time zone rule argument now
allow it to be OFFSET or a list (OFFSET ABBR), where the integer
--
2.9.3
^ permalink raw reply related [flat|nested] 22+ messages in thread* bug#24923: 25.1; Lisp watchpoints
2016-11-11 3:10 bug#24923: 25.1; Lisp watchpoints npostavs
@ 2016-11-11 10:02 ` Eli Zaretskii
2016-11-12 4:34 ` npostavs
0 siblings, 1 reply; 22+ messages in thread
From: Eli Zaretskii @ 2016-11-11 10:02 UTC (permalink / raw)
To: npostavs; +Cc: 24923
> From: npostavs@users.sourceforge.net
> Date: Thu, 10 Nov 2016 22:10:38 -0500
>
> Continuing from
> https://lists.nongnu.org/archive/html/emacs-devel/2015-11/msg01437.html,
> main code difference since then is that I use a subr instead of indexing
> into a table of C functions (the reason for using an index was to avoid
> GC on Ffuncall; instead I did that by checking if the function is SUBRP
> and doing funcall_subr on it (a new function extracted from Ffuncall)).
Thanks. A few comments below.
One general comment is that these patches are harder to review due to
whitespace changes TAB->spaces. How about using some non-default
options to "git diff" when generating the patch?
> >From 0507854b885681c2e57bb1c6cb97f898417bd99c Mon Sep 17 00:00:00 2001
This changeset was attached twice, for some reason.
> --- a/src/data.c
> +++ b/src/data.c
> @@ -649,9 +649,10 @@ DEFUN ("makunbound", Fmakunbound, Smakunbound, 1, 1, 0,
> (register Lisp_Object symbol)
> {
> CHECK_SYMBOL (symbol);
> - if (SYMBOL_CONSTANT_P (symbol))
> + if (XSYMBOL (symbol)->trapped_write == SYMBOL_NOWRITE)
> xsignal1 (Qsetting_constant, symbol);
> - Fset (symbol, Qunbound);
> + else
> + Fset (symbol, Qunbound);
> return symbol;
Why was this needed? Doesn't xsignal1 never return anymore?
> +static void
> +reset_symbol_trapped_write (Lisp_Object symbol)
> +{
> + set_symbol_trapped_write (symbol, SYMBOL_TRAPPED_WRITE);
> +}
Suggest to find a better name for this function, like
restore_symbol_trapped_write, for example. Calling an action that
sets an attribute "reset" makes it harder to read the code.
> +DEFUN ("add-variable-watcher", Fadd_variable_watcher, Sadd_variable_watcher,
> + 2, 2, 0,
> + doc: /* Cause WATCH-FUNCTION to be called when SYMBOL is set. */)
I think the doc string needs to mention that the function also affects
all of SYMBOL's aliases.
> +DEFUN ("remove-variable-watcher", Fremove_variable_watcher, Sremove_variable_watcher,
> + 2, 2, 0,
> + doc: /* Undo the effect of `add-variable-watcher'. */)
The doc string should mention SYMBOL. Also, preferably have the doc
string be self-contained, since that's easy in this case.
> + (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;
Would it be more useful for this and add-variable-watcher to return
the list of watchers instead?
> + /* Avoid recursion. */
> + set_symbol_trapped_write (symbol, SYMBOL_UNTRAPPED_WRITE);
> + ptrdiff_t count = SPECPDL_INDEX ();
> + record_unwind_protect (reset_symbol_trapped_write, symbol);
I think record_unwind_protect should be called before setting the
attribute, for this code to be safer and more future-proof.
> +/* 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_CONSTANT_P) (Lisp_Object sym)
> +(SYMBOL_TRAPPED_WRITE_P) (Lisp_Object sym)
> {
> - return lisp_h_SYMBOL_CONSTANT_P (sym);
> + return lisp_h_SYMBOL_TRAPPED_WRITE_P (sym);
> }
>
> /* Placeholder for make-docfile to process. The actual symbol
> @@ -3289,6 +3299,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;
> +}
> +
So we will have make_symbol_constant, but no SYMBOL_CONSTANT_P? Isn't
that confusing? Some C code may wish to know whether a symbol is
constant, not just either constant or trap-on-write; why not give them
what they want?
> + ;; Watchpoint triggered.
> + ((and `watchpoint (let `(,symbol ,newval . ,details) (cdr args)))
> + (insert
> + "--"
> + (pcase details
> + (`(makunbound ,_) (format "Making %s void" symbol))
> + (`(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 %s to %S"
^^^^^^^^^^^^^^^^^^^^^^^^
IMO, this should include the word "buffer", otherwise it can be
confusing.
> + (_ (format "watchpoint triggered %S" (cdr args))))
Can you give a couple of examples of this, with %S shown explicitly?
I'm not sure whether the result will be self-explanatory.
> +;;;###autoload
> +(defun debug-watch (variable)
> + (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) ": "))
I think all the other commands/variables similar to this one are named
debug-on-SOMETHING, so perhaps this one should also have such a name.
Like debug-on-setting-variable, perhaps?
> +** New function `add-variable-watcher' can be used to execute code
^^^^^^^^^^^^^^^
It is better to say "to call a function" here.
Thanks again for working on this.
^ permalink raw reply [flat|nested] 22+ messages in thread* bug#24923: 25.1; Lisp watchpoints
2016-11-11 10:02 ` Eli Zaretskii
@ 2016-11-12 4:34 ` npostavs
2016-11-12 7:19 ` Eli Zaretskii
0 siblings, 1 reply; 22+ messages in thread
From: npostavs @ 2016-11-12 4:34 UTC (permalink / raw)
To: Eli Zaretskii; +Cc: 24923
Eli Zaretskii <eliz@gnu.org> writes:
> One general comment is that these patches are harder to review due to
> whitespace changes TAB->spaces. How about using some non-default
> options to "git diff" when generating the patch?
Will do for the next one.
>
>> >From 0507854b885681c2e57bb1c6cb97f898417bd99c Mon Sep 17 00:00:00 2001
>
> This changeset was attached twice, for some reason.
Oops, I was trying to insert all the attachments at once in gnus via
some text manipulation and I forgot to delete the first one I copied
from.
>
>> --- a/src/data.c
>> +++ b/src/data.c
>> @@ -649,9 +649,10 @@ DEFUN ("makunbound", Fmakunbound, Smakunbound, 1, 1, 0,
>> (register Lisp_Object symbol)
>> {
>> CHECK_SYMBOL (symbol);
>> - if (SYMBOL_CONSTANT_P (symbol))
>> + if (XSYMBOL (symbol)->trapped_write == SYMBOL_NOWRITE)
>> xsignal1 (Qsetting_constant, symbol);
>> - Fset (symbol, Qunbound);
>> + else
>> + Fset (symbol, Qunbound);
>> return symbol;
>
> Why was this needed? Doesn't xsignal1 never return anymore?
Hmm, I'm not sure why I did this. I think this whole hunk can be
dropped (as long as SYMBOL_CONSTANT_P is preserved as suggested below).
>
>> + (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;
>
> Would it be more useful for this and add-variable-watcher to return
> the list of watchers instead?
I don't think it would be especially useful, but it's easy to do so.
>
>> +/* 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_CONSTANT_P) (Lisp_Object sym)
>> +(SYMBOL_TRAPPED_WRITE_P) (Lisp_Object sym)
>> {
>> - return lisp_h_SYMBOL_CONSTANT_P (sym);
>> + return lisp_h_SYMBOL_TRAPPED_WRITE_P (sym);
>> }
>>
>> /* Placeholder for make-docfile to process. The actual symbol
>> @@ -3289,6 +3299,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;
>> +}
>> +
>
> So we will have make_symbol_constant, but no SYMBOL_CONSTANT_P? Isn't
> that confusing? Some C code may wish to know whether a symbol is
> constant, not just either constant or trap-on-write; why not give them
> what they want?
I suppose I took Stefan's advice to replace SYMBOL_CONSTANT_P with
SYMBOL_TRAPPED_WRITE_P too literally. Although it's almost always the
case that C code checking if a symbol is constant wants to write to the
symbol, in which case it should be doing a 3-way switch (writable,
trapped write, or constant). But there is one exception in Fmakunbound
(mentioned above), so I guess we may as well keep it.
>
>> + (_ (format "watchpoint triggered %S" (cdr args))))
>
> Can you give a couple of examples of this, with %S shown explicitly?
> I'm not sure whether the result will be self-explanatory.
You mean examples of this this clause being used? It was meant more as
a catchall in case some watch types were missed by the previous clauses.
It shouldn't really ever happen unless the debugger and watchpoint code
get out of sync. Do you think it would be better to just signal an
error? (although would signalling an error while the debugger is
invoked cause trouble?)
>
>> +;;;###autoload
>> +(defun debug-watch (variable)
>> + (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) ": "))
>
> I think all the other commands/variables similar to this one are named
> debug-on-SOMETHING, so perhaps this one should also have such a name.
> Like debug-on-setting-variable, perhaps?
Hah, I initially called this debug-on-set
(https://lists.nongnu.org/archive/html/emacs-devel/2015-11/txtyjJDztIULG.txt),
and then you suggested debug-watch instead
(https://lists.nongnu.org/archive/html/emacs-devel/2015-11/msg02017.html).
An alias probably makes sense, how about debug-on-variable-change?
(since it catches some changes other than `set'.)
^ permalink raw reply [flat|nested] 22+ messages in thread* bug#24923: 25.1; Lisp watchpoints
2016-11-12 4:34 ` npostavs
@ 2016-11-12 7:19 ` Eli Zaretskii
2016-11-13 0:54 ` npostavs
0 siblings, 1 reply; 22+ messages in thread
From: Eli Zaretskii @ 2016-11-12 7:19 UTC (permalink / raw)
To: npostavs; +Cc: 24923
> From: npostavs@users.sourceforge.net
> Cc: 24923@debbugs.gnu.org
> Date: Fri, 11 Nov 2016 23:34:33 -0500
>
> >> + (_ (format "watchpoint triggered %S" (cdr args))))
> >
> > Can you give a couple of examples of this, with %S shown explicitly?
> > I'm not sure whether the result will be self-explanatory.
>
> You mean examples of this this clause being used? It was meant more as
> a catchall in case some watch types were missed by the previous clauses.
> It shouldn't really ever happen unless the debugger and watchpoint code
> get out of sync. Do you think it would be better to just signal an
> error? (although would signalling an error while the debugger is
> invoked cause trouble?)
Either signal an error, or include something like "(please submit a
bug report)" in the text.
> >> +;;;###autoload
> >> +(defun debug-watch (variable)
> >> + (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) ": "))
> >
> > I think all the other commands/variables similar to this one are named
> > debug-on-SOMETHING, so perhaps this one should also have such a name.
> > Like debug-on-setting-variable, perhaps?
>
> Hah, I initially called this debug-on-set
> (https://lists.nongnu.org/archive/html/emacs-devel/2015-11/txtyjJDztIULG.txt),
> and then you suggested debug-watch instead
> (https://lists.nongnu.org/archive/html/emacs-devel/2015-11/msg02017.html).
>
> An alias probably makes sense, how about debug-on-variable-change?
> (since it catches some changes other than `set'.)
Fine with me, thanks.
^ permalink raw reply [flat|nested] 22+ messages in thread
* bug#24923: 25.1; Lisp watchpoints
2016-11-12 7:19 ` Eli Zaretskii
@ 2016-11-13 0:54 ` npostavs
2016-11-13 15:29 ` Eli Zaretskii
0 siblings, 1 reply; 22+ messages in thread
From: npostavs @ 2016-11-13 0:54 UTC (permalink / raw)
To: Eli Zaretskii; +Cc: 24923
[-- Attachment #1: Type: text/plain, Size: 995 bytes --]
Eli Zaretskii <eliz@gnu.org> writes:
>> From: npostavs@users.sourceforge.net
>> Cc: 24923@debbugs.gnu.org
>> Date: Fri, 11 Nov 2016 23:34:33 -0500
>>
>> >> + (_ (format "watchpoint triggered %S" (cdr args))))
>> >
>> > Can you give a couple of examples of this, with %S shown explicitly?
>> > I'm not sure whether the result will be self-explanatory.
>>
>> You mean examples of this this clause being used? It was meant more as
>> a catchall in case some watch types were missed by the previous clauses.
>> It shouldn't really ever happen unless the debugger and watchpoint code
>> get out of sync. Do you think it would be better to just signal an
>> error? (although would signalling an error while the debugger is
>> invoked cause trouble?)
>
> Either signal an error, or include something like "(please submit a
> bug report)" in the text.
Here is the updated patch, created with -b. I went with a call to
`error'. And actually, I had missed a couple of watchpoint types.
[-- Attachment #2: patch --]
[-- Type: text/plain, Size: 33306 bytes --]
From dc2e844f824e558711befebd97fb6535e8f47bc2 Mon Sep 17 00:00:00 2001
From: Noam Postavsky <npostavs@gmail.com>
Date: Thu, 19 Nov 2015 19:50:06 -0500
Subject: [PATCH v5 1/5] 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 | 168 ++++++++++++++++++++++++++++--------------------------
src/font.c | 6 +-
src/lisp.h | 54 +++++++++++++++---
src/lread.c | 6 +-
8 files changed, 322 insertions(+), 117 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..a071261 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
+Rmove 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..93a320f 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -595,8 +595,8 @@ DEFUN ("defvaralias", Fdefvaralias, Sdefvaralias, 2, 3, 0,
sym = XSYMBOL (new_alias);
- if (sym->constant)
- /* Not sure why, but why not? */
+ if (sym->trapped_write == SYMBOL_NOWRITE)
+ /* Making it an alias effectively changes its value. */
error ("Cannot make a constant an alias");
switch (sym->redirect)
@@ -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:
@@ -2758,36 +2793,6 @@ DEFUN ("funcall", Ffuncall, Sfuncall, 1, MANY, 0,
emacs_abort ();
}
}
- }
- 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
@@ -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: 4926 bytes --]
From 76719cfbdeed48028c008c423caa81dd18dabb2e Mon Sep 17 00:00:00 2001
From: Noam Postavsky <npostavs@gmail.com>
Date: Sat, 21 Nov 2015 16:03:06 -0500
Subject: [PATCH v5 2/5] 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 #4: patch --]
[-- Type: text/plain, Size: 3913 bytes --]
From 0e4dd8a5bce95e88e924effa683f085499e9bf31 Mon Sep 17 00:00:00 2001
From: Noam Postavsky <npostavs@gmail.com>
Date: Sat, 21 Nov 2015 17:02:42 -0500
Subject: [PATCH v5 3/5] 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 a071261..527c770 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)
+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)
{
- if (HASH_TABLE_P (Vredisplay__variables)
- && hash_lookup (XHASH_TABLE (Vredisplay__variables), symbol, NULL) >= 0)
- {
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 #5: patch --]
[-- Type: text/plain, Size: 6296 bytes --]
From e2b702ac03022b01f2f174522f03c89687c97909 Mon Sep 17 00:00:00 2001
From: Noam Postavsky <npostavs@gmail.com>
Date: Sat, 12 Dec 2015 23:10:15 -0500
Subject: [PATCH v5 4/5] 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 #6: patch --]
[-- Type: text/plain, Size: 884 bytes --]
From 2b8818979d097cf0d6d975f5b5cdd2b0e6673f8a Mon Sep 17 00:00:00 2001
From: Noam Postavsky <npostavs@gmail.com>
Date: Sun, 13 Dec 2015 14:47:58 -0500
Subject: [PATCH v5 5/5] * etc/NEWS: Add entry for watchpoints
---
etc/NEWS | 4 ++++
1 file changed, 4 insertions(+)
diff --git a/etc/NEWS b/etc/NEWS
index e29dfe2..bc3b284 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -626,6 +626,10 @@ two objects are 'eq' ('eql'), then the result of 'sxhash-eq'
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-watch'.
+
+++
** Time conversion functions that accept a time zone rule argument now
allow it to be OFFSET or a list (OFFSET ABBR), where the integer
--
2.9.3
[-- Attachment #7: Type: text/plain, Size: 178 bytes --]
For the manual, do you think I should document just the debugging
commands, or should there additionally be a section in the "Variables"
chapter about the watchpoint mechanism?
^ permalink raw reply related [flat|nested] 22+ messages in thread* bug#24923: 25.1; Lisp watchpoints
2016-11-13 0:54 ` npostavs
@ 2016-11-13 15:29 ` Eli Zaretskii
2016-11-20 2:12 ` npostavs
0 siblings, 1 reply; 22+ messages in thread
From: Eli Zaretskii @ 2016-11-13 15:29 UTC (permalink / raw)
To: npostavs; +Cc: 24923
> From: npostavs@users.sourceforge.net
> Cc: 24923@debbugs.gnu.org
> Date: Sat, 12 Nov 2016 19:54:01 -0500
>
> Here is the updated patch, created with -b. I went with a call to
> `error'. And actually, I had missed a couple of watchpoint types.
This LGTM, just one comment for when you actually push:
> + else if (sym->redirect == SYMBOL_LOCALIZED &&
> + SYMBOL_BLV (sym)->frame_local)
Our coding conventions put the logical operators at the beginning of a
line, not at EOL.
> +static void
> +harmonize_variable_watchers (Lisp_Object alias, Lisp_Object base_variable)
> +{
> + if (!EQ (base_variable, alias) &&
> + EQ (base_variable, Findirect_variable (alias)))
Same here.
> + if (NILP (where) &&
> + !EQ (operation, Qset_default) && !EQ (operation, Qmakunbound) &&
> + !NILP (Flocal_variable_if_set_p (symbol, Fcurrent_buffer ())))
And here.
> --- a/etc/NEWS
> +++ b/etc/NEWS
> @@ -626,6 +626,10 @@ two objects are 'eq' ('eql'), then the result of 'sxhash-eq'
> 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-watch'.
^^^^^^^^^^^
This should follow the renaming.
(Hopefully, this will be followed by a suitable Edebug binding.)
> For the manual, do you think I should document just the debugging
> commands, or should there additionally be a section in the "Variables"
> chapter about the watchpoint mechanism?
Both, I think.
Thanks, I think this is a very important new feature.
^ permalink raw reply [flat|nested] 22+ messages in thread* bug#24923: 25.1; Lisp watchpoints
2016-11-13 15:29 ` Eli Zaretskii
@ 2016-11-20 2:12 ` npostavs
2016-11-20 10:49 ` Stephen Berman
2016-11-20 15:58 ` Eli Zaretskii
0 siblings, 2 replies; 22+ messages in thread
From: npostavs @ 2016-11-20 2:12 UTC (permalink / raw)
To: Eli Zaretskii; +Cc: 24923
[-- 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
^ permalink raw reply related [flat|nested] 22+ messages in thread* bug#24923: 25.1; Lisp watchpoints
2016-11-20 2:12 ` npostavs
@ 2016-11-20 10:49 ` Stephen Berman
2016-11-20 14:14 ` npostavs
2016-11-20 15:58 ` Eli Zaretskii
1 sibling, 1 reply; 22+ messages in thread
From: Stephen Berman @ 2016-11-20 10:49 UTC (permalink / raw)
To: npostavs; +Cc: 24923
There are a few typos in the documentation:
On Sat, 19 Nov 2016 21:12:13 -0500 npostavs@users.sourceforge.net wrote:
> 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.
^^^^^^^
calling
> 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.
Incomplete sentence? Or if it's the continuation of the Subject: line,
shouldn't it be lowercase?
> 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
[...]
> @@ -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.
^
a
> +
> +@deffn Command debug-on-variable-change variable
> +This function arranges causes the debugger to be called whenever
^^^^^^^^^^^^^^^
either "arranges for" or "causes"
> 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
[...]
> @@ -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
^
the
> +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
^
is
> +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
^^^^^^^^^^^^^^
watchpoints
> +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
^
, [comma]
> +at all, @pxref{Variable Scoping}).
> +
> +
> @node Variable Scoping
> @section Scoping Rules for Variable Bindings
> @cindex scoping rule
[...]
> 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
^
is
> +changed, nil otherwise.
> +
> All writes to aliases of SYMBOL will call WATCH-FUNCTION too. */)
> (Lisp_Object symbol, Lisp_Object watch_function)
> {
Steve Berman
^ permalink raw reply [flat|nested] 22+ messages in thread* bug#24923: 25.1; Lisp watchpoints
2016-11-20 10:49 ` Stephen Berman
@ 2016-11-20 14:14 ` npostavs
2016-11-20 16:11 ` Eli Zaretskii
0 siblings, 1 reply; 22+ messages in thread
From: npostavs @ 2016-11-20 14:14 UTC (permalink / raw)
To: Stephen Berman; +Cc: 24923
[-- Attachment #1: Type: text/plain, Size: 154 bytes --]
Stephen Berman <stephen.berman@gmx.net> writes:
> There are a few typos in the documentation:
Thanks, reattaching just the fixed documentation commit.
[-- Attachment #2: patch --]
[-- Type: text/plain, Size: 7770 bytes --]
From b2aff88d97942c32fb0e2695e47ad2cb3433c71f 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.1 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..c047d45 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 a quick way to find the origin of the setting.
+
+@deffn Command debug-on-variable-change variable
+This function arranges for 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..1e0b098 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 the 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 is
+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 watchpoints 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
[-- Attachment #3: Type: text/plain, Size: 669 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.
>
> Incomplete sentence? Or if it's the continuation of the Subject: line,
> shouldn't it be lowercase?
I sort of about it as a continuation, but it looks a bit weird to make
it an official continuation when there's a blank line in between. I
rephrased:
This replaces checking for the variable name in redisplay--variables
when setting it.
^ permalink raw reply related [flat|nested] 22+ messages in thread* bug#24923: 25.1; Lisp watchpoints
2016-11-20 14:14 ` npostavs
@ 2016-11-20 16:11 ` Eli Zaretskii
2016-11-20 19:26 ` npostavs
0 siblings, 1 reply; 22+ messages in thread
From: Eli Zaretskii @ 2016-11-20 16:11 UTC (permalink / raw)
To: npostavs; +Cc: 24923, stephen.berman
> From: npostavs@users.sourceforge.net
> Cc: 24923@debbugs.gnu.org, Eli Zaretskii <eliz@gnu.org>
> Date: Sun, 20 Nov 2016 09:14:02 -0500
>
> > There are a few typos in the documentation:
>
> Thanks, reattaching just the fixed documentation commit.
> diff --git a/doc/lispref/debugging.texi b/doc/lispref/debugging.texi
> index 6c0908a..c047d45 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.
This additional menu item should be also added to the master menu in
elisp.texi.
> +@deffn Command debug-on-variable-change variable
> +This function arranges for 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}.
^^^^^
@xref already generates "See", capitalized, so you want @ref here.
> diff --git a/doc/lispref/variables.texi b/doc/lispref/variables.texi
> index 418a416..1e0b098 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.
Likewise, this should be added to the master menu.
> +@node Watching Variables
> +@section Running a function when a variable is changed.
> +@cindex variable watchpoints
I'd add here an index entry that begins with "watchpoint", like this:
@cindex watchpoints for Lisp variables
That's for those who like using completion in Info-index command.
> +variable settings, and invoking the debugger to track down unexpected
> +changes to variables @pxref{Variable Debugging}.
I believe you meant to put @pxref in parentheses.
> +Each variable has a list of watch functions stored in its
> +@code{watchers} symbol property, @xref{Symbol Properties}.
^^^^^
Either "see @ref" or "@pxref", because @xref generates a capitalized
"See", and so is only appropriate at the beginning of a sentence.
> +@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.
A comma is missing here. Also, I believe "is modified" reads better
here. Or maybe replace the parentheses with commas, then plural
should be okay, I think.
> +@defun get-variable-watchers symbol
> +This function returns the list of active watcher functions.
Please mention SYMBOL here.
Thanks.
^ permalink raw reply [flat|nested] 22+ messages in thread* bug#24923: 25.1; Lisp watchpoints
2016-11-20 16:11 ` Eli Zaretskii
@ 2016-11-20 19:26 ` npostavs
2016-11-20 19:36 ` Eli Zaretskii
0 siblings, 1 reply; 22+ messages in thread
From: npostavs @ 2016-11-20 19:26 UTC (permalink / raw)
To: Eli Zaretskii; +Cc: 24923, stephen.berman
Eli Zaretskii <eliz@gnu.org> writes:
>> +changes to the objects referenced by variables are not detected. For
>> +details, see @xref{Watching Variables}.
> ^^^^^
> @xref already generates "See", capitalized, so you want @ref here.
>
>> +Each variable has a list of watch functions stored in its
>> +@code{watchers} symbol property, @xref{Symbol Properties}.
> ^^^^^
> Either "see @ref" or "@pxref", because @xref generates a capitalized
> "See", and so is only appropriate at the beginning of a sentence.
@xref seems to be generating lowercase "see" for me, perhaps because I'm
using makeinfo 4.13? I'll change to @ref anyway.
>
>> +@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.
>
> A comma is missing here. Also, I believe "is modified" reads better
> here. Or maybe replace the parentheses with commas, then plural
> should be okay, I think.
Hmm, maybe rephrasing like this:
@defun add-variable-watcher symbol watch-function
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.
^ permalink raw reply [flat|nested] 22+ messages in thread* bug#24923: 25.1; Lisp watchpoints
2016-11-20 19:26 ` npostavs
@ 2016-11-20 19:36 ` Eli Zaretskii
2016-11-20 20:16 ` npostavs
0 siblings, 1 reply; 22+ messages in thread
From: Eli Zaretskii @ 2016-11-20 19:36 UTC (permalink / raw)
To: npostavs; +Cc: 24923, stephen.berman
> From: npostavs@users.sourceforge.net
> Cc: 24923@debbugs.gnu.org, stephen.berman@gmx.net
> Date: Sun, 20 Nov 2016 14:26:15 -0500
>
> Eli Zaretskii <eliz@gnu.org> writes:
>
> >> +changes to the objects referenced by variables are not detected. For
> >> +details, see @xref{Watching Variables}.
> > ^^^^^
> > @xref already generates "See", capitalized, so you want @ref here.
> >
> >> +Each variable has a list of watch functions stored in its
> >> +@code{watchers} symbol property, @xref{Symbol Properties}.
> > ^^^^^
> > Either "see @ref" or "@pxref", because @xref generates a capitalized
> > "See", and so is only appropriate at the beginning of a sentence.
>
> @xref seems to be generating lowercase "see" for me, perhaps because I'm
> using makeinfo 4.13?
Unlikely. Are you looking at the file in Info, or as plain text? The
former has its own ideas about how to display cross-references; I
meant what is actually in the file.
> @defun add-variable-watcher symbol watch-function
> 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.
Fine with me, thanks.
^ permalink raw reply [flat|nested] 22+ messages in thread* bug#24923: 25.1; Lisp watchpoints
2016-11-20 19:36 ` Eli Zaretskii
@ 2016-11-20 20:16 ` npostavs
2016-11-21 17:31 ` Eli Zaretskii
0 siblings, 1 reply; 22+ messages in thread
From: npostavs @ 2016-11-20 20:16 UTC (permalink / raw)
To: Eli Zaretskii; +Cc: 24923, stephen.berman
[-- Attachment #1: Type: text/plain, Size: 516 bytes --]
Eli Zaretskii <eliz@gnu.org> writes:
>>
>> @xref seems to be generating lowercase "see" for me, perhaps because I'm
>> using makeinfo 4.13?
>
> Unlikely. Are you looking at the file in Info, or as plain text? The
> former has its own ideas about how to display cross-references; I
> meant what is actually in the file.
I was looking at the file in Info-mode. Looking in fundamental-mode, it
seems that @xref generates an uppercase "*Note", where @ref generates
"*note".
Anyway, here is the final(?) patchset:
[-- Attachment #2: patch --]
[-- Type: text/plain, Size: 33460 bytes --]
From e62c29c23590af50801278e49ffab8aa0a975248 Mon Sep 17 00:00:00 2001
From: Noam Postavsky <npostavs@gmail.com>
Date: Thu, 19 Nov 2015 19:50:06 -0500
Subject: [PATCH v7 1/6] Add lisp watchpoints
This allows calling 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 e4df90f33424df9599c84cabdae5d3d9a4f3219a Mon Sep 17 00:00:00 2001
From: Noam Postavsky <npostavs@gmail.com>
Date: Sat, 19 Nov 2016 16:50:34 -0500
Subject: [PATCH v7 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: 4936 bytes --]
From 1372db86c55c6d8a7cc4023b408f542ee681f442 Mon Sep 17 00:00:00 2001
From: Noam Postavsky <npostavs@gmail.com>
Date: Sat, 21 Nov 2015 16:03:06 -0500
Subject: [PATCH v7 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..5430b72 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-variable-change] 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: 3915 bytes --]
From d7e1393e5d68fa4c6e279a8e7bc584be9bc506d3 Mon Sep 17 00:00:00 2001
From: Noam Postavsky <npostavs@gmail.com>
Date: Sat, 21 Nov 2015 17:02:42 -0500
Subject: [PATCH v7 4/6] Ensure redisplay using variable watcher
This replaces looking up the variable name in redisplay--variables when
setting it.
* 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 d3f07419258505df7d335d1c80e20bf2758e57cd Mon Sep 17 00:00:00 2001
From: Noam Postavsky <npostavs@gmail.com>
Date: Sat, 12 Dec 2015 23:10:15 -0500
Subject: [PATCH v7 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: 8825 bytes --]
From d6e8c7aaa5eecf76e2ecfcf2fcd3484dc7b7fd8a Mon Sep 17 00:00:00 2001
From: Noam Postavsky <npostavs@gmail.com>
Date: Sun, 13 Dec 2015 14:47:58 -0500
Subject: [PATCH v7 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 | 31 +++++++++++++++++++++++
doc/lispref/elisp.texi | 2 ++
doc/lispref/variables.texi | 61 ++++++++++++++++++++++++++++++++++++++++++++++
etc/NEWS | 5 ++++
src/data.c | 9 +++++++
5 files changed, 108 insertions(+)
diff --git a/doc/lispref/debugging.texi b/doc/lispref/debugging.texi
index 6c0908a..c80b0f9 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,36 @@ 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 a quick way to find the origin of the setting.
+
+@deffn Command debug-on-variable-change variable
+This function arranges for 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 @ref{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/elisp.texi b/doc/lispref/elisp.texi
index 4a1e528..c308c79 100644
--- a/doc/lispref/elisp.texi
+++ b/doc/lispref/elisp.texi
@@ -498,6 +498,7 @@ Top
* 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.
@@ -641,6 +642,7 @@ Top
* 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.
diff --git a/doc/lispref/variables.texi b/doc/lispref/variables.texi
index 418a416..393d253 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,66 @@ Setting Variables
@end example
@end defun
+@node Watching Variables
+@section Running a function when a variable is changed.
+@cindex variable watchpoints
+@cindex watchpoints for Lisp variables
+
+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}).
+
+The following functions may be used to manipulate and query the watch
+functions for a variable.
+
+@defun add-variable-watcher symbol watch-function
+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.
+
+@var{watch-function} 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 is
+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 @var{symbol}'s 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 watchpoints 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
^ permalink raw reply related [flat|nested] 22+ messages in thread* bug#24923: 25.1; Lisp watchpoints
2016-11-20 20:16 ` npostavs
@ 2016-11-21 17:31 ` Eli Zaretskii
2016-12-03 1:47 ` npostavs
0 siblings, 1 reply; 22+ messages in thread
From: Eli Zaretskii @ 2016-11-21 17:31 UTC (permalink / raw)
To: npostavs; +Cc: 24923, stephen.berman
> From: npostavs@users.sourceforge.net
> Cc: 24923@debbugs.gnu.org, stephen.berman@gmx.net
> Date: Sun, 20 Nov 2016 15:16:49 -0500
>
> Eli Zaretskii <eliz@gnu.org> writes:
> >>
> >> @xref seems to be generating lowercase "see" for me, perhaps because I'm
> >> using makeinfo 4.13?
> >
> > Unlikely. Are you looking at the file in Info, or as plain text? The
> > former has its own ideas about how to display cross-references; I
> > meant what is actually in the file.
>
> I was looking at the file in Info-mode. Looking in fundamental-mode, it
> seems that @xref generates an uppercase "*Note", where @ref generates
> "*note".
Yes. @xref produces "See" in the printed output (PDF etc.).
> Anyway, here is the final(?) patchset:
LGTM, thanks.
^ permalink raw reply [flat|nested] 22+ messages in thread
* bug#24923: 25.1; Lisp watchpoints
2016-11-21 17:31 ` Eli Zaretskii
@ 2016-12-03 1:47 ` npostavs
2016-12-03 3:49 ` Clément Pit--Claudel
2016-12-03 3:50 ` Clément Pit--Claudel
0 siblings, 2 replies; 22+ messages in thread
From: npostavs @ 2016-12-03 1:47 UTC (permalink / raw)
To: Eli Zaretskii; +Cc: 24923, stephen.berman
tags 24923 fixed
close 24923
quit
Eli Zaretskii <eliz@gnu.org> writes:
>
>> Anyway, here is the final(?) patchset:
>
> LGTM, thanks.
Pushed as 88fefc3 (56c8178, e7cd98b, d3faef9, cfd2b9e, 459a234, 2272131).
^ permalink raw reply [flat|nested] 22+ messages in thread
* bug#24923: 25.1; Lisp watchpoints
2016-12-03 1:47 ` npostavs
@ 2016-12-03 3:49 ` Clément Pit--Claudel
2016-12-03 3:50 ` Clément Pit--Claudel
1 sibling, 0 replies; 22+ messages in thread
From: Clément Pit--Claudel @ 2016-12-03 3:49 UTC (permalink / raw)
To: 24923
[-- Attachment #1.1: Type: text/plain, Size: 368 bytes --]
On 2016-12-02 20:47, npostavs@users.sourceforge.net wrote:
> tags 24923 fixed
> close 24923
> quit
>
> Eli Zaretskii <eliz@gnu.org> writes:
>>
>>> Anyway, here is the final(?) patchset:
>>
>> LGTM, thanks.
>
> Pushed as 88fefc3 (56c8178, e7cd98b, d3faef9, cfd2b9e, 459a234, 2272131).
This is incredibly cool! Thanks so much for working on this :)
[-- Attachment #2: OpenPGP digital signature --]
[-- Type: application/pgp-signature, Size: 819 bytes --]
^ permalink raw reply [flat|nested] 22+ messages in thread
* bug#24923: 25.1; Lisp watchpoints
2016-12-03 1:47 ` npostavs
2016-12-03 3:49 ` Clément Pit--Claudel
@ 2016-12-03 3:50 ` Clément Pit--Claudel
2016-12-03 5:01 ` Daniel Colascione
1 sibling, 1 reply; 22+ messages in thread
From: Clément Pit--Claudel @ 2016-12-03 3:50 UTC (permalink / raw)
To: 24923
[-- Attachment #1.1: Type: text/plain, Size: 358 bytes --]
On 2016-12-02 20:47, npostavs@users.sourceforge.net wrote:
> Pushed as 88fefc3 (56c8178, e7cd98b, d3faef9, cfd2b9e, 459a234, 2272131)
I wonder: would it make sense to extend defcustom to use this, too? Wouldn't it be great if I could tag my defcustom variables in some way, and then setq would automatically invoke the corresponding defcustom setter?
[-- Attachment #2: OpenPGP digital signature --]
[-- Type: application/pgp-signature, Size: 819 bytes --]
^ permalink raw reply [flat|nested] 22+ messages in thread
* bug#24923: 25.1; Lisp watchpoints
2016-12-03 3:50 ` Clément Pit--Claudel
@ 2016-12-03 5:01 ` Daniel Colascione
2016-12-03 14:11 ` npostavs
0 siblings, 1 reply; 22+ messages in thread
From: Daniel Colascione @ 2016-12-03 5:01 UTC (permalink / raw)
To: Clément Pit--Claudel; +Cc: 24923
On Fri, Dec 02 2016, Clément Pit--Claudel wrote:
> On 2016-12-02 20:47, npostavs@users.sourceforge.net wrote:
>> Pushed as 88fefc3 (56c8178, e7cd98b, d3faef9, cfd2b9e, 459a234, 2272131)
>
> I wonder: would it make sense to extend defcustom to use this, too?
> Wouldn't it be great if I could tag my defcustom variables in some
> way, and then setq would automatically invoke the corresponding
> defcustom setter?
setf maybe. setq should not be magical.
^ permalink raw reply [flat|nested] 22+ messages in thread
* bug#24923: 25.1; Lisp watchpoints
2016-12-03 5:01 ` Daniel Colascione
@ 2016-12-03 14:11 ` npostavs
0 siblings, 0 replies; 22+ messages in thread
From: npostavs @ 2016-12-03 14:11 UTC (permalink / raw)
To: Daniel Colascione; +Cc: 24923, Clément Pit--Claudel
Daniel Colascione <dancol@dancol.org> writes:
> On Fri, Dec 02 2016, Clément Pit--Claudel wrote:
>> On 2016-12-02 20:47, npostavs@users.sourceforge.net wrote:
>>> Pushed as 88fefc3 (56c8178, e7cd98b, d3faef9, cfd2b9e, 459a234, 2272131)
>>
>> I wonder: would it make sense to extend defcustom to use this, too?
>> Wouldn't it be great if I could tag my defcustom variables in some
>> way, and then setq would automatically invoke the corresponding
>> defcustom setter?
>
> setf maybe. setq should not be magical.
There were indeed some concerns about that kind usage when this feature
was first proposed, e.g.:
- http://lists.gnu.org/archive/html/emacs-devel/2015-01/msg01064.html
I like the idea of such hooks (which I've always thought of as
"watchers" rather than hooks), actually, but only for purposes such
as debugging.
If we want to use such hooks for purposes such as "automatically
recompute values of dependent vars", then I think the right way is to
introduce a new layer which checks&runs these hooks, using the "raw"
`setq' underneath.
^ permalink raw reply [flat|nested] 22+ messages in thread
* bug#24923: 25.1; Lisp watchpoints
2016-11-20 2:12 ` npostavs
2016-11-20 10:49 ` Stephen Berman
@ 2016-11-20 15:58 ` Eli Zaretskii
2016-11-20 17:00 ` npostavs
1 sibling, 1 reply; 22+ messages in thread
From: Eli Zaretskii @ 2016-11-20 15:58 UTC (permalink / raw)
To: npostavs; +Cc: 24923
> From: npostavs@users.sourceforge.net
> Cc: 24923@debbugs.gnu.org
> Date: Sat, 19 Nov 2016 21:12:13 -0500
>
> 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.
Thanks.
> 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.
I think the property can indeed be left undocumented.
> @@ -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. */
What are those SET_INTERNAL_* values? They are numbers, right? Then
they should be described as such in the doc string.
> +(defun cancel-debug-on-variable-change (&optional variable)
> + "Undo effect of \\[debug-on-entry] on VARIABLE.
^^^^^^^^^^^^^^^^^^
Copy/paste error.
I will comment on the documentation in a separate message.
^ permalink raw reply [flat|nested] 22+ messages in thread* bug#24923: 25.1; Lisp watchpoints
2016-11-20 15:58 ` Eli Zaretskii
@ 2016-11-20 17:00 ` npostavs
2016-11-20 17:25 ` Eli Zaretskii
0 siblings, 1 reply; 22+ messages in thread
From: npostavs @ 2016-11-20 17:00 UTC (permalink / raw)
To: Eli Zaretskii; +Cc: 24923
Eli Zaretskii <eliz@gnu.org> writes:
>> @@ -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. */
>
> What are those SET_INTERNAL_* values? They are numbers, right? Then
> they should be described as such in the doc string.
They're enum values. Perhaps you were confused by the hunk header?
That's not a doc string, it's the comment on set_internal, a C function.
^ permalink raw reply [flat|nested] 22+ messages in thread* bug#24923: 25.1; Lisp watchpoints
2016-11-20 17:00 ` npostavs
@ 2016-11-20 17:25 ` Eli Zaretskii
0 siblings, 0 replies; 22+ messages in thread
From: Eli Zaretskii @ 2016-11-20 17:25 UTC (permalink / raw)
To: npostavs; +Cc: 24923
> From: npostavs@users.sourceforge.net
> Cc: 24923@debbugs.gnu.org
> Date: Sun, 20 Nov 2016 12:00:52 -0500
>
> Eli Zaretskii <eliz@gnu.org> writes:
> >> @@ -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. */
> >
> > What are those SET_INTERNAL_* values? They are numbers, right? Then
> > they should be described as such in the doc string.
>
> They're enum values. Perhaps you were confused by the hunk header?
> That's not a doc string, it's the comment on set_internal, a C function.
Sorry, I thought it was a doc string.
^ permalink raw reply [flat|nested] 22+ messages in thread
end of thread, other threads:[~2016-12-03 14:11 UTC | newest]
Thread overview: 22+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2016-11-11 3:10 bug#24923: 25.1; Lisp watchpoints npostavs
2016-11-11 10:02 ` Eli Zaretskii
2016-11-12 4:34 ` npostavs
2016-11-12 7:19 ` Eli Zaretskii
2016-11-13 0:54 ` npostavs
2016-11-13 15:29 ` Eli Zaretskii
2016-11-20 2:12 ` npostavs
2016-11-20 10:49 ` Stephen Berman
2016-11-20 14:14 ` npostavs
2016-11-20 16:11 ` Eli Zaretskii
2016-11-20 19:26 ` npostavs
2016-11-20 19:36 ` Eli Zaretskii
2016-11-20 20:16 ` npostavs
2016-11-21 17:31 ` Eli Zaretskii
2016-12-03 1:47 ` npostavs
2016-12-03 3:49 ` Clément Pit--Claudel
2016-12-03 3:50 ` Clément Pit--Claudel
2016-12-03 5:01 ` Daniel Colascione
2016-12-03 14:11 ` npostavs
2016-11-20 15:58 ` Eli Zaretskii
2016-11-20 17:00 ` npostavs
2016-11-20 17:25 ` Eli Zaretskii
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).