From: Chris Hanson <org/chris-hanson/cph>
Date: Fri, 10 Aug 2007 19:07:14 +0000 (+0000)
Subject: Implement URI-PREFIX.
X-Git-Tag: 20090517-FFI~467
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=0f3579892c010e14a3a962d34cfa5b538abe5809;p=mit-scheme.git

Implement URI-PREFIX.
---

diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg
index 2641a9fbe..f7535d329 100644
--- a/v7/src/runtime/runtime.pkg
+++ b/v7/src/runtime/runtime.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: runtime.pkg,v 14.624 2007/08/10 18:09:18 cph Exp $
+$Id: runtime.pkg,v 14.625 2007/08/10 19:07:13 cph Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -5038,6 +5038,7 @@ USA.
 	  uri-path-relative?
 	  uri-path?
 	  uri-port?
+	  uri-prefix
 	  uri-query
 	  uri-relative?
 	  uri-rexp:absolute-uri
diff --git a/v7/src/runtime/url.scm b/v7/src/runtime/url.scm
index 865aec9f6..5b6a96f82 100644
--- a/v7/src/runtime/url.scm
+++ b/v7/src/runtime/url.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: url.scm,v 1.51 2007/01/17 21:01:59 cph Exp $
+$Id: url.scm,v 1.52 2007/08/10 19:07:14 cph Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -389,6 +389,12 @@ USA.
 	     (vector-ref v 2)
 	     (vector-ref v 3)
 	     (vector-ref v 4)))
+
+(define (uri-prefix prefix)
+  (guarantee-utf8-string prefix 'URI-PREFIX)
+  (lambda (suffix)
+    (guarantee-utf8-string suffix 'URI-PREFIX)
+    (string->absolute-uri (string-append prefix suffix))))
 
 (define parser:uri
   (*parser