1 (declaim (optimize (speed 0) (space 3) (safety 0)))
2 (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")))
107 (defmethod get-all-instances ((self mewa-list-presentation
))
111 ;;;; * Presentation Searches
114 ;;;; ** "search all fields" criteria
116 (defgeneric search-expr
(criteria instance
)
117 (:documentation
"Return ready to apply criteria.
118 to do with What it is backend dependent."))
120 (defmacro def-search-expr
(((self criteria-type
)) (model-expr &body body
))
121 `(defmethod search-expr ((,self
,criteria-type
) instance
)
124 (slot-name (presentation ,self
))
127 (defmethod search-expr ((self negated-criteria
) instance
)
128 (when (criteria self
)
131 (search-expr (criteria self
) instance
))))
133 (def-search-expr ((self string-starts-with
))
134 (meta-model:expr-starts-with
(search-text self
)))
136 (def-search-expr ((self string-ends-with
))
137 (meta-model:expr-ends-with
(search-text self
)))
139 (def-search-expr ((self string-contains
))
140 (meta-model:expr-contains
(search-text self
)))
142 (def-search-expr ((self number-less-than
))
143 (meta-model:expr-
< (number-input self
)))
145 (def-search-expr ((self number-greater-than
))
146 (meta-model:expr-
> (number-input self
)))
148 (def-search-expr ((self number-equal-to
))
149 (meta-model:expr-
= (number-input self
)))
153 (defcomponent mewa-presentation-search
(presentation-search)
154 ((display-results-p :accessor display-results-p
:initarg
:display-results-p
:initform nil
)
155 (criteria-input :accessor criteria-input
:initform
"")
156 (new-criteria :accessor new-criteria
:initform nil
)))
158 (defmethod instance ((self mewa
:mewa-presentation-search
))
159 (instance (search-presentation self
)))
161 (defmethod search-expr ((self mewa
:mewa-presentation-search
) instance
)
162 (apply #'meta-model
:expr-and instance
163 (mapcan (lambda (c) (let ((e (search-expr c instance
)))
164 (if (listp e
) e
(list e
))))
167 (defmethod search-query ((self mewa
:mewa-presentation-search
))
168 (search-expr self
(instance self
)))
170 (defmethod valid-instances ((self mewa
:mewa-presentation-search
))
171 (meta-model:select-instances
(instance self
) (search-query self
)))
173 (defmethod get-all-instances ((self mewa-presentation-search
))
174 (meta-model:select-instances
(instance self
)))
176 (defmethod ok ((self mewa-presentation-search
) &optional arg
)
177 (declare (ignore arg
))
178 (setf (instances (list-presentation self
)) (valid-instances self
))
179 (setf (display-results-p self
) t
))
182 (defmethod set-search-input-for-criteria ((criteria criteria
) (input t
))
183 (error "No search-input-for-criteria method for ~A : ~A" criteria input
))
185 (defmethod set-search-input-for-criteria ((c string-criteria
) input
)
186 (setf (search-text c
) input
))
188 (defmethod set-search-input-for-criteria ((c negated-criteria
) i
)
192 (defmethod mewa-add-criteria ((self component
) (criteria criteria
))
193 (set-search-input-for-criteria criteria
(criteria-input self
))
194 (add-criteria self criteria
))
196 (defmethod find-default-criteria (c mewa-string-slot-presentation
)
201 (defmethod render-criteria ((res response
) (s mewa-presentation-search
))
202 (setf (criteria-input s
) "")
204 (dolist (c (criteria s
))
205 (<:li
(render-on res c
)
207 (<ucw
:input
:action
(drop-criteria s c
) :type
"submit" :value
"eliminate"))))
210 (<ucw
:input
:type
"text" :accessor
(criteria-input s
))
212 (<ucw
:select
:accessor
(new-criteria s
)
213 (dolist (criteria (applicable-criteria s
))
214 (<ucw
:option
:value criteria
(<:as-html
(label criteria
)))))
215 (<ucw
:input
:type
"submit" :action
(mewa-add-criteria s
(new-criteria s
))
218 (defmethod submit-search ((s mewa-presentation-search
))
219 (with-slots (criteria-input) s
221 (unless (or (null criteria-input
)
222 (string-equal "" (remove #\Space criteria-input
)))
224 (mewa-add-criteria s
(new-criteria s
)))
228 (defmethod render-on ((res response
) (self mewa-presentation-search
))
229 ;(<:as-html (search-query self))
230 (render-criteria res self
)
231 (<ucw
:input
:type
"submit" :value
"Search" :action
(submit-search self
))
232 (when (display-results-p self
)
233 (let ((listing (list-presentation self
)))
235 (slot-value listing
'ucw
::calling-component
) (slot-value self
'ucw
::calling-component
)
236 (slot-value listing
'ucw
::place
) (slot-value self
'ucw
::place
)
237 (slot-value listing
'ucw
::continuation
) (slot-value self
'ucw
::continuation
))
239 (render-on res listing
))))
243 (defcomponent dont-show-unset-slots
()())
245 (defmethod slots :around
((self dont-show-unset-slots
))
246 (remove-if-not #'(lambda (s) (let ((s (presentation-slot-value s
(instance self
))))
247 (and s
(not (equal "" s
)))))