From d99a0b910ac28733dc719fb50d95c332fb56a336 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Thu, 8 Jul 2021 23:35:33 -0700 Subject: ON-CHANGE*: factor out (CAR PROPAPP) Signed-off-by: Sean Whitton --- src/combinator.lisp | 29 ++++++++++++++--------------- 1 file changed, 14 insertions(+), 15 deletions(-) (limited to 'src/combinator.lisp') diff --git a/src/combinator.lisp b/src/combinator.lisp index ffd2828..9500d4e 100644 --- a/src/combinator.lisp +++ b/src/combinator.lisp @@ -234,23 +234,22 @@ ON-CHANGE in order." ,(if (cdr on-change) `(eseqprops ,@on-change) (car on-change)))) (define-function-property-combinator on-change* (propapp on-change) - (:retprop :type - (collapse-types (propapptype propapp) (propapptype on-change)) - :desc (get (car propapp) 'desc) - :hostattrs (lambda (&rest args) - (apply #'propattrs (car propapp) args) - (propappattrs on-change)) - :apply (lambda (&rest args) - (if (eql :no-change - (propappapply (cons (car propapp) args))) - :no-change - (propappapply on-change))) - :unapply (lambda (&rest args) - (if (eql :no-change - (propappunapply (cons (car propapp) args))) + (let ((prop (car propapp))) + (:retprop :type + (collapse-types (propapptype propapp) (propapptype on-change)) + :desc (get prop 'desc) + :hostattrs (lambda (&rest args) + (apply #'propattrs prop args) + (propappattrs on-change)) + :apply (lambda (&rest args) + (if (eql :no-change (apply #'propapply prop args)) :no-change (propappapply on-change))) - :args (cdr propapp))) + :unapply (lambda (&rest args) + (if (eql :no-change (apply #'propunapply prop args)) + :no-change + (propappapply on-change))) + :args (cdr propapp)))) (defmacro as (user &body properties) "Apply PROPERTIES as USER by reconnecting with the :AS connection type. -- cgit v1.2.3