Fix Safari weirdness
parent
bb9d24c18a
commit
d9d5dcc7a6
|
@ -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
|
||||
|
|
|
@ -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 ;
|
||||
|
||||
|
|
Loading…
Reference in New Issue