3 (defaction edit-instance
((self mewa
))
4 (call-presentation (instance self
) :type
:editor
))
7 (defcomponent mewa-one-line-presentation
(mewa one-line-presentation
)
9 (:default-initargs
:attributes-getter
#'one-line-attributes-getter
))
11 (defmethod one-line-attributes-getter ((self mewa
))
12 (or (meta-model:list-keys
(instance self
))))
15 (defcomponent mewa-object-presentation
(mewa ucw
:object-presentation
)
16 ((ucw::instance
:accessor instance
:initarg
:instance
:initform nil
)))
18 (defcomponent two-column-presentation
(mewa-object-presentation) ())
20 (defmethod present ((pres two-column-presentation
))
22 (<:table
:class
(css-class pres
)
23 (loop for slot on
(slots pres
) by
#'cddr
25 (<:tr
:class
"presentation-slot-row"
26 (<:td
:class
"presentation-slot-label"
27 (<:as-html
(label (first slot
))))
28 (<:td
:class
"presentation-slot-value"
29 (present-slot (first slot
) (instance pres
)))
31 (<:td
:class
"presentation-slot-label"
32 (<:as-html
(label (second slot
))))
33 (<:td
:class
"presentation-slot-value"
34 (present-slot (second slot
) (instance pres
))))))
35 (render-options pres
(instance pres
))))
39 (defcomponent mewa-list-presentation
(mewa ucw
:list-presentation
)
40 ((ucw::instances
:accessor instances
:initarg
:instances
:initform nil
)
41 (instance :accessor instance
)
42 (select-label :accessor select-label
:initform
"select" :initarg
:select-label
)
43 (selectablep :accessor selectablep
:initform t
:initarg
:selectablep
)
44 (ucw::deleteablep
:accessor deletablep
:initarg
:deletablep
:initform nil
)
45 (viewablep :accessor viewablep
:initarg
:viewablep
:initform nil
)))
47 (defaction select-from-listing
((listing mewa-list-presentation
) object index
)
50 (defmethod render-list-row ((listing mewa-list-presentation
) object index
)
51 (<:tr
:class
"item-row"
52 (<:td
:align
"center" :valign
"top"
53 (when (ucw::editablep listing
)
54 (let ((object object
))
55 (<ucw
:input
:type
"submit"
56 :action
(edit-from-listing listing object index
)
57 :value
(ucw::edit-label listing
))))
59 (when (ucw::deleteablep listing
)
61 (<ucw
:input
:type
"submit"
62 :action
(delete-from-listing listing object index
)
63 :value
(ucw::delete-label listing
))))
64 (when (selectablep listing
)
66 (<ucw
:input
:type
"submit"
67 :action
(select-from-listing listing object index
)
68 :value
(select-label listing
))))
69 (when (viewablep listing
)
71 (<ucw
:input
:type
"submit"
72 :action
(call-component listing
(make-presentation object
))
74 (dolist (slot (slots listing
))
75 (<:td
:class
"data-cell" (present-slot slot object
)))
76 (<:td
:class
"index-number-cell")
79 (defmethod get-all-instances ((self mewa-list-presentation
))
84 (defgeneric search-expr
(criteria instance
)
85 (:documentation
"Return ready to apply criteria.
86 What to do with it is backend dependent."))
88 (defmacro def-search-expr
(((self criteria-type
)) (model-expr &body body
))
89 `(defmethod search-expr ((,self
,criteria-type
) instance
)
92 (ucw::slot-name
(ucw::presentation
,self
))
95 (defmethod search-expr ((self ucw
::negated-criteria
) instance
)
96 (when (ucw::criteria self
)
99 (search-expr (ucw::criteria self
) instance
))))
101 (def-search-expr ((self ucw
::string-starts-with
))
102 (meta-model:expr-starts-with
(ucw::search-text self
)))
104 (def-search-expr ((self ucw
::string-ends-with
))
105 (meta-model:expr-ends-with
(ucw::search-text self
)))
107 (def-search-expr ((self ucw
::string-contains
))
108 (meta-model:expr-contains
(ucw::search-text self
)))
110 (def-search-expr ((self ucw
::number-less-than
))
111 (meta-model:expr-
< (ucw::number-input self
)))
113 (def-search-expr ((self ucw
::number-greater-than
))
114 (meta-model:expr-
> (ucw::number-input self
)))
116 (def-search-expr ((self ucw
::number-equal-to
))
117 (meta-model:expr-
= (ucw::number-input self
)))
119 (defcomponent mewa-presentation-search
(ucw::presentation-search
)
120 ((display-results-p :accessor display-results-p
:initarg
:display-results-p
:initform nil
)))
122 (defmethod instance ((self mewa
:mewa-presentation-search
))
123 (instance (ucw::search-presentation self
)))
125 (defmethod search-expr ((self mewa
:mewa-presentation-search
) instance
)
126 (apply #'meta-model
:expr-and instance
127 (mapcan (lambda (c) (let ((e (search-expr c instance
)))
128 (if (listp e
) e
(list e
))))
129 (ucw::criteria self
))))
131 (defmethod search-query ((self mewa
:mewa-presentation-search
))
132 (search-expr self
(instance self
)))
134 (defmethod valid-instances ((self mewa
:mewa-presentation-search
))
135 (meta-model:select-instances
(instance self
) (search-query self
)))
137 (defmethod get-all-instances ((self mewa-presentation-search
))
138 (meta-model:select-instances
(instance self
)))
140 (defmethod ok ((self mewa-presentation-search
) &optional arg
)
141 (declare (ignore arg
))
142 (setf (ucw::instances
(ucw::list-presentation self
)) (valid-instances self
))
143 (setf (display-results-p self
) t
))
146 (defmethod render-on ((res response
) (self mewa-presentation-search
))
147 ;(<:as-html (search-query self))
148 (ucw::render-criteria res self
)
149 (<ucw
:input
:type
"submit" :value
"Search" :action
(ok self
))
150 (when (display-results-p self
)
151 (let ((listing (ucw::list-presentation self
)))
153 (slot-value listing
'ucw
::calling-component
) (slot-value self
'ucw
::calling-component
)
154 (slot-value listing
'ucw
::place
) (slot-value self
'ucw
::place
)
155 (slot-value listing
'ucw
::continuation
) (slot-value self
'ucw
::continuation
))
157 (render-on res listing
))))
160 (defcomponent dont-show-unset-slots
()())
162 (defmethod slots :around
((self dont-show-unset-slots
))
163 (remove-if-not #'(lambda (s) (let ((s (presentation-slot-value s
(instance self
))))
164 (and s
(not (equal "" s
)))))