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)