HCoop
/
clinton
/
lisp-on-lines.git
/ commitdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
| commitdiff |
tree
raw
|
patch
|
inline
| side by side (parent:
799ee65
)
lots of great changes to update along with maxwell 0.8
author
Drew Crampsie
<drewc@tech.coop>
Wed, 20 Jul 2005 19:34:32 +0000
(12:34 -0700)
committer
Drew Crampsie
<drewc@tech.coop>
Wed, 20 Jul 2005 19:34:32 +0000
(12:34 -0700)
darcs-hash:
20050720193432
-5417e-
10b8c8256a2f4e14750db7583fd4b4f82f9a7bb5
.gz
src/mewa/mewa.lisp
patch
|
blob
|
blame
|
history
src/mewa/presentations.lisp
patch
|
blob
|
blame
|
history
src/mewa/slot-presentations.lisp
patch
|
blob
|
blame
|
history
src/packages.lisp
patch
|
blob
|
blame
|
history
diff --git
a/src/mewa/mewa.lisp
b/src/mewa/mewa.lisp
index
35faa16
..
f8dad21
100644
(file)
--- 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.
"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 n
ree
ame."
+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*))
(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))))
(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
(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))))
(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)
(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))
(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)))
(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
(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)
: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)))
(modifications :accessor modifications :initform nil)))
@@
-284,6
+280,14
@@
attributes is an alist keyed on the attribute nreeame."
i))
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)))
(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
(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))
(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)
(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))
)))
+ (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)
(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
(file)
--- 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)
((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))
(defaction select-from-listing ((listing mewa-list-presentation) object index)
(answer object))
@@
-62,7
+64,12
@@
(let ((index index))
(<ucw:input :type "submit"
:action (select-from-listing listing object index)
(let ((index index))
(<ucw:input :type "submit"
:action (select-from-listing listing object index)
- :value (select-label listing)))))
+ :value (select-label listing))))
+ (when (viewablep listing)
+ (let ((index index))
+ (<ucw:input :type "submit"
+ :action (call-component listing (make-presentation object))
+ :value "view"))))
(dolist (slot (slots listing))
(<:td :class "data-cell" (present-slot slot object)))
(<:td :class "index-number-cell")
(dolist (slot (slots listing))
(<:td :class "data-cell" (present-slot slot object)))
(<:td :class "index-number-cell")
diff --git
a/src/mewa/slot-presentations.lisp
b/src/mewa/slot-presentations.lisp
index
f501b71
..
db5de2e
100644
(file)
--- a/
src/mewa/slot-presentations.lisp
+++ b/
src/mewa/slot-presentations.lisp
@@
-170,7
+170,12
@@
When T, only the default value for primary keys and the joins are updated."))
(defaction add-to-has-many ((slot has-many-slot-presentation) instance)
(defaction add-to-has-many ((slot has-many-slot-presentation) instance)
+ ;; if the instance is not stored we must make sure to mark it stored now!
+ (unless (mewa::instance-is-stored-p instance)
+ (setf (mewa::modifiedp (parent self)) t))
+ ;; sync up the instance
(mewa:ensure-instance-sync (parent slot))
(mewa:ensure-instance-sync (parent slot))
+
(multiple-value-bindf (class home foreign)
(meta-model:explode-has-many instance (slot-name slot))
(let ((new (make-instance class)))
(multiple-value-bindf (class home foreign)
(meta-model:explode-has-many instance (slot-name slot))
(let ((new (make-instance class)))
diff --git
a/src/packages.lisp
b/src/packages.lisp
index
a3d323b
..
81c1223
100644
(file)
--- a/
src/packages.lisp
+++ b/
src/packages.lisp
@@
-8,6
+8,7
@@
:def-meta-model
:def-base-class
:%def-base-class
:def-meta-model
:def-base-class
:%def-base-class
+
:def-view-class/table
:def-view-class/meta
:view-class-metadata
:def-view-class/table
:def-view-class/meta
:view-class-metadata
@@
-75,8
+76,10
@@
(defpackage :lisp-on-lines
(:use :mewa :meta-model :common-lisp :it.bese.ucw)
(defpackage :lisp-on-lines
(:use :mewa :meta-model :common-lisp :it.bese.ucw)
+ (:nicknames :lol)
(:export
;;;; Mewa Exports
(:export
;;;; Mewa Exports
+ :mewa ;the superclass of all mewa-presentations
:make-presentation
;;attributes
:make-presentation
;;attributes
@@
-95,4
+98,5
@@
;;;; Meta Model Exports))
:def-view-class/table
:def-view-class/meta
;;;; Meta Model Exports))
:def-view-class/table
:def-view-class/meta
- :list-slot-types))
\ No newline at end of file
+ :list-slot-types
+ ))
\ No newline at end of file