r8226: update to new dtd writing functions

diff --git a/package.lisp b/package.lisp
index 033f31ea39e57d92f3cb1742eccd3afeecc3ea02..e348abd2ab1e9b58135d3f019ab85dbd6eeae1ce 100644 (file)
--- 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 67bc1571f55e79467e5392a16615cb50ad9e4555..36cd4e765c45a13034bd386ff2b3c6223c7eabac 100644 (file)
--- 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)
+