From: npostavs@users.sourceforge.net
To: 24923@debbugs.gnu.org
Subject: bug#24923: 25.1; Lisp watchpoints
Date: Thu, 10 Nov 2016 22:10:38 -0500 [thread overview]
Message-ID: <87vavun235.fsf@users.sourceforge.net> (raw)
[-- 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
next reply other threads:[~2016-11-11 3:10 UTC|newest]
Thread overview: 22+ messages / expand[flat|nested] mbox.gz Atom feed top
2016-11-11 3:10 npostavs [this message]
2016-11-11 10:02 ` bug#24923: 25.1; Lisp watchpoints 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
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=87vavun235.fsf@users.sourceforge.net \
--to=npostavs@users.sourceforge.net \
--cc=24923@debbugs.gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/emacs.git
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.