add ON-APPLY-CHANGE

Also see b24ff2c7365ee8d42063cbfa06ece3ef591d9a35.

Signed-off-by: Sean Whitton <spwhitton@spwhitton.name>

1 files changed, 16 insertions, 6 deletions

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)