From c1e2e14097f4488384ea8ea3cab3cd51c41947eb Mon Sep 17 00:00:00 2001 From: Noam Postavsky Date: Thu, 19 Nov 2015 19:50:06 -0500 Subject: [PATCH v2 1/3] 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): (notify_variable_watchers): New functions. (watcher_table): New variable. * src/data.c (Fmakunbound, set_internal, Fset_default): 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. --- src/alloc.c | 2 +- src/buffer.c | 2 +- src/bytecode.c | 2 +- src/data.c | 161 ++++++++++++++++++++++++++++++++++++++++++++++++++------- src/eval.c | 6 +-- src/font.c | 6 +-- src/lisp.h | 35 +++++++++---- src/lread.c | 6 +-- 8 files changed, 177 insertions(+), 43 deletions(-) diff --git a/src/alloc.c b/src/alloc.c index bee7cd1..56c3a55 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -3368,7 +3368,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 ab91aaa..11da887 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -5689,7 +5689,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 864db1a..02edb44 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -799,7 +799,7 @@ 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 { diff --git a/src/data.c b/src/data.c index 5154604..1576280 100644 --- a/src/data.c +++ b/src/data.c @@ -34,6 +34,11 @@ #include "frame.h" #include "keymap.h" +static void notify_variable_watchers (Lisp_Object symbol, + Lisp_Object newval, + Lisp_Object operation, + Lisp_Object where); + static void swap_in_symval_forwarding (struct Lisp_Symbol *, struct Lisp_Buffer_Local_Value *); @@ -629,9 +634,18 @@ DEFUN ("makunbound", Fmakunbound, Smakunbound, 1, 1, 0, (register Lisp_Object symbol) { CHECK_SYMBOL (symbol); - if (SYMBOL_CONSTANT_P (symbol)) - xsignal1 (Qsetting_constant, symbol); - Fset (symbol, Qunbound); + switch (XSYMBOL (symbol)->trapped_write) + { + case SYMBOL_NOWRITE: + xsignal1 (Qsetting_constant, symbol); + + case SYMBOL_TRAPPED_WRITE: + notify_variable_watchers (symbol, Qnil, Qunbind, Qnil); + /* fallthrough */ + case SYMBOL_UNTRAPPED_WRITE: + default: + Fset (symbol, Qunbound); + } return symbol; } @@ -1230,18 +1244,25 @@ 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, newval, bindflag? Qlet : Qset, where); + /* fallthrough */ + case SYMBOL_UNTRAPPED_WRITE: + default: ; } maybe_set_redisplay (symbol); - sym = XSYMBOL (symbol); start: switch (sym->redirect) @@ -1365,6 +1386,89 @@ set_internal (Lisp_Object symbol, Lisp_Object newval, Lisp_Object where, } return; } + +/* A (SYMBOL . (FUNCTIONS...)) alist */ +static Lisp_Object sym_watchers_table; + +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); + sym->trapped_write = trap; +} + +static void +reset_symbol_trapped_write (Lisp_Object symbol) +{ + set_symbol_trapped_write (symbol, SYMBOL_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) +{ + set_symbol_trapped_write (symbol, SYMBOL_TRAPPED_WRITE); + + 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: /* Cause WATCH-FUNCTION to be called when SYMBOL is set. */) + (Lisp_Object symbol, Lisp_Object watch_function) +{ + Lisp_Object watchers = Fget (symbol, Qwatchers); + watchers = Fdelete (watch_function, watchers); + if (NILP (watchers)) + set_symbol_trapped_write (symbol, SYMBOL_UNTRAPPED_WRITE); + Fput (symbol, Qwatchers, watchers); + return Qnil; +} + +typedef void (*WATCHER_FUNCTION) (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object); +static const WATCHER_FUNCTION watcher_table[] = + { + }; +enum + { + }; + +static void +notify_variable_watchers (Lisp_Object symbol, + Lisp_Object newval, + Lisp_Object operation, + Lisp_Object where) +{ + Lisp_Object watchers = Fget (symbol, Qwatchers); + + set_symbol_trapped_write (symbol, SYMBOL_UNTRAPPED_WRITE); /* avoid recursion */ + ptrdiff_t count = SPECPDL_INDEX (); + record_unwind_protect (&reset_symbol_trapped_write, symbol); + + while (!NILP (watchers)) + { + Lisp_Object watcher = XCAR (watchers); + if (INTEGERP (watcher)) + { + EMACS_INT wnum = XINT (watcher); + if (wnum < ARRAYELTS (watcher_table)) + watcher_table[wnum] (operation, where, symbol, newval); + } + else if (FUNCTIONP (watcher)) + CALLN (Ffuncall, watcher, operation, where, symbol, newval); + watchers = XCDR (watchers); + } + + unbind_to (count, Qnil); +} + /* Access or set a buffer-local symbol's default value. */ @@ -1451,16 +1555,23 @@ 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: + notify_variable_watchers (symbol, value, Qset_default, Qnil); + /* fallthrough */ + case SYMBOL_UNTRAPPED_WRITE: + default: ; } - sym = XSYMBOL (symbol); start: switch (sym->redirect) @@ -1631,7 +1742,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) @@ -1706,7 +1817,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))); @@ -1900,7 +2011,7 @@ DEFUN ("make-variable-frame-local", Fmake_variable_frame_local, Smake_variable_f default: emacs_abort (); } - if (sym->constant) + if (sym->trapped_write == SYMBOL_NOWRITE) error ("Symbol %s may not be frame-local", SDATA (SYMBOL_NAME (variable))); blv = make_blv (sym, forwarded, valcontents); @@ -3451,6 +3562,7 @@ 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 (Qinvalid_read_syntax, "invalid-read-syntax"); DEFSYM (Qinvalid_function, "invalid-function"); @@ -3526,6 +3638,8 @@ 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 (Qinvalid_read_syntax, error_tail, "Invalid read syntax"); PUT_ERROR (Qinvalid_function, error_tail, "Invalid function"); PUT_ERROR (Qwrong_number_of_arguments, error_tail, @@ -3698,10 +3812,17 @@ 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 (Qunbind, "unbind"); + DEFSYM (Qset, "set"); + DEFSYM (Qset_default, "Qset_default"); + defsubr (&Sadd_variable_watcher); + defsubr (&Sremove_variable_watcher); } diff --git a/src/eval.c b/src/eval.c index ac98ca1..3d17825 100644 --- a/src/eval.c +++ b/src/eval.c @@ -586,7 +586,7 @@ DEFUN ("defvaralias", Fdefvaralias, Sdefvaralias, 2, 3, 0, sym = XSYMBOL (new_alias); - if (sym->constant) + if (sym->trapped_write == SYMBOL_NOWRITE) /* Not sure why, but why not? */ error ("Cannot make a constant an alias"); @@ -623,7 +623,7 @@ DEFUN ("defvaralias", Fdefvaralias, Sdefvaralias, 2, 3, 0, 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); @@ -2972,7 +2972,7 @@ 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); diff --git a/src/font.c b/src/font.c index 016b7e0..509d3cc 100644 --- a/src/font.c +++ b/src/font.c @@ -5388,19 +5388,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 3efa492..b8431ee 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -337,7 +337,7 @@ error !; #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) @@ -383,7 +383,7 @@ error !; # 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) @@ -630,6 +630,13 @@ enum symbol_redirect 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; @@ -641,10 +648,10 @@ struct Lisp_Symbol 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. */ @@ -1829,14 +1836,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 @@ -3256,6 +3263,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 diff --git a/src/lread.c b/src/lread.c index c4456f3..0852215 100644 --- a/src/lread.c +++ b/src/lread.c @@ -3721,7 +3721,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); } @@ -4010,12 +4010,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.6.2