martin/emacs
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Add lisp watchpoints

Browse Source 
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.
This commit is contained in:
Noam Postavsky
2015-11-19 19:50:06 -05:00
parent 0fc4761ca8
commit 227213164e
8 changed files with 381 additions and 176 deletions
Download Patch File Download Diff File Expand all files Collapse all files

197
src/data.c
View File

@@ -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);
|| !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 +1399,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);
}
/* Access or set a buffer-local symbol's default value. */
@@ -1471,16 +1590,27 @@ for this variable. */)
struct Lisp_Symbol *sym;
CHECK_SYMBOL (symbol);
if (SYMBOL_CONSTANT_P (symbol))
{
if (NILP (Fkeywordp (symbol))
|| !EQ (value, Fdefault_value (symbol)))
xsignal1 (Qsetting_constant, symbol);
else
/* Allow setting keywords to their own value. */
return value;
}
sym = XSYMBOL (symbol);
switch (sym->trapped_write)
{
case SYMBOL_NOWRITE:
if (NILP (Fkeywordp (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 ();
}
start:
switch (sym->redirect)
@@ -1651,7 +1781,7 @@ The function `default-value' gets the default value and `set-default' sets it.
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 @@ Instead, use `add-hook' and specify t for the LOCAL argument. */)
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 @@ From now on the default value will apply in this buffer. Return 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 @@ frame-local bindings). */)
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);
@@ -3465,6 +3598,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");
@@ -3543,6 +3678,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,
@@ -3721,10 +3860,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);
}