From ae09804af7bb83aca901663108c8b05d5cfa3e3a Mon Sep 17 00:00:00 2001 From: drewc Date: Thu, 16 Jun 2005 21:01:12 -0700 Subject: [PATCH] added modified checking and saving instances to the base mewa package darcs-hash:20050617040112-39164-6de366345e07d05665a87d3ae83986f090300539.gz --- src/mewa/mewa.lisp | 42 ++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 40 insertions(+), 2 deletions(-) diff --git a/src/mewa/mewa.lisp b/src/mewa/mewa.lisp index ce7ffb3..a264756 100644 --- a/src/mewa/mewa.lisp +++ b/src/mewa/mewa.lisp @@ -215,7 +215,6 @@ attributes is an alist keyed on the attribute nreeame." (setf (slots self) (find-slot-presentations self))) - (defmethod make-presentation ((object t) &key (type :viewer) (initargs nil)) (let* ((p (make-instance 'mewa-object-presentation)) (a (progn (setf (slot-value p 'instance) object) @@ -259,4 +258,43 @@ attributes is an alist keyed on the attribute nreeame." (slots to)))) (defmacro call-presentation (object &rest args) - `(present-object ,object :presentation (make-presentation ,object ,@args))) \ No newline at end of file + `(present-object ,object :presentation (make-presentation ,object ,@args))) + + + +(defaction cancel-save-instance ((self mewa)) + (answer nil)) + +(defaction save-instance ((self mewa)) + (meta-modqel:sync-instance (instance self)) + (setf (modifiedp self) nil) + (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)) + (when (modifiedp self) + (let ((message (format nil "Record has been modified, Do you wish to save the changes?
~a" (print (modifications self))))) + (case (call 'option-dialog + :message message + :options '((:save . "Save changes to Database") + (:cancel . "Cancel all changes"))) + (:cancel + (cancel-save-instance self)) + (:save + (save-instance 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 (type-of new) (type-of old) (type-of value) slot instance ))))))) \ No newline at end of file -- 2.20.1