3 ;;;; Expiry date picker
5 (defslot-presentation date-slot-presentation
(clsql-wall-time-slot-presentation)
6 ((date-field :component
(my-date-field :year-min
2005 :year-max
2015)
10 (defmethod update-value ((slot date-slot-presentation
))
11 (multiple-value-bind (year month day
)
12 (time-ymd (presentation-slot-value slot
(instance (ucw::parent slot
))))
13 (multiple-value-bind (new-year new-month new-day
)
15 (if (remove nil
(map 'list
#'(lambda (old new
)
16 (unless (equal (car old
) (car new
))
19 (list new-year new-month new-day
)))
20 (setf (presentation-slot-value slot
(instance (ucw::parent slot
)))
23 (defmethod present-slot ((slot date-slot-presentation
) instance
)
24 (let ((date (slot-value instance
(slot-name slot
))))
26 (when (and (not date
) (default-to-now-p slot
))
27 (setf date
(clsql:get-time
)
28 (presentation-slot-value slot instance
) date
))
30 (if (and date
(not (editablep slot
)))
33 (when (editablep slot
)
34 (with-slots ((m month
) (y year
))
37 (multiple-value-bind (year month
) (time-ymd date
)
38 (setf (lisp-value m
) month
40 (<ucw
:render-component
:component
(date-field slot
)))))))
45 (defcomponent %integer-range-field
(ucw::integer-range-field
)
48 (defmethod (setf lisp-value
) :after
(value (self %integer-range-field
))
53 (defclass %date-field
(ucw::date-field
)
54 ((day :component
(%integer-range-field
:min-value
1 :max-value
31))
55 (month :component
(%integer-range-field
:min-value
1 :max-value
12))
56 (year :component
(%integer-range-field
:min-value
2005 :max-value
2015) ))
57 (:metaclass standard-component-class
))
59 (defmethod shared-initialize :after
((field %date-field
) slot-names
60 &key
(year-min 1960) (year-max 2010))
61 (declare (ignore slot-names year-min year-max
))
62 (mapcar #'(lambda (x) (setf (slot-value (slot-value field x
) 'ucw
::parent
) field
))
65 (defclass my-date-field
(%date-field
)
67 (:metaclass standard-component-class
))
69 (defmethod present ((date my-date-field
))
70 (with-slots (year month
)
72 (<ucw
:render-component
:component month
)
74 (<ucw
:render-component
:component year
)))