Merge branch 'master' of git://factorcode.org/git/factor

basis/help/handbook/handbook.factor

@@ -162,7 +162,8 @@ ARTICLE: "encodings-introduction" "An introduction to encodings"
 { $code "\"file.txt\" utf16 file-contents" }
 "Encoding descriptors are also used by " { $link "io.streams.byte-array" } " and taken by combinators like " { $link with-file-writer } " and " { $link with-byte-reader } " which deal with streams. It is " { $emphasis "not" } " used with " { $link "io.streams.string" } " because these deal with abstract text."
 $nl
-"When the " { $link binary } " encoding is used, a " { $link byte-array } " is expected for writing and returned for reading, since the stream deals with bytes. All other encodings deal with strings, since they are used to represent text." ;
+"When the " { $link binary } " encoding is used, a " { $link byte-array } " is expected for writing and returned for reading, since the stream deals with bytes. All other encodings deal with strings, since they are used to represent text."
+{ $see-also "stream-elements" } ;
 
 ARTICLE: "io" "Input and output"
 { $heading "Streams" }

basis/help/help-docs.factor

@@ -36,6 +36,7 @@ ARTICLE: "block-elements" "Block elements"
 "Elements used in " { $link $values } " forms:"
 { $subsection $instance }
 { $subsection $maybe }
+{ $subsection $or }
 { $subsection $quotation }
 "Boilerplate paragraphs:"
 { $subsection $low-level-note }
@@ -88,6 +89,12 @@ $nl
     { "an array of markup elements," }
     { "or an array of the form " { $snippet "{ $directive content... }" } ", where " { $snippet "$directive" } " is a markup word whose name starts with " { $snippet "$" } ", and " { $snippet "content..." } " is a series of markup elements" }
 }
+"Here is a more formal schema for the help markup language:"
+{ $code
+"<element> ::== <string> | <simple-element> | <fancy-element>"
+"<simple-element> ::== { <element>* }"
+"<fancy-element> ::== { <type> <element> }"
+}
 { $subsection "element-types" }
 { $subsection "printing-elements" }
 "Related words can be cross-referenced:"
@@ -119,7 +126,7 @@ ARTICLE: "help" "Help system"
 "The help system maintains documentation written in a simple markup language, along with cross-referencing and search. Documentation can either exist as free-standing " { $emphasis "articles" } " or be associated with words."
 { $subsection "browsing-help" }
 { $subsection "writing-help" }
-{ $vocab-subsection "Help lint tool" "help.lint" }
+{ $subsection "help.lint" }
 { $subsection "help-impl" } ;
 
 IN: help

basis/help/markup/markup.factor

@@ -1,19 +1,12 @@
-! Copyright (C) 2005, 2008 Slava Pestov.
+! Copyright (C) 2005, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays definitions generic io kernel assocs
 hashtables namespaces make parser prettyprint sequences strings
 io.styles vectors words math sorting splitting classes slots
-vocabs help.stylesheet help.topics vocabs.loader quotations ;
+vocabs help.stylesheet help.topics vocabs.loader quotations
+combinators ;
 IN: help.markup
 
-! Simple markup language.
-
-! <element> ::== <string> | <simple-element> | <fancy-element>
-! <simple-element> ::== { <element>* }
-! <fancy-element> ::== { <type> <element> }
-
-! Element types are words whose name begins with $.
-
 PREDICATE: simple-element < array
     [ t ] [ first word? not ] if-empty ;
 
@@ -250,8 +243,21 @@ M: f ($instance)
 
 : $instance ( element -- ) first ($instance) ;
 
+: $or ( element -- )
+    dup length {
+        { 1 [ first ($instance) ] }
+        { 2 [ first2 [ ($instance) " or " print-element ] [ ($instance) ] bi ] }
+        [
+            drop
+            unclip-last
+            [ [ ($instance) ", " print-element ] each ]
+            [ "or " print-element ($instance) ]
+            bi*
+        ]
+    } case ;
+
 : $maybe ( element -- )
-    $instance " or " print-element { f } $instance ;
+    f suffix $or ;
 
 : $quotation ( element -- )
     { "a " { $link quotation } " with stack effect " } print-element

basis/http/client/client.factor

@@ -1,4 +1,4 @@
-! Copyright (C) 2005, 2008 Slava Pestov.
+! Copyright (C) 2005, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors assocs kernel math math.parser namespaces make
 sequences strings splitting calendar continuations accessors vectors
