Added a SET-ATTRIBUTE-PROPERTIES and PERFORM-SET-ATTRIBUTE-PROPERTIES which are just...
authorDrew Crampsie <drewc@tech.coop>
Thu, 7 Jul 2005 02:46:11 +0000 (19:46 -0700)
committerDrew Crampsie <drewc@tech.coop>
Thu, 7 Jul 2005 02:46:11 +0000 (19:46 -0700)
darcs-hash:20050707024611-5417e-06a0893235d64b9d5ffaffef739380d5a9a5b044.gz

src/mewa/mewa.lisp

index 70cce96..80795c8 100644 (file)
@@ -97,6 +97,21 @@ attributes is an alist keyed on the attribute nreeame."
   (dolist (def definitions)
     (funcall #'set-attribute model (first def) (rest def))))
 
   (dolist (def definitions)
     (funcall #'set-attribute model (first def) (rest def))))
 
+
+(defmethod set-attribute-properties ((model t) attribute properties)
+  (let ((a (find-attribute model attribute)))
+    (if a
+       (setf (cddr a) (plist-nunion properties (cddr a)))
+       (error "Attribute ~A does not exist" attribute) )))
+
+(defmethod perform-set-attribute-properties ((model t) definitions)
+  (dolist (def definitions)
+    (funcall #'set-attribute-properties model (car def) (cdr def))))
+  
+
+
+
+
 (defmethod default-attributes ((model t))
   "return the default attributes for a given model using the meta-model's meta-data"
   (append (mapcar #'(lambda (s) 
 (defmethod default-attributes ((model t))
   "return the default attributes for a given model using the meta-model's meta-data"
   (append (mapcar #'(lambda (s)