[claw-cvs] r27 - in trunk/main/claw-core: src tests
achiumenti at common-lisp.net
achiumenti at common-lisp.net
Wed Apr 9 09:26:03 UTC 2008
Author: achiumenti
Date: Wed Apr 9 05:26:01 2008
New Revision: 27
Modified:
trunk/main/claw-core/src/misc.lisp
trunk/main/claw-core/src/packages.lisp
trunk/main/claw-core/src/tags.lisp
trunk/main/claw-core/tests/test1.lisp
Log:
corrected json requests and init script injection that will be evaluate on document load
Modified: trunk/main/claw-core/src/misc.lisp
==============================================================================
--- trunk/main/claw-core/src/misc.lisp (original)
+++ trunk/main/claw-core/src/misc.lisp Wed Apr 9 05:26:01 2008
@@ -144,6 +144,13 @@
(t (push element result))))
(nreverse result)))
+(defun msie-p (&optional (request *request*))
+ "Returns nil when the calling browser is not the evil of MSIE"
+ (let* ((header-props (headers-in request))
+ (user-agent (find :USER-AGENT header-props :test #'(lambda (member value) (eq member (car value))))))
+ (when user-agent
+ (all-matches "MSIE" (string-upcase (cdr user-agent))))))
+
(defmacro with-message (key &optional (default "") locale)
(let ((current-lisplet (gensym))
(current-page (gensym))
Modified: trunk/main/claw-core/src/packages.lisp
==============================================================================
--- trunk/main/claw-core/src/packages.lisp (original)
+++ trunk/main/claw-core/src/packages.lisp Wed Apr 9 05:26:01 2008
@@ -46,6 +46,7 @@
:*clawserver-base-path*
:*apache-http-port*
:*apache-https-port*
+ :*empty-tags*
;:request-realm
:request-id-table-map
;:dyna-id
@@ -260,6 +261,7 @@
#-:hunchentoot-no-ssl :clawserver-ssl-certificate-file
#-:hunchentoot-no-ssl :clawserver-ssl-privatekey-file
#-:hunchentoot-no-ssl :clawserver-ssl-privatekey-password
+ :msie-p
:clawserver-register-configuration
:claw-require-authorization
:configuration
Modified: trunk/main/claw-core/src/tags.lisp
==============================================================================
--- trunk/main/claw-core/src/tags.lisp (original)
+++ trunk/main/claw-core/src/tags.lisp Wed Apr 9 05:26:01 2008
@@ -585,6 +585,16 @@
(page-format-raw page "<?xml version=\"1.0\" encoding=\"~a\"?>~%" encoding))
(when content-type
(page-format-raw page "~a~%" content-type)))))
+
+(defun json-validation-errors ()
+ (let ((validation-errors (aux-request-value :validation-errors)))
+ (if validation-errors
+ (strings-to-jsarray
+ (loop for component-exceptions in validation-errors
+ collect (format "{~a:~a}"(car component-exceptions)
+ (strings-to-jsarray (loop for message in (cdr component-exceptions)
+ collect (prin1-to-string message))))))
+ "null")))
(defmethod page-render ((page page))
(let ((body (page-content page))
@@ -603,7 +613,7 @@
(page-init page)
(when jsonp
(page-format-raw page "{components:{"))
- (setf (page-can-print page) t)
+ ;;(setf (page-can-print page) (null jsonp))
(htcomponent-render (page-content page) page) ;Here we need a fresh new body!!!
(when jsonp
(page-format-raw page "},classInjections:\"")
@@ -615,7 +625,9 @@
(let ((init-scripts (htbody-init-scripts-tag page)))
(when init-scripts
(htcomponent-render init-scripts page)))
- (page-format-raw page "\"}"))))))
+ (page-format-raw page "\",errors:")
+ (page-format-raw page (json-validation-errors))
+ (page-format-raw page "}"))))))
(defmethod page-body-init-scripts ((page page))
(let ((js-body ""))
@@ -651,14 +663,17 @@
(setf (htcomponent-body current-js) class-init-scripts)
(push current-js tag-list)))
(dolist (js-file (page-script-files page))
- (let ((current-js (script> :type "text/javascript" :src "")))
- (setf (getf (htcomponent-attributes current-js) :src) js-file)
- (push current-js tag-list)))
-
+ (if (typep js-file 'htcomponent)
+ (push js-file tag-list)
+ (let ((current-js (script> :type "text/javascript" :src "")))
+ (setf (getf (htcomponent-attributes current-js) :src) js-file)
+ (push current-js tag-list))))
(dolist (css-file (page-stylesheet-files page))
- (let ((current-css (link> :rel "stylesheet" :type "text/css" :href "")))
- (setf (getf (htcomponent-attributes current-css) :href) css-file)
- (push current-css tag-list)))
+ (if (typep css-file 'htcomponent)
+ (push css-file tag-list)
+ (let ((current-css (link> :rel "stylesheet" :type "text/css" :href "")))
+ (setf (getf (htcomponent-attributes current-css) :href) css-file)
+ (push current-css tag-list))))
tag-list))
@@ -681,7 +696,7 @@
(let* ((page (htcomponent-page htcomponent))
(jsonp (page-json-id-list page))
(id (htcomponent-client-id htcomponent)))
- (when (or jsonp
+ (when (and jsonp
(member id jsonp :test #'string-equal))
(when (> (page-json-component-count page) 0)
(page-format page ","))
@@ -692,7 +707,7 @@
(let* ((page (htcomponent-page htcomponent))
(jsonp (page-json-id-list page))
(id (htcomponent-client-id htcomponent)))
- (when (or jsonp
+ (when (and jsonp
(member id jsonp :test #'string-equal))
(page-format-raw page "\""))))
@@ -943,9 +958,21 @@
(htcomponent-json-print-end-component htbody))))
(defmethod htbody-init-scripts-tag ((page page))
- (let ((js (script> :type "text/javascript")))
- (setf (htcomponent-page js) page)
- (setf (htcomponent-body js) (page-body-init-scripts page))
+ (let ((js (script> :type "text/javascript"))
+ (js-start-directive (if (msie-p)
+ "window.attachEvent('onload', function(e) {"
+ "document.addEventListener('DOMContentLoaded', function(e) {"))
+ (js-end-directive (if (msie-p)
+ "});"
+ "}, false);"))
+ (page-body-init-scripts (page-body-init-scripts page)))
+ (setf (htcomponent-page js) page
+ (htcomponent-body js) (when page-body-init-scripts
+ (if (listp page-body-init-scripts)
+ (append (list js-start-directive)
+ page-body-init-scripts
+ (list js-end-directive))
+ (list js-start-directive page-body-init-scripts js-end-directive))))
js))
;;;========= WCOMPONENT ===================================
Modified: trunk/main/claw-core/tests/test1.lisp
==============================================================================
--- trunk/main/claw-core/tests/test1.lisp (original)
+++ trunk/main/claw-core/tests/test1.lisp Wed Apr 9 05:26:01 2008
@@ -163,6 +163,23 @@
(li> (a> :href "unauth.html" "unauthorized page"))))))
(lisplet-register-page-location *test-lisplet* 'index-page "index.html" :welcome-page-p t)
+(defcomponent msie-p ()())
+
+(defmethod wcomponent-parameters ((msie-p msie-p))
+ (list :id :required))
+
+(defmethod wcomponent-template ((msie-p msie-p))
+ (let ((id (htcomponent-client-id msie-p)))
+ (p> :static-id id)))
+
+(defmethod htcomponent-instance-initscript ((msie-p msie-p))
+ (let ((id (htcomponent-client-id msie-p)))
+ (format nil "document.getElementById('~a').innerHTML = '~a';"
+ id
+ (if (msie-p)
+ "The browser is MSIE"
+ "The browser is not MSIE"))))
+
(defclass info-page (page) ())
(defmethod page-content ((o info-page))
@@ -174,7 +191,8 @@
(loop for key-val in header-props
collect (tr>
(td> (format nil "~a" (car key-val))
- (td> (format nil "~a" (cdr key-val)))))))))))
+ (td> (format nil "~a" (cdr key-val))))))))
+ (msie-p> :id "msie"))))
(lisplet-register-page-location *test-lisplet* 'info-page "info.html")
More information about the Claw-cvs
mailing list