Author: achiumenti Date: Thu Jul 17 09:21:02 2008 New Revision: 61

Modified: trunk/main/dojo/tests/ajax-test.lisp trunk/main/dojo/tests/common.lisp trunk/main/dojo/tests/djdialog-test.lisp trunk/main/dojo/tests/djeditor-test.lisp trunk/main/dojo/tests/header-info-page.lisp trunk/main/dojo/tests/index.lisp trunk/main/dojo/tests/main.lisp trunk/main/dojo/tests/packages.lisp trunk/main/dojo/tests/realm.lisp trunk/main/dojo/tests/slider-test.lisp Log: commit of version 0.1.0 (dojo tests)

Modified: trunk/main/dojo/tests/ajax-test.lisp ============================================================================== --- trunk/main/dojo/tests/ajax-test.lisp (original) +++ trunk/main/dojo/tests/ajax-test.lisp Thu Jul 17 09:21:02 2008 @@ -100,15 +100,15 @@ "onClick" nil (lambda () (alert (+ "Hello " - ,(ajax-page-name pobj) + ,(duplicate-back-slashes (ajax-page-name pobj)) " " - ,(ajax-page-surname pobj) + ,(duplicate-back-slashes (ajax-page-surname pobj)) " from " - ,(ajax-page-country pobj) + ,(duplicate-back-slashes (ajax-page-country pobj)) "!\nYour preferred color is " - ,(ajax-page-color pobj) + ,(duplicate-back-slashes (ajax-page-color pobj)) "\nDirection taken --> " - ,(ajax-page-cardinal-point pobj)))))))) + ,(duplicate-back-slashes (ajax-page-cardinal-point pobj)))))))))

(defmethod display-btn ((pobj ajax-page)) (setf (ajax-page-display-btn-p pobj) t)) @@ -279,7 +279,8 @@ (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)))))))))) + :src (format nil "~a/docroot/img/spinner.gif" + (build-lisplet-location *claw-current-lisplet*)))))))))

