-
Notifications
You must be signed in to change notification settings - Fork 2
/
Copy pathfiltering-form.lisp
149 lines (135 loc) · 6.61 KB
/
filtering-form.lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
(in-package :weblocks-filtering-widget)
(defwidget filtering-form (quickform)
((filtering-widget-instance)))
(defclass filtering-data ()
((field :initarg :field)
(compare-type :initarg :compare-type)
(compare-value :initform nil)))
(defun filtering-form-view-field-wt (&key label-class id show-required-indicator required-indicator-label
show-field-label field-label validation-error content
field-class)
(with-html-to-string
(:li :class field-class
(:label :class label-class
:style "display:block;float:left;width:100px;"
:for id
(:span :class "slot-name"
(:span :class "extra"
(when show-field-label
(str field-label)
(str ": ")))))
(:div :style "float:left;width:200px;"
(str content))
(when validation-error
(htm (:p :class "validation-error"
(:em
(:span :class "validation-error-heading" "Error: ")
(str validation-error)))))
(:div :style "clear:both"))))
(deftemplate :form-view-field-wt 'filtering-form-view-field-wt
:context-matches (lambda (&rest args &key widget &allow-other-keys)
(if (subtypep (type-of widget) 'filtering-form)
20
0)))
(defun filtering-form-view-field-for-bootstrap-wt (&key label-class id show-required-indicator required-indicator-label
show-field-label field-label validation-error content
field-class)
(with-html-to-string
(:style :type "text/css"
(str "
div.submit {
margin-top: 10px;
}
.filtering-data .control-group {
margin-bottom: 0;
}
.filtering-data input, .filtering-data .value, .filtering-data select {
margin-left: 25px;
}
.filtering-form .compare-value input {
width: 550px;
}
.filtering-form .compare-value input.input-small {
width: 90px;
}
"))
(:div :class (format nil "control-group ~A" field-class)
(:label :class (format nil "control-label ~A" label-class)
:style "display:block;float:left;"
:for id
(:span :class "slot-name"
(:span :class "extra"
(when show-field-label
(str field-label)
(str ": ")))))
(:div
(str content))
(when validation-error
(htm (:p :class "validation-error"
(:em
(:span :class "validation-error-heading" "Error: ")
(str validation-error)))))
(:div :style "clear:both"))))
(when (find-package :weblocks-twitter-bootstrap-application)
(deftemplate :form-view-field-wt 'filtering-form-view-field-for-bootstrap-wt
:application-class (intern "TWITTER-BOOTSTRAP-WEBAPP" "WEBLOCKS-TWITTER-BOOTSTRAP-APPLICATION")
:context-matches (lambda (&rest args &key widget &allow-other-keys)
(if (subtypep (type-of widget) 'filtering-form)
20
0))))
(defun make-filtering-form-view (&key caption presentation field-choices)
(eval `(defview nil
(:type filtering-form :persistp nil :buttons '((:submit . "Search") (:cancel . "Cancel"))
:caption ,caption)
(field :label "Search for ..." :present-as (,presentation :choices ',field-choices)
:requiredp t)
(compare-type
:label ,(cl-config:get-value
:weblocks-filtering-widget.filtering-form-compare-type-caption
:default "which ..")
:present-as
(,presentation :choices '(("is like ..." . "like")
("is equal to ..." . "equal")
("is not like ..." . "not-like")
("is not equal to ..." . "not-equal")
("is more ..." . "greater-number")
("is less ..." . "less-number")
("is later ..." . "greater-date")
("is earlier ..." . "less-date")
("is identical ..." . "identical")
("is not identical ..." . "not-identical")
("is empty ..." . "null")
("is not empty ..." . "not-null")
))
:requiredp t)
(compare-value :label
,(cl-config:get-value
:weblocks-filtering-widget.filtering-form-compare-value-caption
:default "value ...") :present-as input))))
(defun make-filtering-form (widget data &rest args)
(let* ((presentation (cl-config:get-value
:weblocks-filtering-widget.filtering-form-fields-presentation
:default 'links-choices))
(view (make-filtering-form-view :caption (filtering-widget-form-title widget)
:presentation presentation
:field-choices (compare-field-form-choices widget)))
(data (apply #'make-instance (list* 'filtering-data data)))
(form
(progn
(apply #'make-quickform
view
(append
(list
:data data
:class 'filtering-form
:answerp nil)
args)))))
(with-slots (filtering-widget-instance) form
(setf filtering-widget-instance widget)
(setf (slot-value (dataform-form-view form) 'form) form)
form)))
(defun all-filters-for-model (model-class)
(loop for i in (weblocks-stores:class-visible-slots model-class)
collect (list :id (alexandria:make-keyword (c2mop:slot-definition-name i))
:caption (humanize-name (c2mop:slot-definition-name i))
:slot (c2mop:slot-definition-name i))))