[claw-cvs] r61 - trunk/main/dojo/tests
achiumenti at common-lisp.net
achiumenti at common-lisp.net
Thu Jul 17 13:21:03 UTC 2008
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
More information about the Claw-cvs
mailing list