added a clear-class-attributes method, and added it to set-default-attributes so...
[clinton/lisp-on-lines.git] / src / mewa / mewa.lisp
index 16a08e5..70cce96 100644 (file)
@@ -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 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)))))
@@ -90,6 +93,9 @@ attributes is an alist keyed on the attribute nreeame."
                         (cddr (find-attribute model name))))
            definition)))
 
+(defmethod perform-set-attributes ((model t) definitions)
+  (dolist (def definitions)
+    (funcall #'set-attribute model (first def) (rest def))))
 
 (defmethod default-attributes ((model t))
   "return the default attributes for a given model using the meta-model's meta-data"
@@ -110,6 +116,7 @@ attributes is an alist keyed on the attribute nreeame."
                  (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)))
@@ -277,6 +284,14 @@ attributes is an alist keyed on the attribute nreeame."
 (defmacro call-presentation (object &rest args)
   `(present-object ,object :presentation (make-presentation ,object ,@args)))
 
+
+(defcomponent about-dialog (option-dialog)
+  ((body :initarg :body)))
+
+(defmethod render-on ((res response) (self about-dialog))
+  (render-on res (slot-value self 'body))
+  (call-next-method))
+
 (defaction cancel-save-instance ((self mewa))
   (cond  
     ((slot-value (instance self) 'clsql-sys::view-database)
@@ -290,16 +305,12 @@ attributes is an alist keyed on the attribute nreeame."
        (answer self))
 
 
-(defaction ok ((self mewa) &optional arg)
-  "Returns the component if it has not been modified. if it has been, prompt user to save or cancel"
-  (declare (ignore arg))
-  (ensure-instance-sync self)
-  (answer self))
-
 (defaction ensure-instance-sync ((self mewa))
   (when (modifiedp self)
     (let ((message (format nil "Record has been modified, Do you wish to save the changes?<br/> ~a" (print (modifications self)))))
-      (case (call 'option-dialog 
+      (case (call 'about-dialog
+                  :body (make-presentation (instance self) 
+                                          :type :viewer)
                  :message message
                  :options '((:save . "Save changes to Database")
                             (:cancel . "Cancel all changes")))
@@ -308,6 +319,14 @@ attributes is an alist keyed on the attribute nreeame."
        (:save 
         (save-instance self))))))
 
+(defaction ok ((self mewa) &optional arg)
+  "Returns the component if it has not been modified. if it has been, prompt user to save or cancel"
+  (declare (ignore arg))
+  (ensure-instance-sync self)
+  (answer self))
+
+
+
 
 
 (defmethod (setf presentation-slot-value) :around (value (slot slot-presentation) instance)
@@ -319,7 +338,7 @@ attributes is an alist keyed on the attribute nreeame."
   (unless (equal new old )
     (let ((self (ucw::parent slot)))
       (setf (modifiedp self) instance
-           (modifications self)  (append (list  (type-of new) (type-of old) (type-of value) slot instance )))))))
+           (modifications self)  (append (list new old value slot instance) (modifications self)))))))
 
 
 ;; This software is Copyright (c) Drew Crampsie, 2004-2005.