From: Chris Hanson <org/chris-hanson/cph>
Date: Thu, 8 Sep 2005 18:51:30 +0000 (+0000)
Subject: Add unparser methods to URI record types.
X-Git-Tag: 20090517-FFI~1222
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=fe9147ff803b9ddc407ee048272e567ba80f4a45;p=mit-scheme.git

Add unparser methods to URI record types.
---

diff --git a/v7/src/runtime/url.scm b/v7/src/runtime/url.scm
index 2eda1ccb5..34db6fcb4 100644
--- a/v7/src/runtime/url.scm
+++ b/v7/src/runtime/url.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: url.scm,v 1.35 2005/06/05 19:31:29 cph Exp $
+$Id: url.scm,v 1.36 2005/09/08 18:51:30 cph Exp $
 
 Copyright 2000,2001,2003,2004,2005 Massachusetts Institute of Technology
 
@@ -39,6 +39,12 @@ USA.
   (query uri-query)
   (fragment uri-fragment set-uri-fragment!))
 
+(set-record-type-unparser-method! <uri>
+  (standard-unparser-method 'URI
+    (lambda (uri port)
+      (write-char #\space port)
+      (%write-uri uri port))))
+
 (define (make-uri scheme authority path query fragment)
   (let ((path (if (equal? path '("")) '() path)))
     (if scheme (guarantee-uri-scheme scheme 'MAKE-URI))
@@ -110,6 +116,12 @@ USA.
   (host uri-authority-host)
   (port uri-authority-port))
 
+(set-record-type-unparser-method! <uri-authority>
+  (standard-unparser-method 'URI-AUTHORITY
+    (lambda (authority port)
+      (write-char #\space port)
+      (write-authority authority port))))
+
 (define (make-uri-authority userinfo host port)
   (if userinfo (guarantee-uri-userinfo userinfo 'MAKE-URI-AUTHORITY))
   (guarantee-uri-host host 'MAKE-URI-AUTHORITY)
@@ -1022,6 +1034,12 @@ USA.
   (fragment partial-uri-fragment set-partial-uri-fragment!)
   (extra partial-uri-extra set-partial-uri-extra!))
 
+(set-record-type-unparser-method! <partial-uri>
+  (standard-unparser-method 'PARTIAL-URI
+    (lambda (puri port)
+      (write-char #\space port)
+      (write-partial-uri puri port))))
+
 (define-guarantee partial-uri "partial URI")
 
 (define (make-partial-uri state)