From ec4df62dabef0cec4515ff3d27b1524b5708e7fa Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Thu, 19 Oct 2006 15:20:33 +0000
Subject: [PATCH] Add URI->RDF-PREFIX.
---
v7/src/xml/rdf-struct.scm | 26 +++++++++++++++++---------
1 file changed, 17 insertions(+), 9 deletions(-)
diff --git a/v7/src/xml/rdf-struct.scm b/v7/src/xml/rdf-struct.scm
index 5f8e90462..dc676d1cd 100644
--- a/v7/src/xml/rdf-struct.scm
+++ b/v7/src/xml/rdf-struct.scm
@@ -1,6 +1,6 @@
#| -*-Scheme-*-
-$Id: rdf-struct.scm,v 1.16 2006/08/02 05:05:14 cph Exp $
+$Id: rdf-struct.scm,v 1.17 2006/10/19 15:20:33 cph Exp $
Copyright 2006 Massachusetts Institute of Technology
@@ -291,23 +291,31 @@ USA.
(and p
(cdr p))))
-(define (uri->rdf-qname uri #!optional error? registry)
- (let ((s (uri->string (->absolute-uri uri 'URI->RDF-QNAME))))
+(define (uri->rdf-prefix uri #!optional error? registry)
+ (let ((s (uri->string (->absolute-uri uri 'URI->RDF-PREFIX))))
(let ((p
(let ((alist
(registry-bindings
- (check-registry registry 'URI->RDF-QNAME)))
+ (check-registry registry 'URI->RDF-PREFIX)))
(filter (lambda (p) (string-prefix? (cdr p) s))))
(or (find-matching-item alist
(lambda (p)
(and (not (eq? (car p) ':))
(filter p))))
(find-matching-item alist filter)))))
- (if (and error? (not p))
- (error:bad-range-argument uri 'URI->RDF-QNAME))
- (and p
- (symbol (car p)
- (string-tail s (string-length (cdr p))))))))
+ (if p
+ (values (car p) (cdr p))
+ (begin
+ (if error? (error:bad-range-argument uri 'URI->RDF-PREFIX))
+ (values #f #f))))))
+
+(define (uri->rdf-qname uri #!optional error? registry)
+ (let ((uri (->absolute-uri uri 'URI->RDF-QNAME)))
+ (receive (prefix expansion) (uri->rdf-prefix uri error? registry)
+ (and prefix
+ (symbol prefix
+ (string-tail (uri->string uri)
+ (string-length expansion)))))))
(define (rdf-qname->uri qname #!optional error? registry)
(receive (prefix local) (split-rdf-qname qname)
--
2.25.1