[s-xml-cvs] CVS update: s-xml/src/lxml-dom.lisp s-xml/src/xml.lisp

[Sven Van Caekenberghe]

Update of /project/s-xml/cvsroot/s-xml/src
In directory common-lisp.net:/tmp/cvs-serv22222/src

Modified Files:
	lxml-dom.lisp xml.lisp 
Log Message:
added some minimal code to print namespace qualified xml identifiers

Date: Mon Aug 29 10:54:43 2005
Author: scaekenberghe

Index: s-xml/src/lxml-dom.lisp
diff -u s-xml/src/lxml-dom.lisp:1.2 s-xml/src/lxml-dom.lisp:1.3
--- s-xml/src/lxml-dom.lisp:1.2	Wed Aug 17 10:06:01 2005
+++ s-xml/src/lxml-dom.lisp	Mon Aug 29 10:54:41 2005
@@ -1,6 +1,6 @@
 ;;;; -*- mode: lisp -*-
 ;;;;
-;;;; $Id: lxml-dom.lisp,v 1.2 2005/08/17 08:06:01 scaekenberghe Exp $
+;;;; $Id: lxml-dom.lisp,v 1.3 2005/08/29 08:54:41 scaekenberghe Exp $
 ;;;;
 ;;;; LXML implementation of the generic DOM parser and printer.
 ;;;;
@@ -45,17 +45,17 @@
 				       :text-hook #'lxml-text-hook))))
 
 (defmethod print-xml-dom (dom (input-type (eql :lxml)) stream pretty level)
-  (cond ((symbolp dom) (format stream "<~a/>" dom))
+  (cond ((symbolp dom) (format stream "<~a/>" (print-identifier dom nil)))
 	((stringp dom) (print-string-xml dom stream))
 	((consp dom)
 	 (let (tag attributes)
 	   (cond ((symbolp (car dom)) (setf tag (car dom)))
 		 ((consp (car dom)) (setf tag (caar dom) attributes (cdar dom)))
 		 (t (error "Input not recognized as LXML ~s" dom)))
-	   (format stream "<~a" tag)
+	   (format stream "<~a" (print-identifier tag nil))
 	   (labels ((print-attributes (attributes)
 				      (unless (null attributes)
-					(format stream " ~a=\"" (car attributes))
+					(format stream " ~a=\"" (print-identifier (car attributes) nil t))
 					(print-string-xml (cadr attributes) stream)
 					(format stream "\"")
 					(print-attributes (cddr attributes)))))
@@ -76,7 +76,7 @@
 		     (when pretty
 		       (terpri stream)
 		       (dotimes (i (* 2 (1- level))) (write-char #\space stream)))))
-		 (format stream "</~a>" tag))
+		 (format stream "</~a>" (print-identifier tag nil)))
 	     (format stream "/>"))))
 	(t (error "Input not recognized as LXML ~s" dom))))
   


Index: s-xml/src/xml.lisp
diff -u s-xml/src/xml.lisp:1.8 s-xml/src/xml.lisp:1.9
--- s-xml/src/xml.lisp:1.8	Thu Aug 18 16:00:48 2005
+++ s-xml/src/xml.lisp	Mon Aug 29 10:54:42 2005
@@ -1,6 +1,6 @@
 ;;;; -*- mode: lisp -*-
 ;;;;
-;;;; $Id: xml.lisp,v 1.8 2005/08/18 14:00:48 scaekenberghe Exp $
+;;;; $Id: xml.lisp,v 1.9 2005/08/29 08:54:42 scaekenberghe Exp $
 ;;;;
 ;;;; This is a Common Lisp implementation of a basic but usable XML parser.
 ;;;; The parser is non-validating and not complete (no CDATA).
@@ -161,7 +161,7 @@
   "Ordered list of XML namespaces currently in effect")
 
 (defun split-identifier (identifier)
-  "Split an identifier 'prefix:name' and return (values prefix identifier)"
+  "Split an identifier 'prefix:name' and return (values prefix name)"
   (let ((colon-position (position #\: identifier :test #'char=)))
     (if colon-position
         (values (subseq identifier 0 colon-position)
@@ -228,6 +228,18 @@
                   namespaces)
           (error "No prefix found for default namespace ~s" default-namespace-uri)))))
   namespaces)
+
+(defun print-identifier (identifier stream &optional as-attribute)
+  "Print identifier on stream using namespace conventions"
+  (declare (ignore as-attribute))
+  (let (prefix name)
+    (if (symbolp identifier)
+        (setf prefix (package-name (symbol-package identifier))
+              name (symbol-name identifier))
+      (setf (values prefix name) (split-identifier identifier)))
+    (if (equal prefix "KEYWORD")
+        (format stream "~a" name)
+      (format stream "~a:~a" prefix name))))
 
 ;;; the parser state