Changeset 71

Timestamp:

08/26/08 10:50:29 (3 months ago)

Author:

achiumenti

Message:

CLAW html framework

Location:

trunk/main/claw-html

Files:

• claw-html.asd (modified) (1 diff)
• src/components.lisp (modified) (6 diffs)
• src/packages.lisp (modified) (2 diffs)
• src/tags.lisp (modified) (15 diffs)

trunk/main/claw-html/claw-html.asd

@@ -42 +42 @@
                                      ;(:file "logger" :depends-on ("misc"))
                                      ;(:file "session-manager" :depends-on ("misc"))
-                                     (:file "tags" :depends-on ("packages"))
-                                     (:file "meta" :depends-on ("packages"))
+                                     (:file "meta" :depends-on ("packages"))
+                                     (:file "tags" :depends-on ("packages" "meta"))                                     
                                      (:file "components" :depends-on ("tags" "meta"))
                                      (:file "validators" :depends-on ("components"))

trunk/main/claw-html/src/components.lisp

@@ -62 +62 @@
              :accessor action
              :documentation "Function performed after user submission")
+     (action-object :initarg :action-object
+                    :accessor action-object
+                    :documentation "The object that will be applied to the ACTION property")
      (css-class :initarg :class
                 :reader css-class
@@ -68 +71 @@
              :reader form-method
              :documentation "Form post method (may be \"get\" or \"post\")"))
-  (:default-initargs :action nil :class nil :method "post")
+  (:default-initargs :action nil :class nil :method "post" :action-object nil)
   (:documentation "Internal use component"))
 
@@ -77 +80 @@
                action
                (cform-rewinding-p obj pobj))
-      (funcall action pobj))))
+      (funcall action (or (action-object obj) pobj)))))
 
 (defmethod cform-rewinding-p ((cform _cform) (page page))
@@ -214 +217 @@
 (defclass cinput (base-cinput)
     ((input-type :initarg :type
-                :reader input-type
-                :documentation "The html <input> TYPE attribute. For submit type, use the CSUBMIT> function."))
+                 :reader input-type
+                 :documentation "The html <input> TYPE attribute. For submit type, use the CSUBMIT> function."))
     (:metaclass metacomponent)
     (:default-initargs :reserved-parameters (list :value :name) :empty t :type "text")
@@ -255 +258 @@
           (validator (validator cinput))
           (value (translator-decode (translator cinput) cinput)))
-;      (log-message :info "********************* ~a : ~a" cinput value)
       (unless (or (null value) (component-validation-errors cinput))
         (when validator
@@ -368 +370 @@
           (submitted-p (page-req-parameter pobj (htcomponent-client-id obj))))
       (unless (or (null current-form) (null submitted-p) (null action))
-        (setf (action current-form) action)))))
+        (setf (action current-form) action
+              (action-object current-form) (or (action-object obj) (action-object current-form)))))))
 
 ;-----------------------------------------------------------------------------

trunk/main/claw-html/src/packages.lisp

@@ -48 +48 @@
 
            ;#:duplicate-back-slashes
+           #:attribute-value
            #:build-tagf
            #:page
+           #:page-before-render
            #:page-render
            #:make-page-renderer
@@ -81 +83 @@
            #:$raw>
                                         ;empty tags definition
+           #:*empty-tags*
            #:area>
            #:base>

trunk/main/claw-html/src/tags.lisp

@@ -65 +65 @@
  - PAGE is the page instance that must be given"))
 
