Fix Safari weirdness

db4
Slava Pestov 2008-09-23 14:17:02 -05:00
parent bb9d24c18a
commit d9d5dcc7a6
2 changed files with 20 additions and 10 deletions

View File

@ -225,3 +225,5 @@ urls [
] unit-test ] unit-test
[ "foo#3" ] [ URL" foo" clone 3 >>anchor present ] 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

View File

@ -155,13 +155,30 @@ M: string >url
% password>> [ ":" % % ] when* "@" % % password>> [ ":" % % ] when* "@" %
] [ 2drop ] if ; ] [ 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-host-part ( url protocol -- )
% %
"://" % "://" %
{ {
[ unparse-username-password ] [ unparse-username-password ]
[ host>> url-encode % ] [ host>> url-encode % ]
[ port>> [ ":" % # ] when* ] [ url-port [ ":" % # ] when* ]
[ path>> "/" head? [ "/" % ] unless ] [ path>> "/" head? [ "/" % ] unless ]
} cleave ; } cleave ;
@ -212,15 +229,6 @@ PRIVATE>
[ [ host>> ] [ port>> ] bi <inet> ] [ protocol>> ] bi [ [ host>> ] [ port>> ] bi <inet> ] [ protocol>> ] bi
secure-protocol? [ <secure> ] when ; secure-protocol? [ <secure> ] when ;
: protocol-port ( protocol -- port )
{
{ "http" [ 80 ] }
{ "https" [ 443 ] }
{ "feed" [ 80 ] }
{ "ftp" [ 21 ] }
[ drop f ]
} case ;
: ensure-port ( url -- url' ) : ensure-port ( url -- url' )
dup protocol>> '[ _ protocol-port or ] change-port ; dup protocol>> '[ _ protocol-port or ] change-port ;