From: Drew Crampsie <drewc@tech.coop>
Date: Thu, 7 Jul 2005 02:46:11 +0000 (-0700)
Subject: Added a SET-ATTRIBUTE-PROPERTIES and PERFORM-SET-ATTRIBUTE-PROPERTIES which are just... 
X-Git-Url: https://git.hcoop.net/clinton/lisp-on-lines.git/commitdiff_plain/34e8e2d693c74ced15c3341b0dc36058a14f75c9?hp=46cea8c8b169e593c5ce68dfcfcbb68b7c637444

Added a SET-ATTRIBUTE-PROPERTIES and PERFORM-SET-ATTRIBUTE-PROPERTIES which are just like SET-ATTRIBUTE and PERFORM-S-A only it sets the properties without changing the type

darcs-hash:20050707024611-5417e-06a0893235d64b9d5ffaffef739380d5a9a5b044.gz
---

diff --git a/src/mewa/mewa.lisp b/src/mewa/mewa.lisp
index 70cce96..80795c8 100644
--- a/src/mewa/mewa.lisp
+++ b/src/mewa/mewa.lisp
@@ -97,6 +97,21 @@ attributes is an alist keyed on the attribute nreeame."
   (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)