Rename PORT/BNODE-REGISTRY and PORT/DROP-BNODE-REGISTRY and export
authorChris Hanson <org/chris-hanson/cph>
Sun, 29 Oct 2006 06:18:03 +0000 (06:18 +0000)
committerChris Hanson <org/chris-hanson/cph>
Sun, 29 Oct 2006 06:18:03 +0000 (06:18 +0000)
them to global environment.  Make analogous procedures for prefix
registries.  Add new procedure to merge one prefix registry into
another.

v7/src/xml/rdf-nt.scm
v7/src/xml/rdf-struct.scm
v7/src/xml/xml.pkg

index b9b4c2f5eead0e16e1fea5c3a5d0ba17e8c1ebfd..3b0a13371034069d33189970a5fc8361ee23f8e3 100644 (file)
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: rdf-nt.scm,v 1.9 2006/10/19 17:48:21 cph Exp $
+$Id: rdf-nt.scm,v 1.10 2006/10/29 06:17:49 cph Exp $
 
 Copyright 2006 Massachusetts Institute of Technology
 
@@ -51,10 +51,10 @@ USA.
            triple)))))
 
 (define (read-rdf/nt port)
-  (fluid-let ((*rdf-bnode-registry* (port/bnode-registry port)))
+  (fluid-let ((*rdf-bnode-registry* (port/rdf-bnode-registry port)))
     (let ((triple (%read-rdf/nt port)))
       (if (eof-object? triple)
-         (port/drop-bnode-registry port))
+         (port/drop-rdf-bnode-registry port))
       triple)))
 
 (define (%read-rdf/nt port)
index bd7bc0dfdc25f8a3592b231dc1485c8fa1ecafe3..0b24af9b4168576217d3a645014f54d5d39c6391 100644 (file)
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: rdf-struct.scm,v 1.19 2006/10/29 05:23:59 cph Exp $
+$Id: rdf-struct.scm,v 1.20 2006/10/29 06:17:56 cph Exp $
 
 Copyright 2006 Massachusetts Institute of Technology
 
@@ -141,14 +141,14 @@ USA.
 (define *rdf-bnode-registry*
   (make-rdf-bnode-registry))
 
-(define (port/bnode-registry port)
-  (or (port/get-property port 'PORT/BNODE-REGISTRY #f)
-      (let ((table (make-string-hash-table)))
-       (port/set-property! port 'PORT/BNODE-REGISTRY table)
+(define (port/rdf-bnode-registry port)
+  (or (port/get-property port 'RDF-BNODE-REGISTRY #f)
+      (let ((table (make-rdf-bnode-registry)))
+       (port/set-property! port 'RDF-BNODE-REGISTRY table)
        table)))
 
-(define (port/drop-bnode-registry port)
-  (port/remove-property! port 'PORT/DROP-BNODE-REGISTRY))
+(define (port/drop-rdf-bnode-registry port)
+  (port/remove-property! port 'RDF-BNODE-REGISTRY))
 
 (define (rdf-bnode->handle bnode)
   (string-append bnode-handle-prefix (number->string (hash bnode))))
@@ -261,21 +261,30 @@ USA.
 
 (define (register-rdf-prefix prefix expansion #!optional registry)
   (guarantee-rdf-prefix prefix 'REGISTER-RDF-PREFIX)
-  (let ((registry (check-registry registry 'REGISTER-RDF-PREFIX)))
-    (let ((p (assq prefix (registry-bindings registry)))
-         (new
-          (uri->string
-           (->absolute-uri expansion 'REGISTER-RDF-PREFIX))))
-      (if p
-         (if (not (string=? (cdr p) new))
-             (begin
-               (warn "RDF prefix override:" prefix (cdr p) new)
-               (set-cdr! p new)))
-         (set-registry-bindings! registry
-                                 (cons (cons prefix new)
-                                       (registry-bindings registry))))))
+  (%register-rdf-prefix prefix
+                       (uri->string
+                        (->absolute-uri expansion 'REGISTER-RDF-PREFIX))
+                       (check-registry registry 'REGISTER-RDF-PREFIX))
   prefix)
 
+(define (merge-rdf-prefix-registry! from-registry #!optional to-registry)
+  (guarantee-rdf-prefix-registry from-registry 'MERGE-RDF-PREFIX-REGISTRY!)
+  (let ((to-registry (check-registry to-registry 'MERGE-RDF-PREFIX-REGISTRY!)))
+    (for-each (lambda (p1)
+               (%register-rdf-prefix (car p1) (cdr p1) to-registry))
+             (registry-bindings from-registry))))
+
+(define (%register-rdf-prefix prefix expansion registry)
+  (let ((p (assq prefix (registry-bindings registry))))
+    (if p
+       (if (not (string=? (cdr p) expansion))
+           (begin
+             (warn "RDF prefix override:" prefix (cdr p) expansion)
+             (set-cdr! p expansion)))
+       (set-registry-bindings! registry
+                               (cons (cons prefix expansion)
+                                     (registry-bindings registry))))))
+
 (define (rdf-prefix-expansion prefix #!optional registry)
   (guarantee-rdf-prefix prefix 'RDF-PREFIX-EXPANSION)
   (let ((p
@@ -402,4 +411,15 @@ USA.
     (xsd: . "http://www.w3.org/2001/XMLSchema#")))
 
 (define *default-rdf-prefix-registry*
-  (new-rdf-prefix-registry))
\ No newline at end of file
+  (new-rdf-prefix-registry))
+
+(define (port/set-rdf-prefix-registry port registry)
+  (if registry
+      (begin
+       (guarantee-rdf-prefix-registry registry 'PORT/SET-RDF-PREFIX-REGISTRY!)
+       (port/set-property! port 'RDF-PREFIX-REGISTRY registry))
+      (port/remove-property! port 'RDF-PREFIX-REGISTRY)))
+
+(define (port/rdf-prefix-registry port)
+  (or (port/get-property port 'RDF-PREFIX-REGISTRY #f)
+      *default-rdf-prefix-registry*))
\ No newline at end of file
index 0fc0ee5f9bf6216932cc9a92311ae90d8a674953..e0bed396f5862dde172107192ac3751cad479800 100644 (file)
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: xml.pkg,v 1.84 2006/10/29 05:35:07 cph Exp $
+$Id: xml.pkg,v 1.85 2006/10/29 06:18:03 cph Exp $
 
 Copyright 2001,2002,2003,2004,2005,2006 Massachusetts Institute of Technology
 
@@ -560,7 +560,12 @@ USA.
          make-rdf-literal
          make-rdf-qname
          make-rdf-triple
+         merge-rdf-prefix-registry!
          new-rdf-prefix-registry
+         port/drop-rdf-bnode-registry
+         port/rdf-bnode-registry
+         port/rdf-prefix-registry
+         port/set-rdf-prefix-registry
          rdf-bnode->handle
          rdf-bnode-name
          rdf-bnode?
@@ -592,9 +597,7 @@ USA.
   (export (runtime rdf)
          %make-rdf-literal
          match-bnode-name
-         match-language
-         port/bnode-registry
-         port/drop-bnode-registry))
+         match-language))
 
 (define-package (runtime rdf nt)
   (files "rdf-nt")