Author: achiumenti Date: Tue Jan 13 13:03:03 2009 New Revision: 184

Log: Added html template capabilities for pages and components

Added: trunk/main/claw-html/src/parser.lisp Modified: trunk/main/claw-html/claw-html.asd trunk/main/claw-html/src/meta.lisp 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 Tue Jan 13 13:03:03 2009 @@ -31,10 +31,11 @@ :name "claw-html" :author "Andrea Chiumenti" :description "Common Lisp Active Web HTML generator." - :depends-on (:closer-mop :local-time :parenscript :cl-ppcre :split-sequence) + :depends-on (:closer-mop :local-time :parenscript :cl-ppcre :split-sequence :closure-html) :components ((:module src :components ((:file "packages") (:file "meta" :depends-on ("packages")) + (:file "parser" :depends-on ("packages")) (:file "tags" :depends-on ("packages" "meta")) (:file "components" :depends-on ("tags" "meta")) (:file "validators" :depends-on ("components"))

Modified: trunk/main/claw-html/src/meta.lisp ============================================================================== --- trunk/main/claw-html/src/meta.lisp (original) +++ trunk/main/claw-html/src/meta.lisp Tue Jan 13 13:03:03 2009 @@ -29,6 +29,9 @@

(in-package :claw-html)

+(defvar *components-templates* (make-hash-table) + "Hash table that stores the templates for CLAW components") + (defclass metacomponent (standard-class) () (:documentation "This is the meta class the must be set for every WCOMPONENT.

Modified: trunk/main/claw-html/src/packages.lisp ============================================================================== --- trunk/main/claw-html/src/packages.lisp (original) +++ trunk/main/claw-html/src/packages.lisp Tue Jan 13 13:03:03 2009 @@ -31,7 +31,7 @@

(defpackage :claw-html - (:use :cl :closer-mop :local-time :parenscript :cl-ppcre :split-sequence) + (:use :cl :closer-mop :local-time :parenscript :cl-ppcre :split-sequence :closure-html) (:shadow :flatten) (:documentation "A comprehensive web application framework and server for the Common Lisp programming language") (:export #:*html-4.01-strict* @@ -43,6 +43,7 @@ #:*rewind-parameter* #:*validation-errors* #:*claw-current-page* + #:*claw-this-component* #:error-page #:render-error-page

@@ -51,6 +52,7 @@ #:build-tagf #:page #:page-before-render + #:template #:page-render #:make-page-renderer #:page-current-form @@ -60,7 +62,7 @@ #:page-global-initscripts #:page-initscripts #:page-initstyles - #:page-current-component + #:current-component #:page-body-initscripts #:htcomponent #:htcomponent-page @@ -83,6 +85,8 @@ #:htstring #:$> #:$raw> + #:htignore + #:ignore> ;empty tags definition #:*empty-tags* #:area> @@ -177,6 +181,7 @@ #:u> #:ul> #:var> + #:parse-claw-template ;; class modifiers #:page-content #:generate-id

Added: trunk/main/claw-html/src/parser.lisp ============================================================================== --- (empty file) +++ trunk/main/claw-html/src/parser.lisp Tue Jan 13 13:03:03 2009 @@ -0,0 +1,125 @@ +;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*- +;;; $Header: src/components.lisp $ + +;;; Copyright (c) 2008, Andrea Chiumenti. All rights reserved. + +;;; Redistribution and use in source and binary forms, with or without +;;; modification, are permitted provided that the following conditions +;;; are met: + +;;; * Redistributions of source code must retain the above copyright +;;; notice, this list of conditions and the following disclaimer. + +;;; * Redistributions in binary form must reproduce the above +;;; copyright notice, this list of conditions and the following +;;; disclaimer in the documentation and/or other materials +;;; provided with the distribution. + +;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED +;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY +;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE +;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, +;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING +;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +(in-package :claw-html) + +(defclass claw-html-builder (chtml::lhtml-builder) + ()) + +(defun make-claw-html-builder () + (make-instance 'claw-html-builder)) + +(defmethod hax:start-element ((handler claw-html-builder) name attrs) + (let* ((parent (car (chtml::stack handler))) + (this (list (find-symbol (format nil "~a>" (string-upcase name)) :claw-html) + (flatten (chtml::pt-attributes-to-lhtml attrs))))) + (push this (chtml::stack handler)) + (if parent + (push this (cddr parent)) + (setf (chtml::root handler) this)))) + +(defmethod hax:end-element ((handler claw-html-builder) name) + (let ((current (pop (chtml::stack handler)))) + (setf (cdr current) + (append (cadr current) (reverse (cddr current)))))) + +;; component parser + +(defvar *component-content-template* nil) + +(defclass claw-html-component-builder (claw-html-builder) + ((component-content-template :initform nil + :accessor component-content-template-p) + (component-content-ignore :initform nil + :accessor component-content-ignore-p) + (parsed-content :initform nil + :accessor parsed-content))) + +(defun make-claw-html-component-builder () + (make-instance 'claw-html-component-builder)) + +(defmethod hax:start-element :before ((handler claw-html-builder) name attrs) + (dolist (attr attrs) + (cond + ((and (string-equal (hax:attribute-name attr) "CLAWTYPE") + (string-equal (hax:attribute-value attr) "$ignore$")) + (setf (component-content-ignore-p handler) t)) + ((and (string-equal (hax:attribute-name attr) "CLAWTYPE") + (string-equal (hax:attribute-value attr) "$content$") + (null (component-content-ignore-p handler))) + (if (component-content-template-p handler) + (error "$content$ found multiple times in template") + (setf (component-content-template-p handler) t)))))) + +(defun parse-attributes (attrs) + (loop for (key value) on attrs by #'cddr + collect key + when value collect (parse-attribute-value value))) + +(defun parse-attribute-value (value) + (multiple-value-bind (result matchesp) + (cl-ppcre:regex-replace "(?i)(^\$lisp>)+([.])*" value "\2") + (if matchesp + (read-from-string result) + result))) + + +(defmethod hax:end-element ((handler claw-html-component-builder) name) + (let ((current (pop (chtml::stack handler)))) + (let ((attrs (parse-attributes (cadr current)))) + (cond + ((string-equal (getf attrs :clawtype) "$ignore$") + (setf (cdr current) nil + attrs nil + (component-content-ignore-p handler) nil + (car current) (find-symbol "IGNORE>" "CLAW-HTML"))) + ((string-equal (getf attrs :clawtype) "$body$") + (setf (cdr current) nil + attrs (list (find-symbol "*CLAW-THIS-COMPONENT*" "CLAW-HTML")) + (car current) (find-symbol "HTCOMPONENT-BODY" "CLAW-HTML"))) + ((and (component-content-template-p handler) + (string-equal (getf attrs :clawtype) "$content$") + (null (parsed-content handler))) + (remf attrs :clawtype) + (setf (parsed-content handler) (append (list (first current)) + attrs + (reverse (cddr current)))))) + (unless (component-content-ignore-p handler) + (setf (cdr current) + (append attrs (reverse (cddr current)))))))) + + +(defun parse-claw-template (input) + "Parses the input and returns a claw form template (i.e. a CLAW-HTML:TAG instance) and returns a lambda function with no parameters. +The inpus may be a string a file or a stream. +" + (eval `(lambda () ,(let ((handler (make-claw-html-component-builder))) + (chtml:parse input handler) + (let ((result (parsed-content handler))) + (or (parsed-content handler) result)))))) \ No newline at end of file

Modified: trunk/main/claw-html/src/tags.lisp ============================================================================== --- trunk/main/claw-html/src/tags.lisp (original) +++ trunk/main/claw-html/src/tags.lisp Tue Jan 13 13:03:03 2009 @@ -301,6 +301,9 @@ "The CLAW page currently rendering ")

+(defvar *calw-this-component* nil + "Variable set when rendering a WCOMPONENT-TEMPLATE so it is accessible inside the template") + (defvar *id-table-map* (make-hash-table :test 'equal) "Holds an hash table of used components/tags id as keys and the number of their occurrences as values. So if you have a :id "compId" given to a previous component, the second @@ -396,6 +399,7 @@ (id (getf attributes :id)) (static-id (getf attributes :static-id)) (render-condition (getf attributes :render-condition)) + (claw-type (getf attributes :clawtype)) (real-id (or static-id id)) (instance)) (when static-id @@ -403,19 +407,27 @@ (setf id nil)) (when render-condition (remf attributes :render-condition)) - (setf instance (make-instance parent - :empty emptyp - :real-id real-id - :name (string-downcase tag-name) - :render-condition render-condition - :attributes attributes - :body (second fbody))) - (when real-id - (if (null static-id) - (when (and id-table-map id) - (setf (htcomponent-client-id instance) (generate-id id))) - (setf (htcomponent-client-id instance) static-id))) - instance)) + (if claw-type + (let (clawtype-sybol-list (split "([:]){1,2}" (string-upcase claw-type))) + (if (second clawtype-sybol-list) + (setf claw-type (find-symbol (second clawtype-sybol-list) + (first clawtype-sybol-list))) + (setf claw-type (find-symbol (first clawtype-sybol-list)))) + (make-component claw-type attributes (second fbody))) + (progn + (setf instance (make-instance (or claw-type parent) + :empty emptyp + :real-id real-id + :name (string-downcase tag-name) + :render-condition render-condition + :attributes attributes + :body (second fbody))) + (when real-id + (if (null static-id) + (when (and id-table-map id) + (setf (htcomponent-client-id instance) (generate-id id))) + (setf (htcomponent-client-id instance) static-id))) + instance))))

(defun generate-tagf (tag-name emptyp) "Internal function that generates an htcomponent creation function from the component class name @@ -487,7 +499,10 @@ :documentation "Symbol for page charset encoding (Such as UTF-8)") (injection-writing-p :initform nil :accessor page-injection-writing-p - :documentation "Flag that becomes true when rendering page injections")) + :documentation "Flag that becomes true when rendering page injections") + (teamplate :initarg :template + :accessor template + :documentation "A lambda function with no parameters that, when not nil, is used as page-content.")) (:default-initargs :writer t :external-format-encoding :utf-8 :script-files nil @@ -501,9 +516,14 @@ :xmloutput nil :doc-type *html-4.01-transitional* :request-parameters nil + :template nil :mime-type "text/html") (:documentation "A page object holds claw components to be rendered") )

+(defmethod page-content ((page page)) + (when-let (lambda-content (template page)) + (funcall lambda-content))) + (defun make-page-renderer (page-class http-post-parameters http-get-parameters) "Generates a lambda function from PAGE-RENDER method, that may be used into LISPLET-REGISTER-FUNCTION-LOCATION" #'(lambda () (with-output-to-string (*standard-output*) @@ -572,6 +592,10 @@ (:default-initargs :raw nil) (:documentation "Component needed to render strings"))

+(defclass htignore (htcomponent) + () + (:documentation "Ignore all content")) +

(defmethod initialize-instance :after ((inst tag) &rest keys) @@ -589,6 +613,11 @@ "Creates a non escaping htstring component" (make-instance 'htstring :body value :raw t))

+(defun ignore> (&rest ignore) + "Creates an ignore content" + (declare (ignore ignore)) + (make-instance 'htignore)) + (defclass htscript (tag) () (:documentation "Creates a component for rendering a <script> tag"))

@@ -1062,6 +1091,11 @@ (htcomponent-render injection page))) (tag-render-endtag hthead page))))))

+;;;========= HTIGNORE =================================== +(defmethod htcomponent-rewind((htignore htignore) (page page))) +(defmethod htcomponent-prerender((htignore htignore) (page page))) +(defmethod htcomponent-render ((htignore htignore) (page page))) + ;;;========= HTSTRING ===================================

(defmethod htcomponent-rewind((htstring htstring) (page page))) @@ -1222,11 +1256,19 @@ (allow-informal-parameters :initarg :allow-informal-parameters :reader wcomponent-allow-informal-parametersp :allocation :class - :documentation "Determines if the component accepts informal parameters")) + :documentation "Determines if the component accepts informal parameters") + (teamplate :initarg :template + :accessor template + :documentation "A lambda function with no parameters that, when not nil, is used as page-content. *CLAW-THIS-COMPONENT* is set as a closure, so that may be directly used inside the template.")) (:default-initargs :reserved-parameters nil :allow-informal-parameters t) (:documentation "Base class for creationg customized web components. Use this or one of its subclasses to make your own."))

+(defmethod wcomponent-template ((wcomponent wcomponent)) + (let ((*claw-this-component* wcomponent)) + (when-let (lambda-content (template page)) + (funcall lambda-content)))) + (defmethod wcomponent-created ((wcomponent wcomponent)) nil)

@@ -1270,6 +1312,7 @@ (defun make-component (name parameters content) "This function instantiates a wcomponent by the passed NAME, separetes parameters into formal(the ones that are the initarg of a slot, and informal parameters, that have their own slot in common. The CONTENT is the body content." + (remf :clawtype parameters) (unless (or (getf parameters :id) (getf parameters :static-id)) (setf (getf parameters :id) "claw"))