From: Chris Hanson <org/chris-hanson/cph>
Date: Tue, 24 May 2005 19:53:42 +0000 (+0000)
Subject: Add optional CALLER argument to ->URI.
X-Git-Tag: 20090517-FFI~1304
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=64bb57a226230ef8fd97deead8aaf244bfb51ca6;p=mit-scheme.git

Add optional CALLER argument to ->URI.
---

diff --git a/v7/src/runtime/url.scm b/v7/src/runtime/url.scm
index 43e6cf91a..d56b4922a 100644
--- a/v7/src/runtime/url.scm
+++ b/v7/src/runtime/url.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: url.scm,v 1.18 2005/05/24 04:50:50 cph Exp $
+$Id: url.scm,v 1.19 2005/05/24 19:53:42 cph Exp $
 
 Copyright 2000,2001,2003,2004,2005 Massachusetts Institute of Technology
 
@@ -148,6 +148,13 @@ USA.
 (define-guarantee uri-server "URI server")
 (define-guarantee uri-host "URI host")
 (define-guarantee uri-port "URI port")
+
+(define (->uri object #!optional caller)
+  (cond ((uri? object) object)
+	((string? object) (string->uri object))
+	((symbol? object) (string->uri (symbol-name object)))
+	(else
+	 (error:not-uri object (if (default-object? caller) '->URI caller)))))
 
 (define char-set:uri-alpha)
 (define char-set:uri-digit)
@@ -221,12 +228,6 @@ USA.
     (and v
 	 (vector-ref v 0))))
 
-(define (->uri object)
-  (cond ((uri? object) object)
-	((string? object) (string->uri object))
-	((symbol? object) (string->uri (symbol-name object)))
-	(else (error:not-uri object '->URI))))
-
 (define parse-uri
   (*parser
    (top-level