;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*- ;;; $Header: dojo/tests/ajax-test.lisp $ ;;; Copyright (c) 2008, Andrea Chiumenti. All rights reserved. ;;; Redistribution and use in source and binary forms, with or without ;;; modification, are permitted provided that the following conditions ;;; are met: ;;; * Redistributions of source code must retain the above copyright ;;; notice, this list of conditions and the following disclaimer. ;;; * Redistributions in binary form must reproduce the above ;;; copyright notice, this list of conditions and the following ;;; disclaimer in the documentation and/or other materials ;;; provided with the distribution. ;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED ;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED ;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY ;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL ;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE ;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS ;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, ;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING ;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS ;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. (in-package :claw-dojo-tests) (defgeneric display-btn (pobj)) (defgeneric read-message (pobj)) (defgeneric write-message (pobj value)) (defclass ajax-page (page) ((display-btn-p :initform nil :accessor ajax-page-display-btn-p) (name :initform "" :accessor ajax-page-name) (surname :initform "" :accessor ajax-page-surname) (combo-message :initform "" :accessor ajax-page-country) (cardinal-point :initform "NE" :accessor ajax-page-cardinal-point) (lisper :initform nil :accessor ajax-page-lisper) (color :initform "red" :accessor ajax-page-color) (date :initform (local-time:now) :accessor ajax-page-date) (time :initform (local-time:now) :accessor ajax-page-time) (wallet :initform 50.25 :accessor ajax-page-wallet) (year :initform 2000 :accessor ajax-page-year) (file :initform nil :accessor ajax-page-inputfile))) (defclass simpledjbutton (djbutton) () (:metaclass metacomponent)) (defclass ajax-exception-monitor (exception-monitor) () (:metaclass metacomponent)) (defmethod wcomponent-template ((obj ajax-exception-monitor)) (exception-monitor> :static-id (htcomponent-client-id obj) (let ((errors (validation-errors)) (dialog-id (format nil "~aDialog" (htcomponent-client-id obj)))) (div> :render-condition #'(lambda() errors) (list (djbutton> :id "id" :onclick (ps* `(.show (dijit.by-id ,dialog-id))) "Validation errors") (style> (format nil "#~a .dijitError {border-color:#f3d118;background-color:#f9f7ba;color:red;}" dialog-id)) (djdialog> :static-id dialog-id ;:open "true" :title "Validation errors" (loop for (component-id reasons) on errors by #'cddr collect (loop for reason in reasons collect (p> reason))))))))) (defmethod htcomponent-instance-initscript ((obj ajax-exception-monitor)) (let ((errors (validation-errors)) (dialog-id (format nil "~aDialog" (htcomponent-client-id obj)))) (when errors (ps* `(let ((dialog (dijit.by-id ,dialog-id))) (dojo.add-class (slot-value dialog 'container-node) "dijitError") (.show dialog)))))) (defmethod htcomponent-instance-initscript ((obj simpledjbutton)) (let ((id (htcomponent-client-id obj)) (pobj (htcomponent-page obj))) (ps* `(dojo.connect (dijit.by-id ,id) "onClick" nil (lambda () (alert (+ "Hello " ,(ajax-page-name pobj) " " ,(ajax-page-surname pobj) " from " ,(ajax-page-country pobj) "!\\nYour preferred color is " ,(ajax-page-color pobj) "\\nDirection taken --> " ,(ajax-page-cardinal-point pobj)))))))) (defmethod display-btn ((pobj ajax-page)) (setf (ajax-page-display-btn-p pobj) t)) (defvar *integet-translator* (make-instance 'translator-integer)) (defmethod page-content ((pobj ajax-page)) (let ((dyna-content-id (generate-id "dynacontent")) (spinner-id (generate-id "spinner")) (djbutton-id (generate-id "djbutton")) (path-file-mimetype (ajax-page-inputfile pobj))) (site-template> :title "dojo ajax test page" (style> "table td {text-align: right; vertical-align: top;} td.left {text-align: left;} td p {margin: 0.25em;} .colorInput, .colorBox {float: left; position: relative; } .colorBox {display: block; margin-right: 10px; height: 1em; width: 1em; border: 1px solid gray;}") (p> (div> :static-id dyna-content-id (div> :render-condition #'(lambda () (ajax-page-display-btn-p pobj)) (simpledjbutton> :id djbutton-id (span> "Show message")) (div> :render-condition #'(lambda () path-file-mimetype) :style "border: 1px solid gray;" (third path-file-mimetype)))) (div> (action-link> :id "alink" :action 'display-btn "display") "|" (djaction-link> :id "djlink" :action 'display-btn :update-id (list dyna-content-id) "ajax display") (djform> :id "djform" :enctype "multipart/form-data" :ajax-form-p t :method "post" :action 'display-btn :update-id (list dyna-content-id) :on-before-submit (ps* `(.show (dijit.by-id ,spinner-id))) :on-xhr-finish (ps* `(.hide (dijit.by-id ,spinner-id))) (table> (tr> (td> "Name") (td> :class "left" (djvalidation-text-box> :id "name" :label "Name" :required "true" :accessor 'ajax-page-name :validator #'(lambda (value) (validate-required (page-current-component pobj) value))))) (tr> (td> "Surname") (td> :class "left" (djtext-box> :id "surname" :label "Surname" :accessor 'ajax-page-surname :validator #'(lambda (value) (validate-required (page-current-component pobj) value))))) (tr> (td> "Country") (td> :class "left" (djcombo-box> :id "country" :accessor 'ajax-page-country :label "Country" :validator #'(lambda (value) (validate-required (page-current-component pobj) value)) (option> :value "FR" "France") (option> :value "IT" "Italy") (option> :value "US" "USA") (option> :value "ES" "Spain")) (p> "djcombo-box allow to insert even non expected values.") (p> :style "margin-bottom: .75em;" "The passed parameter value is the one typed"))) (tr> (td> "Cardinal point") (td> :class "left" (djfiltering-select> :id "cardinal" :accessor 'ajax-page-cardinal-point :label "Cardinal point" :validator #'(lambda (value) (validate-required (page-current-component pobj) value)) (option> :value "N" "North") (option> :value "NE" "North-East") (option> :value "E" "East") (option> :value "SE" "South-East") (option> :value "S" "South") (option> :value "SW" "South-West") (option> :value "W" "West") (option> :value "NW" "North-West")) (p> "djfiltring-select doesn't allow to insert non expected values.") (p> :style "margin-bottom: .75em;" "The value submitted with the form is the hidden value (ex: NE), not the displayed value a.k.a. label (ex: North-East)"))) (tr> (td> "Year") (td> :class "left" (djnumber-spinner> :id "year" :label "Year" :pattern "####" :constraints "{min:2000,max:2100}" :translator *integet-translator* :accessor 'ajax-page-year :validator #'(lambda (value) (validate-required (page-current-component pobj) value))))) (tr> (td> "Date") (td> :class "left" (djdate-text-box> :id "date" :label "Date" :accessor 'ajax-page-date))) (tr> (td> "Time") (td> :class "left" (djtime-text-box> :id "time" :label "Time" :accessor 'ajax-page-time))) (tr> (td> "Wallet") (td> :class "left" (djcurrency-text-box> :id "wallet" :label "Wallet" :currency "€" :accessor 'ajax-page-wallet))) (tr> (td> "Lisper") (td> :class "left" (djcheck-box> :id "lisper" :label "Lisper" :translator *boolean-translator* :accessor 'ajax-page-lisper :value T :validator #'(lambda (value) (validate-required (page-current-component pobj) value :message "You must be a lisper to submit data!"))))) (tr> (td> "Preferred color") (td> :class "left" (djradio-button> :id "color" :class "colorInput" :label "Color" :accessor 'ajax-page-color :value "red") (span> :style "background: red;" :class "colorBox") (djradio-button> :id "color" :class "colorInput" :label "Color" :accessor 'ajax-page-color :value "green") (span> :style "background: green;" :class "colorBox") (djradio-button> :id "color" :class "colorInput" :label "Color" :accessor 'ajax-page-color :value "blue") (span> :style "background: blue;" :class "colorBox"))) (tr> (td> "Text file") (td> :class "left" (djtext-box-file> :id "inputFile" :label "File" :accessor 'ajax-page-inputfile)))) (submit-link> :id "slink" :action 'display-btn "update link") (djsubmit-button> :id "submitButton" :value "Update") (ajax-exception-monitor> :id "exceptionMonitor")) (djfloating-content> :static-id spinner-id (img> :alt "spinner" :src (format nil "~a/docroot/img/spinner.gif" (build-lisplet-location (current-lisplet)))))))))) (lisplet-register-page-location *dojo-test-lisplet* 'ajax-page "ajax.html")