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

Modified Files: xml.lisp Log Message: default namespaces without a prefix are now handled by creating a new, uniquely named package and the same prefix

Date: Fri Sep 2 16:38:40 2005 Author: scaekenberghe

Index: s-xml/src/xml.lisp diff -u s-xml/src/xml.lisp:1.10 s-xml/src/xml.lisp:1.11 --- s-xml/src/xml.lisp:1.10 Mon Aug 29 17:01:47 2005 +++ s-xml/src/xml.lisp Fri Sep 2 16:38:39 2005 @@ -1,6 +1,6 @@ ;;;; -*- mode: lisp -*- ;;;; -;;;; $Id: xml.lisp,v 1.10 2005/08/29 15:01:47 scaekenberghe Exp $ +;;;; $Id: xml.lisp,v 1.11 2005/09/02 14:38:39 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). @@ -232,6 +232,25 @@ (defvar *auto-create-namespace-packages* t "If t, new packages will be created for namespaces, if needed, named by the prefix")

+(defun new-namespace (uri &optional prefix) + "Register a new namespace for uri and prefix, creating a package if necessary" + (if prefix + (register-namespace uri + prefix + (or (find-package prefix) + (if *auto-create-namespace-packages* + (make-package prefix :nicknames `(,(string-upcase prefix))) + (error "Cannot find or create package ~s" prefix)))) + (let ((unique-name (loop :for i :upfrom 0 + :do (let ((name (format nil "ns-~d" i))) + (when (not (find-package name)) + (return name)))))) + (register-namespace uri + unique-name + (if *auto-create-namespace-packages* + (make-package (string-upcase unique-name) :nicknames `(,unique-name)) + (error "Cannot create package ~s" unique-name)))))) + (defun extend-namespaces (attributes namespaces) "Given possible 'xmlns[:prefix]' attributes, extend the namespaces bindings" (unless *ignore-namespaces* @@ -246,19 +265,13 @@ (prefix name) (namespace (find-namespace uri))) (unless namespace - (setf namespace - (register-namespace uri - prefix - (or (find-package prefix) - (if *auto-create-namespace-packages* - (make-package prefix :nicknames `(,(string-upcase prefix))) - (error "Cannot find or create package ~s" prefix)))))) + (setf namespace (new-namespace uri prefix))) (push `(,prefix . ,namespace) namespaces)))))) (when default-namespace-uri (let ((namespace (find-namespace default-namespace-uri))) - (if namespace - (push `("" . namespace) namespaces) - (error "No prefix found for default namespace ~s" default-namespace-uri)))))) + (unless namespace + (setf namespace (new-namespace default-namespace-uri))) + (push `("" . ,namespace) namespaces))))) namespaces)

(defun print-identifier (identifier stream &optional as-attribute)