From: Chris Hanson <org/chris-hanson/cph>
Date: Sat, 24 Jul 2004 02:26:24 +0000 (+0000)
Subject: Add constructors to aid in building conformant XHTML documents.
X-Git-Tag: 20090517-FFI~1610
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=ee7d8d6b6a3db1e69e8c7d90b783a4bfe80638f2;p=mit-scheme.git

Add constructors to aid in building conformant XHTML documents.
---

diff --git a/v7/src/xml/xhtml.scm b/v7/src/xml/xhtml.scm
index 43d790b55..8119ebe36 100644
--- a/v7/src/xml/xhtml.scm
+++ b/v7/src/xml/xhtml.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: xhtml.scm,v 1.8 2004/07/24 02:12:14 cph Exp $
+$Id: xhtml.scm,v 1.9 2004/07/24 02:26:19 cph Exp $
 
 Copyright 2002,2003,2004 Massachusetts Institute of Technology
 
@@ -27,6 +27,9 @@ USA.
 
 (declare (usual-integrations))
 
+(define (html-1.0-document attrs . items)
+  (%make-document html-1.0-dtd attrs items))
+
 (define html-1.0-external-dtd
   (make-xml-external-id "-//W3C//DTD XHTML 1.0 Strict//EN"
 			"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd"))
@@ -34,6 +37,9 @@ USA.
 (define html-1.0-dtd
   (make-xml-dtd 'html html-1.0-external-dtd '()))
 
+(define (html-1.1-document attrs . items)
+  (%make-document html-1.1-dtd attrs items))
+
 (define html-1.1-external-dtd
   (make-xml-external-id "-//W3C//DTD XHTML 1.1//EN"
 			"http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd"))
@@ -41,6 +47,20 @@ USA.
 (define html-1.1-dtd
   (make-xml-dtd 'html html-1.1-external-dtd '()))
 
+(define (%make-document dtd attrs items)
+  (make-xml-document (make-xml-declaration "1.0" "UTF-8" #f)
+		     '("\n")
+		     dtd
+		     '("\n")
+		     (html:html (if (there-exists? attrs
+				      (lambda (attr)
+					(eq? (xml-attribute-name attr)
+					     'xmlns)))
+				    attrs
+				    (xml-attrs 'xmlns html-iri attrs))
+				items)
+		     '()))
+
 (define html-iri
   (make-xml-namespace-iri "http://www.w3.org/1999/xhtml"))
 
@@ -59,7 +79,7 @@ USA.
 (define (guarantee-html-element-name object caller)
   (if (not (html-element-name? object))
       (error:wrong-type-argument object "XHTML element name" caller)))
-
+
 (define-syntax define-html-element
   (sc-macro-transformer
    (lambda (form environment)
@@ -95,7 +115,7 @@ USA.
 
 (define element-context-map
   (make-eq-hash-table))
-
+
 (define-html-element a		inline)
 (define-html-element abbr	inline)
 (define-html-element acronym	inline)
@@ -120,6 +140,7 @@ USA.
 (define-html-element div	block)
 (define-html-element dl		block)
 (define-html-element dt		dl)
+
 (define-html-element em		inline)
 (define-html-element fieldset	block)
 (define-html-element form	block)
diff --git a/v7/src/xml/xml.pkg b/v7/src/xml/xml.pkg
index 40920fd8b..24b4cd7c2 100644
--- a/v7/src/xml/xml.pkg
+++ b/v7/src/xml/xml.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: xml.pkg,v 1.48 2004/07/24 02:12:20 cph Exp $
+$Id: xml.pkg,v 1.49 2004/07/24 02:26:24 cph Exp $
 
 Copyright 2001,2002,2003,2004 Massachusetts Institute of Technology
 
@@ -301,12 +301,15 @@ USA.
   (files "xhtml")
   (parent (runtime xml))
   (export ()
+	  (html-document html-1.0-document)
 	  (html-dtd html-1.0-dtd)
 	  (html-external-dtd html-1.0-external-dtd)
 	  guarantee-html-element
 	  guarantee-html-element-name
+	  html-1.0-document
 	  html-1.0-dtd
 	  html-1.0-external-dtd
+	  html-1.1-document
 	  html-1.1-dtd
 	  html-1.1-external-dtd
 	  html-element-context