@@ -10,6 +10,12 @@ io.streams.duplex fry ascii urls urls.encoding present
 http http.parsers ;
 IN: http.client
 
+ERROR: too-many-redirects ;
+
+CONSTANT: max-redirects 10
+
+<PRIVATE
+
 : write-request-line ( request -- request )
     dup
     [ method>> write bl ]
@@ -21,17 +27,29 @@ IN: http.client
     [ host>> ] [ port>> ] bi dup "http" protocol-port =
     [ drop ] [ ":" swap number>string 3append ] if ;
 
+: set-post-data-headers ( header post-data -- header )
+    [
+        data>> dup sequence?
+        [ length "content-length" ]
+        [ drop "chunked" "transfer-encoding" ] if
+        pick set-at
+    ] [ content-type>> "content-type" pick set-at ] bi ;
+
+: set-host-header ( request header -- request header )
+    over url>> url-host "host" pick set-at ;
+
+: set-cookie-header ( header cookies -- header )
+    unparse-cookie "cookie" pick set-at ;
+
 : write-request-header ( request -- request )
     dup header>> >hashtable
-    over url>> host>> [ over url>> url-host "host" pick set-at ] when
-    over post-data>> [
-        [ data>> length "content-length" pick set-at ]
-        [ content-type>> "content-type" pick set-at ]
-        bi
-    ] when*
-    over cookies>> [ unparse-cookie "cookie" pick set-at ] unless-empty
+    over url>> host>> [ set-host-header ] when
+    over post-data>> [ set-post-data-headers ] when*
+    over cookies>> [ set-cookie-header ] unless-empty
     write-header ;
 
+PRIVATE>
+
 GENERIC: >post-data ( object -- post-data )
 
 M: f >post-data ;
@@ -51,6 +69,8 @@ M: object >post-data
     "application/octet-stream" <post-data>
         swap >>data ;
 
+<PRIVATE
+
 : normalize-post-data ( request -- request )
     dup post-data>> [
         dup params>> [
@@ -62,11 +82,18 @@ M: object >post-data
     [ >post-data ] change-post-data
     normalize-post-data ;
 
+: write-chunk ( chunk -- )
+    [ length >hex ";\r\n" append ascii encode write ] [ write ] bi ;
+
+: write-chunked ( stream -- )
+    [ [ write-chunk ] each-block ] with-input-stream
+    "0;\r\n" ascii encode write ;
+
 : write-post-data ( request -- request )
     dup method>> { "POST" "PUT" } member?  [
         dup post-data>> data>> dup sequence?
-        [ write ] [ output-stream get stream-copy ] if
-    ] when ; 
+        [ write ] [ write-chunked ] if
+    ] when ;
 
 : write-request ( request -- )
     unparse-post-data
@@ -95,12 +122,6 @@ M: object >post-data
     read-response-line
     read-response-header ;
 
-: max-redirects 10 ;
-
-ERROR: too-many-redirects ;
-
-<PRIVATE
-
 DEFER: (with-http-request)
 
 SYMBOL: redirects
@@ -130,15 +151,10 @@ SYMBOL: redirects
         read-crlf B{ } assert= read-chunked
     ] if ; inline recursive
 
-: read-unchunked ( quot: ( chunk -- ) -- )
-    8192 read-partial dup [
-        [ swap call ] [ drop read-unchunked ] 2bi
-    ] [ 2drop ] if ; inline recursive
-
 : read-response-body ( quot response -- )
     binary decode-input
     "transfer-encoding" header "chunked" =
-    [ read-chunked ] [ read-unchunked ] if ; inline
+    [ read-chunked ] [ each-block ] if ; inline
 
 : <request-socket> ( -- stream )
     request get url>> url-addr ascii <client> drop
@@ -166,6 +182,11 @@ SYMBOL: redirects
         [ do-redirect ] [ nip ] if
     ] with-variable ; inline recursive
 
+: <client-request> ( url method -- request )
+    <request>
+        swap >>method
+        swap >url ensure-port >>url ; inline
+
 PRIVATE>
 
 : success? ( code -- ? ) 200 299 between? ;
@@ -183,9 +204,7 @@ ERROR: download-failed response ;
     over content-charset>> decode ;
 
 : <get-request> ( url -- request )
-    <request>
-        "GET" >>method
-        swap >url ensure-port >>url ;
+    "GET" <client-request> ;
 
 : http-get ( url -- response data )
     <get-request> http-request ;
