+ definition)))
+
+(defmethod perform-set-attributes ((model t) definitions)
+ (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 perform-define-attributes ((model t) attributes)
+ (loop for attribute in attributes
+ do (destructuring-bind (name type &rest args)
+ attribute
+ (cond ((eq type t)
+ ;;use the existing (default) type
+ (set-attribute-properties model name args))
+ ((not (null type))
+ ;;set the type as well
+ (set-attribute model name (cons type args)))))))
+
+(defmacro define-attributes (models &body attribute-definitions)
+ `(progn
+ ,@(loop for model in models
+ collect `(perform-define-attributes (quote ,model) (quote ,attribute-definitions)))
+ (mapcar #'find-class-attributes (quote ,models ))))
+
+(defun find-presentation-attributes (model)
+ (remove nil (mapcar #'(lambda (att)
+ (when (keywordp (car att))
+ att))
+ (cdr (find-class-attributes model)))))
+
+
+;;;; ** Default Attributes
+
+
+;;;; The default mewa class contains the types use as defaults.
+;;;; maps meta-model slot-types to slot-presentation
+
+(defvar *default-attributes-class-name* 'default)
+
+(define-attributes (default)
+ (boolean mewa-boolean)
+ (string mewa-string)
+ (number mewa-currency)
+ (integer mewa-integer)
+ (currency mewa-currency)
+ (clsql:generalized-boolean mewa-boolean)
+ (foreign-key foreign-key)
+ (:viewer mewa-viewer)
+ (:editor mewa-editor)
+ (:creator mewa-creator)
+ (:one-line mewa-one-line-presentation)
+ (:listing mewa-list-presentation :global-properties (:editablep nil) :editablep t)
+ (:search-model mewa-object-presentation))
+
+
+(defun find-default-presentation-attributes ()
+ (if (eql *default-attributes-class-name* 'default)
+ (find-presentation-attributes 'default)
+ (remove-duplicates (append
+ (find-presentation-attributes 'default)
+ (find-presentation-attributes
+ *default-attributes-class-name*)))))
+
+
+(defmacro with-default-attributes ((model-name) &body body)
+ `(let ((*default-attributes-class-name* ',model-name))
+ ,@body))
+
+(defun gen-ptype (type)
+ (let ((type (if (consp type) (car type) type)))
+ (or (second (find-attribute *default-attributes-class-name* type))
+ (second (find-attribute 'default type))
+ type)))
+
+(defun gen-presentation-slots (instance)
+ (mapcar #'(lambda (x) (gen-pslot (cadr x)
+ (string (car x))
+ (car x)))
+ (meta-model:list-slot-types instance)))
+
+
+(defun gen-pslot (type label slot-name)
+ (copy-list `(,(gen-ptype type)
+ :label ,label
+ :slot-name ,slot-name)))
+
+(defun gen-presentation-args (instance args)
+ (declare (ignore instance))
+ (if args args nil))
+
+
+(defmethod find-default-attributes ((model t))
+ "return the default attributes for a given model using the meta-model's meta-data"
+ (append (mapcar #'(lambda (s)
+ (cons (car s)
+ (gen-pslot
+ (if (meta-model:foreign-key-p model (car s))
+ 'foreign-key
+ (cadr s))
+ (string (car s)) (car s))))
+ (meta-model:list-slot-types model))
+ (mapcar #'(lambda (s)
+ (cons s (append (gen-pslot 'has-many (string s) s)
+ `(:presentation
+ (make-presentation
+ ,model
+ :type :one-line)))))
+ (meta-model:list-has-many model))
+ (find-default-presentation-attributes)))
+
+(defmethod set-default-attributes ((model t))
+ "Set the default attributes for MODEL"
+ (clear-class-attributes model)
+ (mapcar #'(lambda (x)
+ (setf (find-attribute model (car x)) (cdr x)))
+ (find-default-attributes model)))