Add optional CALLER argument to ->URI.

diff --git a/v7/src/runtime/url.scm b/v7/src/runtime/url.scm
index 43e6cf91a6072a2c6c7896736317c644e059a181..d56b4922a5bba4e4bb6acebc708e8d76e030a17e 100644 (file)
--- 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)))))
 \f
 (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