(in-package :lol) ;;;; Expiry date picker (defslot-presentation date-slot-presentation (clsql-wall-time-slot-presentation) ((date-field :component (my-date-field :year-min 2005 :year-max 2015) :accessor date-field)) (:type-name date)) (defmethod update-value ((slot date-slot-presentation)) (multiple-value-bind (year month day) (time-ymd (presentation-slot-value slot (instance (ucw::parent slot)))) (multiple-value-bind (new-year new-month new-day) (time-ymd) (if (remove nil (map 'list #'(lambda (old new) (unless (equal (car old) (car new)) t)) (list year month day) (list new-year new-month new-day))) (setf (presentation-slot-value slot (instance (ucw::parent slot))) (make-time t)))))) (defmethod present-slot ((slot date-slot-presentation) instance) (let ((date (slot-value instance (slot-name slot)))) ;; Default values (when (and (not date) (default-to-now-p slot)) (setf date (clsql:get-time) (presentation-slot-value slot instance) date)) ;;simple viewer (if (and date (not (editablep slot))) (<:as-html date)) ;; editor (when (editablep slot) (with-slots ((m month) (y year)) (date-field slot) (multiple-value-bind (year month) (time-ymd date) (setf (lisp-value m) month (lisp-value y) year) (