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")