1 (declaim (optimize (speed 0) (space 3) (safety 0)))
2 (in-package :lisp-on-lines
)
5 (defmethod render ((self mewa
))
8 (defaction edit-instance
((self mewa
))
9 (call-presentation (instance self
) :type
:editor
))
12 (defcomponent mewa-one-line-presentation
(mewa lol
::one-line-presentation
)
15 :attributes-getter
#'one-line-attributes-getter
16 :global-properties
'(:editablep nil
)))
18 (defmethod one-line-attributes-getter ((self mewa
))
19 (or (meta-model::find-slots-of-type
(instance self
))
20 (meta-model::list-keys
(instance self
))))
23 (defcomponent mewa-object-presentation
(mewa lol
::object-presentation
)
24 ((instance :accessor instance
:initarg
:instance
:initform nil
)))
26 (defcomponent mewa-viewer
(mewa-object-presentation)
29 :global-properties
'(:editablep nil
)))
31 (defcomponent mewa-editor
(mewa-object-presentation)
34 :global-properties
'(:editablep t
)))
36 (defcomponent mewa-creator
(mewa-editor)
39 (defmethod present ((pres mewa-object-presentation
))
40 (<:table
:class
(css-class pres
)
41 (dolist (slot (slots pres
))
42 (<:tr
:class
"presentation-slot-row"
43 (present-slot-as-row pres slot
))))
44 (render-options pres
(instance pres
)))
46 (defmethod present-slot-as-row ((pres mewa-object-presentation
) (slot slot-presentation
))
47 (<:td
:class
"presentation-slot-label" (<:as-html
(label slot
)))
48 (<:td
:class
"presentation-slot-value" (present-slot slot
(instance pres
))))
51 (defcomponent two-column-presentation
(mewa-object-presentation) ())
53 (defmethod present ((pres two-column-presentation
))
55 (<:table
:class
(css-class pres
)
56 (loop for slot on
(slots pres
) by
#'cddr
58 (<:tr
:class
"presentation-slot-row"
59 (<:td
:class
"presentation-slot-label"
60 (<:as-html
(label (first slot
))))
61 (<:td
:class
"presentation-slot-value"
62 (present-slot (first slot
) (instance pres
)))
64 (<:td
:class
"presentation-slot-label"
65 (<:as-html
(label (second slot
))))
66 (<:td
:class
"presentation-slot-value"
67 (present-slot (second slot
) (instance pres
))))))
68 (render-options pres
(instance pres
))))
72 (defcomponent mewa-list-presentation
(mewa list-presentation
)
73 ((instances :accessor instances
:initarg
:instances
:initform nil
)
74 (instance :accessor instance
)
75 (select-label :accessor select-label
:initform
"select" :initarg
:select-label
)
76 (selectablep :accessor selectablep
:initform t
:initarg
:selectablep
)
77 (deleteablep :accessor deletablep
:initarg
:deletablep
:initform nil
)
78 (viewablep :accessor viewablep
:initarg
:viewablep
:initform nil
)))
80 (defaction select-from-listing
((listing mewa-list-presentation
) object index
)
83 (defmethod render-list-row ((listing mewa-list-presentation
) object index
)
84 (<:tr
:class
"item-row"
85 (<:td
:align
"center" :valign
"top"
86 (when (editablep listing
)
87 (let ((object object
))
88 (<ucw
:input
:type
"submit"
89 :action
(edit-from-listing listing object index
)
90 :value
(edit-label listing
))))
92 (when (deleteablep listing
)
94 (<ucw
:input
:type
"submit"
95 :action
(delete-from-listing listing object index
)
96 :value
(delete-label listing
))))
97 (when (selectablep listing
)
99 (<ucw
:input
:type
"submit"
100 :action
(select-from-listing listing object index
)
101 :value
(select-label listing
))))
102 (when (viewablep listing
)
104 (<ucw
:input
:type
"submit"
105 :action
(call-component listing
(make-presentation object
))
107 (dolist (slot (slots listing
))
108 (<:td
:class
"data-cell" (present-slot slot object
)))
109 (<:td
:class
"index-number-cell")))
111 (defmethod get-all-instances ((self mewa-list-presentation
))
115 ;;;; * Presentation Searches
118 ;;;; ** "search all fields" criteria
120 (defgeneric search-expr
(criteria instance
)
121 (:documentation
"Return ready to apply criteria.
122 to do with What it is backend dependent."))
124 (defmacro def-search-expr
(((self criteria-type
)) (model-expr &body body
))
125 `(defmethod search-expr ((,self
,criteria-type
) instance
)
128 (slot-name (presentation ,self
))
131 (defmethod search-expr ((self negated-criteria
) instance
)
132 (when (criteria self
)
135 (search-expr (criteria self
) instance
))))
137 (def-search-expr ((self string-starts-with
))
138 (meta-model:expr-starts-with
(search-text self
)))
140 (def-search-expr ((self string-ends-with
))
141 (meta-model:expr-ends-with
(search-text self
)))
143 (def-search-expr ((self string-contains
))
144 (meta-model:expr-contains
(search-text self
)))
146 (def-search-expr ((self number-less-than
))
147 (meta-model:expr-
< (number-input self
)))
149 (def-search-expr ((self number-greater-than
))
150 (meta-model:expr-
> (number-input self
)))
152 (def-search-expr ((self number-equal-to
))
153 (meta-model:expr-
= (number-input self
)))
157 (defcomponent mewa-presentation-search
(presentation-search)
158 ((display-results-p :accessor display-results-p
:initarg
:display-results-p
:initform nil
)
159 (criteria-input :accessor criteria-input
:initform
"")
160 (new-criteria :accessor new-criteria
:initform nil
)))
162 (defmethod instance ((self mewa
:mewa-presentation-search
))
163 (instance (search-presentation self
)))
165 (defmethod search-expr ((self mewa
:mewa-presentation-search
) instance
)
166 (apply #'meta-model
:expr-and instance
167 (mapcan (lambda (c) (let ((e (search-expr c instance
)))
168 (if (listp e
) e
(list e
))))
171 (defmethod search-query ((self mewa
:mewa-presentation-search
))
172 (search-expr self
(instance self
)))
174 (defmethod valid-instances ((self mewa
:mewa-presentation-search
))
175 (meta-model:select-instances
(instance self
) (search-query self
)))
177 (defmethod get-all-instances ((self mewa-presentation-search
))
178 (meta-model:select-instances
(instance self
)))
180 (defmethod ok ((self mewa-presentation-search
) &optional arg
)
181 (declare (ignore arg
))
182 (setf (instances (list-presentation self
)) (valid-instances self
))
183 (setf (display-results-p self
) t
))
186 (defmethod set-search-input-for-criteria ((criteria criteria
) (input t
))
187 (error "No search-input-for-criteria method for ~A : ~A" criteria input
))
189 (defmethod set-search-input-for-criteria ((c string-criteria
) input
)
190 (setf (search-text c
) input
))
192 (defmethod set-search-input-for-criteria ((c negated-criteria
) i
)
196 (defmethod mewa-add-criteria ((self component
) (criteria criteria
))
197 (set-search-input-for-criteria criteria
(criteria-input self
))
198 (add-criteria self criteria
))
200 (defmethod find-default-criteria (c mewa-string-slot-presentation
)
203 (defmethod render-criteria ((res response
) (s mewa-presentation-search
))
204 (setf (criteria-input s
) "")
206 (dolist (c (criteria s
))
207 (<:li
(render-on res c
)
209 (<ucw
:input
:action
(drop-criteria s c
) :type
"submit" :value
"eliminate"))))
212 (<ucw
:input
:type
"text" :accessor
(criteria-input s
))
214 (<ucw
:select
:accessor
(new-criteria s
)
215 (dolist (criteria (applicable-criteria s
))
216 (<ucw
:option
:value criteria
(<:as-html
(label criteria
)))))
217 (<ucw
:input
:type
"submit" :action
(mewa-add-criteria s
(new-criteria s
))
220 (defmethod submit-search ((s mewa-presentation-search
))
221 (with-slots (criteria-input) s
223 (unless (or (null criteria-input
)
224 (string-equal "" (remove #\Space criteria-input
)))
226 (mewa-add-criteria s
(new-criteria s
)))
230 (defmethod render-on ((res response
) (self mewa-presentation-search
))
231 ;(<:as-html (search-query self))
232 (render-criteria res self
)
233 (<ucw
:input
:type
"submit" :value
"Search" :action
(submit-search self
))
234 (when (display-results-p self
)
235 (let ((listing (list-presentation self
)))
237 (slot-value listing
'ucw
::calling-component
) (slot-value self
'ucw
::calling-component
)
238 (slot-value listing
'ucw
::place
) (slot-value self
'ucw
::place
)
239 (slot-value listing
'ucw
::continuation
) (slot-value self
'ucw
::continuation
))
241 (render-on res listing
))))
245 (defcomponent dont-show-unset-slots
()())
247 (defmethod slots :around
((self dont-show-unset-slots
))
248 (remove-if-not #'(lambda (s) (let ((s (presentation-slot-value s
(instance self
))))
249 (and s
(not (equal "" s
)))))