From f0b311cecbd668b2b33760efe5cf2f578bda2306 Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Sun, 9 Dec 2007 06:09:32 +0000
Subject: [PATCH] Improve line breaking to have a more accurate idea where the
break should go.
---
v7/src/xml/turtle.scm | 102 +++++++++++++++++++++++-------------------
1 file changed, 55 insertions(+), 47 deletions(-)
diff --git a/v7/src/xml/turtle.scm b/v7/src/xml/turtle.scm
index 07998fbc4..97425ae68 100644
--- a/v7/src/xml/turtle.scm
+++ b/v7/src/xml/turtle.scm
@@ -1,6 +1,6 @@
#| -*-Scheme-*-
-$Id: turtle.scm,v 1.40 2007/12/09 05:53:04 cph Exp $
+$Id: turtle.scm,v 1.41 2007/12/09 06:09:32 cph Exp $
Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -738,51 +738,52 @@ USA.
inline-bnode
port))
(indentation (indent+ indentation)))
- (let ((writer
+ (let ((s
(and subject-inline?
(or (eq? (rdf-triple-predicate (caar groups)) rdf:type)
(null? (cdr groups)))
(null? (cdar groups))
- (linear-object-writer (rdf-triple-object (caar groups))
- inline-bnode))))
- (if writer
+ (linear-object-string (rdf-triple-object (caar groups))
+ inline-bnode
+ port))))
+ (if s
(begin
(space port)
(write-predicate (rdf-triple-predicate (caar groups)) port)
(space port)
- (writer port)
+ (write-string s port)
(write-pgroups-tail groups indentation inline-bnode port))
(write-pgroups groups indentation inline-bnode port))))))
-(define (linear-object-writer o inline-bnode)
+(define (linear-object-string o inline-bnode port)
(cond ((rdf-list->list o inline-bnode)
=> (lambda (objects)
(cond ((null? objects)
- (lambda (port)
- (write-string "()" port)))
+ "()")
((and (pair? objects)
(null? (cdr objects))
- (linear-object-writer (car objects) inline-bnode))
- => (lambda (write-elt)
- (lambda (port)
- (write-string "(" port)
- (write-elt port)
- (write-string ")" port))))
+ (linear-object-string (car objects)
+ inline-bnode
+ port))
+ => (lambda (elt)
+ (string-append "(" elt ")")))
(else #f))))
((rdf-bnode? o)
(and (not (inline-bnode o))
- (lambda (port)
- (write-rdf/nt-bnode o port))))
+ (call-with-output-string
+ (lambda (port)
+ (write-rdf/nt-bnode o port)))))
((uri? o)
- (lambda (port)
- (write-rdf/turtle-uri o port)))
+ (call-with-output-string
+ (lambda (port*)
+ (write-uri o (port/rdf-prefix-registry port) port*))))
((rdf-graph? o)
(and (null? (rdf-graph-triples o))
- (lambda (port)
- (write-string "{}" port))))
+ "{}"))
((rdf-literal? o)
- (lambda (port)
- (write-rdf/turtle-literal o port)))
+ (call-with-output-string
+ (lambda (port)
+ (write-rdf/turtle-literal o port))))
(else
(error "Unknown RDF object:" o))))
@@ -801,13 +802,13 @@ USA.
(let ((p (rdf-triple-predicate (car ts)))
(os (map rdf-triple-object ts)))
(write-predicate p port)
- (let ((writer
+ (let ((s
(and (null? (cdr os))
- (linear-object-writer (car os) inline-bnode))))
- (if writer
+ (linear-object-string (car os) inline-bnode port))))
+ (if s
(begin
(space port)
- (writer port))
+ (write-string s port))
(begin
(write-object (car os) indentation inline-bnode port)
(for-each (lambda (o)
@@ -816,22 +817,25 @@ USA.
(cdr os)))))))
(define (write-object o indentation inline-bnode port)
- (maybe-break indentation port)
- (cond ((linear-object-writer o inline-bnode)
- => (lambda (writer)
- (writer port)))
+ (cond ((linear-object-string o inline-bnode port)
+ => (lambda (s)
+ (maybe-break (string-length s) indentation port)
+ (write-string s port)))
((rdf-graph? o)
+ (space port)
(write-graph o indentation inline-bnode port))
((rdf-list->list o inline-bnode)
=> (lambda (os)
+ (space port)
(write-parens "(" ")" indentation port
(lambda (indentation)
(for-each (lambda (o)
- (maybe-break indentation port)
+ (write-indentation indentation port)
(write-object o indentation inline-bnode port))
os)))))
((inline-bnode o)
=> (lambda (ts)
+ (space port)
(write-inline-bnode (cdr ts) indentation inline-bnode port)))
(else
(error "Not an inline bnode:" o))))
@@ -845,9 +849,11 @@ USA.
port)
(write-string ";" port))))
-(define (maybe-break indentation port)
- (if (> (or (output-port/column port) 0)
- (- (output-port/x-size port) 10))
+(define (maybe-break needed indentation port)
+ (if (let ((column (output-port/column port)))
+ (and column
+ (>= (+ column needed 1)
+ (output-port/x-size port))))
(write-indentation (indent+ indentation) port)
(space port)))
@@ -926,18 +932,20 @@ USA.
(define (write-rdf/turtle-uri uri #!optional port)
(let ((port (if (default-object? port) (current-output-port) port)))
- (let* ((s (uri->string uri))
- (end (string-length s)))
- (receive (prefix expansion)
- (uri->rdf-prefix uri (port/rdf-prefix-registry port) #f)
- (if prefix
- (let ((start (string-length expansion)))
- (if (*match-string match:name s start end)
- (begin
- (write-string (symbol-name prefix) port)
- (write-substring s start end port))
- (write-rdf/nt-uri uri port)))
- (write-rdf/nt-uri uri port))))))
+ (write-uri uri (port/rdf-prefix-registry port) port)))
+
+(define (write-uri uri registry port)
+ (let* ((s (uri->string uri))
+ (end (string-length s)))
+ (receive (prefix expansion) (uri->rdf-prefix uri registry #f)
+ (if prefix
+ (let ((start (string-length expansion)))
+ (if (*match-string match:name s start end)
+ (begin
+ (write-string (symbol-name prefix) port)
+ (write-substring s start end port))
+ (write-rdf/nt-uri uri port)))
+ (write-rdf/nt-uri uri port)))))
(define (sort-triples triples)
(sort triples
--
2.25.1