From 8e6e6b5651e88009c62f5502b4fabdf2919e0b4f Mon Sep 17 00:00:00 2001 From: Drew Crampsie Date: Wed, 20 Jul 2005 12:34:32 -0700 Subject: [PATCH 1/1] lots of great changes to update along with maxwell 0.8 darcs-hash:20050720193432-5417e-10b8c8256a2f4e14750db7583fd4b4f82f9a7bb5.gz --- src/mewa/mewa.lisp | 30 +++++++++++++++++++----------- src/mewa/presentations.lisp | 11 +++++++++-- src/mewa/slot-presentations.lisp | 5 +++++ src/packages.lisp | 6 +++++- 4 files changed, 38 insertions(+), 14 deletions(-) diff --git a/src/mewa/mewa.lisp b/src/mewa/mewa.lisp index 35faa16..f8dad21 100644 --- a/src/mewa/mewa.lisp +++ b/src/mewa/mewa.lisp @@ -51,7 +51,7 @@ "return an exisiting class attribute map or create one. A map is a cons of class-name . attributes. -attributes is an alist keyed on the attribute nreeame." +attributes is an alist keyed on the attribute name." (or (assoc class-name *attribute-map*) (progn (setf *attribute-map* (acons class-name (list (list)) *attribute-map*)) @@ -97,7 +97,6 @@ attributes is an alist keyed on the attribute nreeame." (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 @@ -109,9 +108,6 @@ attributes is an alist keyed on the attribute nreeame." (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) @@ -131,6 +127,7 @@ attributes is an alist keyed on the attribute nreeame." (meta-model:list-has-many model)))) (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))) @@ -143,7 +140,6 @@ attributes is an alist keyed on the attribute nreeame." - (defcomponent mewa () ((attributes :initarg :attributes @@ -166,7 +162,7 @@ attributes is an alist keyed on the attribute nreeame." :accessor use-instance-class-p :initform t) (initializedp :initform nil) - (modifiedp :accessor modifiedp :initform nil) + (modifiedp :accessor modifiedp :initform nil :initarg :modifiedp) (modifications :accessor modifications :initform nil))) @@ -284,6 +280,14 @@ attributes is an alist keyed on the attribute nreeame." i)) +(defmethod initialize-slots-place ((place ucw::place) (mewa mewa)) + (setf (slots mewa) (mapcar #'(lambda (x) + (prog1 x + (setf (component.place x) place))) + (slots mewa)))) + + + @@ -307,22 +311,26 @@ attributes is an alist keyed on the attribute nreeame." (call-next-method) (render-on res (slot-value self 'body))) + +(defmethod instance-is-stored-p ((instance clsql:standard-db-object)) + (slot-value instance 'clsql-sys::view-database)) + (defaction cancel-save-instance ((self mewa)) (cond - ((slot-value (instance self) 'clsql-sys::view-database) + ((instance-is-stored-p (instance self)) (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)) + (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?
~a" (print (modifications self))))) + (let ((message (format nil "Record has been modified, Do you wish to save the changes?"))) (case (call 'about-dialog :body (make-presentation (instance self) :type :viewer) diff --git a/src/mewa/presentations.lisp b/src/mewa/presentations.lisp index 230ead5..53942b1 100644 --- a/src/mewa/presentations.lisp +++ b/src/mewa/presentations.lisp @@ -39,7 +39,9 @@ ((ucw::instances :accessor instances :initarg :instances :initform nil) (instance :accessor instance) (select-label :accessor select-label :initform "select" :initarg :select-label) - (selectablep :accessor selectablep :initform t :initarg :selectablep))) + (selectablep :accessor selectablep :initform t :initarg :selectablep) + (ucw::deleteablep :accessor deletablep :initarg :deletablep :initform nil) + (viewablep :accessor viewablep :initarg :viewablep :initform nil))) (defaction select-from-listing ((listing mewa-list-presentation) object index) (answer object)) @@ -62,7 +64,12 @@ (let ((index index)) (