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 (defmethod present ((pres mewa-object-presentation
))
19 (<:table
:class
(css-class pres
)
20 (dolist (slot (slots pres
))
21 (<:tr
:class
"presentation-slot-row"
22 (present-slot-as-row pres slot
))))
23 (render-options pres
(instance pres
)))
25 (defmethod present-slot-as-row ((pres mewa-object-presentation
) (slot ucw
::slot-presentation
))
26 (<:td
:class
"presentation-slot-label" (<:as-html
(label slot
)))
27 (<:td
:class
"presentation-slot-value" (present-slot slot
(instance pres
))))
30 (defcomponent two-column-presentation
(mewa-object-presentation) ())
32 (defmethod present ((pres two-column-presentation
))
34 (<:table
:class
(css-class pres
)
35 (loop for slot on
(slots pres
) by
#'cddr
37 (<:tr
:class
"presentation-slot-row"
38 (<:td
:class
"presentation-slot-label"
39 (<:as-html
(label (first slot
))))
40 (<:td
:class
"presentation-slot-value"
41 (present-slot (first slot
) (instance pres
)))
43 (<:td
:class
"presentation-slot-label"
44 (<:as-html
(label (second slot
))))
45 (<:td
:class
"presentation-slot-value"
46 (present-slot (second slot
) (instance pres
))))))
47 (render-options pres
(instance pres
))))
51 (defcomponent mewa-list-presentation
(mewa ucw
:list-presentation
)
52 ((ucw::instances
:accessor instances
:initarg
:instances
:initform nil
)
53 (instance :accessor instance
)
54 (select-label :accessor select-label
:initform
"select" :initarg
:select-label
)
55 (selectablep :accessor selectablep
:initform t
:initarg
:selectablep
)
56 (ucw::deleteablep
:accessor deletablep
:initarg
:deletablep
:initform nil
)
57 (viewablep :accessor viewablep
:initarg
:viewablep
:initform nil
)))
59 (defaction select-from-listing
((listing mewa-list-presentation
) object index
)
62 (defmethod render-list-row ((listing mewa-list-presentation
) object index
)
63 (<:tr
:class
"item-row"
64 (<:td
:align
"center" :valign
"top"
65 (when (ucw::editablep listing
)
66 (let ((object object
))
67 (<ucw
:input
:type
"submit"
68 :action
(edit-from-listing listing object index
)
69 :value
(ucw::edit-label listing
))))
71 (when (ucw::deleteablep listing
)
73 (<ucw
:input
:type
"submit"
74 :action
(delete-from-listing listing object index
)
75 :value
(ucw::delete-label listing
))))
76 (when (selectablep listing
)
78 (<ucw
:input
:type
"submit"
79 :action
(select-from-listing listing object index
)
80 :value
(select-label listing
))))
81 (when (viewablep listing
)
83 (<ucw
:input
:type
"submit"
84 :action
(call-component listing
(make-presentation object
))
86 (dolist (slot (slots listing
))
87 (<:td
:class
"data-cell" (present-slot slot object
)))
88 (<:td
:class
"index-number-cell")
91 (defmethod get-all-instances ((self mewa-list-presentation
))
95 ;;;; * Presentation Searches
98 ;;;; ** "search all fields" criteria
100 (defgeneric search-expr
(criteria instance
)
101 (:documentation
"Return ready to apply criteria.
102 What to do with it is backend dependent."))
104 (defmacro def-search-expr
(((self criteria-type
)) (model-expr &body body
))
105 `(defmethod search-expr ((,self
,criteria-type
) instance
)
108 (ucw::slot-name
(ucw::presentation
,self
))
111 (defmethod search-expr ((self ucw
::negated-criteria
) instance
)
112 (when (ucw::criteria self
)
115 (search-expr (ucw::criteria self
) instance
))))
117 (def-search-expr ((self ucw
::string-starts-with
))
118 (meta-model:expr-starts-with
(ucw::search-text self
)))
120 (def-search-expr ((self ucw
::string-ends-with
))
121 (meta-model:expr-ends-with
(ucw::search-text self
)))
123 (def-search-expr ((self ucw
::string-contains
))
124 (meta-model:expr-contains
(ucw::search-text self
)))
126 (def-search-expr ((self ucw
::number-less-than
))
127 (meta-model:expr-
< (ucw::number-input self
)))
129 (def-search-expr ((self ucw
::number-greater-than
))
130 (meta-model:expr-
> (ucw::number-input self
)))
132 (def-search-expr ((self ucw
::number-equal-to
))
133 (meta-model:expr-
= (ucw::number-input self
)))
137 (defcomponent mewa-presentation-search
(ucw::presentation-search
)
138 ((display-results-p :accessor display-results-p
:initarg
:display-results-p
:initform nil
)
139 (criteria-input :accessor criteria-input
:initform
"")
140 (new-criteria :accessor new-criteria
:initform nil
)))
142 (defmethod instance ((self mewa
:mewa-presentation-search
))
143 (instance (ucw::search-presentation self
)))
145 (defmethod search-expr ((self mewa
:mewa-presentation-search
) instance
)
146 (apply #'meta-model
:expr-and instance
147 (mapcan (lambda (c) (let ((e (search-expr c instance
)))
148 (if (listp e
) e
(list e
))))
149 (ucw::criteria self
))))
151 (defmethod search-query ((self mewa
:mewa-presentation-search
))
152 (search-expr self
(instance self
)))
154 (defmethod valid-instances ((self mewa
:mewa-presentation-search
))
155 (meta-model:select-instances
(instance self
) (search-query self
)))
157 (defmethod get-all-instances ((self mewa-presentation-search
))
158 (meta-model:select-instances
(instance self
)))
160 (defmethod ok ((self mewa-presentation-search
) &optional arg
)
161 (declare (ignore arg
))
162 (setf (ucw::instances
(ucw::list-presentation self
)) (valid-instances self
))
163 (setf (display-results-p self
) t
))
166 (defmethod set-search-input-for-criteria ((criteria ucw
::criteria
) (input t
))
167 (error "No search-input-for-criteria method for ~A : ~A" criteria input
))
169 (defmethod set-search-input-for-criteria ((c ucw
::string-criteria
) input
)
170 (setf (ucw::search-text c
) input
))
172 (defmethod set-search-input-for-criteria ((c ucw
::negated-criteria
) i
)
176 (defmethod mewa-add-criteria ((self component
) (criteria ucw
::criteria
))
177 (set-search-input-for-criteria criteria
(criteria-input self
))
178 (ucw::add-criteria self criteria
))
180 (defmethod find-default-criteria (c ucw
::mewa-string-slot-presentation
)
181 'ucw
::string-contains
)
185 (defmethod render-criteria ((res response
) (s mewa-presentation-search
))
186 (setf (criteria-input s
) "")
188 (dolist (c (ucw::criteria s
))
189 (<:li
(render-on res c
)
191 (<ucw
:input
:action
(ucw::drop-criteria s c
) :type
"submit" :value
"eliminate"))))
194 (<ucw
:input
:type
"text" :accessor
(criteria-input s
))
196 (<ucw
:select
:accessor
(new-criteria s
)
197 (dolist (criteria (ucw::applicable-criteria s
))
198 (<ucw
:option
:value criteria
(<:as-html
(label criteria
)))))
199 (<ucw
:input
:type
"submit" :action
(mewa-add-criteria s
(new-criteria s
))
202 (defmethod submit-search ((s mewa-presentation-search
))
203 (with-slots (criteria-input) s
205 (unless (or (null criteria-input
)
206 (string-equal "" (remove #\Space criteria-input
)))
208 (mewa-add-criteria s
(new-criteria s
)))
212 (defmethod render-on ((res response
) (self mewa-presentation-search
))
213 ;(<:as-html (search-query self))
214 (render-criteria res self
)
215 (<ucw
:input
:type
"submit" :value
"Search" :action
(submit-search self
))
216 (when (display-results-p self
)
217 (let ((listing (ucw::list-presentation self
)))
219 (slot-value listing
'ucw
::calling-component
) (slot-value self
'ucw
::calling-component
)
220 (slot-value listing
'ucw
::place
) (slot-value self
'ucw
::place
)
221 (slot-value listing
'ucw
::continuation
) (slot-value self
'ucw
::continuation
))
223 (render-on res listing
))))
227 (defcomponent dont-show-unset-slots
()())
229 (defmethod slots :around
((self dont-show-unset-slots
))
230 (remove-if-not #'(lambda (s) (let ((s (presentation-slot-value s
(instance self
))))
231 (and s
(not (equal "" s
)))))