@@ -203,14 +222,19 @@ ERROR: download-failed response ;
     dup download-name download-to ;
 
 : <post-request> ( post-data url -- request )
-    <request>
-        "POST" >>method
-        swap >url ensure-port >>url
+    "POST" <client-request>
         swap >>post-data ;
 
 : http-post ( post-data url -- response data )
     <post-request> http-request ;
 
+: <put-request> ( post-data url -- request )
+    "PUT" <client-request>
+        swap >>post-data ;
+
+: http-put ( post-data url -- response data )
+    <put-request> http-request ;
+
 USING: vocabs vocabs.loader ;
 
 "debugger" vocab [ "http.client.debugger" require ] when

basis/http/http-tests.factor

@@ -1,4 +1,4 @@
-USING: http http.server http.client tools.test multiline
+USING: http http.server http.client http.client.private tools.test multiline
 io.streams.string io.encodings.utf8 io.encodings.8-bit
 io.encodings.binary io.encodings.string kernel arrays splitting
 sequences assocs io.sockets db db.sqlite continuations urls

basis/http/server/cgi/cgi.factor

@@ -55,7 +55,7 @@ IN: http.server.cgi
         binary encode-output
         _ output-stream get swap <cgi-process> binary <process-stream> [
             post-request? [ request get post-data>> data>> write flush ] when
-            input-stream get swap (stream-copy)
+            '[ _ write ] each-block
         ] with-stream
     ] >>body ;
 

basis/http/server/server.factor

@@ -26,8 +26,6 @@ html.elements
 html.streams ;
 IN: http.server
 
-\ parse-cookie DEBUG add-input-logging
-
 : check-absolute ( url -- url )
     dup path>> "/" head? [ "Bad request: URL" throw ] unless ; inline
 

basis/io/directories/directories-docs.factor

@@ -166,6 +166,7 @@ ARTICLE: "io.directories" "Directory manipulation"
 { $subsection "current-directory" }
 { $subsection "io.directories.listing" }
 { $subsection "io.directories.create" }
-{ $subsection "delete-move-copy" } ;
+{ $subsection "delete-move-copy" }
+{ $subsection "io.directories.hierarchy" } ;
 
 ABOUT: "io.directories"

core/io/encodings/encodings-docs.factor

@@ -74,7 +74,7 @@ HELP: replacement-char
 { $description "A code point that replaces input that could not be decoded. The presence of this character in the decoded data usually signifies an error." } ;
 
 ARTICLE: "encodings-descriptors" "Encoding descriptors"
-"An encoding descriptor is something which can be used for input or output streams to encode or decode bytes stored in a certain representation. It must conform to the " { $link "encodings-protocol" } ". Encodings which you can use are defined in the following vocabularies:"
+"An encoding descriptor is something which can be used with binary input or output streams to encode or decode bytes stored in a certain representation. It must conform to the " { $link "encodings-protocol" } ". Encodings which you can use are defined in the following vocabularies:"
 { $subsection "io.encodings.binary" }
 { $subsection "io.encodings.utf8" }
 { $subsection "io.encodings.utf16" }
@@ -99,7 +99,13 @@ ARTICLE: "encodings-constructors" "Manually constructing an encoded stream"
 { $subsection <decoder> } ;
 
 ARTICLE: "io.encodings" "I/O encodings"
-"The " { $vocab-link "io.encodings" } " vocabulary provides utilities for encoding and decoding bytes that represent text. Both strings and streams may be encoded."
+"The " { $vocab-link "io.encodings" } " vocabulary provides utilities for encoding and decoding bytes that represent text. Encodings can be used in the following situations:"
+{ $list
+  "With binary input streams, to convert bytes to characters"
+  "With binary output streams, to convert characters to bytes"
+  "With byte arrays, to convert bytes to characters"
+  "With strings, to convert characters to bytes"
+}
 { $subsection "encodings-descriptors" }
 { $subsection "encodings-constructors" }
 { $subsection "io.encodings.string" }
@@ -113,6 +119,7 @@ ARTICLE: "io.encodings" "I/O encodings"
 { $subsection re-decode }
 "Combinators to change the encoding:"
 { $subsection with-encoded-output }
-{ $subsection with-decoded-input } ;
+{ $subsection with-decoded-input }
+{ $see-also "encodings-introduction" "stream-elements" } ;
 
 ABOUT: "io.encodings"