From 1b6a8a54da3941fb22ade17836c7ab1608422450 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Fri, 19 Mar 2021 18:48:12 -0700 Subject: implement unapplying SEQPROPS, ESEQPROPS, SILENT-SEQPROPS Signed-off-by: Sean Whitton --- src/propspec.lisp | 22 +++++++++++++++------- 1 file changed, 15 insertions(+), 7 deletions(-) (limited to 'src/propspec.lisp') diff --git a/src/propspec.lisp b/src/propspec.lisp index 5979187..db8f81e 100644 --- a/src/propspec.lisp +++ b/src/propspec.lisp @@ -287,14 +287,18 @@ expression." (define-function-property-combinator eseqprops (&rest propapps) (:retprop :type (collapse-types (mapcar #'propapptype propapps)) :hostattrs (lambda () (mapc #'propappattrs propapps)) - :apply (lambda () (apply-and-print propapps)))) + :apply (lambda () (apply-and-print propapps)) + :unapply (lambda () (apply-and-print propapps t)))) (define-function-property-combinator seqprops (&rest propapps) (:retprop :type (collapse-types (mapcar #'propapptype propapps)) :hostattrs (lambda () (mapc #'propappattrs propapps)) :apply (lambda () (with-skip-failed-changes - (apply-and-print propapps))))) + (apply-and-print propapps))) + :unapply (lambda () + (with-skip-failed-changes + (apply-and-print propapps t))))) (defmacro with-requirements (propapp &body requirements) "Apply PROPAPP only after applying each dependency in REQUIREMENTS. @@ -307,20 +311,24 @@ apply the elements of REQUIREMENTS in reverse order." :hostattrs (lambda () (mapc #'propappattrs propapps)) :apply (lambda () (with-skip-failed-changes - (mapc #'propappapply propapps))))) + (mapc #'propappapply propapps))) + :unapply (lambda () + (with-skip-failed-changes + (mapc #'propappunapply (reverse propapps)))))) ;; note that the :FAILED-CHANGE value is only used within this function and ;; should not be returned by property subroutines, per the spec -(defun apply-and-print (propapps) - (dolist (propapp propapps) - (let* ((result (restart-case (propappapply propapp) +(defun apply-and-print (propapps &optional unapply) + (dolist (pa (if unapply (reverse propapps) propapps)) + (let* ((result (restart-case + (if unapply (propappunapply pa) (propappapply pa)) (skip-property () :failed-change))) (status (case result (:no-change "ok") (:failed-change "failed") (t "done")))) (format t "~@[~A :: ~]~@[~A ... ~]~A~%" - (get-hostname) (propappdesc propapp) status)))) + (get-hostname) (propappdesc pa) status)))) (define-function-property-combinator unapply (propapp) (destructuring-bind (psym . args) propapp -- cgit v1.2.3