X-Git-Url: http://git.kpe.io/?p=kmrcl.git;a=blobdiff_plain;f=xml-utils.lisp;h=860d6750a4e4a7e28686a2c4e2f6419935975558;hp=6ef3bb98fd8a69c94b995efcee8ece0a6575d51b;hb=03712fbb06acbb103602bae10f41aeae7fa05127;hpb=739b14ee8844dc777b174105646df3abcb865282

diff --git a/xml-utils.lisp b/xml-utils.lisp
index 6ef3bb9..860d675 100644
--- a/xml-utils.lisp
+++ b/xml-utils.lisp
@@ -24,26 +24,26 @@
 (defun find-start-tag (tag taglen xmlstr start end)
   "Searches for the start of a tag in an xmlstring. Returns STARTPOS ATTRIBUTE-LIST)"
   (declare (simple-string tag xmlstr)
-	   (fixnum taglen start end)
-	   (optimize (speed 3) (safety 0) (space 0)))
+           (fixnum taglen start end)
+           (optimize (speed 3) (safety 0) (space 0)))
   (do* ((search-str (concatenate 'string "<" tag))
-	(search-len (1+ taglen))
-	(bracketpos (fast-string-search search-str xmlstr search-len start end)
-		    (fast-string-search search-str xmlstr search-len start end)))
+        (search-len (1+ taglen))
+        (bracketpos (fast-string-search search-str xmlstr search-len start end)
+                    (fast-string-search search-str xmlstr search-len start end)))
        ((null bracketpos) nil)
     (let* ((endtag (+ bracketpos 1 taglen))
-	   (char-after-tag (schar xmlstr endtag)))
+           (char-after-tag (schar xmlstr endtag)))
       (when (or (char= #\> char-after-tag)
-		(char= #\space char-after-tag))
-	(if (char= #\> char-after-tag) 
-	    (return-from find-start-tag (values (1+ endtag) nil))
-	    (let ((endbrack (position-char #\> xmlstr (1+ endtag) end)))
-	      (if endbrack
-		  (return-from find-start-tag
-		    (values (1+ endbrack)
-			    (string-to-list-skip-delimiter
-			     (subseq xmlstr endtag endbrack))))
-		  (values nil nil)))))
+                (char= #\space char-after-tag))
+        (if (char= #\> char-after-tag)
+            (return-from find-start-tag (values (1+ endtag) nil))
+            (let ((endbrack (position-char #\> xmlstr (1+ endtag) end)))
+              (if endbrack
+                  (return-from find-start-tag
+                    (values (1+ endbrack)
+                            (string-to-list-skip-delimiter
+                             (subseq xmlstr endtag endbrack))))
+                  (values nil nil)))))
       (setq start endtag))))
 
 
@@ -51,31 +51,31 @@
   (fast-string-search
    (concatenate 'string "</" tag ">") xmlstr
    (+ taglen 3) start end))
-  
+
 (defun positions-xml-tag-contents (tag xmlstr &optional (start-xmlstr 0)
-				       (end-xmlstr (length xmlstr)))
+                                       (end-xmlstr (length xmlstr)))
   "Returns three values: the start and end positions of contents between
  the xml tags and the position following the close of the end tag."
   (let* ((taglen (length tag)))
     (multiple-value-bind (start attributes)
-	(find-start-tag tag taglen xmlstr start-xmlstr end-xmlstr)
+        (find-start-tag tag taglen xmlstr start-xmlstr end-xmlstr)
       (unless start
-	(return-from positions-xml-tag-contents (values nil nil nil nil)))
+        (return-from positions-xml-tag-contents (values nil nil nil nil)))
       (let ((end (find-end-tag tag taglen xmlstr start end-xmlstr)))
-	(unless end
-	  (return-from positions-xml-tag-contents (values nil nil nil nil)))
-	(values start end (+ end taglen 3) attributes)))))
+        (unless end
+          (return-from positions-xml-tag-contents (values nil nil nil nil)))
+        (values start end (+ end taglen 3) attributes)))))
 
 
 (defun xml-tag-contents (tag xmlstr &optional (start-xmlstr 0)
-			 (end-xmlstr (length xmlstr)))
-  "Returns two values: the string between XML start and end tag 
+                         (end-xmlstr (length xmlstr)))
+  "Returns two values: the string between XML start and end tag
 and position of character following end tag."
-  (multiple-value-bind 
-      (startpos endpos nextpos attributes) 
+  (multiple-value-bind
+      (startpos endpos nextpos attributes)
       (positions-xml-tag-contents tag xmlstr start-xmlstr end-xmlstr)
     (if (and startpos endpos)
-	(values (subseq xmlstr startpos endpos) nextpos attributes)
+        (values (subseq xmlstr startpos endpos) nextpos attributes)
       (values nil nil nil))))
 
 (defun cdata-string (str)
@@ -89,32 +89,32 @@ and position of character following end tag."
     (declare (fixnum i len))
     (let ((c (schar str i)))
       (case c
-	(#\< (write-string "&lt;" s))
-	(#\& (write-string "&amp;" s))
-	(t   (write-char c s))))))
+        (#\< (write-string "&lt;" s))
+        (#\& (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)
-	      "")))
+          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)
+                       label language url entities)
   (format stream "<!DOCTYPE ~A ~A \"~A//~A//~A ~A//~A\"" top-element
-	  availability (if registered "+" "-") organization type label language)
-  
+          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))
 
@@ -122,25 +122,25 @@ and position of character following end tag."
   (write-char #\newline stream))
 
 (defun doctype-format (stream format &key top-element (availability "PUBLIC")
-		       (registered nil) organization (type "DTD") label
-		       (language "EN") url entities)
+                       (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))
+                     (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))
+                     (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))
+                     (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))
+                     (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
@@ -151,26 +151,26 @@ and position of character following end tag."
      (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))
+                     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")) 
+     (unless label (warn "Missing label in doctype-format"))
      (doctype-stream stream top-element availability registered organization type label language url
-		     entities))))
+                     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)
+                          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))
+                    :availability availability :registered registered
+                    :organization organization :type type :label label :language language
+                    :url url :entities entities))
   stream)