From 41ec4d792a57a1efd282482c2202bf22dbff2d55 Mon Sep 17 00:00:00 2001
From: David Lichteblau <david@lichteblau.com>
Date: Sun, 14 Oct 2007 22:55:06 +0200
Subject: [PATCH] LHTML serialization.

	* src/defpack.lisp (CHTML): New exports serialize-lhtml, serialize-pt.

	* src/parse/lhtml.lisp (SERIALIZE-LHTML-ATTRIBUTES,
	SERIALIZE-LHTML): New.

	* src/parse/html-parser.lisp (PARSE): ignore pathname.
---
 src/defpack.lisp           |  5 ++++-
 src/parse/html-parser.lisp |  1 +
 src/parse/lhtml.lisp       | 31 +++++++++++++++++++++++++++++++
 3 files changed, 36 insertions(+), 1 deletion(-)

diff --git a/src/defpack.lisp b/src/defpack.lisp
index 8d5ac34..18a72ff 100644
--- a/src/defpack.lisp
+++ b/src/defpack.lisp
@@ -125,10 +125,13 @@
 	   #:comment
 
 	   #:make-pt-builder
+	   #:serialize-pt
+	   
 	   #:pt
 	   #:pt-name
 	   #:pt-children
 	   #:pt-parent
 	   #:pt-attrs
 
-	   #:make-lhtml-builder))
+	   #:make-lhtml-builder
+	   #:serialize-lhtml))
diff --git a/src/parse/html-parser.lisp b/src/parse/html-parser.lisp
index 41368e0..55fcf4c 100644
--- a/src/parse/html-parser.lisp
+++ b/src/parse/html-parser.lisp
@@ -65,6 +65,7 @@
 	pt)))
 
 (defun parse (input handler &key pathname)
+  (declare (ignore pathname))
   (etypecase input
     (xstream
      (parse-xstream input handler))
diff --git a/src/parse/lhtml.lisp b/src/parse/lhtml.lisp
index e6b889b..a3a5d39 100644
--- a/src/parse/lhtml.lisp
+++ b/src/parse/lhtml.lisp
@@ -45,6 +45,37 @@
 
 
 
+;;;; Serializing LHTML
+
+(defun serialize-lhtml-attributes (alist)
+  (loop
+     for (name value) in alist
+     collect
+     (let ((n (coerce (symbol-name name) 'rod))
+	   (v (etypecase value
+		(symbol (coerce (string-downcase (symbol-name value)) 'rod))
+		(rod value)
+		(string (coerce value 'rod)))))
+       (hax:make-attribute n v t))))
+
+(defun serialize-lhtml
+    (document handler &key (name "HTML") public-id system-id)
+  (hax:start-document handler name public-id system-id)
+  (labels ((recurse (x)
+	     (typecase x
+	       ((or rod string)
+		(hax:characters handler x))
+	       (t
+		(destructuring-bind (name attrs &rest children) x
+		  (let ((name (coerce (symbol-name name) 'rod))
+			(attrs (serialize-lhtml-attributes attrs)))
+		    (hax:start-element handler name attrs)
+		    (mapc #'recurse children)
+		    (hax:end-element handler name)))))))
+    (recurse document))
+  (hax:end-document handler))
+
+
 ;;;; old stuff
 
 #|
-- 
2.11.4.GIT