added the default presentation attributes to class T

[clinton/lisp-on-lines.git] / src / mewa / mewa.lisp

diff --git a/src/mewa/mewa.lisp b/src/mewa/mewa.lisp
index 54ab29d..35faa16 100644 (file)
--- a/src/mewa/mewa.lisp
+++ b/src/mewa/mewa.lisp
@@ -65,6 +65,9 @@ attributes is an alist keyed on the attribute nreeame."
 (defmethod find-class-attributes ((model symbol))
   (find-or-create-attributes model))
 
 (defmethod find-class-attributes ((model symbol))
   (find-or-create-attributes model))
 

+(defmethod clear-class-attributes ((model t))
+  (setf (cdr (find-class-attributes model)) nil))
+

 (defmethod add-attribute ((model t) name def)
   (let ((map (find-class-attributes model)))
     (setf (cdr map) (acons name def (cdr map)))))
 (defmethod add-attribute ((model t) name def)
   (let ((map (find-class-attributes model)))
     (setf (cdr map) (acons name def (cdr map)))))


@@ -94,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) 


@@ -113,6 +131,7 @@ attributes is an alist keyed on the attribute nreeame."
                  (meta-model:list-has-many model))))
 
 (defmethod set-default-attributes ((model t))
                  (meta-model:list-has-many model))))
 
 (defmethod set-default-attributes ((model t))

+  (clear-class-attributes model)

   (mapcar #'(lambda (x) 
              (setf (find-attribute model (car x)) (cdr x)))
          (default-attributes model)))
   (mapcar #'(lambda (x) 
              (setf (find-attribute model (car x)) (cdr x)))
          (default-attributes model)))


@@ -222,7 +241,7 @@ attributes is an alist keyed on the attribute nreeame."
              (let ((class-name (or (gethash (second s) ucw::*slot-type-mapping*) 'mewa-object-presentation)))
              (apply #'make-instance 
                     class-name
              (let ((class-name (or (gethash (second s) ucw::*slot-type-mapping*) 'mewa-object-presentation)))
              (apply #'make-instance 
                     class-name

-                    (append (cddr s) (list :parent self)))))
+                    (append (cddr s) (list :parent self :size 30)))))

          (find-applicable-attributes self)))
 
 
          (find-applicable-attributes self)))
 
 


@@ -285,8 +304,8 @@ attributes is an alist keyed on the attribute nreeame."
   ((body :initarg :body)))
 
 (defmethod render-on ((res response) (self about-dialog))
   ((body :initarg :body)))
 
 (defmethod render-on ((res response) (self about-dialog))

-  (render-on res (slot-value self 'body))
-  (call-next-method))
+  (call-next-method)
+  (render-on res (slot-value self 'body)))

 
 (defaction cancel-save-instance ((self mewa))
   (cond  
 
 (defaction cancel-save-instance ((self mewa))
   (cond  


@@ -321,10 +340,6 @@ attributes is an alist keyed on the attribute nreeame."
   (ensure-instance-sync self)
   (answer self))
 
   (ensure-instance-sync self)
   (answer self))
 

-
-
-
-

 (defmethod (setf presentation-slot-value) :around (value (slot slot-presentation) instance)
   (let* ((old (prog1 
                 (presentation-slot-value slot instance)
 (defmethod (setf presentation-slot-value) :around (value (slot slot-presentation) instance)
   (let* ((old (prog1 
                 (presentation-slot-value slot instance)


@@ -336,6 +351,22 @@ attributes is an alist keyed on the attribute nreeame."
       (setf (modifiedp self) instance
            (modifications self)  (append (list new old value slot instance) (modifications self)))))))
 
       (setf (modifiedp self) instance
            (modifications self)  (append (list new old value slot instance) (modifications self)))))))
 

+;;;; * Finally set up some defaults
+
+(setf (find-attribute t :viewer) 
+      '(mewa-object-presentation :global-properties (:editablep nil))
+      (find-attribute t :editor)
+      '(mewa-object-presentation :global-properties (:editablep t))
+      (find-attribute t :one-line)
+      '(mewa::mewa-one-line-presentation)
+      (find-attribute t :listing)
+      '(mewa::mewa-list-presentation :global-properties (:editablep nil) :editablep t)
+      (find-attribute t :search-presentation)
+      '(mewa-object-presentation))
+
+
+
+

 
 ;; This software is Copyright (c) Drew Crampsie, 2004-2005.
 ;; You are granted the rights to distribute
 
 ;; This software is Copyright (c) Drew Crampsie, 2004-2005.
 ;; You are granted the rights to distribute