From e1d873e331493485743f8828fa9aa8dd016c405a Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Thu, 22 Jun 2006 19:17:29 +0000 Subject: [PATCH] Export procedures to write the elements of a triple. --- v7/src/xml/rdf-nt.scm | 22 +++++++++++----------- v7/src/xml/rdf-struct.scm | 19 +++++++++---------- v7/src/xml/xml.pkg | 5 ++++- 3 files changed, 24 insertions(+), 22 deletions(-) diff --git a/v7/src/xml/rdf-nt.scm b/v7/src/xml/rdf-nt.scm index 8f67b5730..dfed3cdbb 100644 --- a/v7/src/xml/rdf-nt.scm +++ b/v7/src/xml/rdf-nt.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: rdf-nt.scm,v 1.6 2006/06/10 03:52:00 cph Exp $ +$Id: rdf-nt.scm,v 1.7 2006/06/22 19:17:26 cph Exp $ Copyright 2006 Massachusetts Institute of Technology @@ -212,36 +212,36 @@ USA. (define (write-rdf/nt triple port) (let ((s (rdf-triple-subject triple))) - (cond ((uri? s) (write-uri-ref s port)) - ((rdf-bnode? s) (write-bnode s port)))) + (cond ((uri? s) (write-rdf-uri-ref s port)) + ((rdf-bnode? s) (write-rdf-bnode s port)))) (write-char #\space port) - (write-uri-ref (rdf-triple-predicate triple) port) + (write-rdf-uri-ref (rdf-triple-predicate triple) port) (write-char #\space port) (let ((o (rdf-triple-object triple))) - (cond ((uri? o) (write-uri-ref o port)) - ((rdf-bnode? o) (write-bnode o port)) - ((rdf-literal? o) (write-literal o port)))) + (cond ((uri? o) (write-rdf-uri-ref o port)) + ((rdf-bnode? o) (write-rdf-bnode o port)) + ((rdf-literal? o) (write-rdf-literal o port)))) (write-char #\space port) (write-char #\. port) (newline port)) -(define (write-uri-ref uri port) +(define (write-rdf-uri-ref uri port) (write-char #\< port) (write-uri uri port) (write-char #\> port)) -(define (write-bnode bnode port) +(define (write-rdf-bnode bnode port) (write-string "_:" port) (write-string (rdf-bnode-name bnode) port)) -(define (write-literal literal port) +(define (write-rdf-literal literal port) (write-char #\" port) (write-literal-text (rdf-literal-text literal) port) (write-char #\" port) (cond ((rdf-literal-type literal) => (lambda (uri) (write-string "^^" port) - (write-uri-ref uri port))) + (write-rdf-uri-ref uri port))) ((rdf-literal-language literal) => (lambda (lang) (write-char #\@ port) diff --git a/v7/src/xml/rdf-struct.scm b/v7/src/xml/rdf-struct.scm index 7813679a5..0bbb0d38c 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.8 2006/06/22 18:35:27 cph Exp $ +$Id: rdf-struct.scm,v 1.9 2006/06/22 19:17:27 cph Exp $ Copyright 2006 Massachusetts Institute of Technology @@ -49,9 +49,10 @@ USA. (define-guarantee rdf-bnode "RDF bnode") (set-record-type-unparser-method! - (simple-unparser-method 'RDF-BNODE - (lambda (bnode) - (rdf-bnode-name bnode)))) + (standard-unparser-method 'RDF-BNODE + (lambda (bnode port) + (write-char #\space port) + (write-rdf-bnode bnode port)))) (define (make-rdf-bnode #!optional name) (%make-rdf-bnode @@ -75,12 +76,10 @@ USA. (define-guarantee rdf-literal "RDF literal") (set-record-type-unparser-method! - (simple-unparser-method 'RDF-LITERAL - (lambda (literal) - (list (let ((s (rdf-literal-text literal))) - (if (fix:<= (string-length s) 64) - s - (string-append (string-head s 60) " ..."))))))) + (standard-unparser-method 'RDF-LITERAL + (lambda (literal port) + (write-char #\space port) + (write-rdf-literal literal port)))) (define (make-rdf-literal text type) (guarantee-utf8-string text 'RDF-LITERAL) diff --git a/v7/src/xml/xml.pkg b/v7/src/xml/xml.pkg index 3e5530cc5..c177d2b71 100644 --- a/v7/src/xml/xml.pkg +++ b/v7/src/xml/xml.pkg @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: xml.pkg,v 1.70 2006/06/22 04:48:33 cph Exp $ +$Id: xml.pkg,v 1.71 2006/06/22 19:17:29 cph Exp $ Copyright 2001,2002,2003,2004,2005,2006 Massachusetts Institute of Technology @@ -572,6 +572,9 @@ USA. read-rdf/nt read-rdf/nt-file rdf/nt-file->source + write-rdf-bnode + write-rdf-literal + write-rdf-uri-ref write-rdf/nt write-rdf/nt-file)) -- 2.25.1