Merge branch 'master' into experimental (untested!)

Conflicts:
	basis/http/client/client.factor

diff --combined basis/http/client/client.factor
index e6435ee12b48a9427d1f3671c862c01be1a4ef04,108ae5ecc4c28bbbea3f2441288f8ff48fc09088..9c56411290ab4c7b4b9647658958838747a2199d
--- 1/basis/http/client/client.factor
--- 2/basis/http/client/client.factor
+++ b/basis/http/client/client.factor
@@@ -3,14 -3,15 +3,15 @@@
  USING: accessors assocs kernel math math.parser namespaces make
  sequences io io.sockets io.streams.string io.files io.timeouts
  strings splitting calendar continuations accessors vectors
- math.order hashtables byte-arrays prettyprint destructors
+ math.order hashtables byte-arrays destructors
  io.encodings
  io.encodings.string
  io.encodings.ascii
+ io.encodings.utf8
  io.encodings.8-bit
  io.encodings.binary
  io.streams.duplex
- fry debugger summary ascii urls urls.encoding present
+ fry ascii urls urls.encoding present
  http http.parsers ;
  IN: http.client
  
@@@ -40,11 -41,11 +41,11 @@@ GENERIC: >post-data ( object -- post-da
  
  M: post-data >post-data ;
  
- M: string >post-data "application/octet-stream" <post-data> ;
+ M: string >post-data utf8 encode "application/octet-stream" <post-data> ;
  
  M: byte-array >post-data "application/octet-stream" <post-data> ;
  
- M: assoc >post-data assoc>query "application/x-www-form-urlencoded" <post-data> ;
+ M: assoc >post-data assoc>query ascii encode "application/x-www-form-urlencoded" <post-data> ;
  
  M: f >post-data ;
  
@@@ -52,13 -53,13 +53,14 @@@
      [ >post-data ] change-post-data ;
  
  : write-post-data ( request -- request )
 -    dup method>> [ "POST" = ] [ "PUT" = ] bi or [ dup post-data>> raw>> write ] when ; 
 +    dup method>> [ "POST" = ] [ "PUT" = ] bi or
 +    [ dup post-data>> [ raw>> write ] when* ] when ; 
  
  : write-request ( request -- )
      unparse-post-data
      write-request-line
      write-request-header
+     binary encode-output
      write-post-data
      flush
      drop ;
@@@ -85,13 -86,9 +87,13 @@@
  
  ERROR: too-many-redirects ;
  
 -<PRIVATE
 +M: too-many-redirects summary
 +    drop
 +    [ "Redirection limit of " % max-redirects # " exceeded" % ] "" make ;
 +
 +DEFER: with-http-request
  
 -DEFER: (with-http-request)
 +<PRIVATE
  
  SYMBOL: redirects
  
@@@ -106,7 -103,7 +108,7 @@@
      redirects get max-redirects < [
          request get clone
          swap "location" header redirect-url
 -        "GET" >>method swap (with-http-request)
 +        "GET" >>method swap with-http-request
      ] [ too-many-redirects ] if ; inline recursive
  
  : read-chunk-size ( -- n )
@@@ -134,9 -131,7 +136,9 @@@
      request get url>> url-addr ascii <client> drop
      1 minutes over set-timeout ;
  
 -: (with-http-request) ( request quot: ( chunk -- ) -- response )
 +PRIVATE>
 +
 +: with-http-request ( request quot: ( chunk -- ) -- response )
      swap
      request [
          <request-socket> [
@@@ -158,50 -153,32 +160,50 @@@
          [ do-redirect ] [ nip ] if
      ] with-variable ; inline recursive
  
 -PRIVATE>
 -
  : success? ( code -- ? ) 200 299 between? ;
  
 -ERROR: download-failed response ;
 +ERROR: download-failed response data ;
  
 -: check-response ( response -- response )
 -    dup code>> success? [ download-failed ] unless ;
 +M: download-failed error.
 +    "HTTP request failed:" print nl
 +    [ response>> . ] [ data>> . ] bi ;
 +
 +: check-response* ( response data -- response data )
 +    over code>> success? [ download-failed ] unless ;
  
 -: with-http-request ( request quot -- response )
 -    (with-http-request) check-response ; inline
 +: check-response ( response -- response )
 +    f check-response* drop ;
  
  : http-request ( request -- response data )
      [ [ % ] with-http-request ] B{ } make
 -    over content-charset>> decode ;
 +    over content-charset>> decode check-response* ;
 +
 +: <client-request> ( url -- request )
 +    <request> swap >url ensure-port >>url ;
 +
 +: <client-data-request> ( data url -- request )
 +    <client-request> swap >>post-data ;
  
  : <get-request> ( url -- request )
 -    <request>
 -        "GET" >>method
 -        swap >url ensure-port >>url ;
 +    <client-request> "GET" >>method ;
  
  : http-get ( url -- response data )
      <get-request> http-request ;
  
  : with-http-get ( url quot -- response )
 -    [ <get-request> ] dip with-http-request ; inline
 +    [ <get-request> ] dip with-http-request check-response ; inline
 +
 +: <delete-request> ( url -- request )
 +    <client-request> "DELETE" >>method ;
 +
 +: http-delete ( url -- response data )
 +    <delete-request> http-request ;
 +
 +: <trace-request> ( url -- request )
 +    <client-request> "TRACE" >>method ;
 +
 +: http-trace ( url -- response data )
 +    <trace-request> http-request ;
  
  : download-name ( url -- name )
      present file-name "?" split1 drop "/" ?tail drop ;
@@@ -213,13 -190,14 +215,17 @@@
      dup download-name download-to ;
  
  : <post-request> ( post-data url -- request )
 -    <request>
 -        "POST" >>method
 -        swap >url ensure-port >>url
 -        swap >>post-data ;
 +    <client-data-request> "POST" >>method ;
  
  : http-post ( post-data url -- response data )
      <post-request> http-request ;
  
 +: <put-request> ( data url -- request )
 +    <client-data-request> "PUT" >>method ;
 +
 +: http-put ( data url -- response data )
 +    <put-request> http-request ;
++
+ USING: vocabs vocabs.loader ;
+ 
+ "debugger" vocab [ "http.client.debugger" require ] when

diff --combined basis/urls/encoding/encoding.factor
index ce5bd044ac1e5183323b6a0c98053cbe10ffd792,f621384ede3d77c4a9349bd559ae120f1128db44..3521348a8ce4481cbe6b98b92548c2129f932aa4
--- 1/basis/urls/encoding/encoding.factor
--- 2/basis/urls/encoding/encoding.factor
+++ b/basis/urls/encoding/encoding.factor
@@@ -14,25 -14,6 +14,25 @@@ IN: urls.encodin
          [ "/_-.:" member? ]
      } 1|| ; foldable
  
 +! see http://tools.ietf.org/html/rfc3986#section-2.2
 +: gen-delim? ( ch -- ? )
 +    ":/?#[]@" member? ; foldable
 +
 +: sub-delim? ( ch -- ? )
 +    "!$&'()*+,;=" member? ; foldable
 +
 +: reserved? ( ch -- ? )
 +    [ gen-delim? ] [ sub-delim? ] bi or ; foldable
 +
 +! see http://tools.ietf.org/html/rfc3986#section-2.3
 +: unreserved? ( ch -- ? )
 +    {
 +        [ letter? ]
 +        [ LETTER? ]
 +        [ digit? ]
 +        [ "-._~" member? ]
 +    } 1|| ; foldable
 +
  <PRIVATE
  
  : push-utf8 ( ch -- )
@@@ -46,11 -27,6 +46,11 @@@ PRIVATE
          [ dup url-quotable? [ , ] [ push-utf8 ] if ] each
      ] "" make ;
  
 +: url-encode-full ( str -- encoded )
 +    [
 +        [ dup unreserved? [ , ] [ push-utf8 ] if ] each
 +    ] "" make ;
 +
  <PRIVATE
  
  : url-decode-hex ( index str -- )
@@@ -115,6 -91,6 +115,6 @@@ PRIVATE
      [
          [
              [ url-encode ] dip
-             [ url-encode "=" swap 3append , ] with each
+             [ url-encode "=" glue , ] with each
          ] assoc-each
      ] { } make "&" join ;