From 8224e25bdd090129666f046627052323ec8f2dbd Mon Sep 17 00:00:00 2001
From: "Kevin M. Rosenberg" <kevin@rosenberg.net>
Date: Sun, 16 Nov 2003 15:49:47 +0000
Subject: [PATCH] r8226: update to new dtd writing functions

---
 package.lisp   |  6 ++--
 xml-utils.lisp | 83 +++++++++++++++++++++++++++++++++++++++++++++-----
 2 files changed, 78 insertions(+), 11 deletions(-)

diff --git a/package.lisp b/package.lisp
index 033f31e..e348abd 100644
--- a/package.lisp
+++ b/package.lisp
@@ -213,11 +213,11 @@
    #:decode-uri-query-string
    
    ;; From xml-utils
-   #:wrap-with-xml
+   #:sgml-header-stream
    #:xml-tag-contents
    #:positions-xml-tag-contents
-   #:xml-cdata
-   #:write-xml-cdata
+   #:cdata-string
+   #:write-cdata
    
    ;; From console
    #:*console-msgs*
diff --git a/xml-utils.lisp b/xml-utils.lisp
index 67bc157..36cd4e7 100644
--- a/xml-utils.lisp
+++ b/xml-utils.lisp
@@ -19,12 +19,6 @@
 (in-package #:kmrcl)
 
 
-(defun wrap-with-xml (str entity)
-  "Returns string of xml header along with entity tag start/end with str contents"
-  (format nil "<?xml version=\"1.0\" standalone=\"yes\"?>~%~%<~a>~%~a~%</~a>~%" 
-	  str entity entity))
-
-
 ;;; XML Extraction Functions
 
 (defun find-start-tag (tag taglen xmlstr start end)
@@ -84,10 +78,10 @@ and position of character following end tag."
 	(values (subseq xmlstr startpos endpos) nextpos attributes)
       (values nil nil nil))))
 
-(defun xml-cdata (str)
+(defun cdata-string (str)
   (concatenate 'string "<![CDATA[" str "]]>"))
 
-(defun write-xml-cdata (str s)
+(defun write-cdata (str s)
   (declare (simple-string str) (optimize (speed 3) (safety 0) (space 0)))
   (do ((len (length str))
        (i 0 (1+ i)))
@@ -99,3 +93,76 @@ and position of character following end tag."
 	(#\& (write-string "&amp;" s))
 	(t   (write-char c s))))))
 
+(defun xml-declaration-stream (stream &key (version "1.0") standalone encoding)
+  (format stream "<?xml version=\"~A\"~A~A ?>~%"
+	  version
+	  (if encoding
+	      (format nil " encoding=\"~A\"" encoding)
+	      ""
+	      )
+	  (if 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"))))
+
+  (case format
+    (:html
+     (unless public-id
+       (setq public-id "-//IETF//DTD HTML//EN"))
+     (setq system-id nil))
+    ((: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")))
+    (: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")))
+    (: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")))
+    ((: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)
+
+(defun sgml-header-stream (stream format &key entities (encoding "iso-8859-1") standalone (version "1.0")
+			  name public-id system-id)
+  (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))
+  stream)
+
-- 
2.34.1