1 (in-package :it.bese.ucw
)
3 (defslot-presentation clsql-wall-time-slot-presentation
()
5 (:type-name clsql-sys
:wall-time
))
7 (defmethod present-slot ((slot clsql-wall-time-slot-presentation
) instance
)
8 (<:as-html
(presentation-slot-value slot instance
)))
10 (defslot-presentation mewa-relation-slot-presentation
()
11 ((slot-name :accessor slot-name
:initarg
:slot-name
)
12 (foreign-instance :accessor foreign-instance
)
13 (editablep :initarg
:editablep
:accessor editablep
:initform
:inherit
))
14 (:type-name relation
))
16 (defmethod present-relation (( slot mewa-relation-slot-presentation
) instance
)
17 (when (foreign-instance slot
)
18 (when (eql (editablep slot
) :inherit
)
19 (setf (editablep slot
) (editablep (parent slot
))))
20 (flet ((render-slot ()
21 (<ucw
:render-component
22 :component
(mewa::make-presentation
(foreign-instance slot
) :type
:one-line
:initargs
'(:global-properties
(:editablep nil
))))))
25 (<ucw
:a
:action
(view-instance slot instance
)
28 (defmethod present-slot ((slot mewa-relation-slot-presentation
) instance
)
29 (setf (foreign-instance slot
) (meta-model:explode-foreign-key instance
(slot-name slot
)))
30 (present-relation slot instance
))
32 (defslot-presentation foreign-key-slot-presentation
(mewa-relation-slot-presentation)
34 (:type-name foreign-key
)
35 (:default-initargs
:editablep
:inherit
))
37 (defaction view-instance
((self component
) instance
&rest initargs
)
38 (call-component (parent self
) (apply #'mewa
:make-presentation
(foreign-instance self
) initargs
)))
40 (defmethod present-slot :before
((slot foreign-key-slot-presentation
) instance
)
41 (setf (foreign-instance slot
) (meta-model:explode-foreign-key instance
(slot-name slot
))))
44 (defslot-presentation has-many-slot-presentation
(mewa-relation-slot-presentation)
46 (:type-name has-many
))
48 (defmethod present-slot ((slot has-many-slot-presentation
) instance
)
50 (dolist (s (slot-value instance
(slot-name slot
)))
51 (setf (foreign-instance slot
) s
)
52 (<:li
(present-relation slot instance
)))))
56 (defslot-presentation has-a-slot-presentation
(one-of-presentation)
57 ((key :initarg
:key
:accessor key
))
60 (defmethod get-foreign-slot-value ((slot has-a-slot-presentation
) (object t
) (slot-name t
))
61 (slot-value object slot-name
))
63 (defmethod present-slot ((slot has-a-slot-presentation
) instance
)
64 (<:as-html
(presentation-slot-value slot instance
))
66 (<ucw
:select
:accessor
(presentation-slot-value slot instance
) :test
#'equalp
67 (when (allow-nil-p slot
)
68 (<ucw
:option
:value nil
(<:as-html
(none-label slot
))))
69 (dolist (option (get-foreign-instances (presentation slot
) instance
))
70 (setf (instance (presentation slot
)) option
)
71 (<ucw
:option
:value
(get-foreign-slot-value slot option
(key slot
)) (present (presentation slot
)))))
72 (if (presentation-slot-value slot instance
)
74 (setf (instance (presentation slot
)) (presentation-slot-value slot instance
))
75 (present (presentation slot
)))