diff options
author | Sean Whitton <spwhitton@spwhitton.name> | 2021-07-08 23:35:33 -0700 |
---|---|---|
committer | Sean Whitton <spwhitton@spwhitton.name> | 2021-07-10 21:31:38 -0700 |
commit | d99a0b910ac28733dc719fb50d95c332fb56a336 (patch) | |
tree | 871eaf5c4a3f7438ea04d982d8b882f1fa31a011 /src/combinator.lisp | |
parent | 281abdd3c1768bf75d5c23b52ad77c67052750fa (diff) | |
download | consfigurator-d99a0b910ac28733dc719fb50d95c332fb56a336.tar.gz |
ON-CHANGE*: factor out (CAR PROPAPP)
Signed-off-by: Sean Whitton <spwhitton@spwhitton.name>
Diffstat (limited to 'src/combinator.lisp')
-rw-r--r-- | src/combinator.lisp | 29 |
1 files changed, 14 insertions, 15 deletions
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. |