From 986439442b08b59bb4c44c94fa9f10e12705de66 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Mon, 1 Mar 2021 11:15:04 -0700 Subject: add :PREPROCESS property subroutines Signed-off-by: Sean Whitton --- src/propspec.lisp | 20 ++++++++++++++++++-- 1 file changed, 18 insertions(+), 2 deletions(-) (limited to 'src/propspec.lisp') diff --git a/src/propspec.lisp b/src/propspec.lisp index 262c147..f63958c 100644 --- a/src/propspec.lisp +++ b/src/propspec.lisp @@ -81,6 +81,21 @@ systems, resolve unapply, onchange etc., and then look in the value cell of each PROPERTY to find a property, and pass each of ARGS to the function in the property's apply slot.")) +(defun make-propspec (&key (systems nil systems-supplied-p) props) + (setq props (copy-tree props)) + (labels ((preprocess (item) + (cond + ((and (listp item) (isprop (car item))) + (rplacd item (apply (proppp (car item)) (cdr item)))) + ((consp item) + (mapc #'preprocess item))))) + (preprocess props)) + (if systems-supplied-p + (make-instance 'propspec :props props :systems systems) + (make-instance 'propspec :props props))) + +;; does not use MAKE-PROPSPEC because we do not want the :PREPROCESS +;; subroutines to be run again when the object is read back in (defmethod print-object ((propspec propspec) stream) (format stream "~S" `(make-instance 'propspec @@ -193,11 +208,12 @@ specification." :test #'string=))) `(list ',first ,@rest) `(list ,@(mapcar #'make-eval-propspec form))))))) - `(make-instance - 'propspec + `(make-propspec ,@(and systems-supplied-p `(:systems ,systems)) :props (list ,@(mapcar #'make-eval-propspec forms))))) +;; doesn't use MAKE-PROPSPEC because each of the propspecs will already have +;; had its :PREPROCESS subroutines run (defmethod append-propspecs ((first propspec) (second propspec)) (make-instance 'propspec :props (append (slot-value first 'applications) -- cgit v1.2.3