1 (in-package :lisp-on-lines
)
3 (defaction edit-instance
((self mewa
))
4 (call-presentation (instance self
) :type
:editor
))
7 (defcomponent mewa-one-line-presentation
(mewa one-line-presentation
)
10 :attributes-getter
#'one-line-attributes-getter
11 :global-properties
'(:editablep nil
)))
13 (defmethod one-line-attributes-getter ((self mewa
))
14 (or (meta-model::find-slots-of-type
(instance self
))
15 (meta-model::list-keys
(instance self
))))
18 (defcomponent mewa-object-presentation
(mewa object-presentation
)
19 ((instance :accessor instance
:initarg
:instance
:initform nil
)))
21 (defcomponent mewa-viewer
(mewa-object-presentation)
24 :global-properties
'(:editablep nil
)))
26 (defcomponent mewa-editor
(mewa-object-presentation)
29 :global-properties
'(:editablep t
)))
31 (defcomponent mewa-creator
(mewa-editor)
34 (defmethod present ((pres mewa-object-presentation
))
35 (<:table
:class
(css-class pres
)
36 (dolist (slot (slots pres
))
37 (<:tr
:class
"presentation-slot-row"
38 (present-slot-as-row pres slot
))))
39 (render-options pres
(instance pres
)))
41 (defmethod present-slot-as-row ((pres mewa-object-presentation
) (slot slot-presentation
))
42 (<:td
:class
"presentation-slot-label" (<:as-html
(label slot
)))
43 (<:td
:class
"presentation-slot-value" (present-slot slot
(instance pres
))))
46 (defcomponent two-column-presentation
(mewa-object-presentation) ())
48 (defmethod present ((pres two-column-presentation
))
50 (<:table
:class
(css-class pres
)
51 (loop for slot on
(slots pres
) by
#'cddr
53 (<:tr
:class
"presentation-slot-row"
54 (<:td
:class
"presentation-slot-label"
55 (<:as-html
(label (first slot
))))
56 (<:td
:class
"presentation-slot-value"
57 (present-slot (first slot
) (instance pres
)))
59 (<:td
:class
"presentation-slot-label"
60 (<:as-html
(label (second slot
))))
61 (<:td
:class
"presentation-slot-value"
62 (present-slot (second slot
) (instance pres
))))))
63 (render-options pres
(instance pres
))))
67 (defcomponent mewa-list-presentation
(mewa list-presentation
)
68 ((instances :accessor instances
:initarg
:instances
:initform nil
)
69 (instance :accessor instance
)
70 (select-label :accessor select-label
:initform
"select" :initarg
:select-label
)
71 (selectablep :accessor selectablep
:initform t
:initarg
:selectablep
)
72 (deleteablep :accessor deletablep
:initarg
:deletablep
:initform nil
)
73 (viewablep :accessor viewablep
:initarg
:viewablep
:initform nil
)))
75 (defaction select-from-listing
((listing mewa-list-presentation
) object index
)
78 (defmethod render-list-row ((listing mewa-list-presentation
) object index
)
79 (<:tr
:class
"item-row"
80 (<:td
:align
"center" :valign
"top"
81 (when (editablep listing
)
82 (let ((object object
))
83 (<ucw
:input
:type
"submit"
84 :action
(edit-from-listing listing object index
)
85 :value
(edit-label listing
))))
87 (when (deleteablep listing
)
89 (<ucw
:input
:type
"submit"
90 :action
(delete-from-listing listing object index
)
91 :value
(delete-label listing
))))
92 (when (selectablep listing
)
94 (<ucw
:input
:type
"submit"
95 :action
(select-from-listing listing object index
)
96 :value
(select-label listing
))))
97 (when (viewablep listing
)
99 (<ucw
:input
:type
"submit"
100 :action
(call-component listing
(make-presentation object
))
102 (dolist (slot (slots listing
))
103 (<:td
:class
"data-cell" (present-slot slot object
)))
104 (<: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
)))))