Implement URI-PREFIX.

diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg
index 2641a9fbef15328c85f34cfa0345c554b3f4a064..f7535d3295a55e5e0c9e865b987611fabb2451c5 100644 (file)
--- 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 865aec9f61a14235c73c124bf6e461a7a3d9db92..5b6a96f82e710d4285e0bee13acf843c1a8d0dd8 100644 (file)
--- 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))))
 \f
 (define parser:uri
   (*parser