forked from av83/wizard
-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathshow-linear-elt.lisp
177 lines (144 loc) · 7.66 KB
/
show-linear-elt.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
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
(in-package #:WIZARD)
(defmacro a-fld (name obj)
`(if (equal val :clear)
""
(funcall
(intern
(format nil "A-~A" ,name)
(find-package "WIZARD"))
,obj)))
(defun show-fld-helper (captfld tplfunc namefld valuefld)
(tpl:fld
(list :fldname captfld
:fldcontent (funcall tplfunc (list :name namefld
:value valuefld)))))
(defun show-linear-elt (typedata val namefld captfld permfld)
"intermediate dispatcher (-ext)"
(show-linear-elt-ext (intern (format nil "~{~A~^.~}" typedata) :keyword) val namefld captfld permfld))
(defgeneric show-linear-elt-ext (typedata val namefld captfld permfld))
(defmethod show-linear-elt-ext (typedata val namefld captfld permfld)
(error "no applicable method SHOW-LINEAR-ELT for ~A" (type-of typedata)))
(defmethod show-linear-elt-ext ((typedata (eql :bool)) val namefld captfld permfld)
(show-fld-helper captfld #'tpl:flagupd namefld (a-fld namefld val)))
(defmethod show-linear-elt-ext ((typedata (eql :num)) val namefld captfld permfld)
(show-fld-helper captfld #'tpl:strupd namefld (a-fld namefld val)))
(defmethod show-linear-elt-ext ((typedata (eql :str)) val namefld captfld permfld)
(if (check-perm (a-update permfld) (cur-user) (intern (format nil "LINEAR-FLD-~A-~A" typedata namefld) :keyword))
;; update
(tpl:fld (list :fldname captfld
:fldcontent (tpl:strupd
(list :name namefld
:value (IF (EQUAL VAL :CLEAR)
""
(slot-value val (intern namefld :wizard)))))))
;; else
(if (check-perm (a-view permfld) (cur-user) (intern (format nil "LINEAR-FLD-~A-~A" typedata namefld) :keyword))
;; view
(tpl:fld (list :fldname captfld
:fldcontent (tpl:strview
(list :name namefld
:value (IF (EQUAL VAL :CLEAR)
""
(slot-value val (intern namefld :wizard)))))))
;; else - none
(if (and (boundp '*dbg*) *dbg*)
(format nil "<br/>~%Permisson denied for fld [~A] <br/>~%"
namefld)
""))))
(defmethod show-linear-elt-ext ((typedata (eql :txt)) val namefld captfld permfld)
(if (check-perm (a-update permfld) (cur-user) (intern (format nil "LINEAR-FLD-~A-~A" typedata namefld) :keyword))
;; update
(tpl:fld (list :fldname captfld
:fldcontent (tpl:txtupd
(list :name namefld
:value (IF (EQUAL VAL :CLEAR)
""
(slot-value val (intern namefld :wizard)))))))
;; else
(if (check-perm (a-view permfld) (cur-user) (intern (format nil "LINEAR-FLD-~A-~A" typedata namefld) :keyword))
;; view
(tpl:fld (list :fldname captfld
:fldcontent (tpl:txtview
(list :name namefld
:value (IF (EQUAL VAL :CLEAR)
""
(slot-value val (intern namefld :wizard)))))))
;; else - none
(if (and (boundp '*dbg*) *dbg*)
(format nil "<br/>~%Permisson denied for fld [~A] <br/>~%"
namefld)
""))))
(defmethod show-linear-elt-ext ((typedata (eql :pswd)) val namefld captfld permfld)
(show-fld-helper captfld #'tpl:pswdupd namefld (a-fld namefld val)))
(defmethod show-linear-elt-ext ((typedata (eql :interval)) val namefld captfld permfld)
(let ((val (a-fld namefld val)))
(if (equal 'INTERVAL (type-of val))
(tpl:fld
(list :fldname captfld
:fldcontent (tpl:intervalupd (list :name namefld
:valuebegin (decode-date (interval-begin val))
:valueend (decode-date (interval-end val))))))
(tpl:fld
(list :fldname captfld
:fldcontent (tpl:intervalupd (list :name namefld
:valuebegin ""
:valueend "")))))))
(defmethod show-linear-elt-ext ((typedata (eql :date)) val namefld captfld permfld)
(let ((val (a-fld namefld val)))
(if (or (null val)
(equal "" val))
(tpl:fld
(list :fldname captfld
:fldcontent (tpl:dateupd (list :name namefld
:value ""))))
(tpl:fld
(list :fldname captfld
:fldcontent (tpl:dateupd (list :name namefld
:value (decode-date val))))))))
(defmethod show-linear-elt-ext ((typedata (eql :list-of-keys.supplier-status)) val namefld captfld permfld)
(tpl:fld
(list :fldname captfld
:fldcontent (tpl:strview (list :value (getf *supplier-status* (a-fld namefld val)))))))
(defmethod show-linear-elt-ext ((typedata (eql :list-of-keys.offer-status)) val namefld captfld permfld)
(tpl:fld
(list :fldname captfld
:fldcontent (tpl:strview (list :value (getf *offer-status* (a-fld namefld val)))))))
(defmethod show-linear-elt-ext ((typedata (eql :list-of-keys.resource-types)) val namefld captfld permfld)
(tpl:fld
(list :fldname captfld
:fldcontent (tpl:strview (list :value (getf *resource-types* (a-fld namefld val)))))))
(defmethod show-linear-elt-ext ((typedata (eql :list-of-keys.tender-status)) val namefld captfld permfld)
(tpl:fld
(list :fldname captfld
:fldcontent (tpl:strview (list :value (getf *tender-status* (a-fld namefld val)))))))
(defmethod show-linear-elt-ext ((typedata (eql :link.builder)) val namefld captfld permfld)
(tpl:fld
(list :fldname captfld
:fldcontent (tpl:strview (list :value (a-name (a-fld namefld val)))))))
(defmethod show-linear-elt-ext ((typedata (eql :link.category)) val namefld captfld permfld)
(tpl:fld
(list :fldname captfld
:fldcontent (tpl:strview (list :value (a-name (a-fld namefld val)))))))
(defmethod show-linear-elt-ext ((typedata (eql :link.supplier)) val namefld captfld permfld)
(tpl:fld
(list :fldname captfld
:fldcontent (tpl:strview (list :value (let ((it (a-fld namefld val)))
(if (null it) "" (a-name it))))))))
(defmethod show-linear-elt-ext ((typedata (eql :link.tender)) val namefld captfld permfld)
(tpl:fld
(list :fldname captfld
:fldcontent (tpl:strview (list :value (a-name (a-fld namefld val)))))))
(defmethod show-linear-elt-ext ((typedata (eql :link.tender-resource)) val namefld captfld permfld)
(tpl:fld
(list :fldname captfld
:fldcontent (tpl:strview (list :value (a-name (a-resource (a-fld namefld val))))))))
(defmethod show-linear-elt-ext ((typedata (eql :link.supplier-resource-price)) val namefld captfld permfld)
(tpl:fld
(list :fldname captfld
:fldcontent (tpl:strview (list :name namefld
:value (a-name (a-fld namefld val)))))))
(defmethod show-linear-elt-ext ((typedata (eql :link.resource)) val namefld captfld permfld)
(tpl:fld
(list :fldname captfld
:fldcontent (tpl:strview (list :name namefld
:value (a-name (a-fld namefld val)))))))