From 95cbccc32f051902645c78b0751e85ee3f447b03 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Thu, 8 Jul 2021 23:38:50 -0700 Subject: add ON-APPLY-CHANGE Also see b24ff2c7365ee8d42063cbfa06ece3ef591d9a35. Signed-off-by: Sean Whitton --- src/combinator.lisp | 22 ++++++++++++++++------ 1 file changed, 16 insertions(+), 6 deletions(-) (limited to 'src/combinator.lisp') diff --git a/src/combinator.lisp b/src/combinator.lisp index 9500d4e..a4274ee 100644 --- a/src/combinator.lisp +++ b/src/combinator.lisp @@ -227,13 +227,22 @@ apply the elements of REQUIREMENTS in reverse order." (propappunapply propapp)))) (defmacro on-change (propapp &body on-change) - "If applying PROPAPP makes a change, also apply each of of the propapps -ON-CHANGE in order." + "If applying or unapplying PROPAPP makes a change, also apply each of the +propapps ON-CHANGE in order." + `(on-change* + ,propapp + ,(if (cdr on-change) `(eseqprops ,@on-change) (car on-change)) + t)) + +(defmacro on-apply-change (propapp &body on-change) + "If applying PROPAPP makes a change, also apply each of the propapps ON-CHANGE +in order." `(on-change* ,propapp ,(if (cdr on-change) `(eseqprops ,@on-change) (car on-change)))) -(define-function-property-combinator on-change* (propapp on-change) +(define-function-property-combinator on-change* + (propapp on-change &optional unapply) (let ((prop (car propapp))) (:retprop :type (collapse-types (propapptype propapp) (propapptype on-change)) @@ -246,9 +255,10 @@ ON-CHANGE in order." :no-change (propappapply on-change))) :unapply (lambda (&rest args) - (if (eql :no-change (apply #'propunapply prop args)) - :no-change - (propappapply on-change))) + (let ((result (apply #'propunapply prop args))) + (cond ((eql :no-change result) :no-change) + (unapply (propappapply on-change)) + (t result)))) :args (cdr propapp)))) (defmacro as (user &body properties) -- cgit v1.2.3