+ `(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)
+ (meta-model::update-instance-from-records (instance self))
+ (answer self))
+ (t (answer nil))))
+
+(defaction save-instance ((self mewa))
+ (meta-model:sync-instance (instance self))
+ (setf (modifiedp self) nil)
+ (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 'about-dialog
+ :body (make-presentation (instance self)
+ :type :viewer)
+ :message message
+ :options '((:save . "Save changes to Database")
+ (:cancel . "Cancel all changes")))
+ (:cancel
+ (cancel-save-instance self))
+ (: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)
+ (let* ((old (prog1
+ (presentation-slot-value slot instance)
+ (call-next-method)))
+ (new (presentation-slot-value slot instance)))
+
+ (unless (equal new old )
+ (let ((self (ucw::parent slot)))
+ (setf (modifiedp self) instance
+ (modifications self) (append (list new old value slot instance) (modifications self)))))))
+
+
+;; This software is Copyright (c) Drew Crampsie, 2004-2005.
+;; You are granted the rights to distribute
+;; and use this software as governed by the terms
+;; of the Lisp Lesser GNU Public License
+;; (http://opensource.franz.com/preamble.html),
+;; known as the LLGPL.