X-Git-Url: http://git.kpe.io/?p=kmrcl.git;a=blobdiff_plain;f=xml-utils.lisp;h=6ef3bb98fd8a69c94b995efcee8ece0a6575d51b;hp=8acb0f6a5ef0405fb12b295bf54335e987e51656;hb=19190787da0e49afad011b90b4b6ce8608b22444;hpb=b49f81f86d8fdca99f6b956fa03f6a60689679a1

diff --git a/xml-utils.lisp b/xml-utils.lisp
index 8acb0f6..6ef3bb9 100644
--- a/xml-utils.lisp
+++ b/xml-utils.lisp
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Apr 2000
 ;;;;
-;;;; $Id: xml-utils.lisp,v 1.11 2003/06/07 22:34:16 kevin Exp $
+;;;; $Id$
 ;;;;
 ;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;;
@@ -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,84 @@ 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 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
+    ((:xhtml11 :xhtml)
+     (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
+     (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
+     (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)
+     (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 (format stream &key entities (encoding "iso-8859-1") standalone (version "1.0")
+			  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)
+    (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)
+