From e8e743d7170e308377c728ab1ce41b752317b1ec Mon Sep 17 00:00:00 2001 From: drewc Date: Thu, 30 Jun 2005 02:39:09 -0700 Subject: [PATCH] added perform-set-attribute and a few other fixes to this builds again. darcs-hash:20050630093909-39164-011982c5a8283c8108b063bffa1ef214c0d07342.gz --- src/meta-model.lisp | 5 +++-- src/mewa/mewa.lisp | 17 +++++++++++------ src/packages.lisp | 3 ++- 3 files changed, 16 insertions(+), 9 deletions(-) diff --git a/src/meta-model.lisp b/src/meta-model.lisp index 58b3fd4..dead63e 100644 --- a/src/meta-model.lisp +++ b/src/meta-model.lisp @@ -52,8 +52,9 @@ (defmacro def-base-class (name (model) &rest args) (let ((i (make-instance model))) - `(prog1 - (eval ,(def-base-class-expander i name args)) + `(progn + (eval-when (:compile-toplevel :load-toplevel :execute) + ,(def-base-class-expander i :clsql name args)) (defmethod meta-model.metadata ((m ,name)) ',(meta-model.metadata i))))) diff --git a/src/mewa/mewa.lisp b/src/mewa/mewa.lisp index 16a08e5..e440551 100644 --- a/src/mewa/mewa.lisp +++ b/src/mewa/mewa.lisp @@ -90,6 +90,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" @@ -290,12 +293,6 @@ 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?
~a" (print (modifications self))))) @@ -308,6 +305,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) diff --git a/src/packages.lisp b/src/packages.lisp index 0fd0c87..839feba 100644 --- a/src/packages.lisp +++ b/src/packages.lisp @@ -58,7 +58,8 @@ :make-presentation :call-presentation :label - :set-attribute + :set-attribute + :perform-set-attributes :find-class-attributes :default-attributes :ok -- 2.20.1