From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Kelly Dean Newsgroups: gmane.emacs.devel Subject: [PATCH] Run hook when variable is set Date: Wed, 28 Jan 2015 09:15:07 +0000 Message-ID: NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: ger.gmane.org 1422436775 12901 80.91.229.3 (28 Jan 2015 09:19:35 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Wed, 28 Jan 2015 09:19:35 +0000 (UTC) Cc: Stefan Monnier To: emacs-devel@gnu.org Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Wed Jan 28 10:19:25 2015 Return-path: Envelope-to: ged-emacs-devel@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by plane.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1YGOmL-0002GR-RE for ged-emacs-devel@m.gmane.org; Wed, 28 Jan 2015 10:19:18 +0100 Original-Received: from localhost ([::1]:52080 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1YGOmL-0000yq-0q for ged-emacs-devel@m.gmane.org; Wed, 28 Jan 2015 04:19:17 -0500 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:59516) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1YGOmG-0000yj-1X for emacs-devel@gnu.org; Wed, 28 Jan 2015 04:19:14 -0500 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1YGOmC-0004F7-Of for emacs-devel@gnu.org; Wed, 28 Jan 2015 04:19:11 -0500 Original-Received: from relay4-d.mail.gandi.net ([2001:4b98:c:538::196]:36500) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1YGOmC-0004Eo-Ez for emacs-devel@gnu.org; Wed, 28 Jan 2015 04:19:08 -0500 Original-Received: from mfilter1-d.gandi.net (mfilter1-d.gandi.net [217.70.178.130]) by relay4-d.mail.gandi.net (Postfix) with ESMTP id E0E661720AF; Wed, 28 Jan 2015 10:19:03 +0100 (CET) X-Virus-Scanned: Debian amavisd-new at mfilter1-d.gandi.net Original-Received: from relay4-d.mail.gandi.net ([217.70.183.196]) by mfilter1-d.gandi.net (mfilter1-d.gandi.net [10.0.15.180]) (amavisd-new, port 10024) with ESMTP id ZY5M-UxKydfy; Wed, 28 Jan 2015 10:19:02 +0100 (CET) X-Originating-IP: 66.220.3.179 Original-Received: from localhost (gm179.geneticmail.com [66.220.3.179]) (Authenticated sender: kelly@prtime.org) by relay4-d.mail.gandi.net (Postfix) with ESMTPSA id CA25C17209B; Wed, 28 Jan 2015 10:18:58 +0100 (CET) X-detected-operating-system: by eggs.gnu.org: Error: Malformed IPv6 address (bad octet value). X-Received-From: 2001:4b98:c:538::196 X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.14 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Original-Sender: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Xref: news.gmane.org gmane.emacs.devel:181890 Archived-At: --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable Emacs lets you hook a mode, so you can run some function(s) whenever the = mode is turned on or off. The patch attached below lets you hook a symbol too, so you can run some = function(s) whenever the global or buffer-local variable by that name is = set, or a dynamic variable by that name is bound, set, or unbound. It works for the entire family of Elisp =C2=ABset=C2=BB functions (and ma= kunbound), in both Elisp and C. It also works for dynamic-let bindings. I= t is not implemented for lexical-let bindings. The purpose of this new feature is to enable a proper fix for bug #19068,= and to enable a solution to Stefan's requirement that dynamic-cursor-mod= e be enabled by default as a condition for adding the latter to Emacs. Use it like this: (defun tattle (sym env) (message "Symbol %S modified in env %S. New value: %S" sym env (if (boundp sym) (symbol-value sym) 'none))) (add-hook 'foo-varhook #'tattle) (put 'foo 'varhook 'foo-varhook) ; The varhook property is the trigger (setq foo 'bar) =E2=86=92 =E2=8C=9CSymbol foo modified in env global. New= value: bar=E2=8C=9D (setq lexical-binding nil) (let ((foo 'bar1)) (setq foo 'bar2)) =E2=86=92 =E2=8C=9CSymbol foo modified in env dyn-bind. New value: bar1 Symbol foo modified in env dyn-local. New value: bar2 Symbol foo modified in env dyn-unbind. New value: bar=E2=8C=9D (makunbound 'foo) =E2=86=92 =E2=8C=9CSymbol foo modified in env global. N= ew value: none=E2=8C=9D (setq-local foo 'bar) =E2=86=92 =E2=8C=9CSymbol foo modified in env buffe= r-local. New value: bar=E2=8C=9D (makunbound 'foo) =E2=86=92 =E2=8C=9CSymbol foo modified in env buffer-lo= cal. New value: none=E2=8C=9D The varhook property must be a hook. To turn off the varhook, set the pro= perty to nil. The indirection through a hook, rather than putting the list of functions= directly in the varhook property, lets you turn the varhook on/off witho= ut having to add/remove all your functions on the hook. After you turn it off, if there are no other properties on the symbol, us= e (setf (symbol-plist 'foo) nil) to get rid of the superfluous property list that just records nil for var= hook. If you leave the list there, it causes a minor slowdown (the time r= equired to check whether the property is nil) when setting the symbol. Th= e varhook feature is optimized to immediately skip a symbol if the proper= ty list is nil. Each function on the hook must take two arguments: 0. The symbol S that was set (or bound or unbound), which is passed so yo= u can have one function deal with multiple symbols rather than needing a = separate function for each symbol. 1. The environment or event in which S was set/bound/unbound. This is one= of the following symbols: global: S was set in the global env. buffer-local: S was set in the env of the current buffer. dyn-local: S was set in the innermost dynamic env in which S is bound. dyn-bind: S was bound in a new dynamic env (created by dynamic =C2=ABlet=C2= =BB). dyn-unbind: The innermost dynamic env in which S was bound was destroyed. For lexical bindings, varhook isn't triggered. The names =E2=8C=9Cdyn-=E2=8C=9D are used instead of =E2=8C=9Clet-=E2=8C=9D= for clarity, since =E2=8C=9Clet=E2=8C=9D is also used for lexical bindin= gs in Lisp. If your function receives dyn-unbind and tries to read S, it will get the= value bound to in an outer env, i.e. in the innermost dynamic env in whi= ch S is still bound, or in the buffer-local or global env. If you're only interested in global settings, just wrap your hook functio= n's body in (when (eq env 'global) ...) You get recursion if your function sets the symbol in any env (except lex= ical). Make sure you have a terminating condition. The varhook is run not only when the symbol is set, but also when it's ma= de unbound, either globally or buffer-locally. Make sure your function ch= ecks for this before trying to read the variable. Patch applies to trunk. --=-=-= Content-Type: text/x-diff Content-Disposition: inline; filename=varhook.patch --- src/lisp.h +++ src/lisp.h @@ -3391,6 +3391,14 @@ EXFUN (Fbyteorder, 0) ATTRIBUTE_CONST; /* Defined in data.c. */ +typedef enum + { + Dyn_Unbind = -1, + Dyn_Current = 0, + Dyn_Bind = 1, + Dyn_Skip = 2, + Dyn_Global = 3 + } Dyn_Bind_Direction; extern Lisp_Object indirect_function (Lisp_Object); extern Lisp_Object find_symbol_value (Lisp_Object); enum Arith_Comparison { @@ -3438,10 +3446,23 @@ Lisp_Object); extern _Noreturn Lisp_Object wrong_type_argument (Lisp_Object, Lisp_Object); extern Lisp_Object do_symval_forwarding (union Lisp_Fwd *); +extern void run_varhook (struct Lisp_Symbol*, bool, Dyn_Bind_Direction); extern void set_internal (Lisp_Object, Lisp_Object, Lisp_Object, bool); +extern void set_internal_1 (Lisp_Object, Lisp_Object, Lisp_Object, bool, + Dyn_Bind_Direction); +extern void set_default_internal (Lisp_Object, Lisp_Object, + Dyn_Bind_Direction); extern void syms_of_data (void); extern void swap_in_global_binding (struct Lisp_Symbol *); +INLINE void +try_run_varhook (struct Lisp_Symbol* sym, bool buf_local, Dyn_Bind_Direction dir) +{ + /* Avoid the call in the usual case of nil property list just to save time. */ + if (!NILP (sym->plist)) + run_varhook (sym, buf_local, dir); +} + /* Defined in cmds.c */ extern void syms_of_cmds (void); extern void keys_of_cmds (void); @@ -3905,9 +3926,9 @@ should no longer be used. */ extern Lisp_Object Vrun_hooks; extern void run_hook_with_args_2 (Lisp_Object, Lisp_Object, Lisp_Object); -extern Lisp_Object run_hook_with_args (ptrdiff_t nargs, Lisp_Object *args, - Lisp_Object (*funcall) - (ptrdiff_t nargs, Lisp_Object *args)); +extern Lisp_Object run_hook_with_args (ptrdiff_t, Lisp_Object *, + Lisp_Object (*) (ptrdiff_t, Lisp_Object *)); +extern Lisp_Object funcall_nil (ptrdiff_t, Lisp_Object *); extern _Noreturn void xsignal (Lisp_Object, Lisp_Object); extern _Noreturn void xsignal0 (Lisp_Object); extern _Noreturn void xsignal1 (Lisp_Object, Lisp_Object); --- src/eval.c +++ src/eval.c @@ -2357,7 +2357,7 @@ /* Run hook variables in various ways. */ -static Lisp_Object +Lisp_Object funcall_nil (ptrdiff_t nargs, Lisp_Object *args) { Ffuncall (nargs, args); @@ -3142,9 +3142,12 @@ specpdl_ptr->let.old_value = SYMBOL_VAL (sym); grow_specpdl (); if (!sym->constant) - SET_SYMBOL_VAL (sym, value); + { + SET_SYMBOL_VAL (sym, value); + try_run_varhook (sym, false, Dyn_Bind); + } else - set_internal (symbol, value, Qnil, 1); + set_internal_1 (symbol, value, Qnil, 1, Dyn_Bind); break; case SYMBOL_LOCALIZED: if (SYMBOL_BLV (sym)->frame_local) @@ -3176,7 +3179,7 @@ { specpdl_ptr->let.kind = SPECPDL_LET_DEFAULT; grow_specpdl (); - Fset_default (symbol, value); + set_default_internal (symbol, value, Dyn_Bind); return; } } @@ -3184,7 +3187,7 @@ specpdl_ptr->let.kind = SPECPDL_LET; grow_specpdl (); - set_internal (symbol, value, Qnil, 1); + set_internal_1 (symbol, value, Qnil, 1, Dyn_Bind); break; } default: emacs_abort (); @@ -3320,6 +3323,7 @@ if (sym->redirect == SYMBOL_PLAINVAL) { SET_SYMBOL_VAL (sym, specpdl_old_value (specpdl_ptr)); + try_run_varhook (sym, false, Dyn_Unbind); break; } else @@ -3329,8 +3333,8 @@ } } case SPECPDL_LET_DEFAULT: - Fset_default (specpdl_symbol (specpdl_ptr), - specpdl_old_value (specpdl_ptr)); + set_default_internal (specpdl_symbol (specpdl_ptr), + specpdl_old_value (specpdl_ptr), Dyn_Unbind); break; case SPECPDL_LET_LOCAL: { @@ -3342,7 +3346,7 @@ /* 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_1 (symbol, old_value, where, 1, Dyn_Unbind); } break; } @@ -3537,7 +3541,7 @@ Lisp_Object sym = specpdl_symbol (tmp); Lisp_Object old_value = specpdl_old_value (tmp); set_specpdl_old_value (tmp, Fdefault_value (sym)); - Fset_default (sym, old_value); + set_default_internal (sym, old_value, Dyn_Skip); } break; case SPECPDL_LET_LOCAL: @@ -3553,7 +3557,7 @@ { set_specpdl_old_value (tmp, Fbuffer_local_value (symbol, where)); - set_internal (symbol, old_value, where, 1); + set_internal_1 (symbol, old_value, where, 1, Dyn_Skip); } } break; --- src/data.c +++ src/data.c @@ -1167,6 +1168,42 @@ xsignal1 (Qvoid_variable, symbol); } +/* For the symbol S that was just set, if the varhook property is set to + a hook, run the functions on that hook. To those functions, pass S + as the first argument, and as the second argument, pass a symbol + indicating the environment in which S was set. */ + +void +run_varhook (struct Lisp_Symbol* sym, bool buf_local, Dyn_Bind_Direction dir) +{ + Lisp_Object hook_and_args[3]; + if (dir == Dyn_Skip) /* From backtrace_eval_unrewind */ + return; + hook_and_args[0] = Fplist_get (sym->plist, Qvarhook); + if (NILP (hook_and_args[0])) + return; + XSETSYMBOL (hook_and_args[1], sym); + switch (dir) + { + case Dyn_Current: + { + bool shadowed; + if (buf_local) + shadowed = let_shadows_buffer_binding_p (sym); + else shadowed = let_shadows_global_binding_p (hook_and_args[1]); + if (shadowed) hook_and_args[2] = Qdyn_local; + else if (buf_local) hook_and_args[2] = Qbuffer_local; + else hook_and_args[2] = Qglobal; + break; + } + case Dyn_Global: hook_and_args[2] = Qglobal; break; + case Dyn_Bind: hook_and_args[2] = Qdyn_bind; break; + case Dyn_Unbind: hook_and_args[2] = Qdyn_unbind; break; + default: emacs_abort (); + } + run_hook_with_args (3, hook_and_args, funcall_nil); +} + DEFUN ("set", Fset, Sset, 2, 2, 0, doc: /* Set SYMBOL's value to NEWVAL, and return NEWVAL. */) (register Lisp_Object symbol, Lisp_Object newval) @@ -1187,6 +1224,21 @@ set_internal (Lisp_Object symbol, Lisp_Object newval, Lisp_Object where, bool bindflag) { + set_internal_1 (symbol, newval, where, bindflag, Dyn_Current); +} + +/* Like set_internal but with direction argument to indicate whether this + function call is due to a binding (1), an unbinding (-1), or neither (0). + As special cases, a value of 2 is a flag to disable run_varhook so that + varhooks aren't run during backtraces, and a value of 3 is a flag + indicating that this function call is due to set_default, which allows + run_varhook to distinguish beween the global and the dyn-local binding. +*/ + +void +set_internal_1 (Lisp_Object symbol, Lisp_Object newval, Lisp_Object where, + bool bindflag, Dyn_Bind_Direction dir) +{ bool voide = EQ (newval, Qunbound); struct Lisp_Symbol *sym; Lisp_Object tem1; @@ -1212,9 +1264,15 @@ switch (sym->redirect) { case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start; - case SYMBOL_PLAINVAL: SET_SYMBOL_VAL (sym , newval); return; + case SYMBOL_PLAINVAL: + { + SET_SYMBOL_VAL (sym, newval); + try_run_varhook (sym, false, dir); + return; + } case SYMBOL_LOCALIZED: { + bool buf_local = true; struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (sym); if (NILP (where)) { @@ -1258,6 +1316,7 @@ indicating that we're seeing the default value. Likewise if the variable has been let-bound in the current buffer. */ + buf_local = false; if (bindflag || !blv->local_if_set || let_shadows_buffer_binding_p (sym)) { @@ -1299,6 +1358,7 @@ BUFFERP (where) ? XBUFFER (where) : current_buffer); } + try_run_varhook (sym, buf_local, dir); break; } case SYMBOL_FORWARDED: @@ -1324,6 +1384,9 @@ } else store_symval_forwarding (/* sym, */ innercontents, newval, buf); + try_run_varhook (sym, + (XFWDTYPE (innercontents))==Lisp_Fwd_Buffer_Obj, + dir); break; } default: emacs_abort (); @@ -1413,6 +1476,17 @@ for this variable. */) (Lisp_Object symbol, Lisp_Object value) { + set_default_internal (symbol, value, Dyn_Global); + return value; +} + +/* Like Fset_default, but with direction argument. See set_internal_1 for + a description of this argument. */ + +void +set_default_internal (Lisp_Object symbol, Lisp_Object value, + Dyn_Bind_Direction dir) +{ struct Lisp_Symbol *sym; CHECK_SYMBOL (symbol); @@ -1423,7 +1497,7 @@ xsignal1 (Qsetting_constant, symbol); else /* Allow setting keywords to their own value. */ - return value; + return; } sym = XSYMBOL (symbol); @@ -1431,7 +1505,11 @@ switch (sym->redirect) { case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start; - case SYMBOL_PLAINVAL: return Fset (symbol, value); + case SYMBOL_PLAINVAL: + { + set_internal_1 (symbol, value, Qnil, false, dir); + return; + } case SYMBOL_LOCALIZED: { struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (sym); @@ -1442,7 +1520,8 @@ /* If the default binding is now loaded, set the REALVALUE slot too. */ if (blv->fwd && EQ (blv->defcell, blv->valcell)) store_symval_forwarding (blv->fwd, value, NULL); - return value; + try_run_varhook (sym, false, dir); + return; } case SYMBOL_FORWARDED: { @@ -1468,10 +1547,14 @@ if (!PER_BUFFER_VALUE_P (b, idx)) set_per_buffer_value (b, offset, value); } - return value; + try_run_varhook (sym, false, dir); + return; } else - return Fset (symbol, value); + { + set_internal_1 (symbol, value, Qnil, false, dir); + return; + } } default: emacs_abort (); } @@ -3470,6 +3553,13 @@ DEFSYM (Qad_advice_info, "ad-advice-info"); DEFSYM (Qad_activate_internal, "ad-activate-internal"); + DEFSYM (Qvarhook, "varhook"); + DEFSYM (Qglobal, "global"); + DEFSYM (Qbuffer_local, "buffer-local"); + DEFSYM (Qdyn_local, "dyn-local"); + DEFSYM (Qdyn_bind, "dyn-bind"); + DEFSYM (Qdyn_unbind, "dyn-unbind"); + error_tail = pure_cons (Qerror, Qnil); /* ERROR is used as a signaler for random errors for which nothing else is --=-=-=--