From d9d5dcc7a622af4aa9ede34707832920aba6776e Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Tue, 23 Sep 2008 14:17:02 -0500
Subject: [PATCH] Fix Safari weirdness

---
 basis/urls/urls-tests.factor |  2 ++
 basis/urls/urls.factor       | 28 ++++++++++++++++++----------
 2 files changed, 20 insertions(+), 10 deletions(-)

diff --git a/basis/urls/urls-tests.factor b/basis/urls/urls-tests.factor
index 7f835b2918..75ee7b6740 100644
--- a/basis/urls/urls-tests.factor
+++ b/basis/urls/urls-tests.factor
@@ -225,3 +225,5 @@ urls [
 ] unit-test
 
 [ "foo#3" ] [ URL" foo" clone 3 >>anchor present ] unit-test
+
+[ "http://www.foo.com/" ] [ "http://www.foo.com:80" >url present ] unit-test
diff --git a/basis/urls/urls.factor b/basis/urls/urls.factor
index 488e0a121c..19bae087af 100644
--- a/basis/urls/urls.factor
+++ b/basis/urls/urls.factor
@@ -155,13 +155,30 @@ M: string >url
         % password>> [ ":" % % ] when* "@" %
     ] [ 2drop ] if ;
 
+: protocol-port ( protocol -- port )
+    {
+        { "http" [ 80 ] }
+        { "https" [ 443 ] }
+        { "feed" [ 80 ] }
+        { "ftp" [ 21 ] }
+        [ drop f ]
+    } case ;
+
+<PRIVATE
+
+: url-port ( url -- port/f )
+    [ port>> ] [ port>> ] [ protocol>> protocol-port ] tri =
+    [ drop f ] when ;
+
+PRIVATE>
+
 : unparse-host-part ( url protocol -- )
     %
     "://" %
     {
         [ unparse-username-password ]
         [ host>> url-encode % ]
-        [ port>> [ ":" % # ] when* ]
+        [ url-port [ ":" % # ] when* ]
         [ path>> "/" head? [ "/" % ] unless ]
     } cleave ;
 
@@ -212,15 +229,6 @@ PRIVATE>
     [ [ host>> ] [ port>> ] bi <inet> ] [ protocol>> ] bi
     secure-protocol? [ <secure> ] when ;
 
-: protocol-port ( protocol -- port )
-    {
-        { "http" [ 80 ] }
-        { "https" [ 443 ] }
-        { "feed" [ 80 ] }
-        { "ftp" [ 21 ] }
-        [ drop f ]
-    } case ;
-
 : ensure-port ( url -- url' )
     dup protocol>> '[ _ protocol-port or ] change-port ;