(lisplet-register-page-location *dojo-test-lisplet* 'ajax-page "ajax.html") \ No newline at end of file

Modified: trunk/main/dojo/tests/common.lisp ============================================================================== --- trunk/main/dojo/tests/common.lisp (original) +++ trunk/main/dojo/tests/common.lisp Thu Jul 17 09:21:02 2008 @@ -42,15 +42,18 @@ (head> ;;(meta> :HTTP-EQUIV "expires" :CONTENT "Wed, 26 Feb 2100 08:21:57 GMT") (title> (site-template-title o)) - (link> :href (format nil "~a/docroot/css/style.css" (build-lisplet-location (current-lisplet))) + (link> :href (format nil "~a/docroot/css/style.css" (build-lisplet-location *claw-current-lisplet*)) :rel "stylesheet" :type "text/css")) (djbody> :is-debug "false" :djconfig (site-template-djconfig o) - (p> + (p> :class "header" (a> :href "../test/index.html" "home") (p> - " Current language "" + "Current application language "" + (user-locale) """) + (p> + "Current dojo language "" (djuser-locale) """)) (wcomponent-informal-parameters o) (htcomponent-body o))))

Modified: trunk/main/dojo/tests/djdialog-test.lisp ============================================================================== --- trunk/main/dojo/tests/djdialog-test.lisp (original) +++ trunk/main/dojo/tests/djdialog-test.lisp Thu Jul 17 09:21:02 2008 @@ -37,7 +37,7 @@ :title "HELLO!" (span> ($> "hello world")))) (no-title-dialog-id (generate-id "ntId")) - (lisplet-path (build-lisplet-location (current-lisplet)))) + (lisplet-path (build-lisplet-location *claw-current-lisplet*))) (site-template> :title "dojo buttons test page" (p> (djbutton> :id "djbutton"

Modified: trunk/main/dojo/tests/djeditor-test.lisp ============================================================================== --- trunk/main/dojo/tests/djeditor-test.lisp (original) +++ trunk/main/dojo/tests/djeditor-test.lisp Thu Jul 17 09:21:02 2008 @@ -61,10 +61,8 @@ (defmethod wcomponent-template ((obj result-text)) (let* ((dialog-id (generate-id "resultDialog")) (dialog-content (dialog-content obj)) - (render-content-function #'(lambda () (progn - (hunchentoot:log-message :info "~a::------->~a" (htcomponent-client-id obj) dialog-content) - (and dialog-content - (string-not-equal dialog-content "")))))) + (render-content-function #'(lambda () (and dialog-content + (string-not-equal dialog-content ""))))) (div> :static-id (htcomponent-client-id obj) :style (style obj) (wcomponent-informal-parameters obj)

Modified: trunk/main/dojo/tests/header-info-page.lisp ============================================================================== --- trunk/main/dojo/tests/header-info-page.lisp (original) +++ trunk/main/dojo/tests/header-info-page.lisp Thu Jul 17 09:21:02 2008 @@ -33,7 +33,7 @@ (defclass header-info-page (page) ())

(defmethod page-content ((o header-info-page)) - (let ((header-props (headers-in))) + (let ((header-props (claw-headers-in))) (site-template> :title "Header info page" (p> :id "p" (table>

Modified: trunk/main/dojo/tests/index.lisp ============================================================================== --- trunk/main/dojo/tests/index.lisp (original) +++ trunk/main/dojo/tests/index.lisp Thu Jul 17 09:21:02 2008 @@ -32,21 +32,20 @@

(defclass index-page (page) ())

-(defmethod page-content ((o index-page)) +(defmethod page-content ((o index-page)) (site-template> :title "Home test page" (p> :id "p" (ul> - (li> (a> :href "realm.html" "realm on test")) (li> (a> :href "info.html" "HTTP Header info")) + (li> (a> :href "realm.html" "realm on test")) (li> (a> :href "../test2/realm.html" "realm on test2")) (li> (a> :href "djbutton.html" "dojo buttons integration test")) (li> (a> :href "djdialog.html" "dojo dialog integration test")) (li> (a> :href "djcolorpalette.html" "dojo color palette integration test")) (li> (a> :href "djeditor.html" "dojo editor integration test")) - (li> (a> :href "djevent.html" "dojo event integration test")) (li> (a> :href "ajax.html" "dojo ajax test")) (li> (a> :href "djcalendar.html" "dojo calendar test")) (li> (a> :href "slider.html" "dojo slider test")) (li> (a> :href "djmenu.html" "dojo menu test")))))) - + (lisplet-register-page-location *dojo-test-lisplet* 'index-page "index.html" :welcome-page-p t) \ No newline at end of file

Modified: trunk/main/dojo/tests/main.lisp ============================================================================== --- trunk/main/dojo/tests/main.lisp (original) +++ trunk/main/dojo/tests/main.lisp Thu Jul 17 09:21:02 2008 @@ -29,59 +29,55 @@

(in-package :claw-dojo-tests)

-(setf hunchentoot:*default-content-type* "text/html; charset=UTF-8")

(defvar *main-file* (load-time-value (or #.*compile-file-pathname* *load-pathname*)))

(defvar *dojo-test-lisplet*) (defvar *dojo-test-lisplet2*) -(setf *dojo-test-lisplet* (make-instance 'lisplet :realm "test1" :base-path "/test")) -(setf *dojo-test-lisplet2* (make-instance 'lisplet :realm "test2" :base-path "/test2")) - -(defparameter *clawserver* (make-instance 'clawserver - :port 4242 - :mod-lisp-p nil - :base-path "/claw")) +(setf *dojo-test-lisplet* (make-instance 'lisplet :realm "test1" + :redirect-protected-resources-p t + :base-path "/test")) +(setf *dojo-test-lisplet2* (make-instance 'lisplet :realm "test2" + :redirect-protected-resources-p t + :base-path "/test2")) +(defvar *ht-connector* (make-instance 'hunchentoot-connector + :port 4242 + :sslport nil + :behind-apache-p t + :mod-lisp-p nil)) + +(defvar *sm* (make-instance 'default-session-manager)) + +(defvar *ht-log-manager* (make-instance 'hunchentoot-logger)) + +(defvar *dojo-clawserver* (make-instance 'clawserver + :connector *ht-connector* + :log-manager *ht-log-manager* + :session-manager *sm* + :base-path "/claw"))

;;;(defparameter *clawserver* (make-instance 'clawserver :port 4242 :sslport 4445 :base-path "/claw" -;;; :ssl-certificate-file #P"/home/kiuma/pem/cacert.pem" +;;; :ssl-certificate-file #P"/home/kiuma/pem/cacert.pem" ;;; :ssl-privatekey-file #P"/home/kiuma/pem/privkey.pem"))

-(clawserver-register-lisplet *clawserver* *dojo-test-lisplet*) -(clawserver-register-lisplet *clawserver* *dojo-test-lisplet2*) + (clawserver-register-lisplet *dojo-clawserver* *dojo-test-lisplet*) + (clawserver-register-lisplet *dojo-clawserver* *dojo-test-lisplet2*) + + (defun test-image-file () + (make-pathname :directory (append (pathname-directory *main-file*) '("img")) :name "matrix" :type "jpg")) + + (let ((path (make-pathname :directory (append (pathname-directory *main-file*) '("docroot"))))) + (lisplet-register-resource-location *dojo-test-lisplet* + path + "docroot/") + (lisplet-register-resource-location *dojo-test-lisplet2* + path + "docroot/")) + + (defun djstart () + (clawserver-start *dojo-clawserver*))

-(defun test-image-file () - (make-pathname :directory (append (pathname-directory *main-file*) '("img")) :name "matrix" :type "jpg")) + (defun djstop () + (clawserver-stop *dojo-clawserver*))

-(let ((path (make-pathname :directory (append (pathname-directory *main-file*) '("docroot"))))) - (lisplet-register-resource-location *dojo-test-lisplet* - path - "docroot/") - (lisplet-register-resource-location *dojo-test-lisplet2* - path - "docroot/")) - -(defun djstart () - (clawserver-start *clawserver*) - *clawserver*) - -(defun djstop () - (clawserver-stop *clawserver*) - *clawserver*) - -(defun debug-mode () - (setf hunchentoot:*catch-errors-p* nil - hunchentoot::*log-lisp-backtraces-p* t - hunchentoot::*log-lisp-errors-p* t - hunchentoot::*log-lisp-warnings-p* t - hunchentoot::*show-lisp-errors-p* t - hunchentoot::*show-lisp-backtraces-p* t)) - -(defun production-mode () - (setf hunchentoot:*catch-errors-p* t - hunchentoot::*log-lisp-backtraces-p* nil - hunchentoot::*log-lisp-errors-p* t - hunchentoot::*log-lisp-warnings-p* t - hunchentoot::*show-lisp-errors-p* nil - hunchentoot::*show-lisp-backtraces-p* nil)) \ No newline at end of file

Modified: trunk/main/dojo/tests/packages.lisp ============================================================================== --- trunk/main/dojo/tests/packages.lisp (original) +++ trunk/main/dojo/tests/packages.lisp Thu Jul 17 09:21:02 2008 @@ -31,7 +31,7 @@

(defpackage :claw-dojo-tests (:nicknames :dojo-tests) - (:use :cl :hunchentoot :claw :dojo :parenscript) + (:use :cl :hunchentoot-connector :claw :dojo :parenscript) (:export :djstart :djstop :debug-mode

Modified: trunk/main/dojo/tests/realm.lisp ============================================================================== --- trunk/main/dojo/tests/realm.lisp (original) +++ trunk/main/dojo/tests/realm.lisp Thu Jul 17 09:21:02 2008 @@ -29,31 +29,39 @@

(in-package :claw-dojo-tests)

+(defgeneric realm-page-session-dispose (page))

-(defclass realm-page (page) ()) +(defgeneric realm-page-generate-number (page)) + +(defclass realm-page (page) + ((rnd-number :initform nil + :accessor realm-page-rnd-numuber))) + +(defmethod realm-page-generate-number ((page realm-page)) + (claw-start-session) + (unless (claw-session-value 'RND-NUMBER) + (setf (claw-session-value 'RND-NUMBER) (random 1000))) + (setf (realm-page-rnd-numuber page) (claw-session-value 'RND-NUMBER))) + +(defmethod realm-page-session-dispose ((page realm-page)) + (claw-remove-session) + (realm-page-generate-number page)) + +(defmethod page-content ((o realm-page)) + (realm-page-generate-number o) + (site-template> :title "Realm test page" + (p> + (cform> :id "sessionDispose" :action #'realm-page-session-dispose + (submit-link> :id "submit" "Session dispose")) + (ul> + (li> (a> :href "http://www.gentoo.org" :target "gentoo" + "gentoo")) + (li> (a> :href "../test/realm.html" :target "clwo1" + "realm on lisplet 'test'")) + (li> (a> :href "../test2/realm.html" :target "clwo2" + "realm on lisplet 'test2'")) + (li> "Rnd number value: " #'(lambda () (format nil "~d" (realm-page-rnd-numuber o))))))))

-(defmethod page-content ((o realm-page)) - (when (null hunchentoot:*session*) - (claw-start-session)) - (unless (session-value 'RND-NUMBER) - (setf (session-value 'RND-NUMBER) (random 1000))) - (site-template> :title "Realm test page" - (p> - "session" - (ul> - (li> (a> :href "http://www.gentoo.org" :target "gentoo" - "gentoo")) - (li> (a> :href "../test/realm.html" :target "clwo1" - "realm on lisplet 'test'")) - (li> (a> :href "../test2/realm.html" :target "clwo2" - "realm on lisplet 'test2'")) - (li> "Rnd number value: " (format nil "~d" (session-value 'RND-NUMBER))) - (li> "Remote Addr: " (session-remote-addr *session*)) - (li> "User agent: " (session-user-agent *session*)) - (li> "Lisplet Realm: " (current-realm)) - (li> "Session Realm: " (session-realm *session*)) - (li> "Session value: " (format nil "~a" (hunchentoot::session-string *session*))) - (li> "Request Realm: " (hunchentoot::realm *request*))))))

(lisplet-register-page-location *dojo-test-lisplet* 'realm-page "realm.html") (lisplet-register-page-location *dojo-test-lisplet2* 'realm-page "realm.html")

Modified: trunk/main/dojo/tests/slider-test.lisp ============================================================================== --- trunk/main/dojo/tests/slider-test.lisp (original) +++ trunk/main/dojo/tests/slider-test.lisp Thu Jul 17 09:21:02 2008 @@ -31,36 +31,40 @@

(defgeneric slide-page-null-action (slider-page))

-(defclass slider-page (page) - ((hval :initform 10 +(defclass slider-page (page) + ((hval :initform 60 :accessor slider-page-hval) (vval :initform 50 :accessor slider-page-vval) (message-content :initform "" :accessor slider-page-message-content)))

-(defmethod slide-page-null-action ((slider-page slider-page)) - (setf (slider-page-message-content slider-page) - (div> :style "border: 1px solid gray;" - (format nil "Sent djhorizontal-slider value: ~a" (slider-page-hval slider-page)) - (br>) - (format nil "Sent djvertical-slider value: ~a" (slider-page-vval slider-page))))) - + +(let ((translator (make-instance 'translator-number :decimal-digits 1))) + (defmethod slide-page-null-action ((slider-page slider-page)) + (setf (slider-page-message-content slider-page) + (div> :style "border: 1px solid gray;" + (format nil "Sent djhorizontal-slider value: ~a%" (translator-value-type-to-string translator (slider-page-hval slider-page))) + (br>) + (format nil "Sent djvertical-slider value: ~a" (slider-page-vval slider-page)))))) + (defmethod page-content ((pobj slider-page)) (let ((hs-content-id (generate-id "content")) - (vs-content-id (generate-id "content"))) - (site-template> :title "dojo slider test page" + (vs-content-id (generate-id "content")) + (result-id (generate-id "content"))) + (site-template> :title "dojo slider test page" (h1> :class "testTitle" "Slider") "Also try using the arrow keys, buttons, or clicking on the progress bar to move the slider." (br>) - (cform> :id "djform" + (djform> :id "djform" + :update-id (list result-id) :action 'slide-page-null-action (br>) "initial value=10, min=0, max=100, pageIncrement=100, onChange event triggers span innerHTML change immediately" (br>) (djhorizontal-slider> :id "slider1" :onChange (parenscript:ps* `(setf (slot-value (dojo.by-id ,hs-content-id) 'inner-H-T-M-L) - (dojo.number.format (/ (aref arguments 0) 100) + (dojo.number.format (/ (aref arguments 0) 100) (create :places 1 :pattern "#%")))) :accessor 'slider-page-hval @@ -70,22 +74,26 @@ :show-buttons "false" :intermediate-changes "true" :style "width:50%; height: 20px;" - (djhorizontal-rule-labels> :container "topDecoration" + (djhorizontal-rule-labels> :id "label" + :container "topDecoration" :style "height:1.2em;font-size:75%;color:gray;" :count 6 :numeric-margin 1) - (djhorizontal-rule> :container "topDecoration" + (djhorizontal-rule> :id "rule" + :container "topDecoration" :style "height:5px;" :count 6) - (djhorizontal-rule> :container "bottomDecoration" + (djhorizontal-rule> :id "rule" + :container "bottomDecoration" :style "height:5px;" :count 5) - (djhorizontal-rule-labels> :container "bottomDecoration" - :style "height:1em;font-size:75%;color:gray;" + (djhorizontal-rule-labels> :id "label" + :container "bottomDecoration" + :style "height:1em;font-size:75%;color:gray;" (li> "lowest") (li> "normal") (li> "highest"))) - (p> + (p> (span> :style="font-weight: bolder;" "djhorizontal-slider current value:")(span> :static-id hs-content-id "--"))

(br>) @@ -93,7 +101,7 @@ (br>) (djvertical-slider> :id "slider2" :onChange (parenscript:ps* `(setf (slot-value (dojo.by-id ,vs-content-id) 'inner-H-T-M-L) - (dojo.number.format (/ (aref arguments 0) 100) + (dojo.number.format (/ (aref arguments 0) 100) (create :places 1 :pattern "#%")))) :accessor 'slider-page-vval @@ -102,28 +110,33 @@ :page-increment 100 :discrete-values 11 :style "height: 300px;" - (djvertical-rule-labels> :container "leftDecoration" + (djvertical-rule-labels> :id "label" + :container "leftDecoration" :style "width:2em;color:gray;" (li> "0") (li> "100")) - (djvertical-rule> :container "leftDecoration" + (djvertical-rule> :id "rule" + :container "leftDecoration" :style "width:5px;" :count 11 :rule-style "border-color:gray;") - (djvertical-rule> :container "rightDecoration" + (djvertical-rule> :id "rule" + :container "rightDecoration" :style "width:5px;" :count 11 :rule-style "border-color:gray;") - (djvertical-rule-labels> :container "rightDecoration" + (djvertical-rule-labels> :id "label" + :container "rightDecoration" :style "width:2em;color:gray;" :count 6 :numeric-margin 1 :maximum 100 :constraints "{pattern:'#'}")) - (p> + (p> (span> :style="font-weight: bolder;" "djvertical-slider current value:")(span> :static-id vs-content-id "--")) (djsubmit-button> :id "submit" :value "Submit")) - (slider-page-message-content pobj)))) + (div> :static-id result-id + (slider-page-message-content pobj)))))

(lisplet-register-page-location *dojo-test-lisplet* 'slider-page "slider.html") \ No newline at end of file