[claw-cvs] r149 - in trunk/main/claw-html: . src
Andrea Chiumenti
achiumenti at common-lisp.net
Sat Dec 13 14:16:07 UTC 2008
Author: achiumenti
Date: Sat Dec 13 14:15:57 2008
New Revision: 149
Log:
css component injection bugfix
Modified:
trunk/main/claw-html/claw-html.asd
trunk/main/claw-html/src/packages.lisp
trunk/main/claw-html/src/tags.lisp
Modified: trunk/main/claw-html/claw-html.asd
==============================================================================
--- trunk/main/claw-html/claw-html.asd (original)
+++ trunk/main/claw-html/claw-html.asd Sat Dec 13 14:15:57 2008
@@ -34,17 +34,8 @@
:depends-on (:closer-mop :local-time :parenscript :cl-ppcre :split-sequence)
:components ((:module src
:components ((:file "packages")
- ;(:file "mime-type" :depends-on ("packages"))
- ;(:file "misc" :depends-on ("mime-type"))
- ;:(:file "i18n" :depends-on ("packages"))
- ;(:file "locales" :depends-on ("i18n"))
- ;(:file "connector" :depends-on ("misc"))
- ;(:file "logger" :depends-on ("misc"))
- ;(:file "session-manager" :depends-on ("misc"))
(:file "meta" :depends-on ("packages"))
- (:file "tags" :depends-on ("packages" "meta"))
+ (:file "tags" :depends-on ("packages" "meta"))
(:file "components" :depends-on ("tags" "meta"))
(:file "validators" :depends-on ("components"))
- (:file "translators" :depends-on ("validators"))))))
- ;(:file "server" :depends-on ("components"))
- ;(:file "lisplet" :depends-on ("server"))))))
+ (:file "translators" :depends-on ("validators"))))))
\ No newline at end of file
Modified: trunk/main/claw-html/src/packages.lisp
==============================================================================
--- trunk/main/claw-html/src/packages.lisp (original)
+++ trunk/main/claw-html/src/packages.lisp Sat Dec 13 14:15:57 2008
@@ -46,7 +46,6 @@
#:error-page
#:render-error-page
- ;#:duplicate-back-slashes
#:attribute-value
#:build-tagf
#:page
@@ -59,6 +58,7 @@
#:page-stylesheet-files
#:page-class-initscripts
#:page-instance-initscripts
+ #:page-initstyles
#:page-current-component
#:page-body-init-scripts
#:htcomponent
@@ -71,6 +71,7 @@
#:htcomponent-stylesheet-files
#:htcomponent-class-initscripts
#:htcomponent-instance-initscript
+ #:htcomponent-initstyles
#:tag
#:tag-name
#:tag-attributes
Modified: trunk/main/claw-html/src/tags.lisp
==============================================================================
--- trunk/main/claw-html/src/tags.lisp (original)
+++ trunk/main/claw-html/src/tags.lisp Sat Dec 13 14:15:57 2008
@@ -111,7 +111,9 @@
(defgeneric page-body-init-scripts (page)
(:documentation "During the render phase wcomponent instances inject their initialization scripts (javascript)
that will be evaluated when the page has been loaded.
-This internal method is called to render these scripts.
+This internal method is called to render these scripts. The result is used by the HTBODY-INIT-SCRIPTS-TAG method
+that generates a <script> tag that will be appended at the end of the <body> tag (generated by the BODY> function
+tag.
- PAGE is the page instance that must be given"))
(defgeneric htbody-init-scripts-tag (page &optional on-load)
@@ -391,6 +393,8 @@
:accessor page-class-initscripts :documentation "Holds component class javascript directives injected by components during the request cycle")
(instancee-initscripts :initarg :instance-initscripts
:accessor page-instance-initscripts :documentation "Holds component instance javascript directives injected by components during the request cycle")
+ (initstyles :initarg :initstyles
+ :accessor page-initstyles :documentation "Holds component class and instance stylesheet directives injected by components during the request cycle")
(indent :initarg :indent
:accessor page-indent :documentation "Determine if the output must be indented or not")
(tabulator :initarg :tabulator
@@ -400,7 +404,7 @@
(current-form :initform nil
:accessor page-current-form :documentation "During the rewinding phase the form or the action-link whose action has been fired")
(doc-type :initarg :doc-type
- :accessor page-doc-type :documentation "The DOCUMENT TYPE of the page (default to HTML 4.01 STRICT)")
+ :accessor page-doc-type :documentation "The DOCUMENT TYPE of the page (default to HTML 4.01 Transitional)")
(lasttag :initform nil
:accessor page-lasttag :documentation "Last rendered tag. Needed for page output rendering")
(json-component-count :initarg :json-component-count
@@ -434,10 +438,11 @@
:stylesheet-files nil
:class-initscripts nil
:instance-initscripts nil
+ :initstyles nil
:indent t
:tabulator 0
:xmloutput nil
- :doc-type *html-4.01-strict*
+ :doc-type *html-4.01-transitional*
:request-parameters nil
:mime-type "text/html")
(:documentation "A page object holds claw components to be rendered") )
@@ -480,7 +485,9 @@
(class-initscripts :initarg :class-initscripts
:accessor htcomponent-class-initscripts :documentation "Page injectable javascript class derectives")
(instance-initscript :initarg :instance-initscript
- :accessor htcomponent-instance-initscript :documentation "Page injectable javascript instance derectives"))
+ :accessor htcomponent-instance-initscript :documentation "Page injectable javascript instance derectives")
+ (initstyles :initarg :initstyles
+ :accessor htcomponent-initstyles :documentation "Component injectable css derectives"))
(:default-initargs :page nil
:body nil
:json-render-on-validation-errors-p nil
@@ -491,7 +498,8 @@
:script-files nil
:stylesheet-files nil
:class-initscripts nil
- :instance-initscript nil)
+ :instance-initscript nil
+ :initstyles nil)
(:documentation "Base class for all other claw components"))
(defclass tag (htcomponent)
@@ -605,8 +613,7 @@
(when parameters
(setf retval (gethash (string-upcase name) parameters))
(if (or (null retval) as-list)
- (progn
- retval)
+ retval
(first retval)))))
(defmethod page-format ((page page) str &rest rest)
@@ -637,11 +644,10 @@
(or (page-req-parameter page "jsonSuffix" nil) ""))
(defmethod page-init ((page page))
- (progn
- (reset-request-id-table-map)
- (setf (page-can-print page) (null (page-json-id-list page)))
- (reset-request-id-table-map)
- (setf (page-tabulator page) 0)))
+ (reset-request-id-table-map)
+ (setf (page-can-print page) (null (page-json-id-list page)))
+ (reset-request-id-table-map)
+ (setf (page-tabulator page) 0))
(defmethod page-render-headings ((page page))
(let* ((jsonp (page-json-id-list page))
@@ -679,44 +685,41 @@
(*validation-errors* nil)
(*validation-compliances* nil)
(jsonp (page-json-id-list page)))
- (progn
- (page-init page)
- (page-before-render page)
- (when (page-req-parameter page *rewind-parameter*)
- (htcomponent-rewind (page-content page) page))
- (page-init page)
- (htcomponent-prerender (page-content page) page) ;Here we need a fresh new body!!!
- (page-render-headings page)
- (page-init page)
- (when jsonp
- (page-format-raw page (page-json-prefix page))
- (page-format-raw page "{components:{"))
- (htcomponent-render (page-content page) page) ;Here we need a fresh new body!!!
- (when jsonp
- (page-format-raw page "},classInjections:\"")
- (setf (page-can-print page) t
- (page-injection-writing-p page) t)
- (dolist (injection (page-init-injections page))
- (when injection
- (htcomponent-render injection page)))
- (page-format-raw page "\",instanceInjections:\"")
- (let ((init-scripts (htbody-init-scripts-tag page)))
- (when init-scripts
- (htcomponent-render init-scripts page)))
- (page-format-raw page "\",errors:")
- (page-format-raw page (json-validation-errors))
- (page-format-raw page ",valid:")
- (page-format-raw page (json-validation-compliances))
- (page-format-raw page "}")
- (page-format-raw page (page-json-suffix page))))))
+ (page-init page)
+ (page-before-render page)
+ (when (page-req-parameter page *rewind-parameter*)
+ (htcomponent-rewind (page-content page) page))
+ (page-init page)
+ (htcomponent-prerender (page-content page) page) ;Here we need a fresh new body!!!
+ (page-render-headings page)
+ (page-init page)
+ (when jsonp
+ (page-format-raw page (page-json-prefix page))
+ (page-format-raw page "{components:{"))
+ (htcomponent-render (page-content page) page) ;Here we need a fresh new body!!!
+ (when jsonp
+ (page-format-raw page "},classInjections:\"")
+ (setf (page-can-print page) t
+ (page-injection-writing-p page) t)
+ (dolist (injection (page-init-injections page))
+ (when injection
+ (htcomponent-render injection page)))
+ (page-format-raw page "\",instanceInjections:\"")
+ (let ((init-scripts (htbody-init-scripts-tag page)))
+ (when init-scripts
+ (htcomponent-render init-scripts page)))
+ (page-format-raw page "\",errors:")
+ (page-format-raw page (json-validation-errors))
+ (page-format-raw page ",valid:")
+ (page-format-raw page (json-validation-compliances))
+ (page-format-raw page "}")
+ (page-format-raw page (page-json-suffix page)))))
(defmethod page-body-init-scripts ((page page))
(let ((js-body ""))
(dolist (current-js (reverse (page-instance-initscripts page)))
(setf js-body (format nil "~a~%~a~%" js-body current-js)))
- (if (string= "" js-body)
- js-body
- (format nil "~a" js-body))))
+ (format nil "~@[~a~]" js-body)))
(defmethod page-print-tabulation ((page page))
(let ((tabulator (page-tabulator page))
@@ -733,11 +736,16 @@
(defmethod page-init-injections ((page page))
(let ((tag-list)
- (class-init-scripts ""))
+ (class-init-scripts "")
+ (init-styles ""))
(dolist (script (reverse (page-class-initscripts page)))
(setf class-init-scripts (format nil "~a~%~a"
class-init-scripts
script)))
+ (dolist (style (reverse (page-initstyles page)))
+ (setf init-styles (format nil "~a~%~a"
+ init-styles
+ style)))
(unless (string= "" class-init-scripts)
(let ((current-js (script> :type "text/javascript")))
(setf (htcomponent-body current-js) class-init-scripts)
@@ -754,7 +762,10 @@
(let ((current-css (link> :rel "stylesheet" :type "text/css" :href "")))
(setf (getf (htcomponent-attributes current-css) :href) css-file)
(push current-css tag-list))))
-
+ (unless (string= "" init-styles)
+ (let ((current-css (style> :type "text/css")))
+ (setf (htcomponent-body current-css) (list init-styles))
+ (push current-css tag-list)))
tag-list))
(defmethod page-current-component ((page page))
@@ -944,15 +955,13 @@
(null jsonp)
(null (and jsonp
(string= id (first (page-json-component-id-list page)))))))
- (progn
- (decf (page-tabulator page))
- (if (string= tagname previous-tagname)
- (progn
- (page-format page "</~a>" tagname))
- (progn
- (page-newline page)
- (page-print-tabulation page)
- (page-format page "</~a>" tagname)))))
+ (decf (page-tabulator page))
+ (if (string= tagname previous-tagname)
+ (page-format page "</~a>" tagname)
+ (progn
+ (page-newline page)
+ (page-print-tabulation page)
+ (page-format page "</~a>" tagname))))
(setf (page-lasttag page) nil)))
(defmethod htcomponent-render ((tag tag) (page page))
@@ -1084,7 +1093,7 @@
(unless (getf (htcomponent-attributes htlink) :type)
(append '(:type "text/css") (htcomponent-attributes htlink)))
(unless (getf (htcomponent-attributes htlink) :rel)
- (append '(:rel "styleshhet") (htcomponent-attributes htlink)))
+ (append '(:rel "stylesheet") (htcomponent-attributes htlink)))
(tag-render-starttag htlink page)
(tag-render-endtag htlink page))
(when (null previous-print-status)
@@ -1119,13 +1128,13 @@
(let ((js (script> :type "text/javascript"))
(js-control-string-directive (if on-load
"
-var bodyInitFunction = function\(e){~{~a~}};~%
+var bodyInitFunction = function\(e){~{~a~%~}};~%
if (/MSIE (\\d+\\.\\d+);/.test(navigator.userAgent)) {~%
window.attachEvent\('onload', bodyInitFunction);~%
} else {~%
document.addEventListener\('DOMContentLoaded', bodyInitFunction, false);~%
}"
- "~{~a~}~%"))
+ "~{~a~%~}~%"))
(page-body-init-scripts (page-body-init-scripts page)))
(setf (htcomponent-page js) page
(htcomponent-body js) (when page-body-init-scripts
@@ -1260,8 +1269,8 @@
(pushnew css (page-stylesheet-files page) :test #'equal)))
(dolist (js (htcomponent-class-initscripts wcomponent))
(pushnew js (page-class-initscripts page) :test #'equal))
- (when (htcomponent-instance-initscript wcomponent)
- (pushnew (htcomponent-instance-initscript wcomponent) (page-instance-initscripts page) :test #'equal)))
+ (dolist (style (htcomponent-initstyles wcomponent))
+ (pushnew style (page-initstyles page) :test #'equal)))
(if (listp template)
(dolist (tag template)
(when (subtypep (type-of tag) 'htcomponent)
More information about the Claw-cvs
mailing list