fading-flash.lisp

;;;;
;;;; a flash widget that fades out dynamically without another HTTP request
;;;;
(proclaim '(optimize (debug 3)))
(in-package :lisp-blog)

(export '(fading-flash fading-flash-messages fading-flash-message))

(defwidget fading-flash (flash)
  ((delay :accessor fading-flash-delay
          :initform 3
          :initarg :delay
          :documentation "A fading flash")))

;; copied from weblocks::flash.lisp
(defun flash-messages-to-show (flash)
  "Returns a list of messages that need to be shown or nil if there is
nothing to show. This functions takes into consideration any stale
messages that need to be shown for AJAX effects."
  (or (flash-messages flash)
      (and (ajax-request-p)
           (flash-old-messages flash))))

(defmethod render-widget-body ((obj fading-flash) &rest args)
  (declare (special *on-ajax-complete-scripts* *dirty-widgets*))
  (let ((messages (flash-messages-to-show obj)))
    (when messages
      (with-html
        (:div :class "view"
              (with-extra-tags
                (htm
                 (:ul :class "messages"
                      (mapc (lambda (msg)
                              (htm (:li (apply #'render-widget msg args))))
                            messages)))))
        (send-script (parenscript:ps*
                      `(.*Fade *Effect
                               ,(dom-id obj)
                               (create :duration ,(fading-flash-delay obj)))))))))