From 781a441e42847fb5a1432ea552de89205d173dab Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Mon, 23 Jul 2007 01:43:41 +0000 Subject: [PATCH] Allow relative URIs as namespace names. --- v7/src/xml/xml-names.scm | 23 +++++++++++------------ v7/src/xml/xml-parser.scm | 4 ++-- 2 files changed, 13 insertions(+), 14 deletions(-) diff --git a/v7/src/xml/xml-names.scm b/v7/src/xml/xml-names.scm index 38dc39421..b423ac2cd 100644 --- a/v7/src/xml/xml-names.scm +++ b/v7/src/xml/xml-names.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: xml-names.scm,v 1.15 2007/01/17 03:43:04 cph Exp $ +$Id: xml-names.scm,v 1.16 2007/07/23 01:43:39 cph Exp $ Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, @@ -39,17 +39,16 @@ USA. (%make-xml-name qname uri))))) (define (check-prefix+uri qname uri) - (if (not (and (uri-absolute? uri) - (let ((s (symbol-name qname))) - (let ((c (find-prefix-separator s))) - (case c - ((#f) #t) - ((ILLEGAL) #f) - (else - (case (utf8-string->symbol (string-head s c)) - ((xml) (uri=? uri xml-uri)) - ((xmlns) (uri=? uri xmlns-uri)) - (else #t)))))))) + (if (not (let ((s (symbol-name qname))) + (let ((c (find-prefix-separator s))) + (case c + ((#f) #t) + ((ILLEGAL) #f) + (else + (case (utf8-string->symbol (string-head s c)) + ((xml) (uri=? uri xml-uri)) + ((xmlns) (uri=? uri xmlns-uri)) + (else #t))))))) (error:bad-range-argument uri 'MAKE-XML-NAME))) (define (%make-xml-name qname uri) diff --git a/v7/src/xml/xml-parser.scm b/v7/src/xml/xml-parser.scm index 1a24a34da..78e02176e 100644 --- a/v7/src/xml/xml-parser.scm +++ b/v7/src/xml/xml-parser.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: xml-parser.scm,v 1.74 2007/07/23 00:34:02 cph Exp $ +$Id: xml-parser.scm,v 1.75 2007/07/23 01:43:41 cph Exp $ Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, @@ -573,7 +573,7 @@ USA. (lambda () (if (string-null? value) (null-xml-namespace-uri) - (string->absolute-uri value)))) + (string->uri value)))) (forbidden-uri (lambda (uri) (perror p "Forbidden namespace URI" -- 2.25.1