1 (in-package :lisp-on-lines
)
4 (defaction edit-instance
((self mewa
))
5 (call-presentation (instance self
) :type
:editor
))
8 (defcomponent mewa-one-line-presentation
(mewa one-line-presentation
)
11 :attributes-getter
#'one-line-attributes-getter
12 :global-properties
'(:editablep nil
)))
14 (defmethod one-line-attributes-getter ((self mewa
))
15 (or (meta-model::find-slots-of-type
(instance self
))
16 (meta-model::list-keys
(instance self
))))
19 (defcomponent mewa-object-presentation
(mewa object-presentation
)
20 ((instance :accessor instance
:initarg
:instance
:initform nil
)))
22 (defcomponent mewa-viewer
(mewa-object-presentation)
25 :global-properties
'(:editablep nil
)))
27 (defcomponent mewa-editor
(mewa-object-presentation)
30 :global-properties
'(:editablep t
)))
32 (defcomponent mewa-creator
(mewa-editor)
35 (defmethod present ((pres mewa-object-presentation
))
36 (<:table
:class
(css-class pres
)
37 (dolist (slot (slots pres
))
38 (<:tr
:class
"presentation-slot-row"
39 (present-slot-as-row pres slot
))))
40 (render-options pres
(instance pres
)))
42 (defmethod present-slot-as-row ((pres mewa-object-presentation
) (slot slot-presentation
))
43 (<:td
:class
"presentation-slot-label" (<:as-html
(label slot
)))
44 (<:td
:class
"presentation-slot-value" (present-slot slot
(instance pres
))))
47 (defcomponent two-column-presentation
(mewa-object-presentation) ())
49 (defmethod present ((pres two-column-presentation
))
51 (<:table
:class
(css-class pres
)
52 (loop for slot on
(slots pres
) by
#'cddr
54 (<:tr
:class
"presentation-slot-row"
55 (<:td
:class
"presentation-slot-label"
56 (<:as-html
(label (first slot
))))
57 (<:td
:class
"presentation-slot-value"
58 (present-slot (first slot
) (instance pres
)))
60 (<:td
:class
"presentation-slot-label"
61 (<:as-html
(label (second slot
))))
62 (<:td
:class
"presentation-slot-value"
63 (present-slot (second slot
) (instance pres
))))))
64 (render-options pres
(instance pres
))))
68 (defcomponent mewa-list-presentation
(mewa list-presentation
)
69 ((instances :accessor instances
:initarg
:instances
:initform nil
)
70 (instance :accessor instance
)
71 (select-label :accessor select-label
:initform
"select" :initarg
:select-label
)
72 (selectablep :accessor selectablep
:initform t
:initarg
:selectablep
)
73 (deleteablep :accessor deletablep
:initarg
:deletablep
:initform nil
)
74 (viewablep :accessor viewablep
:initarg
:viewablep
:initform nil
)))
76 (defaction select-from-listing
((listing mewa-list-presentation
) object index
)
79 (defmethod render-list-row ((listing mewa-list-presentation
) object index
)
80 (<:tr
:class
"item-row"
81 (<:td
:align
"center" :valign
"top"
82 (when (editablep listing
)
83 (let ((object object
))
84 (<ucw
:input
:type
"submit"
85 :action
(edit-from-listing listing object index
)
86 :value
(edit-label listing
))))
88 (when (deleteablep listing
)
90 (<ucw
:input
:type
"submit"
91 :action
(delete-from-listing listing object index
)
92 :value
(delete-label listing
))))
93 (when (selectablep listing
)
95 (<ucw
:input
:type
"submit"
96 :action
(select-from-listing listing object index
)
97 :value
(select-label listing
))))
98 (when (viewablep listing
)
100 (<ucw
:input
:type
"submit"
101 :action
(call-component listing
(make-presentation object
))
103 (dolist (slot (slots listing
))
104 (<:td
:class
"data-cell" (present-slot slot object
)))
105 (<:td
:class
"index-number-cell")
108 (defmethod get-all-instances ((self mewa-list-presentation
))
112 ;;;; * Presentation Searches
115 ;;;; ** "search all fields" criteria
117 (defgeneric search-expr
(criteria instance
)
118 (:documentation
"Return ready to apply criteria.
119 to do with What it is backend dependent."))
121 (defmacro def-search-expr
(((self criteria-type
)) (model-expr &body body
))
122 `(defmethod search-expr ((,self
,criteria-type
) instance
)
125 (slot-name (presentation ,self
))
128 (defmethod search-expr ((self negated-criteria
) instance
)
129 (when (criteria self
)
132 (search-expr (criteria self
) instance
))))
134 (def-search-expr ((self string-starts-with
))
135 (meta-model:expr-starts-with
(search-text self
)))
137 (def-search-expr ((self string-ends-with
))
138 (meta-model:expr-ends-with
(search-text self
)))
140 (def-search-expr ((self string-contains
))
141 (meta-model:expr-contains
(search-text self
)))
143 (def-search-expr ((self number-less-than
))
144 (meta-model:expr-
< (number-input self
)))
146 (def-search-expr ((self number-greater-than
))
147 (meta-model:expr-
> (number-input self
)))
149 (def-search-expr ((self number-equal-to
))
150 (meta-model:expr-
= (number-input self
)))
154 (defcomponent mewa-presentation-search
(presentation-search)
155 ((display-results-p :accessor display-results-p
:initarg
:display-results-p
:initform nil
)
156 (criteria-input :accessor criteria-input
:initform
"")
157 (new-criteria :accessor new-criteria
:initform nil
)))
159 (defmethod instance ((self mewa
:mewa-presentation-search
))
160 (instance (search-presentation self
)))
162 (defmethod search-expr ((self mewa
:mewa-presentation-search
) instance
)
163 (apply #'meta-model
:expr-and instance
164 (mapcan (lambda (c) (let ((e (search-expr c instance
)))
165 (if (listp e
) e
(list e
))))
168 (defmethod search-query ((self mewa
:mewa-presentation-search
))
169 (search-expr self
(instance self
)))
171 (defmethod valid-instances ((self mewa
:mewa-presentation-search
))
172 (meta-model:select-instances
(instance self
) (search-query self
)))
174 (defmethod get-all-instances ((self mewa-presentation-search
))
175 (meta-model:select-instances
(instance self
)))
177 (defmethod ok ((self mewa-presentation-search
) &optional arg
)
178 (declare (ignore arg
))
179 (setf (instances (list-presentation self
)) (valid-instances self
))
180 (setf (display-results-p self
) t
))
183 (defmethod set-search-input-for-criteria ((criteria criteria
) (input t
))
184 (error "No search-input-for-criteria method for ~A : ~A" criteria input
))
186 (defmethod set-search-input-for-criteria ((c string-criteria
) input
)
187 (setf (search-text c
) input
))
189 (defmethod set-search-input-for-criteria ((c negated-criteria
) i
)
193 (defmethod mewa-add-criteria ((self component
) (criteria criteria
))
194 (set-search-input-for-criteria criteria
(criteria-input self
))
195 (add-criteria self criteria
))
197 (defmethod find-default-criteria (c mewa-string-slot-presentation
)
202 (defmethod render-criteria ((res response
) (s mewa-presentation-search
))
203 (setf (criteria-input s
) "")
205 (dolist (c (criteria s
))
206 (<:li
(render-on res c
)
208 (<ucw
:input
:action
(drop-criteria s c
) :type
"submit" :value
"eliminate"))))
211 (<ucw
:input
:type
"text" :accessor
(criteria-input s
))
213 (<ucw
:select
:accessor
(new-criteria s
)
214 (dolist (criteria (applicable-criteria s
))
215 (<ucw
:option
:value criteria
(<:as-html
(label criteria
)))))
216 (<ucw
:input
:type
"submit" :action
(mewa-add-criteria s
(new-criteria s
))
219 (defmethod submit-search ((s mewa-presentation-search
))
220 (with-slots (criteria-input) s
222 (unless (or (null criteria-input
)
223 (string-equal "" (remove #\Space criteria-input
)))
225 (mewa-add-criteria s
(new-criteria s
)))
229 (defmethod render-on ((res response
) (self mewa-presentation-search
))
230 ;(<:as-html (search-query self))
231 (render-criteria res self
)
232 (<ucw
:input
:type
"submit" :value
"Search" :action
(submit-search self
))
233 (when (display-results-p self
)
234 (let ((listing (list-presentation self
)))
236 (slot-value listing
'ucw
::calling-component
) (slot-value self
'ucw
::calling-component
)
237 (slot-value listing
'ucw
::place
) (slot-value self
'ucw
::place
)
238 (slot-value listing
'ucw
::continuation
) (slot-value self
'ucw
::continuation
))
240 (render-on res listing
))))
244 (defcomponent dont-show-unset-slots
()())
246 (defmethod slots :around
((self dont-show-unset-slots
))
247 (remove-if-not #'(lambda (s) (let ((s (presentation-slot-value s
(instance self
))))
248 (and s
(not (equal "" s
)))))