- (let ((a (find-attribute occurence-name attribute)))
- (if a
- (setf (attribute.plist a) (plist-nunion properties (attribute.plist a)))
- (error "Attribute ~A does not exist" attribute))))
+ (setf (description.properties attribute) (plist-nunion
+ properties
+ (description.properties attribute)))
+ (loop for (initarg value) on (description.properties attribute)
+ by #'cddr
+ with map = (initargs.slot-names attribute)
+ do (let ((s-n (assoc-if #'(lambda (x) (member initarg x)) map)))
+
+ (if s-n
+ (progn
+ (setf (slot-value attribute
+ (cdr s-n))
+ value))
+ (warn "Cannot find initarg ~A in attribute ~S" initarg attribute)))
+ finally (return attribute)))
+
+(defmethod set-attribute (occurence-name attribute-name attribute-spec &key (inherit t))
+ "If inherit is T, sets the properties of the attribute only, unless the type has changed.
+otherwise, (setf find-attribute)"
+ (let ((att (find-attribute occurence-name attribute-name)))
+ (if (and att inherit (or (eql (car attribute-spec)
+ (description.type att))
+ (eq (car attribute-spec) t)))
+ (set-attribute-properties occurence-name att (cdr attribute-spec))
+ (setf (find-attribute occurence-name attribute-name)
+ (cons (car attribute-spec)
+ (plist-nunion
+ (cdr attribute-spec)
+ (when att (description.properties att))))))))