From 20de275d39fdf56e14078fb8a816f96f2314562f Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Thu, 18 Mar 2021 09:44:21 -0700 Subject: attempt to reintroduce ON-CHANGE Signed-off-by: Sean Whitton --- src/propspec.lisp | 23 +++++++++++++++++++++++ 1 file changed, 23 insertions(+) (limited to 'src/propspec.lisp') diff --git a/src/propspec.lisp b/src/propspec.lisp index 0044d52..5df0410 100644 --- a/src/propspec.lisp +++ b/src/propspec.lisp @@ -330,3 +330,26 @@ apply the elements of REQUIREMENTS in reverse order." :unapply (get psym 'papply) :args args))) +(defmacro on-change (propapp &body on-change) + "If applying PROPAPP makes a change, also apply each of of the propapps +ON-CHANGE in order." + `(on-change* ,propapp ,@on-change)) + +(define-function-property-combinator on-change* (propapp &rest propapps) + (:retprop :type (collapse-types (propapptype propapp) + (mapcar #'propapptype propapps)) + :desc (get (car propapp) 'desc) + :hostattrs (lambda (&rest args) + (apply #'propattrs (car propapp) args)) + :check (get (car propapp) 'check) + :apply (lambda (&rest args) + (unless (eq (propappapply (cons (car propapp) args)) + :no-change) + (dolist (propapp propapps) + (propappapply propapp)))) + :unapply (lambda (&rest args) + (unless (eq (propappunapply (cons (car propapp) args)) + :no-change) + (dolist (propapp (reverse propapps)) + (propappunapply propapp)))) + :args (cdr propapp))) -- cgit v1.2.3