+(defgeneric page-before-render (page)
+  (:documentation "This method is called as first instruction of PAGE-RENDER.
+ - PAGE is the page instance that must be given"))
+
 (defgeneric page-init-injections (page)
   (:documentation "This internal method is called during the request cycle phase to reset page slots that
@@ -248 +252 @@
 
 (defvar *claw-current-page* nil
-    "The CLAW page currently rendering")
-
-(defvar *id-table-map* 
+  "The CLAW page currently rendering")
+
+(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
@@ -262 +266 @@
   "*FILE-TRANSLATOR* is the default translator for any CINPUT component of type \"file\".")
 
-
+(defstruct list-for-tag-attribute
+  "Since tag attributes values are flattened, it is impossible to pass lists as values. Use this struct to pass lists to values"
+  (value nil))
+
+(defun attribute-value (value)
+  "Creates an unflattenable value for tag attributes. This is particularly useful when you need to pass a list as an attribute value"
+  (make-list-for-tag-attribute :value value))
 
 (defun flatten (tree &optional result-list)
@@ -291 +301 @@
                    (or (keywordp elem)
                        (keywordp last-elem)))
-              (push elem attributes)
+              (push (or (when (list-for-tag-attribute-p elem) (list-for-tag-attribute-value elem)) elem) attributes)
               (when elem
                 (push elem body))))
@@ -357 +367 @@
 
 ;;;----------------------------------------------------------------
-#|
-(defclass message-dispatcher ()
-  ()
-  (:documentation "This is and interface for message dispatchers"))
-
-(defclass simple-message-dispatcher (message-dispatcher)
-  ((locales :initform (make-hash-table :test #'equal)
-            :accessor simple-message-dispatcher-locales
-            :documentation "Hash table of locales strings and KEY/VALUE message pairs"))
-  (:documentation "A message disptcher that leave data unchanged during encoding and decoding phases."))
-
-(defclass i18n-aware (message-dispatcher)
-  ((message-dispatcher :initarg :message-dispatcher
-                       :accessor message-dispatcher
-                       :documentation "Reference to a MESSAGE-DISPATCHER instance"))
-  (:default-initargs :message-dispatcher nil)
-  (:documentation "All classes that need to dispatch messages are subclasses of I18N-AWARE"))
-|#
 
 (defclass page()
@@ -413 +405 @@
                     :documentation "http request post parameters")
    (get-parameters :initarg :get-parameters
-                    :reader page-get-parameters
-                    :documentation "http request get parameters")
+                   :reader page-get-parameters
+                   :documentation "http request get parameters")
    (components-stack :initform nil
                      :accessor page-components-stack
@@ -425 +417 @@
                              :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"))
+                        :accessor page-injection-writing-p
+                        :documentation "Flag that becomes true when rendering page injections"))
   (:default-initargs :writer t
     :external-format-encoding :utf-8
@@ -445 +437 @@
   "Generates a lambda function from PAGE-RENDER method, that may be used into LISPLET-REGISTER-FUNCTION-LOCATION"
   #'(lambda () (with-output-to-string (*standard-output*)
-                 (page-render (make-instance page-class :post-parameters http-post-parameters :get-parameters http-get-parameters)))))
+                 (page-render (make-instance page-class 
+                                             :post-parameters (if (functionp http-post-parameters)
+                                                                  (funcall http-post-parameters)
+                                                                  http-post-parameters) 
+                                             :get-parameters (if (functionp http-get-parameters)
+                                                                 (funcall http-get-parameters)
+                                                                 http-get-parameters))))))
 
 (defclass htcomponent ()
@@ -662 +660 @@
     (subseq js-array 0 (1- (length js-array)))))
 
