r8241: rework doctype generator

diff --git a/impl.lisp b/impl.lisp
index c6aa65df7de8fd5b9ab7d5004e9dacae418450fb..c2d7cabb84a3a36750374cf33aefa5d24ae36ae8 100644 (file)
--- a/impl.lisp
+++ b/impl.lisp
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Sep 2003
 ;;;;
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Sep 2003
 ;;;;

-;;;; $Id: io.lisp 7795 2003-09-10 05:44:47Z kevin $
+;;;; $Id$

 ;;;;
 ;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;;
 ;;;;
 ;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;;

diff --git a/xml-utils.lisp b/xml-utils.lisp
index 36cd4e765c45a13034bd386ff2b3c6223c7eabac..a9d641e4c6ce3eeaa078963303e6ff3daff1cd6b 100644 (file)
--- a/xml-utils.lisp
+++ b/xml-utils.lisp
@@ -104,65 +104,73 @@ and position of character following end tag."
              (format nil " standalone=\"~A\"" standalone)
              "")))
 
              (format nil " standalone=\"~A\"" standalone)
              "")))
 

-(defun dtd-stream (stream format &key name public-id system-id entities)
-  (case format
-    ((:xhtml11 :xhtml :xhtml10-strict :xhtml10-transitional :xhtml-frameset)
-     (setq name "html"))
-    (:html
-     (setq name "HTML"))
-    ((:docbook :docbook42)
-     (unless name
-       (setq name "book"))))
+(defun doctype-stream (stream top-element availability registered organization type
+                      label language url entities)
+  (format stream "<!DOCTYPE ~A ~A \"~A//~A//~A ~A//~A\"" top-element
+         availability (if registered "+" "-") organization type label language)
+  
+  (when url
+    (write-char #\space stream)
+    (write-char #\" stream)
+    (write-string url stream)
+    (write-char #\" stream))
+  
+  (when entities
+    (format stream " [~%~A~%]" entities))
+
+  (write-char #\> stream)
+  (write-char #\newline stream))

 
 

+(defun doctype-format (stream format &key top-element (availability "PUBLIC")
+                      (registered nil) organization (type "DTD") label
+                      (language "EN") url entities)

   (case format
   (case format

-    (:html
-     (unless public-id
-       (setq public-id "-//IETF//DTD HTML//EN"))
-     (setq system-id nil))

     ((:xhtml11 :xhtml)
     ((:xhtml11 :xhtml)

-     (unless public-id
-       (setq public-id  "-//W3C//DTD XHTML 1.1//EN"))
-     (unless system-id
-       (setq system-id "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd")))
+     (doctype-stream stream "html" availability registered "W3C" type "XHTML 1.1" language
+                    (if url url "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd")
+                    entities))

     (:xhtml10-strict
     (:xhtml10-strict

-     (unless public-id
-       (setq public-id  "-//W3C//DTD XHTML 1.0 Strict//EN"))
-     (unless system-id
-       (setq system-id "http://www.w3.org/TR/xhtml10/DTD/xhtml10-strict.dtd")))
+     (doctype-stream stream "html" availability registered "W3C" type "XHTML 1.0 Strict" language
+                    (if url url "http://www.w3.org/TR/xhtml10/DTD/xhtml10-strict.dtd")
+                    entities))

     (:xhtml10-transitional
     (:xhtml10-transitional

-     (unless public-id
-       (setq public-id  "-//W3C//DTD XHTML 1.0 Transitional//EN"))
-     (unless system-id
-       (setq system-id "http://www.w3.org/TR/xhtml10/DTD/xhtml10-transitional.dtd")))
-    (:xhtml10-frameset
-     (unless public-id
-       (setq public-id  "-//W3C//DTD XHTML 1.0 Frameset//EN"))
-     (unless system-id
-       (setq system-id "http://www.w3.org/TR/xhtml10/DTD/xhtml10-frameset.dtd")))
+     (doctype-stream stream "html" availability registered "W3C" type "XHTML 1.0 Transitional" language
+                    (if url url "http://www.w3.org/TR/xhtml10/DTD/xhtml10-transitional.dtd")
+                    entities))
+    (:xhtml-frameset
+     (doctype-stream stream "html" availability registered "W3C" type "XHTML 1.0 Frameset" language
+                    (if url url "http://www.w3.org/TR/xhtml10/DTD/xhtml10-frameset.dtd")
+                    entities))
+    (:html2
+     (doctype-stream stream "HTML" availability registered "IETF" type "HTML" language url entities))
+    (:html3
+     (doctype-stream stream "HTML" availability registered "IETF" type "HTML 3.0" language url entities))
+    (:html3.2
+     (doctype-stream stream "HTML" availability registered "W3C" type "HTML 3.2 Final" language url entities))
+    ((:html :html4)
+     (doctype-stream stream "HTML" availability registered "W3C" type "HTML 4.01 Final" language url entities))

     ((:docbook :docbook42)
     ((:docbook :docbook42)

-     (unless public-id
-       (setq public-id  "-//OASIS//DTD DocBook XML V4.2//EN")
-     (unless system-id
-       (setq system-id "http://www.oasis-open.org/docbook/xml/4.2/docbookx.dtd")))))
-    
-  (format stream "<!DOCTYPE ~A PUBLIC \"~A\"~A"
-         name public-id
-         (if system-id
-           (format nil " \"~A\"" system-id)
-           ""))
-  
-  (when entities
-    (format stream " [~%~A~%]" entities))
-  (write-char #\> stream)
-  (write-char #\newline stream)
-  stream)
+     (doctype-stream stream (if top-element top-element "book")
+                    availability registered "OASIS" type "Docbook XML 4.2" language
+                    (if url url "http://www.oasis-open.org/docbook/xml/4.2/docbookx.dtd")
+                    entities))
+    (t
+     (unless top-element (warn "Missing top-element in doctype-format"))
+     (unless organization (warn "Missing organization in doctype-format"))
+     (unless label (warn "Missing label in doctype-format")) 
+     (doctype-stream stream top-element availability registered organization type label language url
+                    entities))))
+

 
 (defun sgml-header-stream (stream format &key entities (encoding "iso-8859-1") standalone (version "1.0")
 
 (defun sgml-header-stream (stream format &key entities (encoding "iso-8859-1") standalone (version "1.0")

-                         name public-id system-id)
+                         top-element (availability "PUBLIC") registered organization (type "DTD")
+                          label (language "EN") url)

   (when (in format :xhtml :xhtml11 :xhtml10-strict :xhtml10-transitional :xhtml10-frameset :xml :docbook)
     (xml-declaration-stream stream :version version :encoding encoding :standalone standalone))
   (unless (eq :xml format)
   (when (in format :xhtml :xhtml11 :xhtml10-strict :xhtml10-transitional :xhtml10-frameset :xml :docbook)
     (xml-declaration-stream stream :version version :encoding encoding :standalone standalone))
   (unless (eq :xml format)

-    (dtd-stream stream format :name name :public-id public-id :system-id system-id
-               :entities entities))
+    (doctype-format stream format :top-element top-element
+                   :availability availability :registered registered
+                   :organization organization :type type :label label :language language
+                   :url url :entities entities))

   stream)
 
   stream)