+(defmethod page-before-render ((page page))
+  nil)
+
 (defmethod page-render ((page page))
   (let ((*claw-current-page* page)
-        (*id-table-map* nil)
+        (*id-table-map* (make-hash-table :test 'equal))
         (*validation-errors* nil)
         (*validation-compliances* nil)
-        (body (page-content page))
         (jsonp (page-json-id-list page)))
-    (if (null body)
-        (format nil "null body for page ~a~%" (type-of page))
-        (progn
-          (page-init page)
-          (when (page-req-parameter page *rewind-parameter*)
-            (htcomponent-rewind body 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)))))))
+    (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))))))
 
 (defmethod page-body-init-scripts ((page page))
@@ -758 +757 @@
 ;;;========= HTCOMPONENT ============================
 (defmethod htcomponent-can-print ((htcomponent htcomponent))
-  (let* ((id (when (slot-boundp htcomponent 'client-id) (htcomponent-client-id htcomponent)))
-         (page (htcomponent-page htcomponent))
-         (print-status (page-can-print page))
-         (validation-errors *validation-errors*)
-         (json-render-on-validation-errors-p (htcomponent-json-render-on-validation-errors-p htcomponent))
-         (render-p (or (and (member id (page-json-id-list page) :test #'string=)
-                            (null validation-errors))
-                       print-status)))
-    (or json-render-on-validation-errors-p print-status render-p)))
+(let* ((id (when (slot-boundp htcomponent 'client-id) 
+             (htcomponent-client-id htcomponent)))
+       (page (htcomponent-page htcomponent))
+       (print-status (page-can-print page))
+       (validation-errors *validation-errors*)
+       (json-render-on-validation-errors-p (htcomponent-json-render-on-validation-errors-p htcomponent))
+       (render-p (or (and (member id (page-json-id-list page) :test #'string=)
+                          (null validation-errors))
+                     print-status)))
+  (or json-render-on-validation-errors-p print-status render-p)))
 
 (defmethod htcomponent-json-print-start-component ((htcomponent htcomponent))
-  (let* ((page (htcomponent-page htcomponent))
-         (jsonp (page-json-id-list page))
-         (id (when (slot-boundp htcomponent 'client-id) (htcomponent-client-id htcomponent)))
-         (validation-errors *validation-errors*))
-    (when (and jsonp
-               (or (and (null validation-errors)
-                        (member id jsonp :test #'string-equal))
-                   (htcomponent-json-render-on-validation-errors-p htcomponent)))
-      (when (> (page-json-component-count page) 0)
-        (page-format page ","))
-      (page-format-raw page "~a:\"" id)
-      (push id (page-json-component-id-list page))
-      (incf (page-json-component-count page)))))
+(let* ((page (htcomponent-page htcomponent))
+       (jsonp (page-json-id-list page))
+       (id (when (slot-boundp htcomponent 'client-id) 
+             (htcomponent-client-id htcomponent)))
+       (validation-errors *validation-errors*))
+  (when (and jsonp
+             (or (and (null validation-errors)
+                      (member id jsonp :test #'string-equal))
+                 (htcomponent-json-render-on-validation-errors-p htcomponent)))
+    (when (> (page-json-component-count page) 0)
+      (page-format page ","))
+    (page-format-raw page "~a:\"" id)
+    (push id (page-json-component-id-list page))
+    (incf (page-json-component-count page)))))
 
 (defmethod htcomponent-json-print-end-component ((htcomponent htcomponent))
-  (let* ((page (htcomponent-page htcomponent))
-         (jsonp (page-json-id-list page))
-         (id (when (slot-boundp htcomponent 'client-id) (htcomponent-client-id htcomponent)))
-         (validation-errors *validation-errors*))
-    (when (and jsonp
-               (or (and (null validation-errors)
-                        (member id jsonp :test #'string-equal))
-                   (htcomponent-json-render-on-validation-errors-p htcomponent)))
-      (pop (page-json-component-id-list page))
-      (page-format-raw page "\""))))
+(let* ((page (htcomponent-page htcomponent))
+       (jsonp (page-json-id-list page))
+       (id (when (slot-boundp htcomponent 'client-id) (htcomponent-client-id htcomponent)))
+       (validation-errors *validation-errors*))
+  (when (and jsonp
+             (or (and (null validation-errors)
+                      (member id jsonp :test #'string-equal))
+                 (htcomponent-json-render-on-validation-errors-p htcomponent)))
+    (pop (page-json-component-id-list page))
+    (page-format-raw page "\""))))
 
 (defmethod htcomponent-rewind :before ((htcomponent htcomponent) (page page))
-  (setf (htcomponent-page htcomponent) page)
-  (push htcomponent (page-components-stack page)))
+(setf (htcomponent-page htcomponent) page)
+(push htcomponent (page-components-stack page)))
 
 (defmethod htcomponent-prerender :before ((htcomponent htcomponent) (page page))
-  (let ((render-condition (htcomponent-render-condition htcomponent)))
-    (unless (and render-condition (null (funcall render-condition)))
-      (setf (htcomponent-page htcomponent) page)
-      (push htcomponent (page-components-stack page)))))
+(let ((render-condition (htcomponent-render-condition htcomponent)))
+  (unless (and render-condition (null (funcall render-condition)))
+    (setf (htcomponent-page htcomponent) page)
+    (push htcomponent (page-components-stack page)))))
 
 (defmethod htcomponent-render :before ((htcomponent htcomponent) (page page))
-  (let ((render-condition (htcomponent-render-condition htcomponent)))
-    (unless (and render-condition (null (funcall render-condition)))
-      (setf (htcomponent-page htcomponent) page)
-      (push htcomponent (page-components-stack page)))))
+(let ((render-condition (htcomponent-render-condition htcomponent)))
+  (unless (and render-condition (null (funcall render-condition)))
+    (setf (htcomponent-page htcomponent) page)
+    (push htcomponent (page-components-stack page)))))
 
 (defmethod htcomponent-rewind :after ((htcomponent htcomponent) (page page))
-  (pop (page-components-stack page)))
+(pop (page-components-stack page)))
 
 (defmethod htcomponent-prerender :after ((htcomponent htcomponent) (page page))
-  (let ((render-condition (htcomponent-render-condition htcomponent)))
-    (unless (and render-condition (null (funcall render-condition)))
-      (pop (page-components-stack page)))))
+(let ((render-condition (htcomponent-render-condition htcomponent)))
+  (unless (and render-condition (null (funcall render-condition)))
+    (pop (page-components-stack page)))))
 
 (defmethod htcomponent-render :after ((htcomponent htcomponent) (page page))
-  (let ((render-condition (htcomponent-render-condition htcomponent)))
-    (unless (and render-condition (null (funcall render-condition)))
-      (pop (page-components-stack page)))))
+(let ((render-condition (htcomponent-render-condition htcomponent)))
+  (unless (and render-condition (null (funcall render-condition)))
+    (pop (page-components-stack page)))))
 
 (defmethod htcomponent-rewind ((htcomponent htcomponent) (page page))
-  (dolist (tag (htcomponent-body htcomponent))
-    (when (subtypep (type-of tag) 'htcomponent)
-      (htcomponent-rewind tag page))))
+(dolist (tag (htcomponent-body htcomponent))
+  (when (subtypep (type-of tag) 'htcomponent)
+    (htcomponent-rewind tag page))))
 
 (defmethod htcomponent-prerender ((htcomponent htcomponent) (page page))
-  (let ((previous-print-status (page-can-print page))
-        (render-condition (htcomponent-render-condition htcomponent)))
-    (unless (and render-condition (null (funcall render-condition)))
-      (when (null previous-print-status)
-        (setf (page-can-print page) (htcomponent-can-print htcomponent)))
-      (dolist (tag (htcomponent-body htcomponent))
-        (when (subtypep (type-of tag) 'htcomponent)
-          (htcomponent-prerender tag page)))
-      (when (null previous-print-status)
-        (setf (page-can-print page) nil)))))
+(let ((previous-print-status (page-can-print page))
+      (render-condition (htcomponent-render-condition htcomponent)))
+  (unless (and render-condition (null (funcall render-condition)))
+    (when (null previous-print-status)
+      (setf (page-can-print page) (htcomponent-can-print htcomponent)))
+    (dolist (tag (htcomponent-body htcomponent))
+      (when (subtypep (type-of tag) 'htcomponent)
+        (htcomponent-prerender tag page)))
+    (when (null previous-print-status)
+      (setf (page-can-print page) nil)))))
 
 (defmethod htcomponent-render ((htcomponent htcomponent) (page page))
-  (let ((body-list (htcomponent-body htcomponent))
-        (previous-print-status (page-can-print page))
-        (render-condition (htcomponent-render-condition htcomponent)))
-    (unless (and render-condition (null (funcall render-condition)))
-      (when (null previous-print-status)
-        (setf (page-can-print page) (htcomponent-can-print htcomponent))
-        (htcomponent-json-print-start-component htcomponent))
-      (dolist (child-tag body-list)
-        (when child-tag
-          (cond
-            ((stringp child-tag) (htcomponent-render ($> child-tag) page))
-            ((functionp child-tag) (htcomponent-render ($> (funcall child-tag)) page))
-            (t (htcomponent-render child-tag page)))))
-      (when (null previous-print-status)
-        (setf (page-can-print page) nil)
-        (htcomponent-json-print-end-component htcomponent)))))
+(let ((body-list (htcomponent-body htcomponent))
+      (previous-print-status (page-can-print page))
+      (render-condition (htcomponent-render-condition htcomponent)))
+  (unless (and render-condition (null (funcall render-condition)))
+    (when (null previous-print-status)
+      (setf (page-can-print page) (htcomponent-can-print htcomponent))
+      (htcomponent-json-print-start-component htcomponent))
+    (dolist (child-tag body-list)
+      (when child-tag
+        (cond
+          ((stringp child-tag) (htcomponent-render ($> child-tag) page))
+          ((functionp child-tag) (htcomponent-render ($> (funcall child-tag)) page))
+          (t (htcomponent-render child-tag page)))))
+    (when (null previous-print-status)
+      (setf (page-can-print page) nil)
+      (htcomponent-json-print-end-component htcomponent)))))
 
 ;;;========= TAG =====================================
 (defmethod tag-attributes ((tag tag))
-  (htcomponent-attributes tag))
+(htcomponent-attributes tag))
 
 (defmethod tag-render-attributes ((tag tag) (page page))
-  (when (htcomponent-attributes tag)
-    (loop for (k v) on (htcomponent-attributes tag) by #'cddr
-       do (progn
-            (assert (keywordp k))
-            (when (and (functionp v) (not (eq k :render-condition)))
-              (setf v (funcall v)))
-            (when (numberp v)
-              (setf v (princ-to-string v)))
-            (when (and (not (eq k :render-condition)) v (string-not-equal v ""))
-              (page-format page " ~a=\"~a\""
-                           (if (eq k :static-id)
-                               "id"
-                               (parenscript::symbol-to-js k))
-                           (let ((s (if (eq k :id)
-                                        (prin1-to-string (htcomponent-client-id tag))
-                                        (if (eq t v)
-                                            "\"true\""
-                                            (prin1-to-string v))))) ;escapes double quotes
-                             (subseq s 1 (1- (length s))))))))))
+(when (htcomponent-attributes tag)
+  (loop for (k v) on (htcomponent-attributes tag) by #'cddr
+     do (progn
+          (assert (keywordp k))
+          (when (and (functionp v) (not (eq k :render-condition)))
+            (setf v (funcall v)))
+          (when (numberp v)
+            (setf v (princ-to-string v)))
+          (when (and (not (eq k :render-condition)) v (string-not-equal v ""))
+            (page-format page " ~a=\"~a\""
+                         (if (eq k :static-id)
+                             "id"
+                             (parenscript::symbol-to-js k))
+                         (let ((s (if (eq k :id)
+                                      (prin1-to-string (htcomponent-client-id tag))
+                                      (if (eq t v)
+                                          "\"true\""
+                                          (prin1-to-string v))))) ;escapes double quotes
+                           (subseq s 1 (1- (length s))))))))))
 
 (defmethod tag-render-starttag ((tag tag) (page page))
-  (let ((tagname (tag-name tag))
-        (id (when (slot-boundp tag 'client-id) (htcomponent-client-id tag)))
-        (jsonp (page-json-id-list page))
-        (emptyp (htcomponent-empty tag))
-        (xml-p (page-xmloutput page))
-        (injection-writing-p (page-injection-writing-p page)))
-    (setf (page-lasttag page) tagname)
-    (when (or injection-writing-p
-              (null jsonp)
-              (null (and jsonp 
-                         (string= id (first (page-json-component-id-list page))))))
-      (page-newline page)
-      (page-print-tabulation page)
-      (page-format page "<~a" tagname)
-      (tag-render-attributes tag page)
-      (if (null emptyp)
+(let ((tagname (tag-name tag))
+      (id (when (slot-boundp tag 'client-id) (htcomponent-client-id tag)))
+      (jsonp (page-json-id-list page))
+      (emptyp (htcomponent-empty tag))
+      (xml-p (page-xmloutput page))
+      (injection-writing-p (page-injection-writing-p page)))
+  (setf (page-lasttag page) tagname)
+  (when (or injection-writing-p
+            (null jsonp)
+            (null (and jsonp 
+                       (string= id (first (page-json-component-id-list page))))))
+    (page-newline page)
+    (page-print-tabulation page)
+    (page-format page "<~a" tagname)
+    (tag-render-attributes tag page)
+    (if (null emptyp)
+        (progn
+          (page-format page ">")
+          (incf (page-tabulator page)))
+        (if (null xml-p)
+            (page-format page ">")
+            (page-format page "/>"))))))
+
+(defmethod tag-render-endtag ((tag tag) (page page))
+(let ((tagname (tag-name tag))
+      (id (when (slot-boundp tag 'client-id) (htcomponent-client-id tag)))
+      (jsonp (page-json-id-list page))
+      (previous-tagname (page-lasttag page))
+      (emptyp (htcomponent-empty tag))
+      (injection-writing-p (page-injection-writing-p page)))
+  (when (and (null emptyp)
+             (or injection-writing-p
+                 (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 ">")
-            (incf (page-tabulator page)))
-          (if (null xml-p)
-              (page-format page ">")
-              (page-format page "/>"))))))
-
-(defmethod tag-render-endtag ((tag tag) (page page))
-  (let ((tagname (tag-name tag))
-        (id (when (slot-boundp tag 'client-id) (htcomponent-client-id tag)))
-        (jsonp (page-json-id-list page))
-        (previous-tagname (page-lasttag page))
-        (emptyp (htcomponent-empty tag))
-        (injection-writing-p (page-injection-writing-p page)))
-    (when (and (null emptyp)
-               (or injection-writing-p
-                   (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)))))
-    (setf (page-lasttag page) nil)))
+            (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))
-  (let ((body-list (htcomponent-body tag))
-        (previous-print-status (page-can-print page))
-        (render-condition (htcomponent-render-condition tag)))
-    (unless (and render-condition (null (funcall render-condition)))
-      (when (null previous-print-status)
-        (setf (page-can-print page) (htcomponent-can-print tag))
-        (htcomponent-json-print-start-component tag))
-      (when (or (page-can-print page) previous-print-status)
-        (tag-render-starttag tag page))
-      (dolist (child-tag body-list)
-        (when child-tag
-          (cond
-            ((stringp child-tag) (htcomponent-render ($> child-tag) page))
-            ((functionp child-tag) (htcomponent-render ($> (funcall child-tag)) page))
-            (t (htcomponent-render child-tag page)))))
-      (when (or (page-can-print page) previous-print-status)
-        (tag-render-endtag tag page))
-      (unless previous-print-status
-        (setf (page-can-print page) nil)