diff --git a/core/alien/c-types/c-types.factor b/core/alien/c-types/c-types.factor index 7d01fb2b00..a67c7f4fb9 100755 --- a/core/alien/c-types/c-types.factor +++ b/core/alien/c-types/c-types.factor @@ -4,7 +4,7 @@ USING: bit-arrays byte-arrays float-arrays arrays generator.registers assocs kernel kernel.private libc math namespaces parser sequences strings words assocs splitting math.parser cpu.architecture alien alien.accessors quotations -system compiler.units ; +system compiler.units io.files io.encodings.binary ; IN: alien.c-types DEFER: @@ -273,6 +273,9 @@ M: long-long-type box-return ( type -- ) r> add* ] when ; +: malloc-file-contents ( path -- alien ) + binary file-contents >byte-array malloc-byte-array ; + [ [ alien-cell ] [ set-alien-cell ] diff --git a/core/bootstrap/image/image.factor b/core/bootstrap/image/image.factor index 35dae109cf..241511c00d 100755 --- a/core/bootstrap/image/image.factor +++ b/core/bootstrap/image/image.factor @@ -7,7 +7,7 @@ strings sbufs vectors words quotations assocs system layouts splitting growable classes tuples words.private io.binary io.files vocabs vocabs.loader source-files definitions debugger float-arrays quotations.private -sequences.private combinators ; +sequences.private combinators io.encodings.binary ; IN: bootstrap.image : my-arch ( -- arch ) @@ -416,7 +416,7 @@ M: curry ' "Writing image to " write architecture get boot-image-name resource-path dup write "..." print flush - [ (write-image) ] with-file-writer ; + binary [ (write-image) ] with-stream ; PRIVATE> diff --git a/core/bootstrap/primitives.factor b/core/bootstrap/primitives.factor index f3f233ea0b..ab0e1cebe0 100755 --- a/core/bootstrap/primitives.factor +++ b/core/bootstrap/primitives.factor @@ -623,6 +623,7 @@ builtins get num-tags get tail f union-class define-class { "fopen" "io.streams.c" } { "fgetc" "io.streams.c" } { "fread" "io.streams.c" } + { "fputc" "io.streams.c" } { "fwrite" "io.streams.c" } { "fflush" "io.streams.c" } { "fclose" "io.streams.c" } diff --git a/core/inference/known-words/known-words.factor b/core/inference/known-words/known-words.factor index 8e8251ff62..5e150e66b7 100755 --- a/core/inference/known-words/known-words.factor +++ b/core/inference/known-words/known-words.factor @@ -538,6 +538,8 @@ set-primitive-effect \ fwrite { string alien } { } set-primitive-effect +\ fputc { object alien } { } set-primitive-effect + \ fread { integer string } { object } set-primitive-effect \ fflush { alien } { } set-primitive-effect diff --git a/core/io/backend/backend.factor b/core/io/backend/backend.factor index c38b7355b1..1595ecd576 100755 --- a/core/io/backend/backend.factor +++ b/core/io/backend/backend.factor @@ -1,13 +1,17 @@ ! Copyright (C) 2007, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: init kernel system namespaces ; +USING: init kernel system namespaces io io.encodings io.encodings.utf8 ; IN: io.backend SYMBOL: io-backend HOOK: init-io io-backend ( -- ) -HOOK: init-stdio io-backend ( -- ) +HOOK: (init-stdio) io-backend ( -- stdin stdout stderr ) + +: init-stdio ( -- ) + (init-stdio) utf8 stderr set-global + utf8 stdio set-global ; HOOK: io-multiplex io-backend ( ms -- ) @@ -19,7 +23,7 @@ HOOK: normalize-pathname io-backend ( str -- newstr ) M: object normalize-pathname ; -: set-io-backend ( backend -- ) +: set-io-backend ( io-backend -- ) io-backend set-global init-io init-stdio ; [ init-io embedded? [ init-stdio ] unless ] diff --git a/core/io/binary/binary.factor b/core/io/binary/binary.factor old mode 100644 new mode 100755 index c4d3abefce..9f6231b643 --- a/core/io/binary/binary.factor +++ b/core/io/binary/binary.factor @@ -10,7 +10,7 @@ IN: io.binary : nth-byte ( x n -- b ) -8 * shift mask-byte ; inline -: >le ( x n -- str ) [ nth-byte ] with "" map-as ; +: >le ( x n -- str ) [ nth-byte ] with B{ } map-as ; : >be ( x n -- str ) >le dup reverse-here ; : d>w/w ( d -- w1 w2 ) diff --git a/core/io/encodings/binary/binary-docs.factor b/core/io/encodings/binary/binary-docs.factor index f8be5054df..823eea67be 100644 --- a/core/io/encodings/binary/binary-docs.factor +++ b/core/io/encodings/binary/binary-docs.factor @@ -2,4 +2,4 @@ USING: help.syntax help.markup ; IN: io.encodings.binary HELP: binary -{ $class-description "This is the encoding descriptor for binary I/O." } ; +{ $class-description "This is the encoding descriptor for binary I/O. Making an encoded stream with the binary encoding is a no-op; streams with this encoding deal with byte-arrays, not strings." } ; diff --git a/core/io/encodings/binary/binary.factor b/core/io/encodings/binary/binary.factor index c4c6237715..b8bcc0f87a 100644 --- a/core/io/encodings/binary/binary.factor +++ b/core/io/encodings/binary/binary.factor @@ -1,3 +1,3 @@ -USING: kernel io.encodings ; - -TUPLE: binary ; +! Copyright (C) 2008 Daniel Ehrenberg. +! See http://factorcode.org/license.txt for BSD license. +IN: io.encodings.binary SYMBOL: binary diff --git a/core/io/encodings/encodings-docs.factor b/core/io/encodings/encodings-docs.factor new file mode 100644 index 0000000000..e5e71b05f0 --- /dev/null +++ b/core/io/encodings/encodings-docs.factor @@ -0,0 +1,68 @@ +USING: help.markup help.syntax ; +IN: io.encodings + +ABOUT: "encodings" + +ARTICLE: "io.encodings" "I/O encodings" +"Many streams deal with bytes, rather than Unicode code points, at some level. The translation between these two things is specified by an encoding. To abstract this away from the programmer, Factor provides a system where these streams are associated with an encoding which is always used when the stream is read from or written to. For most purposes, an encoding descriptor consisting of a symbol is all that is needed when initializing a stream." +{ $subsection "encodings-constructors" } +{ $subsection "encodings-descriptors" } +{ $subsection "encodings-protocol" } ; + +ARTICLE: "encodings-constructors" "Constructing an encoded stream" +{ $subsection } +{ $subsection } +{ $subsection } ; + +HELP: ( stream encoding -- newstream ) +{ $values { "stream" "an output stream" } + { "encoding" "an encoding descriptor" } + { "newstream" "an encoded output stream" } } +{ $description "Wraps the given stream in a new stream using the given encoding for all output. The encoding descriptor can either be a class or an instance of something conforming to the " { $link "encodings-protocol" } "." } ; + +HELP: ( stream encoding -- newstream ) +{ $values { "stream" "an input stream" } + { "encoding" "an encoding descriptor" } + { "newstream" "an encoded output stream" } } +{ $description "Wraps the given stream in a new stream using the given encoding for all input. The encoding descriptor can either be a class or an instance of something conforming to the " { $link "encodings-protocol" } "." } ; + +HELP: ( stream-in stream-out encoding -- duplex ) +{ $values { "stream-in" "an input stream" } + { "stream-out" "an output stream" } + { "encoding" "an encoding descriptor" } + { "duplex" "an encoded duplex stream" } } +{ $description "Wraps the given streams in an encoder or decoder stream, and puts them together in a duplex stream for input and output. If either input stream is already encoded, that encoding is stripped off before it is reencoded. The encoding descriptor must conform to the " { $link "encodings-protocol" } "." } ; + +{ } related-words + +ARTICLE: "encodings-descriptors" "Encoding descriptors" +"An encoding descriptor is something which can be used for input or output streams to encode or decode files. It must conform to the " { $link "encodings-protocol" } ". Encodings which you can use are defined in the following vocabularies:" +$nl { $vocab-link "io.encodings.utf8" } +$nl { $vocab-link "io.encodings.ascii" } +$nl { $vocab-link "io.encodings.binary" } +$nl { $vocab-link "io.encodings.utf16" } ; + +ARTICLE: "encodings-protocol" "Encoding protocol" +"An encoding descriptor must implement the following methods. The methods are implemented on tuple classes by instantiating the class and calling the method again." +{ $subsection decode-step } +{ $subsection init-decoder } +{ $subsection stream-write-encoded } ; + +HELP: decode-step ( buf char encoding -- ) +{ $values { "buf" "A string buffer which characters can be pushed to" } + { "char" "An octet which is read from a stream" } + { "encoding" "An encoding descriptor tuple" } } +{ $description "A single step in the decoding process must be defined for the decoding descriptor. When each octet is read, this word is called, and depending on the decoder's internal state, something may be pushed to the buffer or the state may change. This should not be used directly." } ; + +HELP: stream-write-encoded ( string stream encoding -- ) +{ $values { "string" "a string" } + { "stream" "an output stream" } + { "encoding" "an encoding descriptor" } } +{ $description "Encodes the string with the given encoding descriptor, outputing the result to the given stream. This should not be used directly." } ; + +HELP: init-decoder ( stream encoding -- encoding ) +{ $values { "stream" "an input stream" } + { "encoding" "an encoding descriptor" } } +{ $description "Initializes the decoder tuple's state. The stream is exposed so that it can be read, eg for a BOM. This should not be used directly." } ; + +{ init-decoder decode-step stream-write-encoded } related-words diff --git a/core/io/streams/lines/lines-tests.factor b/core/io/encodings/encodings-tests.factor similarity index 86% rename from core/io/streams/lines/lines-tests.factor rename to core/io/encodings/encodings-tests.factor index e8ecc65526..73d2efa7d4 100755 --- a/core/io/streams/lines/lines-tests.factor +++ b/core/io/encodings/encodings-tests.factor @@ -1,9 +1,9 @@ -USING: io.streams.lines io.files io.streams.string io -tools.test kernel ; -IN: io.streams.lines.tests +USING: io.files io.streams.string io +tools.test kernel io.encodings.ascii ; +IN: io.streams.encodings.tests : ( resource -- stream ) - resource-path ; + resource-path ascii ; [ { } ] [ "/core/io/test/empty-file.txt" lines ] diff --git a/core/io/encodings/encodings.factor b/core/io/encodings/encodings.factor index 2d94e3ea80..2f68334bde 100755 --- a/core/io/encodings/encodings.factor +++ b/core/io/encodings/encodings.factor @@ -1,13 +1,24 @@ -! Copyright (C) 2006, 2007 Daniel Ehrenberg. +! Copyright (C) 2008 Daniel Ehrenberg. ! See http://factorcode.org/license.txt for BSD license. -USING: math kernel sequences sbufs vectors io.streams.lines io.streams.plain -namespaces unicode growable strings io classes io.streams.c -continuations ; +USING: math kernel sequences sbufs vectors namespaces +growable strings io classes continuations combinators +io.styles io.streams.plain io.encodings.binary splitting +io.streams.duplex byte-arrays ; IN: io.encodings -TUPLE: encode-error ; +! The encoding descriptor protocol -: encode-error ( -- * ) \ encode-error construct-empty throw ; +GENERIC: decode-step ( buf char encoding -- ) +M: object decode-step drop swap push ; + +GENERIC: init-decoder ( stream encoding -- encoding ) +M: tuple-class init-decoder construct-empty init-decoder ; +M: object init-decoder nip ; + +GENERIC: stream-write-encoded ( string stream encoding -- byte-array ) +M: object stream-write-encoded drop stream-write ; + +! Decoding TUPLE: decode-error ; @@ -15,24 +26,12 @@ TUPLE: decode-error ; SYMBOL: begin -: decoded ( buf ch -- buf ch state ) +: push-decoded ( buf ch -- buf ch state ) over push 0 begin ; : push-replacement ( buf -- buf ch state ) - CHAR: replacement-character decoded ; - -: finish-decoding ( buf ch state -- str ) - begin eq? [ decode-error ] unless drop "" like ; - -: start-decoding ( seq length -- buf ch state seq ) - 0 begin roll ; - -GENERIC: decode-step ( buf byte ch state encoding -- buf ch state ) - -: decode ( seq quot -- string ) - >r dup length start-decoding r> - [ -rot ] swap compose each - finish-decoding ; inline + ! This is the replacement character + HEX: fffd push-decoded ; : space ( resizable -- room-left ) dup underlying swap [ length ] 2apply - ; @@ -42,54 +41,113 @@ GENERIC: decode-step ( buf byte ch state encoding -- buf ch state ) : end-read-loop ( buf ch state stream quot -- string/f ) 2drop 2drop >string f like ; -: decode-read-loop ( buf ch state stream encoding -- string/f ) - >r >r pick r> r> rot full? [ end-read-loop ] [ +: decode-read-loop ( buf stream encoding -- string/f ) + pick full? [ 2drop >string ] [ over stream-read1 [ - -rot tuck >r >r >r -rot r> decode-step r> r> decode-read-loop - ] [ end-read-loop ] if* + -rot tuck >r >r >r dupd r> decode-step r> r> + decode-read-loop + ] [ 2drop >string f like ] if* ] if ; : decode-read ( length stream encoding -- string ) - >r swap start-decoding r> - decode-read-loop ; + rot -rot decode-read-loop ; -: ( stream decoding-class -- decoded-stream ) - construct-delegate ; +TUPLE: decoder code cr ; +: ( stream encoding -- newstream ) + dup binary eq? [ drop ] [ + dupd init-decoder { set-delegate set-decoder-code } + decoder construct + ] if ; -: ( stream encoding-class -- encoded-stream ) - construct-delegate ; +: cr+ t swap set-decoder-cr ; inline -GENERIC: encode-string ( string encoding -- byte-array ) -M: tuple-class encode-string construct-empty encode-string ; +: cr- f swap set-decoder-cr ; inline -MIXIN: encoding-stream +: line-ends/eof ( stream str -- str ) f like swap cr- ; inline -M: encoding-stream stream-read1 1 swap stream-read ; +: line-ends\r ( stream str -- str ) swap cr+ ; inline -M: encoding-stream stream-read - [ delegate ] keep decode-read ; +: line-ends\n ( stream str -- str ) + over decoder-cr over empty? and + [ drop dup cr- stream-readln ] [ swap cr- ] if ; inline -M: encoding-stream stream-read-partial stream-read ; +: handle-readln ( stream str ch -- str ) + { + { f [ line-ends/eof ] } + { CHAR: \r [ line-ends\r ] } + { CHAR: \n [ line-ends\n ] } + } case ; -M: encoding-stream stream-read-until +: fix-read ( stream string -- string ) + over decoder-cr [ + over cr- + "\n" ?head [ + swap stream-read1 [ add ] when* + ] [ nip ] if + ] [ nip ] if ; + +M: decoder stream-read + tuck { delegate decoder-code } get-slots decode-read fix-read ; + +M: decoder stream-read-partial stream-read ; + +: decoder-read-until ( stream delim -- ch ) ! Copied from { c-reader stream-read-until }!!! - [ swap read-until-loop ] "" make + over stream-read1 dup [ + dup pick memq? [ 2nip ] [ , decoder-read-until ] if + ] [ + 2nip + ] if ; + +M: decoder stream-read-until + ! Copied from { c-reader stream-read-until }!!! + [ swap decoder-read-until ] "" make swap over empty? over not and [ 2drop f f ] when ; -M: encoding-stream stream-write1 +: fix-read1 ( stream char -- char ) + over decoder-cr [ + over cr- + dup CHAR: \n = [ + drop stream-read1 + ] [ nip ] if + ] [ nip ] if ; + +M: decoder stream-read1 + 1 swap stream-read f like [ first ] [ f ] if* ; + +M: decoder stream-readln ( stream -- str ) + "\r\n" over stream-read-until handle-readln ; + +! Encoding + +TUPLE: encode-error ; + +: encode-error ( -- * ) \ encode-error construct-empty throw ; + +TUPLE: encoder code ; +: ( stream encoding -- newstream ) + dup binary eq? [ drop ] [ + construct-empty { set-delegate set-encoder-code } + encoder construct + ] if ; + +M: encoder stream-write1 >r 1string r> stream-write ; -M: encoding-stream stream-write - [ encode-string ] keep delegate stream-write ; +M: encoder stream-write + { delegate encoder-code } get-slots stream-write-encoded ; -M: encoding-stream dispose delegate dispose ; +M: encoder dispose delegate dispose ; -GENERIC: underlying-stream ( encoded-stream -- delegate ) -M: encoding-stream underlying-stream delegate ; +INSTANCE: encoder plain-writer -GENERIC: set-underlying-stream ( new-underlying stream -- ) -M: encoding-stream set-underlying-stream set-delegate ; +! Rebinding duplex streams which have not read anything yet -: set-encoding ( encoding stream -- ) ! This doesn't work now - [ underlying-stream swap construct-delegate ] keep - set-underlying-stream ; +: reencode ( stream encoding -- newstream ) + over encoder? [ >r delegate r> ] when ; + +: redecode ( stream encoding -- newstream ) + over decoder? [ >r delegate r> ] when ; + +: ( stream-in stream-out encoding -- duplex ) + tuck reencode >r redecode r> ; diff --git a/core/io/encodings/latin1/latin1.factor b/core/io/encodings/latin1/latin1.factor deleted file mode 100755 index e6d6281eb6..0000000000 --- a/core/io/encodings/latin1/latin1.factor +++ /dev/null @@ -1,10 +0,0 @@ -USING: io io.encodings strings kernel ; -IN: io.encodings.latin1 - -TUPLE: latin1 ; - -M: latin1 stream-read delegate stream-read >string ; - -M: latin1 stream-read-until delegate stream-read-until >string ; - -M: latin1 stream-read-partial delegate stream-read-partial >string ; diff --git a/core/io/encodings/latin1/authors.txt b/core/io/encodings/string/authors.txt similarity index 100% rename from core/io/encodings/latin1/authors.txt rename to core/io/encodings/string/authors.txt diff --git a/core/io/encodings/string/string-docs.factor b/core/io/encodings/string/string-docs.factor new file mode 100644 index 0000000000..0a35eee272 --- /dev/null +++ b/core/io/encodings/string/string-docs.factor @@ -0,0 +1,18 @@ +! Copyright (C) 2008 Daniel Ehrenberg. +! See http://factorcode.org/license.txt for BSD license. +USING: help.markup help.syntax byte-arrays strings ; +IN: io.encodings.string + +ARTICLE: "io.encodings.string" "Encoding and decoding strings" +"Strings can be encoded or decoded to and from byte arrays through an encoding with the following words:" +{ $subsection encode } +{ $subsection decode } ; + +HELP: decode +{ $values { "byte-array" byte-array } { "encoding" "an encoding descriptor" } + { "string" string } } +{ $description "Decodes the byte array using the given encoding, outputting a string" } ; + +HELP: encode +{ $values { "string" string } { "encoding" "an encoding descriptor" } { "byte-array" byte-array } } +{ $description "Encodes the given string into a byte array with the given encoding." } ; diff --git a/core/io/encodings/string/string-tests.factor b/core/io/encodings/string/string-tests.factor new file mode 100644 index 0000000000..ddae9c8734 --- /dev/null +++ b/core/io/encodings/string/string-tests.factor @@ -0,0 +1,11 @@ +! Copyright (C) 2008 Daniel Ehrenberg. +! See http://factorcode.org/license.txt for BSD license. +USING: strings io.encodings.utf8 io.encodings.utf16 +io.encodings.string tools.test ; +IN: io.encodings.string.tests + +[ "hello" ] [ "hello" utf8 decode ] unit-test +[ "he" ] [ "\0h\0e" utf16be decode ] unit-test + +[ "hello" ] [ "hello" utf8 encode >string ] unit-test +[ "\0h\0e" ] [ "he" utf16be encode >string ] unit-test diff --git a/core/io/encodings/string/string.factor b/core/io/encodings/string/string.factor new file mode 100644 index 0000000000..5e57a943a9 --- /dev/null +++ b/core/io/encodings/string/string.factor @@ -0,0 +1,10 @@ +! Copyright (C) 2008 Daniel Ehrenberg. +! See http://factorcode.org/license.txt for BSD license. +USING: io io.streams.byte-array ; +IN: io.encodings.string + +: decode ( byte-array encoding -- string ) + contents ; + +: encode ( string encoding -- byte-array ) + [ write ] with-byte-writer ; diff --git a/core/io/encodings/string/summary.txt b/core/io/encodings/string/summary.txt new file mode 100644 index 0000000000..59b8927dea --- /dev/null +++ b/core/io/encodings/string/summary.txt @@ -0,0 +1 @@ +Encoding and decoding strings diff --git a/core/io/encodings/latin1/tags.txt b/core/io/encodings/string/tags.factor similarity index 100% rename from core/io/encodings/latin1/tags.txt rename to core/io/encodings/string/tags.factor diff --git a/core/io/encodings/utf16/utf16-docs.factor b/core/io/encodings/utf16/utf16-docs.factor deleted file mode 100644 index c49c030ef3..0000000000 --- a/core/io/encodings/utf16/utf16-docs.factor +++ /dev/null @@ -1,45 +0,0 @@ -USING: help.markup help.syntax io.encodings strings ; -IN: io.encodings.utf16 - -ARTICLE: "io.utf16" "Working with UTF16-encoded data" -"The UTF16 encoding is a variable-width encoding. Unicode code points are encoded as 2 or 4 byte sequences." -{ $subsection encode-utf16le } -{ $subsection encode-utf16be } -{ $subsection decode-utf16le } -{ $subsection decode-utf16be } -"Support for UTF16 data with a byte order mark:" -{ $subsection encode-utf16 } -{ $subsection decode-utf16 } ; - -ABOUT: "io.utf16" - -HELP: decode-utf16 -{ $values { "seq" "a sequence of bytes" } { "str" string } } -{ $description "Decodes a sequence of bytes representing a Unicode string in UTF16 format. The bytes must begin with a UTF16 byte order mark, which determines if the input is in little or big endian. To decode data without a byte order mark, use " { $link decode-utf16le } " or " { $link decode-utf16be } "." } -{ $errors "Throws a " { $link decode-error } " if the input is malformed." } ; - -HELP: decode-utf16be -{ $values { "seq" "a sequence of bytes" } { "str" string } } -{ $description "Decodes a sequence of bytes representing a Unicode string in big endian UTF16 format. The bytes must not begin with a UTF16 byte order mark. To decode data with a byte order mark, use " { $link decode-utf16 } "." } -{ $errors "Throws a " { $link decode-error } " if the input is malformed." } ; - -HELP: decode-utf16le -{ $values { "seq" "a sequence of bytes" } { "str" string } } -{ $description "Decodes a sequence of bytes representing a Unicode string in little endian UTF16 format. The bytes must not begin with a UTF16 byte order mark. To decode data with a byte order mark, use " { $link decode-utf16 } "." } -{ $errors "Throws a " { $link decode-error } " if the input is malformed." } ; - -{ decode-utf16 decode-utf16le decode-utf16be } related-words - -HELP: encode-utf16be -{ $values { "str" string } { "seq" "a sequence of bytes" } } -{ $description "Encodes a Unicode string as a sequence of bytes in big endian UTF16 format." } ; - -HELP: encode-utf16le -{ $values { "str" string } { "seq" "a sequence of bytes" } } -{ $description "Encodes a Unicode string as a sequence of bytes in little endian UTF16 format." } ; - -HELP: encode-utf16 -{ $values { "str" string } { "seq" "a sequence of bytes" } } -{ $description "Encodes a Unicode string as a sequence of bytes in UTF16 format with a byte order mark." } ; - -{ encode-utf16 encode-utf16be encode-utf16le } related-words diff --git a/core/io/encodings/utf16/utf16-tests.factor b/core/io/encodings/utf16/utf16-tests.factor deleted file mode 100755 index 041c486915..0000000000 --- a/core/io/encodings/utf16/utf16-tests.factor +++ /dev/null @@ -1,28 +0,0 @@ -USING: kernel tools.test io.encodings.utf16 arrays sbufs sequences io.encodings -io unicode ; - -: decode-w/stream ( array encoding -- newarray ) - >r >sbuf dup reverse-here r> contents >array ; - -: encode-w/stream ( array encoding -- newarray ) - >r SBUF" " clone tuck r> stream-write >array ; - -[ { CHAR: x } ] [ { 0 CHAR: x } utf16be decode-w/stream ] unit-test -[ { HEX: 1D11E } ] [ { HEX: D8 HEX: 34 HEX: DD HEX: 1E } utf16be decode-w/stream ] unit-test -[ { CHAR: replacement-character } ] [ { BIN: 11011111 CHAR: q } utf16be decode-w/stream ] unit-test -[ { CHAR: replacement-character } ] [ { BIN: 11011011 CHAR: x BIN: 11011011 CHAR: x } utf16be decode-w/stream ] unit-test - -[ { 0 120 216 52 221 30 } ] [ { CHAR: x HEX: 1d11e } utf16be encode-w/stream ] unit-test - -[ { CHAR: x } ] [ { CHAR: x 0 } utf16le decode-w/stream ] unit-test -[ { 119070 } ] [ { HEX: 34 HEX: D8 HEX: 1E HEX: DD } utf16le decode-w/stream ] unit-test -[ { CHAR: replacement-character } ] [ { 0 BIN: 11011111 } utf16le decode-w/stream ] unit-test -[ { CHAR: replacement-character } ] [ { 0 BIN: 11011011 0 0 } utf16le decode-w/stream ] unit-test -[ { 119070 } ] [ { HEX: 34 HEX: D8 HEX: 1E HEX: DD } utf16le decode-w/stream ] unit-test - -[ { 120 0 52 216 30 221 } ] [ { CHAR: x HEX: 1d11e } utf16le encode-w/stream ] unit-test - -[ { CHAR: x } ] [ { HEX: ff HEX: fe CHAR: x 0 } utf16 decode-w/stream ] unit-test -[ { CHAR: x } ] [ { HEX: fe HEX: ff 0 CHAR: x } utf16 decode-w/stream ] unit-test - -[ { HEX: ff HEX: fe 120 0 52 216 30 221 } ] [ { CHAR: x HEX: 1d11e } utf16 encode-w/stream ] unit-test diff --git a/core/io/encodings/utf8/utf8-docs.factor b/core/io/encodings/utf8/utf8-docs.factor index 6e1923824f..dbbc193a02 100755 --- a/core/io/encodings/utf8/utf8-docs.factor +++ b/core/io/encodings/utf8/utf8-docs.factor @@ -1,18 +1,11 @@ -USING: help.markup help.syntax io.encodings strings ; +USING: help.markup help.syntax io.encodings strings io.files ; IN: io.encodings.utf8 ARTICLE: "io.encodings.utf8" "Working with UTF8-encoded data" -"The UTF8 encoding is a variable-width encoding. 7-bit ASCII characters are encoded as single bytes, and other Unicode code points are encoded as 2 to 4 byte sequences." -{ $subsection encode-utf8 } -{ $subsection decode-utf8 } ; +"The UTF8 encoding is a variable-width encoding. 7-bit ASCII characters are encoded as single bytes, and other Unicode code points are encoded as 2 to 4 byte sequences. The encoding descriptor for UTF-8:" +{ $subsection utf8 } ; + +HELP: utf8 +{ $class-description "This is the class of encoding tuples which denote a UTF-8 encoding. This conforms to the " { $link "encodings-protocol" } "." } ; ABOUT: "io.encodings.utf8" - -HELP: decode-utf8 -{ $values { "seq" "a sequence of bytes" } { "str" string } } -{ $description "Decodes a sequence of bytes representing a Unicode string in UTF8 format." } -{ $errors "Throws a " { $link decode-error } " if the input is malformed." } ; - -HELP: encode-utf8 -{ $values { "str" string } { "seq" "a sequence of bytes" } } -{ $description "Encodes a Unicode string as a sequence of bytes in UTF8 format." } ; diff --git a/core/io/encodings/utf8/utf8-tests.factor b/core/io/encodings/utf8/utf8-tests.factor index 44d0870385..8f1c998f3d 100644 --- a/core/io/encodings/utf8/utf8-tests.factor +++ b/core/io/encodings/utf8/utf8-tests.factor @@ -1,21 +1,20 @@ -USING: io.encodings.utf8 tools.test sbufs kernel io io.encodings -sequences strings arrays unicode ; +USING: io.encodings.utf8 tools.test io.encodings.string strings arrays ; : decode-utf8-w/stream ( array -- newarray ) - >sbuf dup reverse-here utf8 contents ; + utf8 decode >array ; : encode-utf8-w/stream ( array -- newarray ) - SBUF" " clone tuck utf8 stream-write >array ; + utf8 encode >array ; -[ { CHAR: replacement-character } ] [ { BIN: 11110101 BIN: 10111111 BIN: 10000000 BIN: 11111111 } decode-utf8-w/stream >array ] unit-test +[ { CHAR: replacement-character } ] [ { BIN: 11110101 BIN: 10111111 BIN: 10000000 BIN: 11111111 } decode-utf8-w/stream ] unit-test -[ { BIN: 101111111000000111111 } ] [ { BIN: 11110101 BIN: 10111111 BIN: 10000000 BIN: 10111111 } decode-utf8-w/stream >array ] unit-test +[ { BIN: 101111111000000111111 } ] [ { BIN: 11110101 BIN: 10111111 BIN: 10000000 BIN: 10111111 } decode-utf8-w/stream ] unit-test [ "x" ] [ "x" decode-utf8-w/stream >string ] unit-test [ { BIN: 11111000000 } ] [ { BIN: 11011111 BIN: 10000000 } decode-utf8-w/stream >array ] unit-test -[ { CHAR: replacement-character } ] [ { BIN: 10000000 } decode-utf8-w/stream >array ] unit-test +[ { CHAR: replacement-character } ] [ { BIN: 10000000 } decode-utf8-w/stream ] unit-test [ { BIN: 1111000000111111 } ] [ { BIN: 11101111 BIN: 10000000 BIN: 10111111 } decode-utf8-w/stream >array ] unit-test diff --git a/core/io/encodings/utf8/utf8.factor b/core/io/encodings/utf8/utf8.factor index 6a3a8b8ec7..5887a8375e 100644 --- a/core/io/encodings/utf8/utf8.factor +++ b/core/io/encodings/utf8/utf8.factor @@ -1,11 +1,13 @@ -! Copyright (C) 2006, 2007 Daniel Ehrenberg. +! Copyright (C) 2006, 2008 Daniel Ehrenberg. ! See http://factorcode.org/license.txt for BSD license. USING: math kernel sequences sbufs vectors growable io continuations -namespaces io.encodings combinators strings io.streams.c ; +namespaces io.encodings combinators strings ; IN: io.encodings.utf8 ! Decoding UTF-8 +TUPLE: utf8 ch state ; + SYMBOL: double SYMBOL: triple SYMBOL: triple2 @@ -23,7 +25,7 @@ SYMBOL: quad3 : begin-utf8 ( buf byte -- buf ch state ) { - { [ dup -7 shift zero? ] [ decoded ] } + { [ dup -7 shift zero? ] [ push-decoded ] } { [ dup -5 shift BIN: 110 number= ] [ BIN: 11111 bitand double ] } { [ dup -4 shift BIN: 1110 number= ] [ BIN: 1111 bitand triple ] } { [ dup -3 shift BIN: 11110 number= ] [ BIN: 111 bitand quad ] } @@ -31,7 +33,7 @@ SYMBOL: quad3 } cond ; : end-multibyte ( buf byte ch -- buf ch state ) - f append-nums [ decoded ] unless* ; + f append-nums [ push-decoded ] unless* ; : decode-utf8-step ( buf byte ch state -- buf ch state ) { @@ -44,42 +46,42 @@ SYMBOL: quad3 { quad3 [ end-multibyte ] } } case ; -: decode-utf8 ( seq -- str ) - [ decode-utf8-step ] decode ; +: unpack-state ( encoding -- ch state ) + { utf8-ch utf8-state } get-slots ; + +: pack-state ( ch state encoding -- ) + { set-utf8-ch set-utf8-state } set-slots ; + +M: utf8 decode-step ( buf char encoding -- ) + [ unpack-state decode-utf8-step ] keep pack-state drop ; + +M: utf8 init-decoder nip begin over set-utf8-state ; ! Encoding UTF-8 : encoded ( char -- ) - BIN: 111111 bitand BIN: 10000000 bitor , ; + BIN: 111111 bitand BIN: 10000000 bitor write1 ; : char>utf8 ( char -- ) { - { [ dup -7 shift zero? ] [ , ] } + { [ dup -7 shift zero? ] [ write1 ] } { [ dup -11 shift zero? ] [ - dup -6 shift BIN: 11000000 bitor , + dup -6 shift BIN: 11000000 bitor write1 encoded ] } { [ dup -16 shift zero? ] [ - dup -12 shift BIN: 11100000 bitor , + dup -12 shift BIN: 11100000 bitor write1 dup -6 shift encoded encoded ] } { [ t ] [ - dup -18 shift BIN: 11110000 bitor , + dup -18 shift BIN: 11110000 bitor write1 dup -12 shift encoded dup -6 shift encoded encoded ] } } cond ; -: encode-utf8 ( str -- seq ) - [ [ char>utf8 ] each ] B{ } make ; - -! Interface for streams - -TUPLE: utf8 ; -INSTANCE: utf8 encoding-stream - -M: utf8 encode-string drop encode-utf8 ; -M: utf8 decode-step drop decode-utf8-step ; -! In the future, this should detect and ignore a BOM at the beginning +M: utf8 stream-write-encoded + ! For efficiency, this should be modified to avoid variable reads + drop [ [ char>utf8 ] each ] with-stream* ; diff --git a/core/io/files/authors.txt b/core/io/files/authors.txt index 1901f27a24..a44f8d7f8d 100644 --- a/core/io/files/authors.txt +++ b/core/io/files/authors.txt @@ -1 +1,2 @@ Slava Pestov +Daniel Ehrenberg diff --git a/core/io/files/files-docs.factor b/core/io/files/files-docs.factor index 9dc178ee57..9609cd123b 100755 --- a/core/io/files/files-docs.factor +++ b/core/io/files/files-docs.factor @@ -10,7 +10,9 @@ ARTICLE: "file-streams" "Reading and writing files" "Utility combinators:" { $subsection with-file-reader } { $subsection with-file-writer } -{ $subsection with-file-appender } ; +{ $subsection with-file-appender } +{ $subsection file-contents } +{ $subsection file-lines } ; ARTICLE: "pathnames" "Pathname manipulation" "Pathname manipulation:" @@ -87,7 +89,6 @@ ARTICLE: "io.files" "Basic file operations" { $subsection "fs-meta" } { $subsection "directories" } { $subsection "delete-move-copy" } -{ $subsection "unique" } { $see-also "os" } ; ABOUT: "io.files" @@ -114,33 +115,44 @@ HELP: file-name } ; HELP: -{ $values { "path" "a pathname string" } { "stream" "an input stream" } } -{ $description "Outputs an input stream for reading from the specified pathname." } +{ $values { "path" "a pathname string" } { "encoding" "an encoding descriptors" } + { "stream" "an input stream" } } +{ $description "Outputs an input stream for reading from the specified pathname using the given encoding." } { $errors "Throws an error if the file is unreadable." } ; HELP: -{ $values { "path" "a pathname string" } { "stream" "an output stream" } } -{ $description "Outputs an output stream for writing to the specified pathname. The file's length is truncated to zero." } +{ $values { "path" "a pathname string" } { "encoding" "an encoding descriptor" } { "stream" "an output stream" } } +{ $description "Outputs an output stream for writing to the specified pathname using the given encoding. The file's length is truncated to zero." } { $errors "Throws an error if the file cannot be opened for writing." } ; HELP: -{ $values { "path" "a pathname string" } { "stream" "an output stream" } } -{ $description "Outputs an output stream for writing to the specified pathname. The stream begins writing at the end of the file." } +{ $values { "path" "a pathname string" } { "encoding" "an encoding descriptor" } { "stream" "an output stream" } } +{ $description "Outputs an output stream for writing to the specified pathname using the given encoding. The stream begins writing at the end of the file." } { $errors "Throws an error if the file cannot be opened for writing." } ; HELP: with-file-reader -{ $values { "path" "a pathname string" } { "quot" "a quotation" } } +{ $values { "path" "a pathname string" } { "encoding" "an encoding descriptor" } { "quot" "a quotation" } } { $description "Opens a file for reading and calls the quotation using " { $link with-stream } "." } { $errors "Throws an error if the file is unreadable." } ; HELP: with-file-writer -{ $values { "path" "a pathname string" } { "quot" "a quotation" } } -{ $description "Opens a file for writing and calls the quotation using " { $link with-stream } "." } +{ $values { "path" "a pathname string" } { "encoding" "an encoding descriptor" } { "quot" "a quotation" } } +{ $description "Opens a file for writing using the given encoding and calls the quotation using " { $link with-stream } "." } { $errors "Throws an error if the file cannot be opened for writing." } ; HELP: with-file-appender -{ $values { "path" "a pathname string" } { "quot" "a quotation" } } -{ $description "Opens a file for appending and calls the quotation using " { $link with-stream } "." } +{ $values { "path" "a pathname string" } { "encoding" "an encoding descriptor" } { "quot" "a quotation" } } +{ $description "Opens a file for appending using the given encoding and calls the quotation using " { $link with-stream } "." } +{ $errors "Throws an error if the file cannot be opened for writing." } ; + +HELP: file-lines +{ $values { "path" "a pathname string" } { "encoding" "an encoding descriptor" } { "seq" "an array of strings" } } +{ $description "Opens the file at the given path using the given encoding, and returns a list of the lines in that file." } +{ $errors "Throws an error if the file cannot be opened for writing." } ; + +HELP: file-contents +{ $values { "path" "a pathname string" } { "encoding" "an encoding descriptor" } { "str" "a string" } } +{ $description "Opens the file at the given path using the given encoding, and the contents of that file as a string." } { $errors "Throws an error if the file cannot be opened for writing." } ; HELP: cwd diff --git a/core/io/files/files-tests.factor b/core/io/files/files-tests.factor index 6943163c5d..e7f7f4f777 100755 --- a/core/io/files/files-tests.factor +++ b/core/io/files/files-tests.factor @@ -1,34 +1,34 @@ IN: io.files.tests -USING: tools.test io.files io threads kernel continuations ; +USING: tools.test io.files io threads kernel continuations io.encodings.ascii ; [ "passwd" ] [ "/etc/passwd" file-name ] unit-test [ "awk" ] [ "/usr/libexec/awk/" file-name ] unit-test [ "awk" ] [ "/usr/libexec/awk///" file-name ] unit-test [ ] [ - "test-foo.txt" temp-file [ + "test-foo.txt" temp-file ascii [ "Hello world." print ] with-file-writer ] unit-test [ ] [ - "test-foo.txt" temp-file [ + "test-foo.txt" temp-file ascii [ "Hello appender." print - ] with-stream + ] with-file-appender ] unit-test [ ] [ - "test-bar.txt" temp-file [ + "test-bar.txt" temp-file ascii [ "Hello appender." print - ] with-stream + ] with-file-appender ] unit-test [ "Hello world.\nHello appender.\n" ] [ - "test-foo.txt" temp-file file-contents + "test-foo.txt" temp-file ascii file-contents ] unit-test [ "Hello appender.\n" ] [ - "test-bar.txt" temp-file file-contents + "test-bar.txt" temp-file ascii file-contents ] unit-test [ ] [ "test-foo.txt" temp-file delete-file ] unit-test @@ -42,7 +42,7 @@ USING: tools.test io.files io threads kernel continuations ; [ ] [ "test-blah" temp-file make-directory ] unit-test [ ] [ - "test-blah/fooz" temp-file dispose + "test-blah/fooz" temp-file ascii dispose ] unit-test [ t ] [ @@ -55,11 +55,11 @@ USING: tools.test io.files io threads kernel continuations ; [ f ] [ "test-blah" temp-file exists? ] unit-test -[ ] [ "test-quux.txt" temp-file [ [ yield "Hi" write ] "Test" spawn drop ] with-file-writer ] unit-test +[ ] [ "test-quux.txt" temp-file ascii [ [ yield "Hi" write ] "Test" spawn drop ] with-file-writer ] unit-test [ ] [ "test-quux.txt" temp-file delete-file ] unit-test -[ ] [ "test-quux.txt" temp-file [ [ yield "Hi" write ] "Test" spawn drop ] with-file-writer ] unit-test +[ ] [ "test-quux.txt" temp-file ascii [ [ yield "Hi" write ] "Test" spawn drop ] with-file-writer ] unit-test [ ] [ "test-quux.txt" "quux-test.txt" [ temp-file ] 2apply move-file ] unit-test [ t ] [ "quux-test.txt" temp-file exists? ] unit-test @@ -70,7 +70,7 @@ USING: tools.test io.files io threads kernel continuations ; [ ] [ "delete-tree-test/a/b/c/d" temp-file - [ "Hi" print ] with-file-writer + ascii [ "Hi" print ] with-file-writer ] unit-test [ ] [ @@ -83,7 +83,7 @@ USING: tools.test io.files io threads kernel continuations ; [ ] [ "copy-tree-test/a/b/c/d" temp-file - [ "Foobar" write ] with-file-writer + ascii [ "Foobar" write ] with-file-writer ] unit-test [ ] [ @@ -92,7 +92,7 @@ USING: tools.test io.files io threads kernel continuations ; ] unit-test [ "Foobar" ] [ - "copy-destination/a/b/c/d" temp-file file-contents + "copy-destination/a/b/c/d" temp-file ascii file-contents ] unit-test [ ] [ @@ -105,7 +105,7 @@ USING: tools.test io.files io threads kernel continuations ; ] unit-test [ "Foobar" ] [ - "copy-destination/copy-tree-test/a/b/c/d" temp-file file-contents + "copy-destination/copy-tree-test/a/b/c/d" temp-file ascii file-contents ] unit-test [ ] [ @@ -113,7 +113,7 @@ USING: tools.test io.files io threads kernel continuations ; ] unit-test [ "Foobar" ] [ - "d" temp-file file-contents + "d" temp-file ascii file-contents ] unit-test [ ] [ "d" temp-file delete-file ] unit-test diff --git a/core/io/files/files.factor b/core/io/files/files.factor index 899a1be006..f740d1dc21 100755 --- a/core/io/files/files.factor +++ b/core/io/files/files.factor @@ -1,11 +1,28 @@ -! Copyright (C) 2004, 2008 Slava Pestov. +! Copyright (C) 2004, 2008 Slava Pestov, Daniel Ehrenberg. ! See http://factorcode.org/license.txt for BSD license. USING: io.backend io.files.private io hashtables kernel math memory namespaces sequences strings assocs arrays definitions -system combinators splitting sbufs continuations ; - +system combinators splitting sbufs continuations io.encodings +io.encodings.binary ; IN: io.files +HOOK: (file-reader) io-backend ( path -- stream ) + +HOOK: (file-writer) io-backend ( path -- stream ) + +HOOK: (file-appender) io-backend ( path -- stream ) + +: ( path encoding -- stream ) + swap (file-reader) swap ; + +: ( path encoding -- stream ) + swap (file-writer) swap ; + +: ( path encoding -- stream ) + swap (file-appender) swap ; + +HOOK: rename-file io-backend ( from to -- ) + ! Pathnames : path-separator? ( ch -- ? ) windows? "/\\" "/" ? member? ; @@ -147,6 +164,14 @@ HOOK: move-file io-backend ( from to -- ) ! Copying files HOOK: copy-file io-backend ( from to -- ) +M: object copy-file + dup parent-directory make-directories + binary [ + swap binary [ + swap stream-copy + ] with-disposal + ] with-disposal ; + : copy-file-into ( from to -- ) to-directory copy-file ; @@ -181,6 +206,28 @@ DEFER: copy-tree-into : resource-exists? ( path -- ? ) ?resource-path exists? ; +! Pathname presentations +TUPLE: pathname string ; + +C: pathname + +M: pathname <=> [ pathname-string ] compare ; + +: file-lines ( path encoding -- seq ) lines ; + +: file-contents ( path encoding -- str ) + dupd swap file-length + [ stream-copy ] keep >string ; + +: with-file-reader ( path encoding quot -- ) + >r r> with-stream ; inline + +: with-file-writer ( path encoding quot -- ) + >r r> with-stream ; inline + +: with-file-appender ( path encoding quot -- ) + >r r> with-stream ; inline + : temp-directory ( -- path ) "temp" resource-path dup exists? not @@ -189,35 +236,6 @@ DEFER: copy-tree-into : temp-file ( name -- path ) temp-directory swap path+ ; -! Pathname presentations -TUPLE: pathname string ; - -C: pathname - -M: pathname <=> [ pathname-string ] compare ; - -! Streams -HOOK: io-backend ( path -- stream ) - -HOOK: io-backend ( path -- stream ) - -HOOK: io-backend ( path -- stream ) - -: file-lines ( path -- seq ) lines ; - -: file-contents ( path -- str ) - dup swap file-length - [ stream-copy ] keep >string ; - -: with-file-reader ( path quot -- ) - >r r> with-stream ; inline - -: with-file-writer ( path quot -- ) - >r r> with-stream ; inline - -: with-file-appender ( path quot -- ) - >r r> with-stream ; inline - ! Home directory : home ( -- dir ) { diff --git a/core/io/io-docs.factor b/core/io/io-docs.factor index 0986196e8d..fd40950e62 100755 --- a/core/io/io-docs.factor +++ b/core/io/io-docs.factor @@ -100,7 +100,7 @@ $nl { $subsection "stream-protocol" } { $subsection "stdio" } { $subsection "stream-utils" } -{ $see-also "io.streams.string" "io.streams.lines" "io.streams.plain" "io.streams.duplex" } ; +{ $see-also "io.streams.string" "io.streams.plain" "io.streams.duplex" } ; ABOUT: "streams" diff --git a/core/io/io-tests.factor b/core/io/io-tests.factor old mode 100644 new mode 100755 index e3c249ec5d..22c942d2d9 --- a/core/io/io-tests.factor +++ b/core/io/io-tests.factor @@ -1,5 +1,6 @@ USING: arrays io io.files kernel math parser strings system -tools.test words namespaces ; +tools.test words namespaces io.encodings.latin1 +io.encodings.binary ; IN: io.tests [ f ] [ @@ -8,7 +9,7 @@ IN: io.tests ] unit-test : ( resource -- stream ) - resource-path ; + resource-path latin1 ; [ "This is a line.\rThis is another line.\r" @@ -31,10 +32,10 @@ IN: io.tests ! [ ] [ "123" write 9000 CHAR: x write flush ] unit-test -[ "" ] [ +[ "/core/io/test/binary.txt" [ 0.2 read ] with-stream -] unit-test +] must-fail [ { @@ -53,7 +54,7 @@ IN: io.tests ] unit-test [ ] [ - image [ + image binary [ 10 [ 65536 read drop ] times ] with-file-reader ] unit-test diff --git a/core/io/streams/byte-array/byte-array-docs.factor b/core/io/streams/byte-array/byte-array-docs.factor new file mode 100644 index 0000000000..8e0b97e06b --- /dev/null +++ b/core/io/streams/byte-array/byte-array-docs.factor @@ -0,0 +1,33 @@ +USING: help.syntax help.markup io byte-arrays quotations ; +IN: io.streams.byte-array + +ABOUT: "io.streams.byte-array" + +ARTICLE: "io.streams.byte-array" "Byte-array streams" +"Byte array streams:" +{ $subsection } +{ $subsection } +"Utility combinators:" +{ $subsection with-byte-reader } +{ $subsection with-byte-writer } ; + +HELP: +{ $values { "byte-array" byte-array } + { "encoding" "an encoding descriptor" } } +{ $description "Provides an input stream reading off the given byte array using the given encoding." } ; + +HELP: +{ $values { "encoding" "an encoding descriptor" } + { "stream" "an output stream" } } +{ $description "Provides an output stream, putting things in the given encoding, storing everything written to it in a byte-array." } ; + +HELP: with-byte-reader +{ $values { "encoding" "an encoding descriptor" } + { "quot" quotation } { "byte-array" byte-array } } +{ $description "Calls the quotation in a new dynamic scope with " { $link stdio } " rebound to an input stream reading the byte array in the given encoding from beginning to end." } ; + +HELP: with-byte-writer +{ $values { "encoding" "an encoding descriptor" } + { "quot" quotation } + { "byte-array" byte-array } } +{ $description "Calls the quotation in a new dynamic scope with " { $link stdio } " rebound to a new byte array writer, putting things in the given encoding. The accumulated byte array is output when the quotation returns." } ; diff --git a/core/io/streams/byte-array/byte-array.factor b/core/io/streams/byte-array/byte-array.factor index eb224650f3..d5ca8eac68 100644 --- a/core/io/streams/byte-array/byte-array.factor +++ b/core/io/streams/byte-array/byte-array.factor @@ -3,14 +3,14 @@ sequences io namespaces ; IN: io.streams.byte-array : ( encoding -- stream ) - 512 swap ; + 512 swap ; : with-byte-writer ( encoding quot -- byte-array ) >r r> [ stdio get ] compose with-stream* >byte-array ; inline : ( byte-array encoding -- stream ) - >r >byte-vector dup reverse-here r> ; + >r >byte-vector dup reverse-here r> ; : with-byte-reader ( byte-array encoding quot -- ) >r r> with-stream ; inline diff --git a/core/io/streams/c/c-docs.factor b/core/io/streams/c/c-docs.factor index de8a756f92..5d9c7b1a53 100644 --- a/core/io/streams/c/c-docs.factor +++ b/core/io/streams/c/c-docs.factor @@ -6,7 +6,6 @@ ARTICLE: "io.streams.c" "ANSI C streams" "C streams are found in the " { $vocab-link "io.streams.c" } " vocabulary; they are " { $link "stream-protocol" } " implementations which read and write C " { $snippet "FILE*" } " handles." { $subsection } { $subsection } -{ $subsection } "Underlying primitives used to implement the above:" { $subsection fopen } { $subsection fwrite } @@ -31,10 +30,6 @@ HELP: ( out -- stream ) { $description "Creates a stream which writes data by calling C standard library functions." } { $notes "Usually C streams are only used during bootstrap, and non-blocking OS-specific I/O routines are used during normal operation." } ; -HELP: -{ $values { "in" "a C FILE* handle" } { "out" "a C FILE* handle" } { "stream" "a new stream" } } -{ $description "Creates a stream which reads and writes data by calling C standard library functions, wrapping the input portion in a " { $link line-reader } " and the output portion in a " { $link plain-writer } "." } ; - HELP: fopen ( path mode -- alien ) { $values { "path" "a pathname string" } { "mode" "an access mode specifier" } { "alien" "a C FILE* handle" } } { $description "Opens a file named by " { $snippet "path" } ". The " { $snippet "mode" } " parameter should be something like " { $snippet "\"r\"" } " or " { $snippet "\"rw\"" } "; consult the " { $snippet "fopen(3)" } " manual page for details." } diff --git a/core/io/streams/c/c-tests.factor b/core/io/streams/c/c-tests.factor index 3da9f27646..321cad4d19 100755 --- a/core/io/streams/c/c-tests.factor +++ b/core/io/streams/c/c-tests.factor @@ -1,10 +1,12 @@ -USING: tools.test io.files io io.streams.c ; +USING: tools.test io.files io io.streams.c +io.encodings.ascii strings ; IN: io.streams.c.tests [ "hello world" ] [ - "test.txt" temp-file [ + "test.txt" temp-file ascii [ "hello world" write ] with-file-writer "test.txt" temp-file "rb" fopen contents + >string ] unit-test diff --git a/core/io/streams/c/c.factor b/core/io/streams/c/c.factor index 48d6e6e430..372acbe0c1 100755 --- a/core/io/streams/c/c.factor +++ b/core/io/streams/c/c.factor @@ -1,9 +1,8 @@ ! Copyright (C) 2004, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: kernel kernel.private namespaces io -strings sequences math generic threads.private classes -io.backend io.streams.lines io.streams.plain io.streams.duplex -io.files continuations ; +USING: kernel kernel.private namespaces io io.encodings +sequences math generic threads.private classes io.backend +io.streams.duplex io.files continuations byte-arrays ; IN: io.streams.c TUPLE: c-writer handle ; @@ -11,7 +10,7 @@ TUPLE: c-writer handle ; C: c-writer M: c-writer stream-write1 - >r 1string r> stream-write ; + c-writer-handle fputc ; M: c-writer stream-write c-writer-handle fwrite ; @@ -27,7 +26,7 @@ TUPLE: c-reader handle ; C: c-reader M: c-reader stream-read - >r >fixnum r> c-reader-handle fread ; + c-reader-handle fread ; M: c-reader stream-read-partial stream-read ; @@ -43,41 +42,39 @@ M: c-reader stream-read1 ] if ; M: c-reader stream-read-until - [ swap read-until-loop ] "" make swap + [ swap read-until-loop ] B{ } make swap over empty? over not and [ 2drop f f ] when ; M: c-reader dispose c-reader-handle fclose ; -: ( in out -- stream ) - >r r> - - ; - M: object init-io ; : stdin-handle 11 getenv ; : stdout-handle 12 getenv ; : stderr-handle 38 getenv ; -M: object init-stdio - stdin-handle stdout-handle stdio set-global - stderr-handle stderr set-global ; +M: object (init-stdio) + stdin-handle + stdout-handle + stderr-handle ; M: object io-multiplex 60 60 * 1000 * or (sleep) ; -M: object - "rb" fopen ; +M: object (file-reader) + "rb" fopen ; -M: object - "wb" fopen ; +M: object (file-writer) + "wb" fopen ; -M: object - "ab" fopen ; +M: object (file-appender) + "ab" fopen ; : show ( msg -- ) #! A word which directly calls primitives. It is used to #! print stuff from contexts where the I/O system would #! otherwise not work (tools.deploy.shaker, the I/O #! multiplexer thread). - "\r\n" append stdout-handle fwrite stdout-handle fflush ; + "\r\n" append >byte-array + stdout-handle fwrite + stdout-handle fflush ; diff --git a/core/io/streams/lines/authors.txt b/core/io/streams/lines/authors.txt deleted file mode 100644 index 1901f27a24..0000000000 --- a/core/io/streams/lines/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Slava Pestov diff --git a/core/io/streams/lines/lines-docs.factor b/core/io/streams/lines/lines-docs.factor deleted file mode 100644 index 789a060ed5..0000000000 --- a/core/io/streams/lines/lines-docs.factor +++ /dev/null @@ -1,17 +0,0 @@ -USING: help.markup help.syntax io strings ; -IN: io.streams.lines - -ARTICLE: "io.streams.lines" "Line reader streams" -"Line reader streams wrap an underlying stream and provide a default implementation of " { $link stream-readln } "." -{ $subsection line-reader } -{ $subsection } ; - -ABOUT: "io.streams.lines" - -HELP: line-reader -{ $class-description "An input stream which delegates to an underlying stream while providing an implementation of the " { $link stream-readln } " word in terms of the underlying stream's " { $link stream-read-until } ". Line readers are created by calling " { $link } "." } ; - -HELP: -{ $values { "stream" "an input stream" } { "new-stream" "an input stream" } } -{ $description "Creates a new " { $link line-reader } "." } -{ $notes "Stream constructors should call this word to wrap streams that do not natively support reading lines. Unix (" { $snippet "\\n" } "), Windows (" { $snippet "\\r\\n" } ") and MacOS (" { $snippet "\\r" } ") line endings are supported." } ; diff --git a/core/io/streams/lines/lines.factor b/core/io/streams/lines/lines.factor deleted file mode 100755 index 391c602cc3..0000000000 --- a/core/io/streams/lines/lines.factor +++ /dev/null @@ -1,57 +0,0 @@ -! Copyright (C) 2004, 2007 Slava Pestov. -! See http://factorcode.org/license.txt for BSD license. -IN: io.streams.lines -USING: arrays generic io kernel math namespaces sequences -vectors combinators splitting ; - -TUPLE: line-reader cr ; - -: ( stream -- new-stream ) - line-reader construct-delegate ; - -: cr+ t swap set-line-reader-cr ; inline - -: cr- f swap set-line-reader-cr ; inline - -: line-ends/eof ( stream str -- str ) f like swap cr- ; inline - -: line-ends\r ( stream str -- str ) swap cr+ ; inline - -: line-ends\n ( stream str -- str ) - over line-reader-cr over empty? and - [ drop dup cr- stream-readln ] [ swap cr- ] if ; inline - -: handle-readln ( stream str ch -- str ) - { - { f [ line-ends/eof ] } - { CHAR: \r [ line-ends\r ] } - { CHAR: \n [ line-ends\n ] } - } case ; - -M: line-reader stream-readln ( stream -- str ) - "\r\n" over delegate stream-read-until handle-readln ; - -: fix-read ( stream string -- string ) - over line-reader-cr [ - over cr- - "\n" ?head [ - swap stream-read1 [ add ] when* - ] [ nip ] if - ] [ nip ] if ; - -M: line-reader stream-read - tuck delegate stream-read fix-read ; - -M: line-reader stream-read-partial - tuck delegate stream-read-partial fix-read ; - -: fix-read1 ( stream char -- char ) - over line-reader-cr [ - over cr- - dup CHAR: \n = [ - drop stream-read1 - ] [ nip ] if - ] [ nip ] if ; - -M: line-reader stream-read1 ( stream -- char ) - dup delegate stream-read1 fix-read1 ; diff --git a/core/io/streams/lines/summary.txt b/core/io/streams/lines/summary.txt deleted file mode 100644 index 8c0c096f0b..0000000000 --- a/core/io/streams/lines/summary.txt +++ /dev/null @@ -1 +0,0 @@ -Read lines of text from a character-oriented stream diff --git a/core/io/streams/plain/plain-docs.factor b/core/io/streams/plain/plain-docs.factor index 4d7c5cc25e..a84e5be4f7 100644 --- a/core/io/streams/plain/plain-docs.factor +++ b/core/io/streams/plain/plain-docs.factor @@ -8,17 +8,10 @@ ARTICLE: "io.streams.plain" "Plain writer streams" { $link make-span-stream } ", " { $link make-block-stream } " and " { $link make-cell-stream } "." -{ $subsection plain-writer } -{ $subsection } ; +{ $subsection plain-writer } ; ABOUT: "io.streams.plain" HELP: plain-writer -{ $class-description "An output stream which delegates to an underlying stream while providing an implementation of the extended stream output protocol in a trivial way. Plain writers are created by calling " { $link } "." } -{ $see-also "stream-protocol" } ; - -HELP: -{ $values { "stream" "an input stream" } { "new-stream" "an input stream" } } -{ $description "Creates a new " { $link plain-writer } "." } -{ $notes "Stream constructors should call this word to wrap streams that do not natively support the extended stream output protocol." } +{ $class-description "An output stream mixin providing an implementation of the extended stream output protocol in a trivial way." } { $see-also "stream-protocol" } ; diff --git a/core/io/streams/plain/plain.factor b/core/io/streams/plain/plain.factor index 70421eb1c2..4898a58fb1 100644 --- a/core/io/streams/plain/plain.factor +++ b/core/io/streams/plain/plain.factor @@ -1,13 +1,9 @@ ! Copyright (C) 2005, 2007 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. +USING: kernel io io.streams.nested ; IN: io.streams.plain -USING: generic assocs kernel math namespaces sequences -io.styles io io.streams.nested ; -TUPLE: plain-writer ; - -: ( stream -- new-stream ) - plain-writer construct-delegate ; +MIXIN: plain-writer M: plain-writer stream-nl CHAR: \n swap stream-write1 ; diff --git a/core/io/streams/string/string-docs.factor b/core/io/streams/string/string-docs.factor index e948d2162a..91ac244608 100644 --- a/core/io/streams/string/string-docs.factor +++ b/core/io/streams/string/string-docs.factor @@ -26,4 +26,4 @@ HELP: HELP: with-string-reader { $values { "str" string } { "quot" quotation } } -{ $description "Calls the quotation in a new dynamic scope with " { $link stdio } " rebound to an input stream reading " { $snippet "str" } " from beginning to end. The accumulated string is output when the quotation returns." } ; +{ $description "Calls the quotation in a new dynamic scope with " { $link stdio } " rebound to an input stream reading " { $snippet "str" } " from beginning to end." } ; diff --git a/core/io/streams/string/string.factor b/core/io/streams/string/string.factor index a45c616b9a..7833e0aa47 100755 --- a/core/io/streams/string/string.factor +++ b/core/io/streams/string/string.factor @@ -2,8 +2,8 @@ ! See http://factorcode.org/license.txt for BSD license. IN: io.streams.string USING: io kernel math namespaces sequences sbufs strings -generic splitting io.streams.plain io.streams.lines growable -continuations ; +generic splitting growable continuations io.streams.plain +io.encodings ; M: growable dispose drop ; @@ -12,38 +12,19 @@ M: growable stream-write push-all ; M: growable stream-flush drop ; : ( -- stream ) - 512 ; + 512 ; : with-string-writer ( quot -- str ) swap [ stdio get ] compose with-stream* >string ; inline -: format-column ( seq ? -- seq ) - [ - [ 0 [ length max ] reduce ] keep - swap [ CHAR: \s pad-right ] curry map - ] unless ; - -: map-last ( seq quot -- seq ) - swap dup length - [ zero? rot [ call ] keep swap ] 2map nip ; inline - -: format-table ( table -- seq ) - flip [ format-column ] map-last - flip [ " " join ] map ; - -M: plain-writer stream-write-table - [ drop format-table [ print ] each ] with-stream* ; - -M: plain-writer make-cell-stream 2drop ; - M: growable stream-read1 dup empty? [ drop f ] [ pop ] if ; : harden-as ( seq growble-exemplar -- newseq ) underlying like ; : growable-read-until ( growable n -- str ) - dupd tail-slice swap harden-as dup reverse-here ; + >fixnum dupd tail-slice swap harden-as dup reverse-here ; : find-last-sep swap [ memq? ] curry find-last drop ; @@ -69,7 +50,31 @@ M: growable stream-read-partial stream-read ; : ( str -- stream ) - >sbuf dup reverse-here ; + >sbuf dup reverse-here f ; : with-string-reader ( str quot -- ) >r r> with-stream ; inline + +INSTANCE: growable plain-writer + +: format-column ( seq ? -- seq ) + [ + [ 0 [ length max ] reduce ] keep + swap [ CHAR: \s pad-right ] curry map + ] unless ; + +: map-last ( seq quot -- seq ) + swap dup length + [ zero? rot [ call ] keep swap ] 2map nip ; inline + +: format-table ( table -- seq ) + flip [ format-column ] map-last + flip [ " " join ] map ; + +M: plain-writer stream-write-table + [ drop format-table [ print ] each ] with-stream* ; + +M: plain-writer make-cell-stream 2drop ; + +M: growable stream-readln ( stream -- str ) + "\r\n" over stream-read-until handle-readln ; diff --git a/core/listener/listener.factor b/core/listener/listener.factor index fe1471716d..61d3f9836d 100755 --- a/core/listener/listener.factor +++ b/core/listener/listener.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2003, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: arrays hashtables io kernel math math.parser memory -namespaces parser sequences strings io.styles io.streams.lines +namespaces parser sequences strings io.styles io.streams.duplex vectors words generic system combinators tuples continuations debugger definitions compiler.units ; IN: listener @@ -32,7 +32,7 @@ GENERIC: stream-read-quot ( stream -- quot/f ) 3drop f ] if ; -M: line-reader stream-read-quot +M: object stream-read-quot V{ } clone read-quot-loop ; M: duplex-stream stream-read-quot diff --git a/core/parser/parser.factor b/core/parser/parser.factor index 2f2d4a8c18..8e1927c043 100755 --- a/core/parser/parser.factor +++ b/core/parser/parser.factor @@ -4,7 +4,7 @@ USING: arrays definitions generic assocs kernel math namespaces prettyprint sequences strings vectors words quotations inspector io.styles io combinators sorting splitting math.parser effects continuations debugger -io.files io.streams.string io.streams.lines vocabs +io.files io.streams.string vocabs io.encodings.utf8 source-files classes hashtables compiler.errors compiler.units ; IN: parser @@ -500,7 +500,7 @@ SYMBOL: interactive-vocabs [ [ [ parsing-file ] keep - [ ?resource-path ] keep + [ ?resource-path utf8 ] keep parse-stream ] with-compiler-errors ] [ diff --git a/core/source-files/source-files.factor b/core/source-files/source-files.factor index 98c39ae390..55300a3c29 100755 --- a/core/source-files/source-files.factor +++ b/core/source-files/source-files.factor @@ -4,8 +4,8 @@ USING: arrays definitions generic assocs kernel math namespaces prettyprint sequences strings vectors words quotations inspector io.styles io combinators sorting splitting math.parser effects continuations debugger -io.files io.crc32 io.streams.string io.streams.lines vocabs -hashtables graphs compiler.units ; +io.files io.crc32 io.streams.string vocabs +hashtables graphs compiler.units io.encodings.utf8 ; IN: source-files SYMBOL: source-files @@ -17,7 +17,7 @@ uses definitions ; : (source-modified?) ( path modified checksum -- ? ) pick file-modified rot [ 0 or ] 2apply > - [ swap file-lines lines-crc32 = not ] [ 2drop f ] if ; + [ swap utf8 file-lines lines-crc32 = not ] [ 2drop f ] if ; : source-modified? ( path -- ? ) dup source-files get at [ @@ -70,7 +70,7 @@ uses definitions ; swap ?resource-path dup exists? [ over record-modified - file-lines swap record-checksum + utf8 file-lines swap record-checksum ] [ 2drop ] if ] assoc-each ; diff --git a/core/vocabs/loader/loader.factor b/core/vocabs/loader/loader.factor index acc6c783a5..b21329de9c 100755 --- a/core/vocabs/loader/loader.factor +++ b/core/vocabs/loader/loader.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: namespaces sequences io.files kernel assocs words vocabs definitions parser continuations inspector debugger io io.styles -io.streams.lines hashtables sorting prettyprint source-files +hashtables sorting prettyprint source-files arrays combinators strings system math.parser compiler.errors splitting init ; IN: vocabs.loader diff --git a/core/words/words-docs.factor b/core/words/words-docs.factor index f1cc678d17..4903f8933b 100755 --- a/core/words/words-docs.factor +++ b/core/words/words-docs.factor @@ -1,5 +1,5 @@ -USING: definitions help.markup help.syntax kernel -kernel.private parser words.private vocabs classes quotations +USING: definitions help.markup help.syntax kernel parser +kernel.private words.private vocabs classes quotations strings effects compiler.units ; IN: words diff --git a/core/words/words-tests.factor b/core/words/words-tests.factor index 06f3c7a782..4d9933147b 100755 --- a/core/words/words-tests.factor +++ b/core/words/words-tests.factor @@ -141,7 +141,11 @@ SYMBOL: quot-uses-b [ { + } ] [ \ quot-uses-b uses ] unit-test -[ "IN: words.tests FORGET: undef-test : undef-test ; << undef-test >>" eval ] +"undef-test" "words.tests" lookup [ + [ forget ] with-compilation-unit +] when* + +[ "IN: words.tests : undef-test ; << undef-test >>" eval ] [ [ undefined? ] is? ] must-fail-with [ ] [ diff --git a/extra/benchmark/fasta/fasta.factor b/extra/benchmark/fasta/fasta.factor index 1740bcb28e..3c9c78d358 100644 --- a/extra/benchmark/fasta/fasta.factor +++ b/extra/benchmark/fasta/fasta.factor @@ -1,6 +1,6 @@ ! Based on http://shootout.alioth.debian.org/gp4/benchmark.php?test=fasta&lang=java&id=2 USING: math kernel io io.files locals multiline assocs sequences -sequences.private benchmark.reverse-complement hints +sequences.private benchmark.reverse-complement hints io.encodings.ascii byte-arrays float-arrays ; IN: benchmark.fasta @@ -94,7 +94,7 @@ HINTS: random fixnum ; n [ ] seed [ initial-seed ] | - out [ + out ascii [ n 2 * ALU "Homo sapiens alu" "ONE" write-repeat-fasta initial-seed diff --git a/extra/benchmark/knucleotide/knucleotide.factor b/extra/benchmark/knucleotide/knucleotide.factor index b95e182bd1..e06b81f6de 100644 --- a/extra/benchmark/knucleotide/knucleotide.factor +++ b/extra/benchmark/knucleotide/knucleotide.factor @@ -1,4 +1,4 @@ -USING: kernel io io.files splitting strings +USING: kernel io io.files splitting strings io.encodings.ascii hashtables sequences assocs math namespaces prettyprint math.parser combinators arrays sorting unicode.case ; @@ -57,7 +57,7 @@ IN: benchmark.knucleotide : knucleotide ( -- ) "extra/benchmark/knucleotide/knucleotide-input.txt" resource-path - [ read-input ] with-file-reader + ascii [ read-input ] with-file-reader process-input ; MAIN: knucleotide diff --git a/extra/benchmark/mandel/mandel.factor b/extra/benchmark/mandel/mandel.factor index 0da4785785..05eda2ad81 100755 --- a/extra/benchmark/mandel/mandel.factor +++ b/extra/benchmark/mandel/mandel.factor @@ -1,6 +1,6 @@ IN: benchmark.mandel USING: arrays io kernel math namespaces sequences strings sbufs -math.functions math.parser io.files colors.hsv ; +math.functions math.parser io.files colors.hsv io.encodings.binary ; : max-color 360 ; inline : zoom-fact 0.8 ; inline @@ -66,6 +66,6 @@ SYMBOL: cols : mandel-main ( -- ) "mandel.ppm" temp-file - [ mandel write ] with-file-writer ; + binary [ mandel write ] with-file-writer ; MAIN: mandel-main diff --git a/extra/benchmark/raytracer/raytracer.factor b/extra/benchmark/raytracer/raytracer.factor index ddfd0ed6dd..232842a51e 100644 --- a/extra/benchmark/raytracer/raytracer.factor +++ b/extra/benchmark/raytracer/raytracer.factor @@ -3,7 +3,7 @@ USING: float-arrays compiler generic io io.files kernel math math.functions math.vectors math.parser namespaces sequences -sequences.private words ; +sequences.private words io.encodings.binary ; IN: benchmark.raytracer ! parameters @@ -171,6 +171,6 @@ DEFER: create ( level c r -- scene ) : raytracer-main "raytracer.pnm" temp-file - [ run write ] with-file-writer ; + binary [ run write ] with-file-writer ; MAIN: raytracer-main diff --git a/extra/benchmark/reverse-complement/reverse-complement.factor b/extra/benchmark/reverse-complement/reverse-complement.factor index cf4143d533..9c782e65e6 100755 --- a/extra/benchmark/reverse-complement/reverse-complement.factor +++ b/extra/benchmark/reverse-complement/reverse-complement.factor @@ -1,6 +1,6 @@ USING: io io.files io.streams.duplex kernel sequences sequences.private strings vectors words memoize splitting -hints unicode.case continuations ; +hints unicode.case continuations io.encodings.latin1 ; IN: benchmark.reverse-complement MEMO: trans-map ( -- str ) @@ -32,8 +32,8 @@ HINTS: do-line vector string ; readln [ do-line (reverse-complement) ] [ show-seq ] if* ; : reverse-complement ( infile outfile -- ) - [ - swap [ + latin1 [ + swap latin1 [ swap [ 500000 (reverse-complement) ] with-stream diff --git a/extra/benchmark/sockets/sockets.factor b/extra/benchmark/sockets/sockets.factor index 4927776575..25212c7264 100755 --- a/extra/benchmark/sockets/sockets.factor +++ b/extra/benchmark/sockets/sockets.factor @@ -1,4 +1,4 @@ -USING: io.sockets io kernel math threads +USING: io.sockets io kernel math threads io.encodings.ascii debugger tools.time prettyprint concurrency.count-downs namespaces arrays continuations ; IN: benchmark.sockets @@ -24,13 +24,13 @@ SYMBOL: counter : simple-server ( -- ) [ - server-addr dup "server" set [ + server-addr ascii dup "server" set [ server-loop ] with-disposal ] ignore-errors ; : simple-client ( -- ) - server-addr [ + server-addr ascii [ CHAR: b write1 flush number-of-requests [ CHAR: a dup write1 flush read1 assert= ] times @@ -38,7 +38,7 @@ SYMBOL: counter ] with-stream ; : stop-server ( -- ) - server-addr [ + server-addr ascii [ CHAR: x write1 ] with-stream ; diff --git a/extra/benchmark/sum-file/sum-file.factor b/extra/benchmark/sum-file/sum-file.factor index 1d52beebfc..bb7aebba62 100644 --- a/extra/benchmark/sum-file/sum-file.factor +++ b/extra/benchmark/sum-file/sum-file.factor @@ -1,12 +1,12 @@ USING: io io.files math math.parser kernel prettyprint -benchmark.random ; +benchmark.random io.encodings.ascii ; IN: benchmark.sum-file : sum-file-loop ( n -- n' ) readln [ string>number + sum-file-loop ] when* ; : sum-file ( file -- ) - [ 0 sum-file-loop ] with-file-reader . ; + ascii [ 0 sum-file-loop ] with-file-reader . ; : sum-file-main ( -- ) random-numbers-path sum-file ; diff --git a/extra/bootstrap/image/upload/upload.factor b/extra/bootstrap/image/upload/upload.factor index 3c0b464dbf..ab26a4ff13 100755 --- a/extra/bootstrap/image/upload/upload.factor +++ b/extra/bootstrap/image/upload/upload.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. IN: bootstrap.image.upload USING: http.client crypto.md5 splitting assocs kernel io.files -bootstrap.image sequences io namespaces io.launcher math ; +bootstrap.image sequences io namespaces io.launcher math io.encodings.ascii ; SYMBOL: upload-images-destination @@ -16,7 +16,7 @@ SYMBOL: upload-images-destination : boot-image-names images [ boot-image-name ] map ; : compute-checksums ( -- ) - checksums [ + checksums ascii [ boot-image-names [ dup write bl file>md5str print ] each ] with-file-writer ; diff --git a/extra/bunny/model/model.factor b/extra/bunny/model/model.factor index 49a0f9254a..1d90209ed4 100755 --- a/extra/bunny/model/model.factor +++ b/extra/bunny/model/model.factor @@ -1,5 +1,5 @@ USING: alien alien.c-types arrays sequences math math.vectors math.matrices - math.parser io io.files kernel opengl opengl.gl opengl.glu + math.parser io io.files kernel opengl opengl.gl opengl.glu io.encodings.ascii opengl.capabilities shuffle http.client vectors splitting tools.time system combinators combinators.cleave float-arrays continuations namespaces sequences.lib ; @@ -35,7 +35,7 @@ IN: bunny.model : read-model ( stream -- model ) "Reading model" print flush [ - [ parse-model ] with-file-reader + ascii [ parse-model ] with-file-reader [ normals ] 2keep 3array ] time ; diff --git a/extra/concurrency/distributed/distributed.factor b/extra/concurrency/distributed/distributed.factor index 2c54a872f7..f09c441d26 100755 --- a/extra/concurrency/distributed/distributed.factor +++ b/extra/concurrency/distributed/distributed.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: serialize sequences concurrency.messaging threads io io.server qualified arrays -namespaces kernel ; +namespaces kernel io.encodings.binary ; QUALIFIED: io.sockets IN: concurrency.distributed @@ -15,7 +15,7 @@ SYMBOL: local-node ( -- addrspec ) [ local-node set-global "concurrency.distributed" - [ handle-node-client ] with-server + binary [ handle-node-client ] with-server ] 2curry f spawn drop ; : start-node ( port -- ) @@ -28,7 +28,7 @@ C: remote-process M: remote-process send ( message thread -- ) { remote-process-id remote-process-node } get-slots - io.sockets: [ 2array serialize ] with-stream ; + binary io.sockets: [ 2array serialize ] with-stream ; M: thread (serialize) ( obj -- ) thread-id local-node get-global diff --git a/extra/cpu/8080/emulator/emulator.factor b/extra/cpu/8080/emulator/emulator.factor index 187297d0a0..24eceee744 100755 --- a/extra/cpu/8080/emulator/emulator.factor +++ b/extra/cpu/8080/emulator/emulator.factor @@ -3,7 +3,7 @@ ! USING: kernel math sequences words arrays io io.files namespaces math.parser assocs quotations parser parser-combinators -tools.time ; +tools.time io.encodings.binary ; IN: cpu.8080.emulator TUPLE: cpu b c d e f h l a pc sp halted? last-interrupt cycles ram ; @@ -439,7 +439,7 @@ M: cpu reset ( cpu -- ) : load-rom ( filename cpu -- ) #! Load the contents of the file into ROM. #! (address 0x0000-0x1FFF). - cpu-ram swap [ + cpu-ram swap binary [ 0 swap (load-rom) ] with-file-reader ; @@ -455,7 +455,7 @@ SYMBOL: rom-root #! file path shoul dbe relative to the '/roms' resource path. rom-dir [ cpu-ram [ - swap first2 rom-dir swap path+ [ + swap first2 rom-dir swap path+ binary [ swap (load-rom) ] with-file-reader ] curry each diff --git a/extra/crypto/hmac/hmac.factor b/extra/crypto/hmac/hmac.factor index 7c358a8c09..56d39e71dc 100644 --- a/extra/crypto/hmac/hmac.factor +++ b/extra/crypto/hmac/hmac.factor @@ -1,6 +1,6 @@ USING: arrays combinators crypto.common crypto.md5 crypto.sha1 crypto.md5.private io io.binary io.files io.streams.string -kernel math math.vectors memoize sequences ; +kernel math math.vectors memoize sequences io.encodings.binary ; IN: crypto.hmac : sha1-hmac ( Ko Ki -- hmac ) @@ -32,7 +32,7 @@ MEMO: opad ( -- seq ) 64 HEX: 5c ; [ init-hmac sha1-hmac ] with-stream ; : file>sha1-hmac ( K path -- hmac ) - stream>sha1-hmac ; + binary stream>sha1-hmac ; : string>sha1-hmac ( K string -- hmac ) stream>sha1-hmac ; @@ -42,7 +42,7 @@ MEMO: opad ( -- seq ) 64 HEX: 5c ; [ init-hmac md5-hmac ] with-stream ; : file>md5-hmac ( K path -- hmac ) - stream>md5-hmac ; + binary stream>md5-hmac ; : string>md5-hmac ( K string -- hmac ) stream>md5-hmac ; diff --git a/extra/crypto/md5/md5.factor b/extra/crypto/md5/md5.factor index 631a7a1020..debef26de4 100644 --- a/extra/crypto/md5/md5.factor +++ b/extra/crypto/md5/md5.factor @@ -2,7 +2,8 @@ USING: kernel io io.binary io.files io.streams.string math math.functions math.parser namespaces splitting strings -sequences crypto.common byte-arrays locals sequences.private ; +sequences crypto.common byte-arrays locals sequences.private +io.encodings.binary ; IN: crypto.md5 : string>md5 ( string -- byte-array ) stream>md5 ; : string>md5str ( string -- md5-string ) string>md5 hex-string ; -: file>md5 ( path -- byte-array ) stream>md5 ; +: file>md5 ( path -- byte-array ) binary stream>md5 ; : file>md5str ( path -- md5-string ) file>md5 hex-string ; diff --git a/extra/crypto/sha1/sha1.factor b/extra/crypto/sha1/sha1.factor index f6dfbcd031..eaad6df622 100644 --- a/extra/crypto/sha1/sha1.factor +++ b/extra/crypto/sha1/sha1.factor @@ -1,6 +1,6 @@ -USING: arrays combinators crypto.common kernel io io.binary +USING: arrays combinators crypto.common kernel io io.encodings.binary io.files io.streams.string math.vectors strings sequences -namespaces math parser sequences vectors +namespaces math parser sequences vectors io.binary hashtables ; IN: crypto.sha1 @@ -123,7 +123,7 @@ SYMBOL: K : string>sha1 ( string -- sha1 ) stream>sha1 ; : string>sha1str ( string -- str ) string>sha1 hex-string ; : string>sha1-bignum ( string -- n ) string>sha1 be> ; -: file>sha1 ( file -- sha1 ) stream>sha1 ; +: file>sha1 ( file -- sha1 ) binary stream>sha1 ; : string>sha1-interleave ( string -- seq ) [ zero? ] left-trim diff --git a/extra/db/tuples/tuples-tests.factor b/extra/db/tuples/tuples-tests.factor index 7d72a644bf..5913f053da 100755 --- a/extra/db/tuples/tuples-tests.factor +++ b/extra/db/tuples/tuples-tests.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: io.files kernel tools.test db db.tuples -db.types continuations namespaces db.postgresql math +db.types continuations namespaces math prettyprint tools.walker db.sqlite calendar math.intervals ; IN: db.tuples.tests @@ -161,8 +161,8 @@ TUPLE: annotation n paste-id summary author mode contents ; : test-sqlite ( quot -- ) >r "tuples-test.db" temp-file sqlite-db r> with-db ; -: test-postgresql ( -- ) - >r { "localhost" "postgres" "" "factor-test" } postgresql-db r> with-db ; +! : test-postgresql ( -- ) +! >r { "localhost" "postgres" "" "factor-test" } postgresql-db r> with-db ; [ native-person-schema test-tuples ] test-sqlite [ assigned-person-schema test-tuples ] test-sqlite diff --git a/extra/documents/documents.factor b/extra/documents/documents.factor index 34ecce5f8e..993e69ec14 100755 --- a/extra/documents/documents.factor +++ b/extra/documents/documents.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2006, 2007 Slava Pestov ! See http://factorcode.org/license.txt for BSD license. USING: arrays io kernel math models namespaces sequences strings -splitting io.streams.lines combinators unicode.categories ; +splitting combinators unicode.categories ; IN: documents : +col ( loc n -- newloc ) >r first2 r> + 2array ; diff --git a/extra/editors/jedit/jedit.factor b/extra/editors/jedit/jedit.factor index fd5b6c1b06..ed579dde42 100644 --- a/extra/editors/jedit/jedit.factor +++ b/extra/editors/jedit/jedit.factor @@ -3,11 +3,11 @@ USING: arrays definitions io kernel math namespaces parser prettyprint sequences strings words editors io.files io.sockets io.streams.string io.binary -math.parser ; +math.parser io.encodings.ascii ; IN: editors.jedit : jedit-server-info ( -- port auth ) - home "/.jedit/server" path+ [ + home "/.jedit/server" path+ ascii [ readln drop readln string>number readln string>number diff --git a/extra/graphics/bitmap/bitmap.factor b/extra/graphics/bitmap/bitmap.factor index 8e61766de1..ec4d6b79e1 100644 --- a/extra/graphics/bitmap/bitmap.factor +++ b/extra/graphics/bitmap/bitmap.factor @@ -4,7 +4,7 @@ USING: alien arrays byte-arrays combinators graphics.viewer io io.binary io.files kernel libc math math.functions namespaces opengl opengl.gl prettyprint -sequences strings ui ui.gadgets.panes ; +sequences strings ui ui.gadgets.panes io.encodings.binary ; IN: graphics.bitmap ! Currently can only handle 24bit bitmaps. @@ -59,7 +59,7 @@ TUPLE: bitmap magic size reserved offset header-length width dup color-index-length read swap set-bitmap-color-index ; : load-bitmap ( path -- bitmap ) - [ + binary [ T{ bitmap } clone dup parse-file-header dup parse-bitmap-header @@ -69,7 +69,7 @@ TUPLE: bitmap magic size reserved offset header-length width raw-bitmap>string >byte-array over set-bitmap-array ; : save-bitmap ( bitmap path -- ) - [ + binary [ "BM" write dup bitmap-array length 14 + 40 + 4 >le write 0 4 >le write diff --git a/extra/help/cookbook/cookbook.factor b/extra/help/cookbook/cookbook.factor index ebdbdeb37e..72b300b585 100755 --- a/extra/help/cookbook/cookbook.factor +++ b/extra/help/cookbook/cookbook.factor @@ -191,11 +191,11 @@ ARTICLE: "cookbook-io" "Input and output cookbook" } "Print the lines of a file in sorted order:" { $code - "\"lines.txt\" file-lines natural-sort [ print ] each" + "utf8 \"lines.txt\" file-lines natural-sort [ print ] each" } "Read 1024 bytes from a file:" { $code - "\"data.bin\" [ 1024 read ] with-file-reader" + "\"data.bin\" binary [ 1024 read ] with-file-reader" } "Convert a file of 4-byte cells from little to big endian or vice versa, by directly mapping it into memory and operating on it with sequence words:" { $code diff --git a/extra/help/handbook/handbook.factor b/extra/help/handbook/handbook.factor index 178b7a5d35..84108a1db6 100755 --- a/extra/help/handbook/handbook.factor +++ b/extra/help/handbook/handbook.factor @@ -2,7 +2,7 @@ USING: help help.markup help.syntax help.definitions help.topics namespaces words sequences classes assocs vocabs kernel arrays prettyprint.backend kernel.private io generic math system strings sbufs vectors byte-arrays bit-arrays float-arrays -quotations ; +quotations io.streams.byte-array io.encodings.string ; IN: help.handbook ARTICLE: "conventions" "Conventions" @@ -176,9 +176,9 @@ ARTICLE: "io" "Input and output" { $subsection "streams" } "Wrapper streams:" { $subsection "io.streams.duplex" } -{ $subsection "io.streams.lines" } { $subsection "io.streams.plain" } { $subsection "io.streams.string" } +{ $subsection "io.streams.byte-array" } "Utilities:" { $subsection "stream-binary" } { $subsection "styles" } @@ -186,6 +186,9 @@ ARTICLE: "io" "Input and output" { $subsection "io.files" } { $subsection "io.mmap" } { $subsection "io.monitors" } +{ $heading "Encodings" } +{ $subsection "io.encodings" } +{ $subsection "io.encodings.string" } { $heading "Other features" } { $subsection "network-streams" } { $subsection "io.launcher" } diff --git a/extra/html/parser/analyzer/analyzer.factor b/extra/html/parser/analyzer/analyzer.factor index 511730efb4..45197b1a90 100755 --- a/extra/html/parser/analyzer/analyzer.factor +++ b/extra/html/parser/analyzer/analyzer.factor @@ -1,14 +1,7 @@ USING: assocs html.parser kernel math sequences strings ascii -arrays shuffle unicode.case namespaces splitting -http.server.responders sequences.lib ; +arrays shuffle unicode.case namespaces splitting http ; IN: html.parser.analyzer -: multi-find* ( n seq quots -- i elt ) - ; - -: multi-find ( seq quots -- i elt ) - 0 -rot ; - : (find-relative) [ >r + dup r> ?nth* [ 2drop f f ] unless ] [ 2drop f ] if ; @@ -128,8 +121,8 @@ IN: html.parser.analyzer : href-contains? ( str tag -- ? ) tag-attributes "href" swap at* [ subseq? ] [ 2drop f ] if ; -: query>hash* ( str -- hash ) - "?" split1 nip query>hash ; +: query>assoc* ( str -- hash ) + "?" split1 nip query>assoc ; ! clear "http://fark.com" http-get parse-html find-links [ "go.pl" swap start ] subset [ "=" split peek ] map @@ -137,5 +130,5 @@ IN: html.parser.analyzer ! "a" over find-opening-tags-by-name ! [ nip "shipposition.phtml?call=GBTT" swap href-contains? ] assoc-subset ! first first 8 + over nth -! tag-attributes "href" swap at query>hash* +! tag-attributes "href" swap at query>assoc* ! "lat" over at "lon" rot at diff --git a/extra/http/client/client.factor b/extra/http/client/client.factor index 1c408e44e3..f7a160017a 100755 --- a/extra/http/client/client.factor +++ b/extra/http/client/client.factor @@ -2,8 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: assocs http kernel math math.parser namespaces sequences io io.sockets io.streams.string io.files io.timeouts strings -splitting continuations calendar vectors hashtables -accessors ; +splitting calendar continuations accessors vectors io.encodings.binary ; IN: http.client : parse-url ( url -- resource host port ) @@ -79,7 +78,7 @@ PRIVATE> : download-to ( url file -- ) #! Downloads the contents of a URL to a file. swap http-get-stream check-response - [ swap stream-copy ] with-disposal ; + [ swap binary stream-copy ] with-disposal ; : download ( url -- ) dup download-name download-to ; diff --git a/extra/http/http.factor b/extra/http/http.factor index 35fe3ce544..849b9e2fc9 100755 --- a/extra/http/http.factor +++ b/extra/http/http.factor @@ -2,9 +2,9 @@ ! See http://factorcode.org/license.txt for BSD license. USING: hashtables io io.streams.string kernel math namespaces math.parser assocs sequences strings splitting ascii -io.encodings.utf8 namespaces unicode.case combinators -vectors sorting new-slots accessors calendar calendar.format -quotations arrays ; +io.encodings.utf8 io.encodings.string namespaces +unicode.case combinators vectors sorting new-slots accessors +calendar calendar.format quotations arrays ; IN: http : http-port 80 ; inline @@ -18,7 +18,7 @@ IN: http swap "/_-." member? or ; foldable : push-utf8 ( ch -- ) - 1string encode-utf8 [ CHAR: % , >hex 2 CHAR: 0 pad-left % ] each ; + 1string utf8 encode [ CHAR: % , >hex 2 CHAR: 0 pad-left % ] each ; : url-encode ( str -- str ) [ [ @@ -50,7 +50,7 @@ IN: http ] if ; : url-decode ( str -- str ) - [ 0 swap url-decode-iter ] "" make decode-utf8 ; + [ 0 swap url-decode-iter ] "" make utf8 decode ; : crlf "\r\n" write ; diff --git a/extra/http/server/server.factor b/extra/http/server/server.factor index 990c77f71e..133783114d 100755 --- a/extra/http/server/server.factor +++ b/extra/http/server/server.factor @@ -4,7 +4,7 @@ USING: assocs kernel namespaces io io.timeouts strings splitting threads http sequences prettyprint io.server logging calendar new-slots html.elements accessors math.parser combinators.lib vocabs.loader debugger html continuations random combinators -destructors ; +destructors io.encodings.latin1 ; IN: http.server GENERIC: call-responder ( request path responder -- response ) @@ -165,7 +165,7 @@ LOG: httpd-hit NOTICE : httpd ( port -- ) internet-server "http.server" - [ handle-client ] with-server ; + latin1 [ handle-client ] with-server ; : httpd-main ( -- ) 8888 httpd ; diff --git a/extra/http/server/templating/fhtml/fhtml-tests.factor b/extra/http/server/templating/fhtml/fhtml-tests.factor old mode 100644 new mode 100755 index 0ae3b41454..40654734fa --- a/extra/http/server/templating/fhtml/fhtml-tests.factor +++ b/extra/http/server/templating/fhtml/fhtml-tests.factor @@ -1,4 +1,4 @@ -USING: io io.files io.streams.string +USING: io io.files io.streams.string io.encodings.utf8 http.server.templating.fhtml kernel tools.test sequences ; IN: http.server.templating.fhtml.tests @@ -8,7 +8,7 @@ IN: http.server.templating.fhtml.tests ".fhtml" append resource-path [ run-template-file ] with-string-writer ] keep - ".html" append resource-path file-contents = ; + ".html" append resource-path utf8 file-contents = ; [ t ] [ "example" test-template ] unit-test [ t ] [ "bug" test-template ] unit-test diff --git a/extra/http/server/templating/fhtml/fhtml.factor b/extra/http/server/templating/fhtml/fhtml.factor index e5770affc5..3dcd23b99f 100755 --- a/extra/http/server/templating/fhtml/fhtml.factor +++ b/extra/http/server/templating/fhtml/fhtml.factor @@ -2,10 +2,10 @@ ! Copyright (C) 2006, 2007 Slava Pestov ! See http://factorcode.org/license.txt for BSD license. USING: continuations sequences kernel parser namespaces io -io.files io.streams.lines io.streams.string html html.elements +io.files io.streams.string html html.elements source-files debugger combinators math quotations generic strings splitting accessors http.server.static http.server -assocs ; +assocs io.encodings.utf8 ; IN: http.server.templating.fhtml @@ -83,7 +83,7 @@ DEFER: <% delimiter templating-vocab use+ ! so that reload works properly dup source-file file set - ?resource-path file-contents + ?resource-path utf8 file-contents [ eval-template ] [ html-error. drop ] recover ] with-file-vocabs ] curry assert-depth ; @@ -93,7 +93,7 @@ DEFER: <% delimiter swap path+ run-template-file ; : template-convert ( infile outfile -- ) - [ run-template-file ] with-file-writer ; + utf8 [ run-template-file ] with-file-writer ; ! file responder integration : serve-fhtml ( filename -- response ) diff --git a/extra/icfp/2006/2006.factor b/extra/icfp/2006/2006.factor index ae0e058490..1740e8a523 100755 --- a/extra/icfp/2006/2006.factor +++ b/extra/icfp/2006/2006.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: kernel math sequences kernel.private namespaces arrays io io.files splitting io.binary math.functions vectors quotations -combinators ; +combinators io.encodings.binary ; IN: icfp.2006 SYMBOL: regs @@ -134,7 +134,7 @@ SYMBOL: open-arrays [ run-op exec-loop ] unless ; : load-platters ( path -- ) - file-contents 4 group [ be> ] map + binary file-contents 4 group [ be> ] map 0 arrays get set-nth ; : init ( path -- ) diff --git a/extra/io/buffers/buffers-docs.factor b/extra/io/buffers/buffers-docs.factor index def3e475f7..cf069f17aa 100644 --- a/extra/io/buffers/buffers-docs.factor +++ b/extra/io/buffers/buffers-docs.factor @@ -30,7 +30,7 @@ $nl ABOUT: "buffers" HELP: buffer -{ $class-description "The class of I/O buffers, which resemble FIFO queues, but are optimize for holding bytes, are have underlying storage allocated at a fixed address. Buffers must be de-allocated manually." +{ $class-description "The class of I/O buffers, which resemble FIFO queues, but are optimized for holding bytes, are have underlying storage allocated at a fixed address. Buffers must be de-allocated manually." $nl "Buffers have two internal pointers:" { $list diff --git a/extra/io/encodings/ascii/ascii.factor b/extra/io/encodings/ascii/ascii.factor new file mode 100644 index 0000000000..fdefc35634 --- /dev/null +++ b/extra/io/encodings/ascii/ascii.factor @@ -0,0 +1,15 @@ +! Copyright (C) 2008 Daniel Ehrenberg. +! See http://factorcode.org/license.txt for BSD license. +USING: io io.encodings strings kernel math sequences byte-arrays io.encodings ; +IN: io.encodings.ascii + +: encode-check<= ( string stream max -- ) + [ pick <= [ encode-error ] [ stream-write1 ] if ] 2curry each ; + +TUPLE: ascii ; + +M: ascii stream-write-encoded ( string stream encoding -- ) + drop 127 encode-check<= ; + +M: ascii decode-step + drop dup 128 >= [ decode-error ] [ swap push ] if ; diff --git a/core/io/encodings/utf16/authors.txt b/extra/io/encodings/ascii/authors.txt similarity index 100% rename from core/io/encodings/utf16/authors.txt rename to extra/io/encodings/ascii/authors.txt diff --git a/extra/io/encodings/ascii/summary.txt b/extra/io/encodings/ascii/summary.txt new file mode 100644 index 0000000000..8c54de7680 --- /dev/null +++ b/extra/io/encodings/ascii/summary.txt @@ -0,0 +1 @@ +ASCII encoding for streams diff --git a/core/io/encodings/utf16/tags.txt b/extra/io/encodings/ascii/tags.txt similarity index 100% rename from core/io/encodings/utf16/tags.txt rename to extra/io/encodings/ascii/tags.txt diff --git a/extra/io/encodings/latin1/authors.txt b/extra/io/encodings/latin1/authors.txt new file mode 100644 index 0000000000..f990dd0ed2 --- /dev/null +++ b/extra/io/encodings/latin1/authors.txt @@ -0,0 +1 @@ +Daniel Ehrenberg diff --git a/core/io/encodings/latin1/latin1-docs.factor b/extra/io/encodings/latin1/latin1-docs.factor similarity index 100% rename from core/io/encodings/latin1/latin1-docs.factor rename to extra/io/encodings/latin1/latin1-docs.factor diff --git a/extra/io/encodings/latin1/latin1.factor b/extra/io/encodings/latin1/latin1.factor new file mode 100755 index 0000000000..989f45bc64 --- /dev/null +++ b/extra/io/encodings/latin1/latin1.factor @@ -0,0 +1,12 @@ +! Copyright (C) 2008 Daniel Ehrenberg. +! See http://factorcode.org/license.txt for BSD license. +USING: io io.encodings strings kernel io.encodings.ascii sequences math ; +IN: io.encodings.latin1 + +TUPLE: latin1 ; + +M: latin1 stream-write-encoded + drop 255 encode-check<= ; + +M: latin1 decode-step + drop dup 256 >= [ decode-error ] [ swap push ] if ; diff --git a/core/io/encodings/latin1/summary.txt b/extra/io/encodings/latin1/summary.txt similarity index 100% rename from core/io/encodings/latin1/summary.txt rename to extra/io/encodings/latin1/summary.txt diff --git a/extra/io/encodings/latin1/tags.txt b/extra/io/encodings/latin1/tags.txt new file mode 100644 index 0000000000..8e27be7d61 --- /dev/null +++ b/extra/io/encodings/latin1/tags.txt @@ -0,0 +1 @@ +text diff --git a/core/io/encodings/utf16/.utf16.factor.swo b/extra/io/encodings/utf16/.utf16.factor.swo similarity index 100% rename from core/io/encodings/utf16/.utf16.factor.swo rename to extra/io/encodings/utf16/.utf16.factor.swo diff --git a/extra/io/encodings/utf16/authors.txt b/extra/io/encodings/utf16/authors.txt new file mode 100644 index 0000000000..f990dd0ed2 --- /dev/null +++ b/extra/io/encodings/utf16/authors.txt @@ -0,0 +1 @@ +Daniel Ehrenberg diff --git a/core/io/encodings/utf16/summary.txt b/extra/io/encodings/utf16/summary.txt similarity index 100% rename from core/io/encodings/utf16/summary.txt rename to extra/io/encodings/utf16/summary.txt diff --git a/extra/io/encodings/utf16/tags.txt b/extra/io/encodings/utf16/tags.txt new file mode 100644 index 0000000000..8e27be7d61 --- /dev/null +++ b/extra/io/encodings/utf16/tags.txt @@ -0,0 +1 @@ +text diff --git a/extra/io/encodings/utf16/utf16-docs.factor b/extra/io/encodings/utf16/utf16-docs.factor new file mode 100644 index 0000000000..018a15a534 --- /dev/null +++ b/extra/io/encodings/utf16/utf16-docs.factor @@ -0,0 +1,22 @@ +USING: help.markup help.syntax io.encodings strings ; +IN: io.encodings.utf16 + +ARTICLE: "utf16" "Working with UTF-16-encoded data" +"The UTF-16 encoding is a variable-width encoding. Unicode code points are encoded as 2 or 4 byte sequences. There are three encoding descriptor classes for working with UTF-16, depending on endianness or the presence of a BOM:" +{ $subsection utf16le } +{ $subsection utf16be } +{ $subsection utf16 } +"All of these conform to the " { $link "encodings-protocol" } "." ; + +ABOUT: "utf16" + +HELP: utf16le +{ $class-description "The encoding protocol for UTF-16LE, that is, UTF-16 in little endian, without a byte order mark. Streams can be made which read or write wth this encoding." } ; + +HELP: utf16be +{ $class-description "The encoding protocol for UTF-16BE, that is, UTF-16 in big endian, without a byte order mark. Streams can be made which read or write wth this encoding." } ; + +HELP: utf16 +{ $class-description "The encoding protocol for UTF-16, that is, UTF-16 with a byte order mark. This is the most useful for general input and output in UTF-16. Streams can be made which read or write wth this encoding." } ; + +{ utf16 utf16le utf16be } related-words diff --git a/extra/io/encodings/utf16/utf16-tests.factor b/extra/io/encodings/utf16/utf16-tests.factor new file mode 100755 index 0000000000..89b61a3e37 --- /dev/null +++ b/extra/io/encodings/utf16/utf16-tests.factor @@ -0,0 +1,22 @@ +USING: kernel tools.test io.encodings.utf16 arrays sbufs +sequences io.encodings io unicode io.encodings.string ; + +[ { CHAR: x } ] [ { 0 CHAR: x } utf16be decode >array ] unit-test +[ { HEX: 1D11E } ] [ { HEX: D8 HEX: 34 HEX: DD HEX: 1E } utf16be decode >array ] unit-test +[ { CHAR: replacement-character } ] [ { BIN: 11011111 CHAR: q } utf16be decode >array ] unit-test +[ { CHAR: replacement-character } ] [ { BIN: 11011011 CHAR: x BIN: 11011011 CHAR: x } utf16be decode >array ] unit-test + +[ { 0 120 216 52 221 30 } ] [ { CHAR: x HEX: 1d11e } utf16be encode >array ] unit-test + +[ { CHAR: x } ] [ { CHAR: x 0 } utf16le decode >array ] unit-test +[ { 119070 } ] [ { HEX: 34 HEX: D8 HEX: 1E HEX: DD } utf16le decode >array ] unit-test +[ { CHAR: replacement-character } ] [ { 0 BIN: 11011111 } utf16le decode >array ] unit-test +[ { CHAR: replacement-character } ] [ { 0 BIN: 11011011 0 0 } utf16le decode >array ] unit-test +[ { 119070 } ] [ { HEX: 34 HEX: D8 HEX: 1E HEX: DD } utf16le decode >array ] unit-test + +[ { 120 0 52 216 30 221 } ] [ { CHAR: x HEX: 1d11e } utf16le encode >array ] unit-test + +[ { CHAR: x } ] [ { HEX: ff HEX: fe CHAR: x 0 } utf16 decode >array ] unit-test +[ { CHAR: x } ] [ { HEX: fe HEX: ff 0 CHAR: x } utf16 decode >array ] unit-test + +[ { HEX: ff HEX: fe 120 0 52 216 30 221 } ] [ { CHAR: x HEX: 1d11e } utf16 encode >array ] unit-test diff --git a/core/io/encodings/utf16/utf16.factor b/extra/io/encodings/utf16/utf16.factor similarity index 55% rename from core/io/encodings/utf16/utf16.factor rename to extra/io/encodings/utf16/utf16.factor index 35b6282e21..a501fad0bd 100755 --- a/core/io/encodings/utf16/utf16.factor +++ b/extra/io/encodings/utf16/utf16.factor @@ -1,9 +1,13 @@ -! Copyright (C) 2006, 2007 Daniel Ehrenberg. +! Copyright (C) 2006, 2008 Daniel Ehrenberg. ! See http://factorcode.org/license.txt for BSD license. USING: math kernel sequences sbufs vectors namespaces io.binary io.encodings combinators splitting io byte-arrays ; IN: io.encodings.utf16 +! UTF-16BE decoding + +TUPLE: utf16be ch state ; + SYMBOL: double SYMBOL: quad1 SYMBOL: quad2 @@ -16,7 +20,7 @@ SYMBOL: ignore 8 shift bitor ; : end-multibyte ( buf byte ch -- buf ch state ) - append-nums decoded ; + append-nums push-decoded ; : begin-utf16be ( buf byte -- buf ch state ) dup -3 shift BIN: 11011 number= [ @@ -36,12 +40,24 @@ SYMBOL: ignore { double [ end-multibyte ] } { quad1 [ append-nums quad2 ] } { quad2 [ handle-quad2be ] } - { quad3 [ append-nums HEX: 10000 + decoded ] } + { quad3 [ append-nums HEX: 10000 + push-decoded ] } { ignore [ 2drop push-replacement ] } } case ; -: decode-utf16be ( seq -- str ) - [ decode-utf16be-step ] decode ; +: unpack-state-be ( encoding -- ch state ) + { utf16be-ch utf16be-state } get-slots ; + +: pack-state-be ( ch state encoding -- ) + { set-utf16be-ch set-utf16be-state } set-slots ; + +M: utf16be decode-step + [ unpack-state-be decode-utf16be-step ] keep pack-state-be drop ; + +M: utf16be init-decoder nip begin over set-utf16be-state ; + +! UTF-16LE decoding + +TUPLE: utf16le ch state ; : handle-double ( buf byte ch -- buf ch state ) swap dup -3 shift BIN: 11011 = [ @@ -52,7 +68,7 @@ SYMBOL: ignore : handle-quad3le ( buf byte ch -- buf ch state ) swap dup -2 shift BIN: 110111 = [ - BIN: 11 bitand append-nums HEX: 10000 + decoded + BIN: 11 bitand append-nums HEX: 10000 + push-decoded ] [ 2drop push-replacement ] if ; : decode-utf16le-step ( buf byte ch state -- buf ch state ) @@ -64,8 +80,18 @@ SYMBOL: ignore { quad3 [ handle-quad3le ] } } case ; -: decode-utf16le ( seq -- str ) - [ decode-utf16le-step ] decode ; +: unpack-state-le ( encoding -- ch state ) + { utf16le-ch utf16le-state } get-slots ; + +: pack-state-le ( ch state encoding -- ) + { set-utf16le-ch set-utf16le-state } set-slots ; + +M: utf16le decode-step + [ unpack-state-le decode-utf16le-step ] keep pack-state-le drop ; + +M: utf16le init-decoder nip begin over set-utf16le-state ; + +! UTF-16LE/BE encoding : encode-first -10 shift @@ -80,73 +106,50 @@ SYMBOL: ignore : char>utf16be ( char -- ) dup HEX: FFFF > [ HEX: 10000 - - dup encode-first swap , , - encode-second swap , , - ] [ h>b/b , , ] if ; + dup encode-first swap write1 write1 + encode-second swap write1 write1 + ] [ h>b/b write1 write1 ] if ; -: encode-utf16be ( str -- seq ) - [ [ char>utf16be ] each ] B{ } make ; +: stream-write-utf16be ( string stream -- ) + [ [ char>utf16be ] each ] with-stream* ; + +M: utf16be stream-write-encoded ( string stream encoding -- ) + drop stream-write-utf16be ; : char>utf16le ( char -- ) dup HEX: FFFF > [ HEX: 10000 - - dup encode-first , , - encode-second , , - ] [ h>b/b swap , , ] if ; + dup encode-first write1 write1 + encode-second write1 write1 + ] [ h>b/b swap write1 write1 ] if ; -: encode-utf16le ( str -- seq ) - [ [ char>utf16le ] each ] B{ } make ; +: stream-write-utf16le ( string stream -- ) + [ [ char>utf16le ] each ] with-stream* ; + +M: utf16le stream-write-encoded ( string stream encoding -- ) + drop stream-write-utf16le ; + +! UTF-16 : bom-le B{ HEX: ff HEX: fe } ; inline : bom-be B{ HEX: fe HEX: ff } ; inline -: encode-utf16 ( str -- seq ) - encode-utf16le bom-le swap append ; - : start-utf16le? ( seq1 -- seq2 ? ) bom-le ?head ; : start-utf16be? ( seq1 -- seq2 ? ) bom-be ?head ; -: decode-utf16 ( seq -- str ) - { - { [ start-utf16le? ] [ decode-utf16le ] } - { [ start-utf16be? ] [ decode-utf16be ] } - { [ t ] [ decode-error ] } - } cond ; +TUPLE: utf16 started? ; -TUPLE: utf16le ; -INSTANCE: utf16le encoding-stream - -M: utf16le encode-string drop encode-utf16le ; -M: utf16le decode-step drop decode-utf16le-step ; - -TUPLE: utf16be ; -INSTANCE: utf16be encoding-stream - -M: utf16be encode-string drop encode-utf16be ; -M: utf16be decode-step drop decode-utf16be-step ; - -TUPLE: utf16 encoding ; -INSTANCE: utf16 encoding-stream -M: utf16 underlying-stream delegate dup delegate [ ] [ ] ?if ; ! necessary? -M: utf16 set-underlying-stream delegate set-delegate ; ! necessary? - -M: utf16 encode-string - >r encode-utf16le r> - dup utf16-encoding [ drop ] - [ t swap set-utf16-encoding bom-le swap append ] if ; +M: utf16 stream-write-encoded + dup utf16-started? [ drop ] + [ t swap set-utf16-started? bom-le over stream-write ] if + stream-write-utf16le ; : bom>le/be ( bom -- le/be ) dup bom-le sequence= [ drop utf16le ] [ bom-be sequence= [ utf16be ] [ decode-error ] if ] if ; -: read-bom ( utf16 -- encoding ) - 2 over delegate stream-read bom>le/be construct-empty - [ swap set-utf16-encoding ] keep ; - -M: utf16 decode-step - ! inefficient: checks if bom is done many times - ! This should transform itself into utf16be or utf16le after reading BOM - dup utf16-encoding [ ] [ read-bom ] ?if decode-step ; +M: utf16 init-decoder ( stream encoding -- newencoding ) + 2 rot stream-read bom>le/be construct-empty init-decoder ; diff --git a/extra/io/launcher/launcher-docs.factor b/extra/io/launcher/launcher-docs.factor index 31d7e7a60d..0e50fd642a 100755 --- a/extra/io/launcher/launcher-docs.factor +++ b/extra/io/launcher/launcher-docs.factor @@ -159,8 +159,9 @@ HELP: process-stream HELP: { $values { "desc" "a launch descriptor" } + { "encoding" "an encoding descriptor" } { "stream" "a bidirectional stream" } } -{ $description "Launches a process and redirects its input and output via a pair of pipes which may be read and written as a stream." } +{ $description "Launches a process and redirects its input and output via a pair of pipes which may be read and written as a stream of the given encoding." } { $notes "Closing the stream will block until the process exits." } ; HELP: with-process-stream diff --git a/extra/io/launcher/launcher.factor b/extra/io/launcher/launcher.factor index c5ea4feeaf..ea5c58a3d3 100755 --- a/extra/io/launcher/launcher.factor +++ b/extra/io/launcher/launcher.factor @@ -1,9 +1,9 @@ ! Copyright (C) 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: io io.backend io.nonblocking io.streams.duplex -io.timeouts system kernel namespaces strings hashtables -sequences assocs combinators vocabs.loader init threads -continuations math ; +USING: io io.backend io.timeouts system kernel namespaces +strings hashtables sequences assocs combinators vocabs.loader +init threads continuations math io.encodings io.streams.duplex +io.nonblocking ; IN: io.launcher ! Non-blocking process exit notification facility @@ -125,13 +125,13 @@ M: process set-timeout set-process-timeout ; M: process timed-out kill-process ; -HOOK: process-stream* io-backend ( desc -- stream process ) +HOOK: (process-stream) io-backend ( desc -- in out process ) TUPLE: process-stream process ; -: ( desc -- stream ) - >descriptor - [ process-stream* ] keep +: ( desc encoding -- stream ) + swap >descriptor + [ (process-stream) >r rot r> ] keep +timeout+ swap at [ over set-timeout ] when* { set-delegate set-process-stream-process } process-stream construct ; diff --git a/extra/io/mmap/mmap-tests.factor b/extra/io/mmap/mmap-tests.factor index 832b88b248..81c3faec1e 100644 --- a/extra/io/mmap/mmap-tests.factor +++ b/extra/io/mmap/mmap-tests.factor @@ -1,9 +1,10 @@ -USING: io io.mmap io.files kernel tools.test continuations sequences ; +USING: io io.mmap io.files kernel tools.test continuations +sequences io.encodings.ascii ; IN: io.mmap.tests [ "mmap-test-file.txt" resource-path delete-file ] ignore-errors -[ ] [ "mmap-test-file.txt" resource-path [ "12345" write ] with-file-writer ] unit-test +[ ] [ "mmap-test-file.txt" resource-path ascii [ "12345" write ] with-file-writer ] unit-test [ ] [ "mmap-test-file.txt" resource-path dup file-length [ CHAR: 2 0 pick set-nth drop ] with-mapped-file ] unit-test [ 5 ] [ "mmap-test-file.txt" resource-path dup file-length [ length ] with-mapped-file ] unit-test -[ "22345" ] [ "mmap-test-file.txt" resource-path file-contents ] unit-test +[ "22345" ] [ "mmap-test-file.txt" resource-path ascii file-contents ] unit-test [ "mmap-test-file.txt" resource-path delete-file ] ignore-errors diff --git a/extra/io/nonblocking/nonblocking.factor b/extra/io/nonblocking/nonblocking.factor index 6798f37887..6eee3739d9 100755 --- a/extra/io/nonblocking/nonblocking.factor +++ b/extra/io/nonblocking/nonblocking.factor @@ -2,9 +2,9 @@ ! See http://factorcode.org/license.txt for BSD license. IN: io.nonblocking USING: math kernel io sequences io.buffers io.timeouts generic -sbufs system io.streams.lines io.streams.plain io.streams.duplex +byte-vectors system io.streams.duplex io.encodings io.backend continuations debugger classes byte-arrays namespaces -splitting dlists assocs ; +splitting dlists assocs io.encodings.binary ; SYMBOL: default-buffer-size 64 1024 * default-buffer-size set-global @@ -38,16 +38,14 @@ GENERIC: close-handle ( handle -- ) : ( handle type -- port ) default-buffer-size get swap ; -: ( handle -- stream ) - input-port ; +: ( handle -- input-port ) + input-port ; -: ( handle -- stream ) - output-port ; +: ( handle -- output-port ) + output-port ; -: handle>duplex-stream ( in-handle out-handle -- stream ) - - [ >r r> ] [ ] [ dispose ] - cleanup ; +: ( read-handle write-handle -- input-port output-port ) + swap [ swap ] [ ] [ dispose drop ] cleanup ; : pending-error ( port -- ) dup port-error f rot set-port-error [ throw ] when* ; @@ -73,7 +71,7 @@ GENERIC: (wait-to-read) ( port -- ) M: input-port stream-read1 dup wait-to-read1 [ buffer-pop ] unless-eof ; -: read-step ( count port -- string/f ) +: read-step ( count port -- byte-array/f ) [ wait-to-read ] 2keep [ dupd buffer> ] unless-eof nip ; @@ -92,10 +90,10 @@ M: input-port stream-read >r 0 max >fixnum r> 2dup read-step dup [ pick over length > [ - pick + pick [ push-all ] keep [ read-loop ] keep - "" like + B{ } like ] [ 2nip ] if @@ -103,7 +101,7 @@ M: input-port stream-read 2nip ] if ; -: read-until-step ( separators port -- string/f separator/f ) +: read-until-step ( separators port -- byte-array/f separator/f ) dup wait-to-read1 dup port-eof? [ f swap set-port-eof? drop f f @@ -111,7 +109,7 @@ M: input-port stream-read buffer-until ] if ; -: read-until-loop ( seps port sbuf -- separator/f ) +: read-until-loop ( seps port byte-vector -- separator/f ) 2over read-until-step over [ >r over push-all r> dup [ >r 3drop r> @@ -122,18 +120,20 @@ M: input-port stream-read >r 2drop 2drop r> ] if ; -M: input-port stream-read-until ( seps port -- str/f sep/f ) +M: input-port stream-read-until ( seps port -- byte-array/f sep/f ) 2dup read-until-step dup [ >r 2nip r> ] [ over [ - drop >sbuf [ read-until-loop ] keep "" like swap + drop >byte-vector + [ read-until-loop ] keep + B{ } like swap ] [ >r 2nip r> ] if ] if ; -M: input-port stream-read-partial ( max stream -- string/f ) +M: input-port stream-read-partial ( max stream -- byte-array/f ) >r 0 max >fixnum r> read-step ; : can-write? ( len writer -- ? ) @@ -171,11 +171,11 @@ M: port dispose [ dup port-type >r closed over set-port-type r> close-port ] if ; -TUPLE: server-port addr client ; +TUPLE: server-port addr client client-addr encoding ; -: ( handle addr -- server ) - >r f server-port r> - { set-delegate set-server-port-addr } +: ( handle addr encoding -- server ) + rot f server-port + { set-server-port-addr set-server-port-encoding set-delegate } server-port construct ; : check-server-port ( port -- ) diff --git a/extra/io/server/server-tests.factor b/extra/io/server/server-tests.factor index 8e56169bb3..e1297a9839 100755 --- a/extra/io/server/server-tests.factor +++ b/extra/io/server/server-tests.factor @@ -1,4 +1,4 @@ IN: io.server.tests USING: tools.test io.server io.server.private ; -{ 1 0 } [ [ ] server-loop ] must-infer-as +{ 2 0 } [ [ ] server-loop ] must-infer-as diff --git a/extra/io/server/server.factor b/extra/io/server/server.factor index a76ebcc450..4267f7d1e8 100755 --- a/extra/io/server/server.factor +++ b/extra/io/server/server.factor @@ -25,7 +25,7 @@ LOG: accepted-connection NOTICE >r accept r> [ with-client ] 2curry "Client" spawn drop ] 2keep accept-loop ; inline -: server-loop ( addrspec quot -- ) +: server-loop ( addrspec encoding quot -- ) >r dup servers get push r> [ accept-loop ] curry with-disposal ; inline @@ -39,12 +39,12 @@ PRIVATE> : internet-server ( port -- seq ) f swap t resolve-host ; -: with-server ( seq service quot -- ) +: with-server ( seq service encoding quot -- ) V{ } clone [ - servers [ - [ server-loop ] curry with-logging + swap servers [ + [ server-loop ] 2curry with-logging ] with-variable - ] 3curry parallel-each ; inline + ] 3curry curry parallel-each ; inline : stop-server ( -- ) servers get [ dispose ] each ; diff --git a/extra/io/sockets/authors.txt b/extra/io/sockets/authors.txt index 1901f27a24..a44f8d7f8d 100644 --- a/extra/io/sockets/authors.txt +++ b/extra/io/sockets/authors.txt @@ -1 +1,2 @@ Slava Pestov +Daniel Ehrenberg diff --git a/extra/io/sockets/sockets-docs.factor b/extra/io/sockets/sockets-docs.factor index 9136c3ca22..fa38ec90ee 100755 --- a/extra/io/sockets/sockets-docs.factor +++ b/extra/io/sockets/sockets-docs.factor @@ -92,20 +92,20 @@ HELP: inet6 } ; HELP: -{ $values { "addrspec" "an address specifier" } { "stream" "a bidirectional stream" } } -{ $description "Opens a network connection and outputs a bidirectional stream." } +{ $values { "addrspec" "an address specifier" } { "encoding" "an encding descriptor" } { "stream" "a bidirectional stream" } } +{ $description "Opens a network connection and outputs a bidirectional stream using the given encoding." } { $errors "Throws an error if the connection cannot be established." } { $examples - { $code "\"www.apple.com\" \"http\" " } + { $code "\"www.apple.com\" \"http\" utf8 " } } ; HELP: -{ $values { "addrspec" "an address specifier" } { "server" "a handle" } } +{ $values { "addrspec" "an address specifier" } { "encoding" "an encoding descriptor" } { "server" "a handle" } } { $description "Begins listening for network connections to a local address. Server objects responds to two words:" { $list { { $link dispose } " - stops listening on the port and frees all associated resources" } - { { $link accept } " - blocks until there is a connection" } + { { $link accept } " - blocks until there is a connection, and returns a stream of the encoding passed to the constructor" } } } { $notes @@ -119,7 +119,7 @@ HELP: HELP: accept { $values { "server" "a handle" } { "client" "a bidirectional stream" } } -{ $description "Waits for a connection to a server socket created by " { $link } ", and outputs a bidirectional stream when the connection has been established." +{ $description "Waits for a connection to a server socket created by " { $link } ", and outputs a bidirectional stream when the connection has been established. The encoding of this stream is the one that was passed to the server constructor." $nl "The returned client stream responds to the " { $link client-stream-addr } " word with the address of the incoming connection." } { $errors "Throws an error if the server socket is closed or otherwise is unavailable." } ; @@ -139,6 +139,7 @@ HELP: "To accept UDP/IP packets from the loopback interface only, use an address specifier returned by the following code, where 1234 is the desired port number:" { $code "\"localhost\" 1234 t resolve-host" } "Since " { $link resolve-host } " can return multiple address specifiers, your code must create a datagram socket for each one and co-ordinate packet sending accordingly." + "Datagrams are low-level binary ports that don't map onto streams, so the constructor does not use an encoding" } { $errors "Throws an error if the port is already in use, or if the OS forbids access." } ; diff --git a/extra/io/sockets/sockets.factor b/extra/io/sockets/sockets.factor index 1afffcc7b2..1dc7f4883d 100755 --- a/extra/io/sockets/sockets.factor +++ b/extra/io/sockets/sockets.factor @@ -1,8 +1,8 @@ -! Copyright (C) 2007 Slava Pestov. +! Copyright (C) 2007, 2008 Slava Pestov, Daniel Ehrenberg. ! See http://factorcode.org/license.txt for BSD license. -IN: io.sockets USING: generic kernel io.backend namespaces continuations -sequences arrays ; +sequences arrays io.encodings io.nonblocking ; +IN: io.sockets TUPLE: local path ; @@ -26,17 +26,26 @@ TUPLE: client-stream addr ; { set-client-stream-addr set-delegate } client-stream construct ; -HOOK: (client) io-backend ( addrspec -- stream ) +HOOK: (client) io-backend ( addrspec -- client-in client-out ) -GENERIC: ( addrspec -- stream ) +GENERIC: client* ( addrspec -- client-in client-out ) +M: array client* [ (client) 2array ] attempt-all first2 ; +M: object client* (client) ; -M: array [ (client) ] attempt-all ; +: ( addrspec encoding -- stream ) + >r client* r> ; -M: object (client) ; +HOOK: (server) io-backend ( addrspec -- handle ) -HOOK: io-backend ( addrspec -- server ) +: ( addrspec encoding -- server ) + >r [ (server) ] keep r> ; -HOOK: accept io-backend ( server -- client ) +HOOK: (accept) io-backend ( server -- addrspec handle ) + +: accept ( server -- client ) + [ (accept) dup ] keep + server-port-encoding + ; HOOK: io-backend ( addrspec -- datagram ) @@ -48,7 +57,7 @@ HOOK: resolve-host io-backend ( host serv passive? -- seq ) HOOK: host-name io-backend ( -- string ) -M: inet +M: inet client* dup inet-host swap inet-port f resolve-host dup empty? [ "Host name lookup failed" throw ] when - ; + client* ; diff --git a/extra/io/unix/backend/backend.factor b/extra/io/unix/backend/backend.factor index fe2f63e99a..93691c63e2 100755 --- a/extra/io/unix/backend/backend.factor +++ b/extra/io/unix/backend/backend.factor @@ -2,9 +2,9 @@ ! See http://factorcode.org/license.txt for BSD license. USING: alien generic assocs kernel kernel.private math io.nonblocking sequences strings structs sbufs -threads unix vectors io.buffers io.backend +threads unix vectors io.buffers io.backend io.encodings io.streams.duplex math.parser continuations system libc -qualified namespaces io.timeouts ; +qualified namespaces io.timeouts io.encodings.utf8 ; QUALIFIED: io IN: io.unix.backend @@ -181,9 +181,10 @@ M: port port-flush ( port -- ) M: unix-io io-multiplex ( ms/f -- ) mx get-global wait-for-events ; -M: unix-io init-stdio ( -- ) - 0 1 handle>duplex-stream io:stdio set-global - 2 io:stderr set-global ; +M: unix-io (init-stdio) ( -- ) + 0 + 1 + 2 ; ! mx io-task for embedding an fd-based mx inside another mx TUPLE: mx-port mx ; diff --git a/extra/io/unix/files/files.factor b/extra/io/unix/files/files.factor index 4142c4be77..1d472c19a3 100755 --- a/extra/io/unix/files/files.factor +++ b/extra/io/unix/files/files.factor @@ -1,8 +1,9 @@ ! Copyright (C) 2005, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: io.backend io.nonblocking io.unix.backend io.files io - unix unix.stat unix.time kernel math continuations math.bitfields - byte-arrays alien combinators combinators.cleave calendar ; +unix unix.stat unix.time kernel math continuations math.bitfields +byte-arrays alien combinators combinators.cleave calendar +io.encodings.binary ; IN: io.unix.files @@ -18,7 +19,7 @@ M: unix-io cd : open-read ( path -- fd ) O_RDONLY file-mode open dup io-error ; -M: unix-io ( path -- stream ) +M: unix-io (file-reader) ( path -- stream ) open-read ; : write-flags { O_WRONLY O_CREAT O_TRUNC } flags ; inline @@ -26,7 +27,7 @@ M: unix-io ( path -- stream ) : open-write ( path -- fd ) write-flags file-mode open dup io-error ; -M: unix-io ( path -- stream ) +M: unix-io (file-writer) ( path -- stream ) open-write ; : append-flags { O_WRONLY O_APPEND O_CREAT } flags ; inline @@ -35,7 +36,7 @@ M: unix-io ( path -- stream ) append-flags file-mode open dup io-error [ dup 0 SEEK_END lseek io-error ] [ ] [ close ] cleanup ; -M: unix-io ( path -- stream ) +M: unix-io (file-appender) ( path -- stream ) open-append ; : touch-mode @@ -60,8 +61,8 @@ M: unix-io delete-directory ( path -- ) : (copy-file) ( from to -- ) dup parent-directory make-directories - [ - swap [ + binary [ + swap binary [ swap stream-copy ] with-disposal ] with-disposal ; diff --git a/extra/io/unix/kqueue/kqueue.factor b/extra/io/unix/kqueue/kqueue.factor index 60e3754ec6..c5dc964a7a 100755 --- a/extra/io/unix/kqueue/kqueue.factor +++ b/extra/io/unix/kqueue/kqueue.factor @@ -31,7 +31,8 @@ M: output-task io-task-filter drop EVFILT_WRITE ; swap io-task-filter over set-kevent-filter ; : register-kevent ( kevent mx -- ) - mx-fd swap 1 f 0 f kevent io-error ; + mx-fd swap 1 f 0 f kevent + 0 < [ err_no ESRCH = [ (io-error) ] unless ] when ; M: kqueue-mx register-io-task ( task mx -- ) over EV_ADD make-kevent over register-kevent diff --git a/extra/io/unix/launcher/launcher-tests.factor b/extra/io/unix/launcher/launcher-tests.factor index fd2fb53cc5..c24d5c7c9e 100644 --- a/extra/io/unix/launcher/launcher-tests.factor +++ b/extra/io/unix/launcher/launcher-tests.factor @@ -1,6 +1,6 @@ IN: io.unix.launcher.tests USING: io.files tools.test io.launcher arrays io namespaces -continuations math ; +continuations math io.encodings.ascii ; [ ] [ [ "launcher-test-1" temp-file delete-file ] ignore-errors @@ -30,7 +30,7 @@ continuations math ; "cat" "launcher-test-1" temp-file 2array - contents + ascii contents ] unit-test [ "" ] [ @@ -39,7 +39,7 @@ continuations math ; "launcher-test-1" temp-file 2array +arguments+ set +inherit+ +stdout+ set - ] { } make-assoc contents + ] { } make-assoc ascii contents ] unit-test [ ] [ @@ -58,12 +58,12 @@ continuations math ; "cat" "launcher-test-1" temp-file 2array - contents + ascii contents ] unit-test [ ] [ 2 [ - "launcher-test-1" temp-file [ + "launcher-test-1" temp-file ascii [ [ +stdout+ set "echo Hello" +command+ set @@ -76,5 +76,5 @@ continuations math ; "cat" "launcher-test-1" temp-file 2array - contents + ascii contents ] unit-test diff --git a/extra/io/unix/launcher/launcher.factor b/extra/io/unix/launcher/launcher.factor index 58e41a06c0..e79ca43e33 100755 --- a/extra/io/unix/launcher/launcher.factor +++ b/extra/io/unix/launcher/launcher.factor @@ -4,7 +4,7 @@ USING: io io.backend io.launcher io.nonblocking io.unix.backend io.unix.files io.nonblocking sequences kernel namespaces math system alien.c-types debugger continuations arrays assocs combinators unix.process strings threads unix -io.unix.launcher.parser ; +io.unix.launcher.parser io.encodings.latin1 ; IN: io.unix.launcher ! Search unix first @@ -86,9 +86,9 @@ M: unix-io kill-process* ( pid -- ) -rot 2dup second close first close ] with-fork first swap second rot ; -M: unix-io process-stream* +M: unix-io (process-stream) [ - spawn-process-stream >r handle>duplex-stream r> + spawn-process-stream >r r> ] with-descriptor ; : find-process ( handle -- process ) diff --git a/extra/io/unix/sockets/sockets.factor b/extra/io/unix/sockets/sockets.factor index 930240419a..bd7dfd9ce1 100755 --- a/extra/io/unix/sockets/sockets.factor +++ b/extra/io/unix/sockets/sockets.factor @@ -1,14 +1,14 @@ -! Copyright (C) 2004, 2008 Slava Pestov, Ivan Tikhonov. +! Copyright (C) 2004, 2008 Slava Pestov, Ivan Tikhonov. ! See http://factorcode.org/license.txt for BSD license. ! We need to fiddle with the exact search order here, since ! unix::accept shadows streams::accept. -IN: io.unix.sockets USING: alien alien.c-types generic io kernel math namespaces io.nonblocking parser threads unix sequences byte-arrays io.sockets io.binary io.unix.backend io.streams.duplex io.sockets.impl math.parser continuations libc combinators ; +IN: io.unix.sockets : pending-init-error ( port -- ) #! We close it here to avoid a resource leak; callers of @@ -42,16 +42,15 @@ M: connect-task do-io-task : wait-to-connect ( port -- ) [ add-io-task ] with-port-continuation drop ; -M: unix-io (client) ( addrspec -- stream ) +M: unix-io (client) ( addrspec -- client-in client-out ) dup make-sockaddr/size >r >r protocol-family SOCK_STREAM socket-fd dup r> r> connect zero? err_no EINPROGRESS = or [ dup init-client-socket - dup handle>duplex-stream - dup duplex-stream-out + dup dup wait-to-connect - pending-init-error + dup pending-init-error ] [ dup close (io-error) ] if ; @@ -72,10 +71,10 @@ TUPLE: accept-task ; dup [ swap heap-size accept ] keep ; inline : do-accept ( port fd sockaddr -- ) - rot [ - server-port-addr parse-sockaddr - swap dup handle>duplex-stream - ] keep set-server-port-client ; + rot + [ server-port-addr parse-sockaddr ] keep + [ set-server-port-client-addr ] keep + set-server-port-client ; M: accept-task do-io-task io-task-port dup accept-sockaddr @@ -92,18 +91,17 @@ USE: io.sockets dup rot make-sockaddr/size bind zero? [ dup close (io-error) ] unless ; -M: unix-io ( addrspec -- stream ) - [ - SOCK_STREAM server-fd - dup 10 listen zero? [ dup close (io-error) ] unless - ] keep ; +M: unix-io (server) ( addrspec -- handle ) + SOCK_STREAM server-fd + dup 10 listen zero? [ dup close (io-error) ] unless ; -M: unix-io accept ( server -- client ) +M: unix-io (accept) ( server -- addrspec handle ) #! Wait for a client connection. dup check-server-port dup wait-to-accept dup pending-error - server-port-client ; + dup server-port-client-addr + swap server-port-client ; ! Datagram sockets - UDP and Unix domain M: unix-io diff --git a/extra/io/unix/unix-tests.factor b/extra/io/unix/unix-tests.factor index 680cb0b3e5..c8ed4fc41c 100755 --- a/extra/io/unix/unix-tests.factor +++ b/extra/io/unix/unix-tests.factor @@ -1,6 +1,6 @@ USING: io.files io.sockets io kernel threads namespaces tools.test continuations strings byte-arrays -sequences prettyprint system ; +sequences prettyprint system io.encodings.binary io.encodings.ascii ; IN: io.unix.tests ! Unix domain stream sockets @@ -10,12 +10,12 @@ IN: io.unix.tests [ socket-server delete-file ] ignore-errors socket-server - [ - stdio get accept [ + ascii [ + accept [ "Hello world" print flush readln "XYZ" = "FOO" "BAR" ? print flush ] with-stream - ] with-stream + ] with-disposal socket-server delete-file ] "Test" spawn drop @@ -24,7 +24,7 @@ yield [ { "Hello world" "FOO" } ] [ [ - socket-server + socket-server ascii [ readln , "XYZ" print flush @@ -125,15 +125,15 @@ datagram-client delete-file ! Invalid parameter tests [ - image [ stdio get accept ] with-file-reader + image binary [ stdio get accept ] with-file-reader ] must-fail [ - image [ stdio get receive ] with-file-reader + image binary [ stdio get receive ] with-file-reader ] must-fail [ - image [ + image binary [ B{ 1 2 } datagram-server stdio get send ] with-file-reader diff --git a/extra/io/windows/ce/backend/backend.factor b/extra/io/windows/ce/backend/backend.factor index d92b4db77c..f51521dfcc 100755 --- a/extra/io/windows/ce/backend/backend.factor +++ b/extra/io/windows/ce/backend/backend.factor @@ -1,7 +1,7 @@ USING: io.nonblocking io.windows threads.private kernel io.backend windows.winsock windows.kernel32 windows io.streams.duplex io namespaces alien.syntax system combinators -io.buffers ; +io.buffers io.encodings io.encodings.utf8 combinators.lib ; IN: io.windows.ce.backend : port-errored ( port -- ) @@ -33,15 +33,18 @@ LIBRARY: libc FUNCTION: void* _getstdfilex int fd ; FUNCTION: void* _fileno void* file ; -M: windows-ce-io init-stdio ( -- ) +M: windows-ce-io (init-stdio) ( -- ) #! We support Windows NT too, to make this I/O backend #! easier to debug. 512 default-buffer-size [ winnt? [ STD_INPUT_HANDLE GetStdHandle STD_OUTPUT_HANDLE GetStdHandle + STD_ERROR_HANDLE GetStdHandle ] [ 0 _getstdfilex _fileno 1 _getstdfilex _fileno - ] if - ] with-variable stdio set-global ; + 2 _getstdfilex _fileno + ] if [ f ] 3apply + rot -rot [ ] 2apply + ] with-variable ; diff --git a/extra/io/windows/ce/sockets/sockets.factor b/extra/io/windows/ce/sockets/sockets.factor index e9ca6220af..9bc583a3d8 100755 --- a/extra/io/windows/ce/sockets/sockets.factor +++ b/extra/io/windows/ce/sockets/sockets.factor @@ -31,17 +31,15 @@ M: win32-socket wince-write ( port port-handle -- ) windows.winsock:WSAConnect windows.winsock:winsock-error!=0/f ; -M: windows-ce-io (client) ( addrspec -- duplex-stream ) - do-connect dup handle>duplex-stream ; +M: windows-ce-io (client) ( addrspec -- reader writer ) + do-connect dup ; -M: windows-ce-io ( addrspec -- duplex-stream ) - [ - windows.winsock:SOCK_STREAM server-fd - dup listen-on-socket - - ] keep ; +M: windows-ce-io (server) ( addrspec -- handle ) + windows.winsock:SOCK_STREAM server-fd + dup listen-on-socket + ; -M: windows-ce-io accept ( server -- client ) +M: windows-ce-io (accept) ( server -- client ) [ dup check-server-port [ @@ -54,7 +52,7 @@ M: windows-ce-io accept ( server -- client ) [ windows.winsock:winsock-error ] when ] keep ] keep server-port-addr parse-sockaddr swap - dup handle>duplex-stream + ] with-timeout ; M: windows-ce-io ( addrspec -- datagram ) diff --git a/extra/io/windows/nt/launcher/launcher.factor b/extra/io/windows/nt/launcher/launcher.factor index a4a3122b4d..500a2b0d1f 100755 --- a/extra/io/windows/nt/launcher/launcher.factor +++ b/extra/io/windows/nt/launcher/launcher.factor @@ -119,7 +119,7 @@ M: windows-nt-io fill-redirection over redirect-stdin over set-STARTUPINFO-hStdInput drop ; -M: windows-nt-io process-stream* +M: windows-nt-io (process-stream) [ [ make-CreateProcess-args @@ -135,8 +135,10 @@ M: windows-nt-io process-stream* dup CreateProcess-args-stdout-pipe pipe-out CloseHandle drop dup CreateProcess-args-stdout-pipe pipe-in - over CreateProcess-args-stdin-pipe pipe-out + over CreateProcess-args-stdin-pipe pipe-out - swap CreateProcess-args-lpProcessInformation + [ f ] 2apply + + rot CreateProcess-args-lpProcessInformation ] with-destructors ] with-descriptor ; diff --git a/extra/io/windows/nt/sockets/sockets.factor b/extra/io/windows/nt/sockets/sockets.factor index eef7476dd5..a63a533ba1 100755 --- a/extra/io/windows/nt/sockets/sockets.factor +++ b/extra/io/windows/nt/sockets/sockets.factor @@ -45,13 +45,12 @@ TUPLE: ConnectEx-args port "stdcall" alien-indirect drop winsock-error-string [ throw ] when* ; -: connect-continuation ( ConnectEx -- ) - dup ConnectEx-args-lpOverlapped* - swap ConnectEx-args-port duplex-stream-in - [ save-callback ] 2keep +: connect-continuation ( ConnectEx port -- ) + >r ConnectEx-args-lpOverlapped* r> + 2dup save-callback get-overlapped-result drop ; -M: windows-nt-io (client) ( addrspec -- duplex-stream ) +M: windows-nt-io (client) ( addrspec -- client-in client-out ) [ \ ConnectEx-args construct-empty over make-sockaddr/size pick init-connect @@ -61,13 +60,8 @@ M: windows-nt-io (client) ( addrspec -- duplex-stream ) dup ConnectEx-args-s* INADDR_ANY roll bind-socket dup (ConnectEx) - dup ConnectEx-args-s* dup handle>duplex-stream - over set-ConnectEx-args-port - - dup connect-continuation - ConnectEx-args-port - [ duplex-stream-in pending-error ] keep - [ duplex-stream-out pending-error ] keep + dup ConnectEx-args-s* dup + >r [ connect-continuation ] keep [ pending-error ] keep r> ] with-destructors ; TUPLE: AcceptEx-args port @@ -91,7 +85,7 @@ TUPLE: AcceptEx-args port f over set-AcceptEx-args-lpdwBytesReceived* (make-overlapped) swap set-AcceptEx-args-lpOverlapped* ; -: (accept) ( AcceptEx -- ) +: ((accept)) ( AcceptEx -- ) \ AcceptEx-args >tuple*< AcceptEx drop winsock-error-string [ throw ] when* ; @@ -117,38 +111,31 @@ TUPLE: AcceptEx-args port ] keep *void* ] keep AcceptEx-args-port server-port-addr parse-sockaddr ; -: accept-continuation ( AcceptEx -- client ) +: accept-continuation ( AcceptEx -- addrspec client ) [ make-accept-continuation ] keep [ check-accept-error ] keep [ extract-remote-host ] keep ! addrspec AcceptEx - [ - AcceptEx-args-sAcceptSocket* add-completion - ] keep - AcceptEx-args-sAcceptSocket* dup handle>duplex-stream - ; + [ AcceptEx-args-sAcceptSocket* add-completion ] keep + AcceptEx-args-sAcceptSocket* ; -M: windows-nt-io accept ( server -- client ) +M: windows-nt-io (accept) ( server -- addrspec handle ) [ [ dup check-server-port \ AcceptEx-args construct-empty [ init-accept ] keep - [ (accept) ] keep + [ ((accept)) ] keep [ accept-continuation ] keep AcceptEx-args-port pending-error - dup duplex-stream-in pending-error - dup duplex-stream-out pending-error ] with-timeout ] with-destructors ; -M: windows-nt-io ( addrspec -- server ) +M: windows-nt-io (server) ( addrspec -- handle ) [ - [ - SOCK_STREAM server-fd dup listen-on-socket - dup add-completion - - ] keep + SOCK_STREAM server-fd dup listen-on-socket + dup add-completion + ] with-destructors ; M: windows-nt-io ( addrspec -- datagram ) diff --git a/extra/io/windows/windows.factor b/extra/io/windows/windows.factor index 291bef6018..094a6ec0d6 100755 --- a/extra/io/windows/windows.factor +++ b/extra/io/windows/windows.factor @@ -20,9 +20,6 @@ TUPLE: win32-file handle ptr ; C: win32-file -: ( in out -- stream ) - >r f r> f handle>duplex-stream ; - HOOK: CreateFile-flags io-backend ( DWORD -- DWORD ) HOOK: FileArgs-overlapped io-backend ( port -- overlapped/f ) HOOK: add-completion io-backend ( port -- ) @@ -112,13 +109,13 @@ C: FileArgs [ FileArgs-lpNumberOfBytesRet ] keep FileArgs-lpOverlapped ; -M: windows-io ( path -- stream ) +M: windows-io (file-reader) ( path -- stream ) open-read ; -M: windows-io ( path -- stream ) +M: windows-io (file-writer) ( path -- stream ) open-write ; -M: windows-io ( path -- stream ) +M: windows-io (file-appender) ( path -- stream ) open-append ; M: windows-io move-file ( from to -- ) diff --git a/extra/irc/irc.factor b/extra/irc/irc.factor index 44c682e671..8a39846fc4 100755 --- a/extra/irc/irc.factor +++ b/extra/irc/irc.factor @@ -1,7 +1,8 @@ ! Copyright (C) 2007 Doug Coleman, Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: arrays calendar io io.sockets kernel match namespaces -sequences splitting strings continuations threads ascii ; +sequences splitting strings continuations threads ascii +io.encodings.utf8 ; IN: irc ! "setup" objects @@ -97,7 +98,7 @@ SYMBOL: irc-client " hostname servername :irc.factor" irc-print ; : connect* ( server port -- ) - irc-client get set-irc-client-stream ; + utf8 irc-client get set-irc-client-stream ; : connect ( server -- ) 6667 connect* ; diff --git a/extra/ldap/ldap-tests.factor b/extra/ldap/ldap-tests.factor index e4338615ce..42e51c782a 100644 --- a/extra/ldap/ldap-tests.factor +++ b/extra/ldap/ldap-tests.factor @@ -5,10 +5,12 @@ tools.test ; get-ldp LDAP_OPT_PROTOCOL_VERSION LDAP_VERSION3 set-option -[ B{ 0 0 0 3 } ] [ +[ 3 ] [ get-ldp LDAP_OPT_PROTOCOL_VERSION "int*" [ get-option ] keep + *int ] unit-test +[ get-ldp "cn=jimbob,dc=example,dc=com" "secret" [ ! get-ldp "dc=example,dc=com" LDAP_SCOPE_ONELEVEL "(objectclass=*)" f 0 @@ -52,3 +54,4 @@ get-ldp "cn=jimbob,dc=example,dc=com" "secret" [ get-ldp get-message next-message msgtype result-type ] with-bind +] drop diff --git a/extra/ldap/libldap/libldap.factor b/extra/ldap/libldap/libldap.factor index 492aed1a54..ae613bd461 100755 --- a/extra/ldap/libldap/libldap.factor +++ b/extra/ldap/libldap/libldap.factor @@ -9,11 +9,11 @@ USING: alien alien.syntax combinators kernel system ; IN: ldap.libldap -"libldap" { +<< "libldap" { { [ win32? ] [ "libldap.dll" "stdcall" ] } { [ macosx? ] [ "libldap.dylib" "cdecl" ] } { [ unix? ] [ "$LD_LIBRARY_PATH/libldap.so" "cdecl" ] } -} cond add-library +} cond add-library >> : LDAP_VERSION1 1 ; inline : LDAP_VERSION2 2 ; inline diff --git a/extra/log-viewer/log-viewer.factor b/extra/log-viewer/log-viewer.factor index 0f139d184e..7bc63d3e34 100755 --- a/extra/log-viewer/log-viewer.factor +++ b/extra/log-viewer/log-viewer.factor @@ -1,4 +1,4 @@ -USING: kernel io io.files io.monitors ; +USING: kernel io io.files io.monitors io.encodings.utf8 ; IN: log-viewer : read-lines ( stream -- ) @@ -9,6 +9,6 @@ IN: log-viewer dup next-change 2drop over read-lines tail-file-loop ; : tail-file ( file -- ) - dup dup read-lines + dup utf8 dup read-lines swap parent-directory f tail-file-loop ; diff --git a/extra/logging/insomniac/insomniac.factor b/extra/logging/insomniac/insomniac.factor index bb143879bf..0294085eda 100755 --- a/extra/logging/insomniac/insomniac.factor +++ b/extra/logging/insomniac/insomniac.factor @@ -1,7 +1,8 @@ ! Copyright (C) 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: logging.analysis logging.server logging smtp io.sockets -kernel io.files io.streams.string namespaces raptor.cron assocs ; +kernel io.files io.streams.string namespaces raptor.cron assocs +io.encodings.utf8 ; IN: logging.insomniac SYMBOL: insomniac-smtp-host @@ -11,7 +12,7 @@ SYMBOL: insomniac-recipients : ?analyze-log ( service word-names -- string/f ) >r log-path 1 log# dup exists? [ - file-lines r> [ analyze-log ] with-string-writer + utf8 file-lines r> [ analyze-log ] with-string-writer ] [ r> 2drop f ] if ; diff --git a/extra/logging/server/server.factor b/extra/logging/server/server.factor index 99f637f4a0..d181ab8a16 100755 --- a/extra/logging/server/server.factor +++ b/extra/logging/server/server.factor @@ -3,7 +3,8 @@ USING: namespaces kernel io calendar sequences io.files io.sockets continuations prettyprint assocs math.parser words debugger math combinators concurrency.messaging -threads arrays init math.ranges strings calendar.format ; +threads arrays init math.ranges strings calendar.format +io.encodings.ascii ; IN: logging.server : log-root ( -- string ) @@ -20,7 +21,7 @@ SYMBOL: log-files : open-log-stream ( service -- stream ) log-path dup make-directories - 1 log# ; + 1 log# ascii ; : log-stream ( service -- stream ) log-files get [ open-log-stream ] cache ; diff --git a/extra/msxml-to-csv/msxml-to-csv.factor b/extra/msxml-to-csv/msxml-to-csv.factor index 8a9ba9cf98..3004324511 100644 --- a/extra/msxml-to-csv/msxml-to-csv.factor +++ b/extra/msxml-to-csv/msxml-to-csv.factor @@ -1,4 +1,4 @@ -USING: io io.files sequences xml xml.utilities ; +USING: io io.files sequences xml xml.utilities io.encodings.utf8 ; IN: msxml-to-csv : print-csv ( table -- ) [ "," join print ] each ; @@ -13,6 +13,6 @@ IN: msxml-to-csv ] map ; : msxml>csv ( infile outfile -- ) - [ + utf8 [ file>xml (msxml>csv) print-csv ] with-file-writer ; diff --git a/extra/multiline/multiline.factor b/extra/multiline/multiline.factor index d32c11dd06..5baa205d15 100755 --- a/extra/multiline/multiline.factor +++ b/extra/multiline/multiline.factor @@ -38,3 +38,5 @@ IN: multiline : <" "\">" parse-multiline-string parsed ; parsing + +: /* "*/" parse-multiline-string drop ; parsing diff --git a/extra/ogg/player/player.factor b/extra/ogg/player/player.factor index e24cee748e..2a685eccd1 100755 --- a/extra/ogg/player/player.factor +++ b/extra/ogg/player/player.factor @@ -14,7 +14,8 @@ USING: kernel alien ogg ogg.vorbis ogg.theora io byte-arrays sequences libc shuffle alien.c-types system openal math namespaces threads shuffle opengl arrays ui.gadgets.worlds combinators math.parser ui.gadgets ui.render opengl.gl ui - continuations io.files hints combinators.lib sequences.lib debugger ; + continuations io.files hints combinators.lib sequences.lib + io.encodings.binary debugger ; IN: ogg.player @@ -611,7 +612,7 @@ M: theora-gadget draw-gadget* ( gadget -- ) play-ogg ; : play-vorbis-file ( filename -- ) - play-vorbis-stream ; + binary play-vorbis-stream ; : play-theora-stream ( stream -- ) @@ -619,5 +620,5 @@ M: theora-gadget draw-gadget* ( gadget -- ) play-ogg ; : play-theora-file ( filename -- ) - play-theora-stream ; + binary play-theora-stream ; diff --git a/extra/openssl/libssl/libssl.factor b/extra/openssl/libssl/libssl.factor index 29016f6d57..8d1b3b5247 100644 --- a/extra/openssl/libssl/libssl.factor +++ b/extra/openssl/libssl/libssl.factor @@ -9,11 +9,11 @@ USING: alien alien.syntax combinators kernel system ; IN: openssl.libssl -"libssl" { +<< "libssl" { { [ win32? ] [ "ssleay32.dll" "stdcall" ] } { [ macosx? ] [ "libssl.dylib" "cdecl" ] } { [ unix? ] [ "$LD_LIBRARY_PATH/libssl.so" "cdecl" ] } -} cond add-library +} cond add-library >> : X509_FILETYPE_PEM 1 ; inline : X509_FILETYPE_ASN1 2 ; inline diff --git a/extra/pdf/libhpdf/libhpdf.factor b/extra/pdf/libhpdf/libhpdf.factor index 85ccc70c25..a40b7cddee 100644 --- a/extra/pdf/libhpdf/libhpdf.factor +++ b/extra/pdf/libhpdf/libhpdf.factor @@ -9,11 +9,11 @@ USING: alien alien.syntax combinators system ; IN: pdf.libhpdf -"libhpdf" { +<< "libhpdf" { { [ win32? ] [ "libhpdf.dll" "stdcall" ] } { [ macosx? ] [ "libhpdf.dylib" "cdecl" ] } { [ unix? ] [ "$LD_LIBRARY_PATH/libhpdf.so" "cdecl" ] } -} cond add-library +} cond add-library >> ! compression mode : HPDF_COMP_NONE HEX: 00 ; inline ! No contents are compressed diff --git a/extra/pdf/pdf-tests.factor b/extra/pdf/pdf-tests.factor index dc42874d2a..097f671d9a 100644 --- a/extra/pdf/pdf-tests.factor +++ b/extra/pdf/pdf-tests.factor @@ -92,6 +92,6 @@ SYMBOL: twidth ] with-text - "extra/pdf/test/font_test.pdf" resource-path save-to-file + "font_test.pdf" temp-file save-to-file ] with-pdf diff --git a/extra/pdf/test/font_test.pdf b/extra/pdf/test/font_test.pdf deleted file mode 100644 index 4360cf349f..0000000000 --- a/extra/pdf/test/font_test.pdf +++ /dev/null @@ -1,300 +0,0 @@ -%PDF-1.3 -%·¾­ª -1 0 obj -<< -/Type /Catalog -/Pages 2 0 R ->> -endobj -2 0 obj -<< -/Type /Pages -/Kids [ 4 0 R ] -/Count 1 ->> -endobj -3 0 obj -<< -/Producer (Haru\040Free\040PDF\040Library\0402.0.8) ->> -endobj -4 0 obj -<< -/Type /Page -/MediaBox [ 0 0 595 841 ] -/Contents 5 0 R -/Resources << -/ProcSet [ /PDF /Text /ImageB /ImageC /ImageI ] -/Font << -/F1 7 0 R -/F2 8 0 R -/F3 9 0 R -/F4 10 0 R -/F5 11 0 R -/F6 12 0 R -/F7 13 0 R -/F8 14 0 R -/F9 15 0 R -/F10 16 0 R -/F11 17 0 R -/F12 18 0 R -/F13 19 0 R -/F14 20 0 R ->> ->> -/Parent 2 0 R ->> -endobj -5 0 obj -<< -/Length 6 0 R ->> -stream -1 w -50 50 495 731 re -S -/F1 24 Tf -BT -238.148 791 Td -(Font\040Demo) Tj -ET -BT -/F1 16 Tf -60 761 Td -(\074Standard\040Type1\040font\040samples\076) Tj -ET -BT -60 736 Td -/F2 9 Tf -(Courier) Tj -0 -18 Td -/F2 20 Tf -(abcdefgABCDEFG12345!\043$\045&+-@?) Tj -0 -20 Td -/F3 9 Tf -(Courier-Bold) Tj -0 -18 Td -/F3 20 Tf -(abcdefgABCDEFG12345!\043$\045&+-@?) Tj -0 -20 Td -/F4 9 Tf -(Courier-Oblique) Tj -0 -18 Td -/F4 20 Tf -(abcdefgABCDEFG12345!\043$\045&+-@?) Tj -0 -20 Td -/F5 9 Tf -(Courier-BoldOblique) Tj -0 -18 Td -/F5 20 Tf -(abcdefgABCDEFG12345!\043$\045&+-@?) Tj -0 -20 Td -/F1 9 Tf -(Helvetica) Tj -0 -18 Td -/F1 20 Tf -(abcdefgABCDEFG12345!\043$\045&+-@?) Tj -0 -20 Td -/F6 9 Tf -(Helvetica-Bold) Tj -0 -18 Td -/F6 20 Tf -(abcdefgABCDEFG12345!\043$\045&+-@?) Tj -0 -20 Td -/F7 9 Tf -(Helvetica-Oblique) Tj -0 -18 Td -/F7 20 Tf -(abcdefgABCDEFG12345!\043$\045&+-@?) Tj -0 -20 Td -/F8 9 Tf -(Helvetica-BoldOblique) Tj -0 -18 Td -/F8 20 Tf -(abcdefgABCDEFG12345!\043$\045&+-@?) Tj -0 -20 Td -/F9 9 Tf -(Times-Roman) Tj -0 -18 Td -/F9 20 Tf -(abcdefgABCDEFG12345!\043$\045&+-@?) Tj -0 -20 Td -/F10 9 Tf -(Times-Bold) Tj -0 -18 Td -/F10 20 Tf -(abcdefgABCDEFG12345!\043$\045&+-@?) Tj -0 -20 Td -/F11 9 Tf -(Times-Italic) Tj -0 -18 Td -/F11 20 Tf -(abcdefgABCDEFG12345!\043$\045&+-@?) Tj -0 -20 Td -/F12 9 Tf -(Times-BoldItalic) Tj -0 -18 Td -/F12 20 Tf -(abcdefgABCDEFG12345!\043$\045&+-@?) Tj -0 -20 Td -/F13 9 Tf -(Symbol) Tj -0 -18 Td -/F13 20 Tf -(abcdefgABCDEFG12345!\043$\045&+-@?) Tj -0 -20 Td -/F14 9 Tf -(ZapfDingbats) Tj -0 -18 Td -/F14 20 Tf -(abcdefgABCDEFG12345!\043$\045&+-@?) Tj -0 -20 Td -ET - -endstream -endobj -6 0 obj -1517 -endobj -7 0 obj -<< -/Type /Font -/BaseFont /Helvetica -/Subtype /Type1 -/Encoding /StandardEncoding ->> -endobj -8 0 obj -<< -/Type /Font -/BaseFont /Courier -/Subtype /Type1 -/Encoding /StandardEncoding ->> -endobj -9 0 obj -<< -/Type /Font -/BaseFont /Courier-Bold -/Subtype /Type1 -/Encoding /StandardEncoding ->> -endobj -10 0 obj -<< -/Type /Font -/BaseFont /Courier-Oblique -/Subtype /Type1 -/Encoding /StandardEncoding ->> -endobj -11 0 obj -<< -/Type /Font -/BaseFont /Courier-BoldOblique -/Subtype /Type1 -/Encoding /StandardEncoding ->> -endobj -12 0 obj -<< -/Type /Font -/BaseFont /Helvetica-Bold -/Subtype /Type1 -/Encoding /StandardEncoding ->> -endobj -13 0 obj -<< -/Type /Font -/BaseFont /Helvetica-Oblique -/Subtype /Type1 -/Encoding /StandardEncoding ->> -endobj -14 0 obj -<< -/Type /Font -/BaseFont /Helvetica-BoldOblique -/Subtype /Type1 -/Encoding /StandardEncoding ->> -endobj -15 0 obj -<< -/Type /Font -/BaseFont /Times-Roman -/Subtype /Type1 -/Encoding /StandardEncoding ->> -endobj -16 0 obj -<< -/Type /Font -/BaseFont /Times-Bold -/Subtype /Type1 -/Encoding /StandardEncoding ->> -endobj -17 0 obj -<< -/Type /Font -/BaseFont /Times-Italic -/Subtype /Type1 -/Encoding /StandardEncoding ->> -endobj -18 0 obj -<< -/Type /Font -/BaseFont /Times-BoldItalic -/Subtype /Type1 -/Encoding /StandardEncoding ->> -endobj -19 0 obj -<< -/Type /Font -/BaseFont /Symbol -/Subtype /Type1 ->> -endobj -20 0 obj -<< -/Type /Font -/BaseFont /ZapfDingbats -/Subtype /Type1 ->> -endobj -xref -0 21 -0000000000 65535 f -0000000015 00000 n -0000000064 00000 n -0000000123 00000 n -0000000196 00000 n -0000000518 00000 n -0000002089 00000 n -0000002109 00000 n -0000002207 00000 n -0000002303 00000 n -0000002404 00000 n -0000002509 00000 n -0000002618 00000 n -0000002722 00000 n -0000002829 00000 n -0000002940 00000 n -0000003041 00000 n -0000003141 00000 n -0000003243 00000 n -0000003349 00000 n -0000003417 00000 n -trailer -<< -/Root 1 0 R -/Info 3 0 R -/Size 21 ->> -startxref -3491 -%%EOF diff --git a/extra/peg/search/search-tests.factor b/extra/peg/search/search-tests.factor index c65001be09..b22a5ef0d0 100755 --- a/extra/peg/search/search-tests.factor +++ b/extra/peg/search/search-tests.factor @@ -1,7 +1,8 @@ ! Copyright (C) 2007 Chris Double. ! See http://factorcode.org/license.txt for BSD license. ! -USING: kernel math math.parser arrays tools.test peg peg.search ; +USING: kernel math math.parser arrays tools.test peg peg.parsers +peg.search ; IN: peg.search.tests { V{ 123 456 } } [ diff --git a/extra/porter-stemmer/porter-stemmer-tests.factor b/extra/porter-stemmer/porter-stemmer-tests.factor index 7294ac0e8f..da0658f94d 100644 --- a/extra/porter-stemmer/porter-stemmer-tests.factor +++ b/extra/porter-stemmer/porter-stemmer-tests.factor @@ -1,6 +1,6 @@ IN: porter-stemmer.tests USING: arrays io kernel porter-stemmer sequences tools.test -io.files ; +io.files io.encodings.utf8 ; [ 0 ] [ "xa" consonant-seq ] unit-test [ 0 ] [ "xxaa" consonant-seq ] unit-test @@ -56,7 +56,7 @@ io.files ; [ "hell" ] [ "hell" step5 "" like ] unit-test [ "mate" ] [ "mate" step5 "" like ] unit-test -: resource-lines resource-path file-lines ; +: resource-lines resource-path utf8 file-lines ; [ { } ] [ "extra/porter-stemmer/test/voc.txt" resource-lines diff --git a/extra/project-euler/042/042.factor b/extra/project-euler/042/042.factor index c66be27df7..a87722debc 100644 --- a/extra/project-euler/042/042.factor +++ b/extra/project-euler/042/042.factor @@ -1,7 +1,7 @@ ! Copyright (c) 2008 Aaron Schaefer. ! See http://factorcode.org/license.txt for BSD license. USING: ascii io.files kernel math math.functions namespaces - project-euler.common sequences sequences.lib splitting ; + project-euler.common sequences sequences.lib splitting io.encodings.ascii ; IN: project-euler.042 ! http://projecteuler.net/index.php?section=problems&id=42 @@ -31,7 +31,7 @@ IN: project-euler.042 : source-042 ( -- seq ) "extra/project-euler/042/words.txt" resource-path - file-contents [ quotable? ] subset "," split ; + ascii file-contents [ quotable? ] subset "," split ; : (triangle-upto) ( limit n -- ) 2dup nth-triangle > [ diff --git a/extra/project-euler/067/067.factor b/extra/project-euler/067/067.factor index f206f59472..436ccde776 100644 --- a/extra/project-euler/067/067.factor +++ b/extra/project-euler/067/067.factor @@ -1,6 +1,7 @@ ! Copyright (c) 2007 Samuel Tardieu, Aaron Schaefer. ! See http://factorcode.org/license.txt for BSD license. -USING: io.files math.parser namespaces project-euler.common sequences splitting ; +USING: io.files math.parser namespaces project-euler.common +io.encodings.ascii sequences splitting ; IN: project-euler.067 ! http://projecteuler.net/index.php?section=problems&id=67 @@ -38,7 +39,7 @@ IN: project-euler.067 : source-067 ( -- seq ) "extra/project-euler/067/triangle.txt" resource-path - file-lines [ " " split [ string>number ] map ] map ; + ascii file-lines [ " " split [ string>number ] map ] map ; PRIVATE> diff --git a/extra/project-euler/079/079.factor b/extra/project-euler/079/079.factor index f068db77ec..30c46de0a0 100644 --- a/extra/project-euler/079/079.factor +++ b/extra/project-euler/079/079.factor @@ -1,6 +1,7 @@ ! Copyright (c) 2008 Aaron Schaefer. ! See http://factorcode.org/license.txt for BSD license. -USING: assocs hashtables io.files kernel math math.parser namespaces sequences ; +USING: assocs hashtables io.files kernel math math.parser namespaces +io.encodings.ascii sequences ; IN: project-euler.079 ! http://projecteuler.net/index.php?section=problems&id=79 @@ -26,7 +27,7 @@ IN: project-euler.079 edges ( seq -- seq ) [ diff --git a/extra/random-tester/safe-words/safe-words.factor b/extra/random-tester/safe-words/safe-words.factor index ab528786bb..f7eac4c32d 100755 --- a/extra/random-tester/safe-words/safe-words.factor +++ b/extra/random-tester/safe-words/safe-words.factor @@ -54,7 +54,6 @@ IN: random-tester.safe-words : method-words { - method-def forget-word } ; diff --git a/extra/raptor/raptor.factor b/extra/raptor/raptor.factor index 1ada2a30c6..1bf9b2d4c7 100755 --- a/extra/raptor/raptor.factor +++ b/extra/raptor/raptor.factor @@ -42,11 +42,11 @@ SYMBOL: networking-hook ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! USING: io io.files io.streams.lines io.streams.plain io.streams.duplex - listener ; + listener io.encodings.utf8 ; : tty-listener ( tty -- ) - dup [ - swap [ + dup utf8 [ + swap utf8 [ [ listener ] with-stream diff --git a/extra/rss/rss-tests.factor b/extra/rss/rss-tests.factor index 68a40704b3..1d493d3c14 100644 --- a/extra/rss/rss-tests.factor +++ b/extra/rss/rss-tests.factor @@ -1,9 +1,9 @@ -USING: rss io kernel io.files tools.test ; +USING: rss io kernel io.files tools.test io.encodings.utf8 ; : load-news-file ( filename -- feed ) #! Load an news syndication file and process it, returning #! it as an feed tuple. - read-feed ; + utf8 read-feed ; [ T{ feed diff --git a/extra/smtp/server/server.factor b/extra/smtp/server/server.factor index c28ec7745a..92b605e91c 100755 --- a/extra/smtp/server/server.factor +++ b/extra/smtp/server/server.factor @@ -1,5 +1,8 @@ ! Copyright (C) 2007 Elie CHAFTARI ! See http://factorcode.org/license.txt for BSD license. +USING: combinators kernel prettyprint io io.timeouts io.server +sequences namespaces io.sockets continuations calendar io.encodings.ascii ; +IN: smtp.server ! Mock SMTP server for testing purposes. @@ -27,10 +30,6 @@ ! bye ! Connection closed by foreign host. -USING: combinators kernel prettyprint io io.timeouts io.server -sequences namespaces io.sockets continuations calendar ; -IN: smtp.server - SYMBOL: data-mode : process ( -- ) @@ -64,7 +63,7 @@ SYMBOL: data-mode : smtp-server ( port -- ) "Starting SMTP server on port " write dup . flush - "127.0.0.1" swap [ + "127.0.0.1" swap ascii [ accept [ 1 minutes stdio get set-timeout "220 hello\r\n" write flush diff --git a/extra/smtp/smtp-tests.factor b/extra/smtp/smtp-tests.factor index c1afeced3d..32b2f3be14 100755 --- a/extra/smtp/smtp-tests.factor +++ b/extra/smtp/smtp-tests.factor @@ -84,6 +84,7 @@ IN: smtp.tests [ ] [ [ + "localhost" smtp-host set 4321 smtp-port set "Hi guys\nBye guys" @@ -96,4 +97,4 @@ IN: smtp.tests send-simple-message ] with-scope -] unit-test \ No newline at end of file +] unit-test diff --git a/extra/smtp/smtp.factor b/extra/smtp/smtp.factor index f3f90f68b9..bbec129ef6 100755 --- a/extra/smtp/smtp.factor +++ b/extra/smtp/smtp.factor @@ -3,7 +3,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: namespaces io io.timeouts kernel logging io.sockets sequences combinators sequences.lib splitting assocs strings -math.parser random system calendar calendar.format ; +math.parser random system calendar io.encodings.ascii calendar.format ; IN: smtp @@ -20,7 +20,7 @@ SYMBOL: esmtp t esmtp set-global : with-smtp-connection ( quot -- ) smtp-host get smtp-port get 2dup log-smtp-connection - [ + ascii [ smtp-domain [ host-name or ] change read-timeout get stdio get set-timeout call @@ -180,4 +180,4 @@ TUPLE: email from to subject body ; : send ( email -- ) { email-body email-subject email-to email-from } get-slots - send-simple-message ; \ No newline at end of file + send-simple-message ; diff --git a/extra/tar/tar.factor b/extra/tar/tar.factor index 9d492e6467..06e9644370 100755 --- a/extra/tar/tar.factor +++ b/extra/tar/tar.factor @@ -1,7 +1,7 @@ USING: combinators io io.files io.streams.duplex io.streams.string kernel math math.parser continuations namespaces pack prettyprint sequences strings system -hexdump ; +hexdump io.encodings.binary ; IN: tar : zero-checksum 256 ; @@ -94,7 +94,7 @@ TUPLE: unimplemented-typeflag header ; ! Normal file : typeflag-0 - tar-header-name tar-path+ + tar-header-name tar-path+ binary [ read-data-blocks ] keep dispose ; ! Hard link @@ -236,7 +236,7 @@ TUPLE: unimplemented-typeflag header ; ] when* ; : parse-tar ( path -- obj ) - [ + binary [ "tar-test" resource-path base-dir set global [ nl nl nl "Starting to parse .tar..." print flush ] bind global [ "Expanding to: " write base-dir get . flush ] bind diff --git a/extra/tools/browser/browser.factor b/extra/tools/browser/browser.factor index e9aaa190dc..24836c1201 100755 --- a/extra/tools/browser/browser.factor +++ b/extra/tools/browser/browser.factor @@ -2,15 +2,15 @@ ! See http://factorcode.org/license.txt for BSD license. USING: namespaces splitting sequences io.files kernel assocs words vocabs vocabs.loader definitions parser continuations -inspector debugger io io.styles io.streams.lines hashtables +inspector debugger io io.styles hashtables sorting prettyprint source-files arrays combinators strings system math.parser help.markup help.topics help.syntax -help.stylesheet memoize ; +help.stylesheet memoize io.encodings.utf8 ; IN: tools.browser MEMO: (vocab-file-contents) ( path -- lines ) ?resource-path dup exists? - [ file-lines ] [ drop f ] if ; + [ utf8 file-lines ] [ drop f ] if ; : vocab-file-contents ( vocab name -- seq ) vocab-path+ dup [ (vocab-file-contents) ] when ; @@ -18,7 +18,7 @@ MEMO: (vocab-file-contents) ( path -- lines ) : set-vocab-file-contents ( seq vocab name -- ) dupd vocab-path+ [ ?resource-path - [ [ print ] each ] with-file-writer + utf8 [ [ print ] each ] with-file-writer ] [ "The " swap vocab-name " vocabulary was not loaded from the file system" diff --git a/extra/tools/deploy/backend/backend.factor b/extra/tools/deploy/backend/backend.factor index 2439ef8636..bcdc0f806f 100755 --- a/extra/tools/deploy/backend/backend.factor +++ b/extra/tools/deploy/backend/backend.factor @@ -6,7 +6,7 @@ continuations math definitions mirrors splitting parser classes inspector layouts vocabs.loader prettyprint.config prettyprint debugger io.streams.c io.streams.duplex io.files io.backend quotations io.launcher words.private tools.deploy.config -bootstrap.image ; +bootstrap.image io.encodings.utf8 ; IN: tools.deploy.backend : (copy-lines) ( stream -- ) @@ -20,7 +20,7 @@ IN: tools.deploy.backend [ +arguments+ set +stdout+ +stderr+ set - ] H{ } make-assoc + ] H{ } make-assoc utf8 dup duplex-stream-out dispose dup copy-lines process-stream-process wait-for-process zero? [ diff --git a/extra/tools/deploy/macosx/macosx.factor b/extra/tools/deploy/macosx/macosx.factor index 61d7b9eaed..6cab5c98b9 100755 --- a/extra/tools/deploy/macosx/macosx.factor +++ b/extra/tools/deploy/macosx/macosx.factor @@ -1,8 +1,9 @@ ! Copyright (C) 2007, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: io io.files kernel namespaces sequences system -tools.deploy.backend tools.deploy.config assocs hashtables -prettyprint cocoa cocoa.application cocoa.classes cocoa.plists ; +USING: io io.files kernel namespaces sequences +system tools.deploy.backend tools.deploy.config assocs +hashtables prettyprint io.unix.backend cocoa io.encodings.utf8 +cocoa.application cocoa.classes cocoa.plists qualified ; IN: tools.deploy.macosx : bundle-dir ( -- dir ) @@ -32,8 +33,8 @@ IN: tools.deploy.macosx ] H{ } make-assoc print-plist ; : create-app-plist ( vocab bundle-name -- ) - dup "Contents/Info.plist" path+ - [ print-app-plist ] with-stream ; + dup "Contents/Info.plist" path+ + utf8 [ print-app-plist ] with-file-writer ; : create-app-dir ( vocab bundle-name -- vm ) dup "Frameworks" copy-bundle-dir diff --git a/extra/tools/disassembler/disassembler.factor b/extra/tools/disassembler/disassembler.factor index 8a0cd495cf..647b02baa5 100755 --- a/extra/tools/disassembler/disassembler.factor +++ b/extra/tools/disassembler/disassembler.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: io.files io words alien kernel math.parser alien.syntax io.launcher system assocs arrays sequences namespaces qualified -system math generator.fixup ; +system math generator.fixup io.encodings.ascii ; IN: tools.disassembler : in-file "gdb-in.txt" temp-file ; @@ -15,7 +15,7 @@ M: word make-disassemble-cmd word-xt code-format - 2array make-disassemble-cmd ; M: pair make-disassemble-cmd - in-file [ + in-file ascii [ "attach " write current-process-handle number>string print "disassemble " write @@ -28,7 +28,7 @@ M: pair make-disassemble-cmd out-file +stdout+ set [ "gdb" , "-x" , in-file , "-batch" , ] { } make +arguments+ set ] { } make-assoc try-process - out-file file-lines ; + out-file ascii file-lines ; : tabs>spaces ( str -- str' ) { { CHAR: \t CHAR: \s } } substitute ; diff --git a/extra/tty-server/tty-server.factor b/extra/tty-server/tty-server.factor index f71265e6f0..2936c39070 100644 --- a/extra/tty-server/tty-server.factor +++ b/extra/tty-server/tty-server.factor @@ -1,11 +1,11 @@ -USING: listener io.server ; +USING: listener io.server io.encodings.utf8 ; IN: tty-server : tty-server ( port -- ) local-server "tty-server" - [ listener ] with-server ; + utf8 [ listener ] with-server ; : default-tty-server 9999 tty-server ; -MAIN: default-tty-server \ No newline at end of file +MAIN: default-tty-server diff --git a/extra/ui/freetype/freetype.factor b/extra/ui/freetype/freetype.factor index 2dade0f58e..8078ec4a33 100755 --- a/extra/ui/freetype/freetype.factor +++ b/extra/ui/freetype/freetype.factor @@ -73,7 +73,7 @@ M: freetype-renderer free-fonts ( world -- ) : open-face ( font style -- face ) ttf-name ttf-path - dup file-contents >byte-array malloc-byte-array + dup malloc-file-contents swap file-length (open-face) ; diff --git a/extra/ui/gadgets/labels/labels.factor b/extra/ui/gadgets/labels/labels.factor index 5e5801dd02..167aa26084 100755 --- a/extra/ui/gadgets/labels/labels.factor +++ b/extra/ui/gadgets/labels/labels.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2005, 2007 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: arrays hashtables io kernel math namespaces -opengl sequences io.streams.lines strings splitting +opengl sequences strings splitting ui.gadgets ui.gadgets.tracks ui.gadgets.theme ui.render colors models ; IN: ui.gadgets.labels diff --git a/extra/ui/x11/x11.factor b/extra/ui/x11/x11.factor index 1fec668717..158a48a1c0 100755 --- a/extra/ui/x11/x11.factor +++ b/extra/ui/x11/x11.factor @@ -3,7 +3,7 @@ USING: alien alien.c-types arrays ui ui.gadgets ui.gestures ui.backend ui.clipboards ui.gadgets.worlds assocs kernel math namespaces opengl sequences strings x11.xlib x11.events x11.xim -x11.glx x11.clipboard x11.constants x11.windows +x11.glx x11.clipboard x11.constants x11.windows io.encodings.string io.encodings.utf8 combinators debugger system command-line ui.render math.vectors tuples opengl.gl threads ; IN: ui.x11 @@ -137,7 +137,7 @@ M: world selection-notify-event : encode-clipboard ( string type -- bytes ) XSelectionRequestEvent-target XA_UTF8_STRING = - [ encode-utf8 ] [ string>char-alien ] if ; + [ utf8 encode ] [ string>char-alien ] if ; : set-selection-prop ( evt -- ) dpy get swap @@ -212,7 +212,7 @@ M: x-clipboard paste-clipboard : set-title-new ( dpy window string -- ) >r XA_NET_WM_NAME XA_UTF8_STRING 8 PropModeReplace - r> encode-utf8 dup length XChangeProperty drop ; + r> utf8 encode dup length XChangeProperty drop ; M: x11-ui-backend set-title ( string world -- ) world-handle x11-handle-window swap dpy get -rot diff --git a/extra/unicode/breaks/breaks.factor b/extra/unicode/breaks/breaks.factor index 1014d3ad7e..dfc7bf2264 100644 --- a/extra/unicode/breaks/breaks.factor +++ b/extra/unicode/breaks/breaks.factor @@ -1,7 +1,7 @@ USING: unicode.categories kernel math combinators splitting sequences math.parser io.files io assocs arrays namespaces combinators.lib assocs.lib math.ranges unicode.normalize -unicode.syntax unicode.data compiler.units alien.syntax ; +unicode.syntax unicode.data compiler.units alien.syntax io.encodings.ascii ; IN: unicode.breaks C-ENUM: Any L V T Extend Control CR LF graphemes ; @@ -30,7 +30,7 @@ CATEGORY: grapheme-control Zl Zp Cc Cf ; concat >set ; : other-extend-lines ( -- lines ) - "extra/unicode/PropList.txt" resource-path file-lines ; + "extra/unicode/PropList.txt" resource-path ascii file-lines ; VALUE: other-extend diff --git a/extra/unicode/categories/categories.factor b/extra/unicode/categories/categories.factor index e5f157463d..4ba96fb9c4 100644 --- a/extra/unicode/categories/categories.factor +++ b/extra/unicode/categories/categories.factor @@ -1,7 +1,7 @@ USING: unicode.syntax ; IN: unicode.categories -CATEGORY: blank Zs Zl Zp ; +CATEGORY: blank Zs Zl Zp \r\n ; CATEGORY: letter Ll ; CATEGORY: LETTER Lu ; CATEGORY: Letter Lu Ll Lt Lm Lo ; diff --git a/extra/unicode/data/data.factor b/extra/unicode/data/data.factor index c3998a6132..11be803893 100755 --- a/extra/unicode/data/data.factor +++ b/extra/unicode/data/data.factor @@ -1,6 +1,6 @@ USING: assocs math kernel sequences io.files hashtables quotations splitting arrays math.parser combinators.lib hash2 -byte-arrays words namespaces words compiler.units parser ; +byte-arrays words namespaces words compiler.units parser io.encodings.ascii ; IN: unicode.data << @@ -21,7 +21,7 @@ IN: unicode.data ! Loading data from UnicodeData.txt : data ( filename -- data ) - file-lines [ ";" split ] map ; + ascii file-lines [ ";" split ] map ; : load-data ( -- data ) "extra/unicode/UnicodeData.txt" resource-path data ; diff --git a/extra/unix/unix.factor b/extra/unix/unix.factor index 9cc8552f98..e1d49b8c6c 100755 --- a/extra/unix/unix.factor +++ b/extra/unix/unix.factor @@ -21,6 +21,7 @@ TYPEDEF: ulong size_t : MAP_FAILED -1 ; inline +: ESRCH 3 ; inline : EEXIST 17 ; inline ! ! ! Unix functions diff --git a/extra/webapps/callback/authors.txt b/extra/webapps/callback/authors.txt deleted file mode 100755 index a8fb961d36..0000000000 --- a/extra/webapps/callback/authors.txt +++ /dev/null @@ -1,2 +0,0 @@ -Chris Double -Slava Pestov diff --git a/extra/webapps/callback/callback.factor b/extra/webapps/callback/callback.factor deleted file mode 100644 index 6bdc84bfa6..0000000000 --- a/extra/webapps/callback/callback.factor +++ /dev/null @@ -1,126 +0,0 @@ -! Copyright (C) 2004 Chris Double. -! Copyright (C) 2006 Slava Pestov. -! See http://factorcode.org/license.txt for BSD license. -USING: html http http.server.responders io kernel math -namespaces prettyprint continuations random system sequences -assocs ; -IN: webapps.callback - -#! Name of the variable holding the continuation used to exit -#! back to the httpd responder. -SYMBOL: exit-continuation - -#! Tuple to hold global request data. This gets passed to -#! the continuation when resumed so it can restore things -#! like 'stdio' so it writes to the correct socket. -TUPLE: request stream exitcc method url raw-query query header response ; - -: ( -- request ) - stdio get - exit-continuation get - "method" get - "request" get - "raw-query" get - "query" get - "header" get - "response" get - request construct-boa ; - -: restore-request ( -- ) - request get - dup request-stream stdio set - dup request-method "method" set - dup request-raw-query "raw-query" set - dup request-query "query" set - dup request-header "header" set - dup request-response "response" set - request-exitcc exit-continuation set ; - -: update-request ( request new-request -- ) - [ request-stream over set-request-stream ] keep - [ request-method over set-request-method ] keep - [ request-url over set-request-url ] keep - [ request-raw-query over set-request-raw-query ] keep - [ request-query over set-request-query ] keep - [ request-header over set-request-header ] keep - [ request-response over set-request-response ] keep - request-exitcc swap set-request-exitcc ; - -: with-exit-continuation ( quot -- ) - #! Call the quotation with the variable exit-continuation bound - #! such that when the exit continuation is called, computation - #! will resume from the end of this 'with-exit-continuation' call. - [ - exit-continuation set call exit-continuation get continue - ] callcc0 drop ; - -: expiry-timeout ( -- ms ) 900 1000 * ; - -: get-random-id ( -- id ) - #! Generate a random id to use for continuation URL's - 4 big-random unparse ; - -: callback-table ( -- ) - #! Return the global table of continuations - \ callback-table get-global ; - -: reset-callback-table ( -- ) - #! Create the initial global table - H{ } clone \ callback-table set-global ; - -reset-callback-table - -#! Tuple for holding data related to a callback. -TUPLE: item quot expire? request id time-added ; - -: ( quot expire? request id -- item ) - millis item construct-boa ; - -: expired? ( item -- ? ) - #! Return true if the callback item is expirable - #! and has expired (ie. was added to the table more than - #! timeout milliseconds ago). - [ item-time-added expiry-timeout + millis < ] keep - item-expire? and ; - -: expire-callbacks ( -- ) - #! Expire all continuations in the continuation table - #! if they are 'timeout-seconds' old (ie. were added - #! more than 'timeout-seconds' ago. - callback-table clone [ - expired? [ callback-table delete-at ] [ drop ] if - ] assoc-each ; - -: id>url ( id -- string ) - #! Convert the continuation id to an URL suitable for - #! embedding in an HREF or other HTML. - "/responder/callback/?id=" swap url-encode append ; - -: register-callback ( quot expire? -- url ) - #! Store a continuation in the table and associate it with - #! a random id. That continuation will be expired after - #! a certain period of time if 'expire?' is true. - request get get-random-id [ ] keep - [ callback-table set-at ] keep - id>url ; - -: register-html-callback ( quot expire? -- url ) - >r [ serving-html ] swap append r> register-callback ; - -: callback-responder ( -- ) - expire-callbacks - "id" query-param callback-table at [ - [ - dup item-request [ - update-request - ] when* - item-quot call - exit-continuation get continue - ] with-exit-continuation drop - ] [ - "404 Callback not available" httpd-error - ] if* ; - -global [ - "callback" [ callback-responder ] add-simple-responder -] bind diff --git a/extra/webapps/continuation/authors.txt b/extra/webapps/continuation/authors.txt deleted file mode 100755 index 44b06f94bc..0000000000 --- a/extra/webapps/continuation/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Chris Double diff --git a/extra/webapps/continuation/continuation.factor b/extra/webapps/continuation/continuation.factor deleted file mode 100644 index 6b6838d89f..0000000000 --- a/extra/webapps/continuation/continuation.factor +++ /dev/null @@ -1,151 +0,0 @@ -! Copyright (C) 2004 Chris Double. -! See http://factorcode.org/license.txt for BSD license. - -USING: http math namespaces io strings kernel html html.elements -hashtables continuations quotations parser generic sequences -webapps.callback http.server.responders ; -IN: webapps.continuation - -#! Used inside the session state of responders to indicate whether the -#! next request should use the post-refresh-get pattern. It is set to -#! true after each request. -SYMBOL: post-refresh-get? - -: >callable ( quot|interp|f -- interp ) - dup continuation? [ - [ continue ] curry - ] when ; - -: forward-to-url ( url -- ) - #! When executed inside a 'show' call, this will force a - #! HTTP 302 to occur to instruct the browser to forward to - #! the request URL. - [ - "HTTP/1.1 302 Document Moved\nLocation: " % % - "\nContent-Length: 0\nContent-Type: text/plain\n\n" % - ] "" make write exit-continuation get continue ; - -: forward-to-id ( id -- ) - #! When executed inside a 'show' call, this will force a - #! HTTP 302 to occur to instruct the browser to forward to - #! the request URL. - >r "request" get r> id>url append forward-to-url ; - -SYMBOL: current-show - -: store-current-show ( -- ) - #! Store the current continuation in the variable 'current-show' - #! so it can be returned to later by href callbacks. Note that it - #! recalls itself when the continuation is called to ensure that - #! it resets its value back to the most recent show call. - [ ( 0 -- ) - [ ( 0 1 -- ) - current-show set ( 0 -- ) - continue - ] callcc1 - nip - restore-request - call - store-current-show - ] callcc0 restore-request ; - -: redirect-to-here ( -- ) - #! Force a redirect to the client browser so that the browser - #! goes to the current point in the code. This forces an URL - #! change on the browser so that refreshing that URL will - #! immediately run from this code point. This prevents the - #! "this request will issue a POST" warning from the browser - #! and prevents re-running the previous POST logic. This is - #! known as the 'post-refresh-get' pattern. - post-refresh-get? get [ - [ - >callable t register-callback forward-to-url - ] callcc0 restore-request - ] [ - t post-refresh-get? set - ] if ; - -: (show) ( quot -- hashtable ) - #! See comments for show. The difference is the - #! quotation MUST set the content-type using 'serving-html' - #! or similar. - store-current-show redirect-to-here - [ - >callable t register-callback swap with-scope - exit-continuation get continue - ] callcc0 drop restore-request "response" get ; - -: show ( quot -- namespace ) - #! Call the quotation with the URL associated with the current - #! continuation. All output from the quotation goes to the client - #! browser. When the URL is later referenced then - #! computation will resume from this 'show' call with a hashtable on - #! the stack containing any query or post parameters. - #! 'quot' has stack effect ( url -- ) - #! NOTE: On return from 'show' the stack is exactly the same as - #! initial entry with 'quot' popped off and the hashtable pushed on. Even - #! if the quotation consumes items on the stack. - [ serving-html ] swap append (show) ; - -: (show-final) ( quot -- namespace ) - #! See comments for show-final. The difference is the - #! quotation MUST set the content-type using 'serving-html' - #! or similar. - store-current-show redirect-to-here - with-scope exit-continuation get continue ; - -: show-final ( quot -- namespace ) - #! Similar to 'show', except the quotation does not receive the URL - #! to resume computation following 'show-final'. No continuation is - #! stored for this resumption. As a result, 'show-final' is for use - #! when a page is to be displayed with no further action to occur. Its - #! use is an optimisation to save having to generate and save a continuation - #! in that special case. - #! 'quot' has stack effect ( -- ). - [ serving-html ] swap compose (show-final) ; - -#! Name of variable for holding initial continuation id that starts -#! the responder. -SYMBOL: root-callback - -: cont-get/post-responder ( id-or-f -- ) - #! httpd responder that handles the root continuation request. - #! The requests for actual continuation are processed by the - #! 'callback-responder'. - [ - [ f post-refresh-get? set request set root-callback get call ] with-scope - exit-continuation get continue - ] with-exit-continuation drop ; - -: quot-url ( quot -- url ) - current-show get [ continue-with ] 2curry t register-callback ; - -: quot-href ( text quot -- ) - #! Write to standard output an HTML HREF where the href, - #! when referenced, will call the quotation and then return - #! back to the most recent 'show' call (via the callback-cc). - #! The text of the link will be the 'text' argument on the - #! stack. - write ; - -: install-cont-responder ( name quot -- ) - #! Install a cont-responder with the given name - #! that will initially run the given quotation. - #! - #! Convert the quotation so it is run within a session namespace - #! and that namespace is initialized first. - [ - [ cont-get/post-responder ] "get" set - [ cont-get/post-responder ] "post" set - swap "responder" set - root-callback set - ] make-responder ; - -: show-message-page ( message -- ) - #! Display the message in an HTML page with an OK button. - [ - "Press OK to Continue" [ - swap paragraph - "OK" write - ] simple-page - ] show 2drop ; diff --git a/extra/webapps/continuation/examples/authors.txt b/extra/webapps/continuation/examples/authors.txt deleted file mode 100755 index 44b06f94bc..0000000000 --- a/extra/webapps/continuation/examples/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Chris Double diff --git a/extra/webapps/continuation/examples/examples.factor b/extra/webapps/continuation/examples/examples.factor deleted file mode 100644 index 2899562503..0000000000 --- a/extra/webapps/continuation/examples/examples.factor +++ /dev/null @@ -1,115 +0,0 @@ -! Copyright (C) 2004 Chris Double. -! -! Redistribution and use in source and binary forms, with or without -! modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, -! this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, -! this list of conditions and the following disclaimer in the documentation -! and/or other materials provided with the distribution. -! -! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, -! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND -! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE -! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, -! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; -! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, -! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR -! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF -! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -! -! Simple test applications -USING: hashtables html kernel io html html.elements strings math -assocs quotations webapps.continuation namespaces prettyprint -sequences ; - -IN: webapps.continuation.examples - -: display-page ( title -- ) - #! Display a page with some text to test the cont-responder. - #! The page has a link to the 'next' continuation. - [ -

over write

- swap [ - "Next" write - ] simple-html-document - ] show 2drop ; - -: display-get-name-page ( -- name ) - #! Display a page prompting for input of a name and return that name. - [ - "Enter your name" [ -

swap write

-
- "Name: " write - - -
- ] simple-html-document - ] show "name" swap at ; - -: test-cont-responder ( -- ) - #! Test the cont-responder responder by displaying a few pages in a row. - "Page one" display-page - "Hello " display-get-name-page append display-page - "Page three" display-page ; - -: test-cont-responder2 ( -- ) - #! Test the cont-responder responder by displaying a few pages in a loop. - [ "one" "two" "three" "four" ] [ display-page ] each - "Done!" display-page ; - -: test-cont-responder3 ( -- ) - #! Test the quot-href word by displaying a menu of the current - #! test words. Note that we use show-final as we don't link to a 'next' page. - [ - "Menu" [ -

"Menu" write

-
    -
  1. "Test responder1" [ test-cont-responder ] quot-href
    2. -
  2. "Test responder2" [ test-cont-responder2 ] quot-href
    3. -
- ] simple-html-document - ] show-final ; - -: counter-example ( count -- ) - #! Display a counter which can be incremented or decremented - #! using anchors. - #! - #! Don't need the original alist - [ - #! And we don't need the 'url' argument - drop - "Counter: " over unparse append [ - dup

unparse write

- "++" over 1quotation [ f ] swap append [ 1 + counter-example ] append quot-href - "--" over 1quotation [ f ] swap append [ 1 - counter-example ] append quot-href - drop - ] simple-html-document - ] show drop ; - -: counter-example2 ( -- ) - #! Display a counter which can be incremented or decremented - #! using anchors. - #! - 0 "counter" set - [ - #! We don't need the 'url' argument - drop - "Counter: " "counter" get unparse append [ -

"counter" get unparse write

- "++" [ "counter" get 1 + "counter" set ] quot-href - "--" [ "counter" get 1 - "counter" set ] quot-href - ] simple-html-document - ] show - drop ; - -! Install the examples -"counter1" [ drop 0 counter-example ] install-cont-responder -"counter2" [ drop counter-example2 ] install-cont-responder -"test1" [ test-cont-responder ] install-cont-responder -"test2" [ drop test-cont-responder2 ] install-cont-responder -"test3" [ drop test-cont-responder3 ] install-cont-responder diff --git a/extra/x11/clipboard/clipboard.factor b/extra/x11/clipboard/clipboard.factor index eb4191ebb1..0313776a20 100755 --- a/extra/x11/clipboard/clipboard.factor +++ b/extra/x11/clipboard/clipboard.factor @@ -1,7 +1,8 @@ ! Copyright (C) 2006, 2007 Slava Pestov ! See http://factorcode.org/license.txt for BSD license. USING: alien alien.c-types alien.syntax arrays kernel math -namespaces sequences io.encodings.utf8 x11.xlib x11.constants ; +namespaces sequences io.encodings.string io.encodings.utf8 x11.xlib +x11.constants ; IN: x11.clipboard ! This code was based on by McCLIM's Backends/CLX/port.lisp @@ -35,7 +36,7 @@ TUPLE: x-clipboard atom contents ; >r XSelectionEvent-property zero? [ r> drop f ] [ - r> selection-property 1 window-property decode-utf8 + r> selection-property 1 window-property utf8 decode ] if ; : own-selection ( prop win -- ) diff --git a/extra/xml/xml.factor b/extra/xml/xml.factor index ec3e24b99d..970ff39cf1 100644 --- a/extra/xml/xml.factor +++ b/extra/xml/xml.factor @@ -3,7 +3,7 @@ USING: io io.streams.string io.files kernel math namespaces prettyprint sequences arrays generic strings vectors xml.char-classes xml.data xml.errors xml.tokenize xml.writer -xml.utilities state-parser assocs ascii ; +xml.utilities state-parser assocs ascii io.encodings.utf8 ; IN: xml ! -- Overall parser with data tree @@ -167,7 +167,8 @@ TUPLE: pull-xml scope ; read-xml ; : file>xml ( filename -- xml ) - read-xml ; + ! Autodetect encoding! + utf8 read-xml ; : xml-reprint ( string -- ) string>xml print-xml ; diff --git a/extra/xmode/catalog/catalog.factor b/extra/xmode/catalog/catalog.factor index d6402603fa..6bff786fff 100755 --- a/extra/xmode/catalog/catalog.factor +++ b/extra/xmode/catalog/catalog.factor @@ -1,6 +1,6 @@ USING: xmode.loader xmode.utilities xmode.rules namespaces strings splitting assocs sequences kernel io.files xml memoize -words globs combinators ; +words globs combinators io.encodings.utf8 ; IN: xmode.catalog TUPLE: mode file file-name-glob first-line-glob ; @@ -25,7 +25,7 @@ TAGS> : load-catalog ( -- modes ) "extra/xmode/modes/catalog" resource-path - read-xml parse-modes-tag ; + file>xml parse-modes-tag ; : modes ( -- assoc ) \ modes get-global [ @@ -38,7 +38,7 @@ TAGS> MEMO: (load-mode) ( name -- rule-sets ) modes at mode-file "extra/xmode/modes/" swap append - resource-path parse-mode ; + resource-path utf8 parse-mode ; SYMBOL: rule-sets diff --git a/extra/xmode/code2html/code2html.factor b/extra/xmode/code2html/code2html.factor index 3db70cf2e9..47e619cc00 100755 --- a/extra/xmode/code2html/code2html.factor +++ b/extra/xmode/code2html/code2html.factor @@ -1,5 +1,5 @@ USING: xmode.tokens xmode.marker xmode.catalog kernel html html.elements io - io.files sequences words ; + io.files sequences words io.encodings.utf8 ; IN: xmode.code2html : htmlize-tokens ( tokens -- ) @@ -20,7 +20,7 @@ IN: xmode.code2html : default-stylesheet ( -- ) ; : htmlize-stream ( path stream -- ) @@ -40,5 +40,5 @@ IN: xmode.code2html ; : htmlize-file ( path -- ) - dup over ".html" append + dup utf8 over ".html" append utf8 [ htmlize-stream ] with-stream ; diff --git a/extra/xmode/utilities/utilities-tests.factor b/extra/xmode/utilities/utilities-tests.factor index bbb19a7555..eb30ad59f7 100755 --- a/extra/xmode/utilities/utilities-tests.factor +++ b/extra/xmode/utilities/utilities-tests.factor @@ -49,5 +49,5 @@ TAGS> } ] [ "extra/xmode/utilities/test.xml" - resource-path read-xml parse-company-tag + resource-path file>xml parse-company-tag ] unit-test diff --git a/extra/yahoo/yahoo-tests.factor b/extra/yahoo/yahoo-tests.factor index 22ea687a29..197fa4900b 100644 --- a/extra/yahoo/yahoo-tests.factor +++ b/extra/yahoo/yahoo-tests.factor @@ -6,6 +6,6 @@ USING: tools.test yahoo kernel io.files xml sequences ; "Official Foo Fighters" "http://www.foofighters.com/" "Official site with news, tour dates, discography, store, community, and more." -} ] [ "extra/yahoo/test-results.xml" resource-path read-xml parse-yahoo first ] unit-test +} ] [ "extra/yahoo/test-results.xml" resource-path file>xml parse-yahoo first ] unit-test [ "http://search.yahooapis.com/WebSearchService/V1/webSearch?appid=Factor-search&query=hi&results=1" ] [ "hi" 1 query ] unit-test diff --git a/unmaintained/cryptlib/cryptlib-tests.factor b/unmaintained/cryptlib/cryptlib-tests.factor index c404114716..aeac468ba3 100644 --- a/unmaintained/cryptlib/cryptlib-tests.factor +++ b/unmaintained/cryptlib/cryptlib-tests.factor @@ -1,5 +1,6 @@ USING: cryptlib.libcl cryptlib prettyprint kernel alien sequences libc math -tools.test io io.files continuations alien.c-types splitting generic.math ; +tools.test io io.files continuations alien.c-types splitting generic.math +io.encodings.binary ; "=========================================================" print "Envelope/de-envelop test..." print @@ -152,7 +153,7 @@ tools.test io io.files continuations alien.c-types splitting generic.math ; ! envelope CRYPT_FORMAT_CRYPTLIB [ "extra/cryptlib/test/large_data.txt" resource-path - file-contents set-pop-buffer + binary file-contents set-pop-buffer envelope-handle CRYPT_ATTRIBUTE_BUFFERSIZE get-pop-buffer alien>char-string length 10000 + set-attribute envelope-handle CRYPT_ENVINFO_DATASIZE @@ -192,7 +193,7 @@ tools.test io io.files continuations alien.c-types splitting generic.math ; CRYPT_FORMAT_CRYPTLIB [ envelope-handle CRYPT_ENVINFO_PASSWORD "password" set-attribute-string "extra/cryptlib/test/large_data.txt" resource-path - file-contents set-pop-buffer + binary file-contents set-pop-buffer envelope-handle CRYPT_ATTRIBUTE_BUFFERSIZE get-pop-buffer alien>char-string length 10000 + set-attribute envelope-handle CRYPT_ENVINFO_DATASIZE diff --git a/unmaintained/id3/id3.factor b/unmaintained/id3/id3.factor index b894c574f3..7f39025c4c 100755 --- a/unmaintained/id3/id3.factor +++ b/unmaintained/id3/id3.factor @@ -3,7 +3,7 @@ USING: arrays combinators io io.binary io.files io.paths io.encodings.utf16 kernel math math.parser namespaces sequences -splitting strings assocs unicode.categories ; +splitting strings assocs unicode.categories io.encodings.binary ; IN: id3 @@ -107,20 +107,20 @@ C: extended-header read-header read-frames ; : supported-version? ( version -- ? ) - [ 3 4 ] member? ; + { 3 4 } member? ; : read-id3v2 ( -- tag/f ) read1 dup supported-version? [ (read-id3v2) ] [ drop f ] if ; : id3v2? ( -- ? ) - 3 read "ID3" = ; + 3 read "ID3" sequence= ; : read-tag ( stream -- tag/f ) id3v2? [ read-id3v2 ] [ f ] if ; : id3v2 ( filename -- tag/f ) - [ read-tag ] with-file-reader ; + binary [ read-tag ] with-file-reader ; : file? ( path -- ? ) stat 3drop not ; @@ -135,7 +135,7 @@ C: extended-header [ mp3? ] subset ; : id3? ( file -- ? ) - [ id3v2? ] with-file-reader ; + binary [ id3v2? ] with-file-reader ; : id3s ( files -- id3s ) [ id3? ] subset ; diff --git a/unmaintained/mad/api/api.factor b/unmaintained/mad/api/api.factor index d803fa64e0..fdc2903d46 100644 --- a/unmaintained/mad/api/api.factor +++ b/unmaintained/mad/api/api.factor @@ -1,7 +1,8 @@ ! Copyright (C) 2007 Adam Wendt. ! See http://factorcode.org/license.txt for BSD license. USING: alien alien.c-types byte-arrays io io.binary io.files kernel mad - namespaces prettyprint sbufs sequences tools.interpreter vars ; + namespaces prettyprint sbufs sequences tools.interpreter vars + io.encodings.binary ; IN: mad.api VARS: buffer-start buffer-length output-callback-var ; @@ -80,9 +81,6 @@ VARS: buffer-start buffer-length output-callback-var ; : make-decoder ( -- decoder ) "mad_decoder" malloc-object ; -: malloc-file-contents ( path -- alien ) - file-contents >byte-array malloc-byte-array ; - : mad-run ( -- int ) make-decoder [ mad-init ] keep MAD_DECODER_MODE_SYNC mad_decoder_run ; diff --git a/extra/channels/sniffer/backend/backend.factor b/unmaintained/sniffer/channels/backend/backend.factor similarity index 100% rename from extra/channels/sniffer/backend/backend.factor rename to unmaintained/sniffer/channels/backend/backend.factor diff --git a/extra/channels/sniffer/bsd/bsd.factor b/unmaintained/sniffer/channels/bsd/bsd.factor similarity index 100% rename from extra/channels/sniffer/bsd/bsd.factor rename to unmaintained/sniffer/channels/bsd/bsd.factor diff --git a/extra/channels/sniffer/sniffer.factor b/unmaintained/sniffer/channels/sniffer.factor similarity index 100% rename from extra/channels/sniffer/sniffer.factor rename to unmaintained/sniffer/channels/sniffer.factor diff --git a/extra/io/sniffer/authors.txt b/unmaintained/sniffer/io/authors.txt similarity index 100% rename from extra/io/sniffer/authors.txt rename to unmaintained/sniffer/io/authors.txt diff --git a/extra/io/sniffer/backend/authors.txt b/unmaintained/sniffer/io/backend/authors.txt similarity index 100% rename from extra/io/sniffer/backend/authors.txt rename to unmaintained/sniffer/io/backend/authors.txt diff --git a/extra/io/sniffer/backend/backend.factor b/unmaintained/sniffer/io/backend/backend.factor similarity index 100% rename from extra/io/sniffer/backend/backend.factor rename to unmaintained/sniffer/io/backend/backend.factor diff --git a/extra/io/sniffer/bsd/authors.txt b/unmaintained/sniffer/io/bsd/authors.txt similarity index 100% rename from extra/io/sniffer/bsd/authors.txt rename to unmaintained/sniffer/io/bsd/authors.txt diff --git a/extra/io/sniffer/bsd/bsd.factor b/unmaintained/sniffer/io/bsd/bsd.factor similarity index 95% rename from extra/io/sniffer/bsd/bsd.factor rename to unmaintained/sniffer/io/bsd/bsd.factor index 1c72a4780c..5f82b21069 100644 --- a/extra/io/sniffer/bsd/bsd.factor +++ b/unmaintained/sniffer/io/bsd/bsd.factor @@ -1,13 +1,13 @@ ! Copyright (C) 2007 Elie Chaftari, Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: alien.c-types alien.syntax destructors hexdump io -io.buffers io.nonblocking io.sockets io.streams.lines +io.buffers io.nonblocking io.sockets io.unix.backend io.unix.files kernel libc locals math qualified sequences io.sniffer.backend ; QUALIFIED: unix IN: io.sniffer.bsd -M: unix-io destruct-handle ( obj -- ) unix:close drop ; +M: unix-io destruct-handle ( obj -- ) unix:close ; C-UNION: ifreq_props "sockaddr-in" "short" "int" "caddr_t" ; C-STRUCT: ifreq { { "char" 16 } "name" } { "ifreq_props" "props" } ; diff --git a/extra/io/sniffer/filter/authors.txt b/unmaintained/sniffer/io/filter/authors.txt similarity index 100% rename from extra/io/sniffer/filter/authors.txt rename to unmaintained/sniffer/io/filter/authors.txt diff --git a/extra/io/sniffer/filter/backend/authors.txt b/unmaintained/sniffer/io/filter/backend/authors.txt similarity index 100% rename from extra/io/sniffer/filter/backend/authors.txt rename to unmaintained/sniffer/io/filter/backend/authors.txt diff --git a/extra/io/sniffer/filter/backend/backend.factor b/unmaintained/sniffer/io/filter/backend/backend.factor similarity index 100% rename from extra/io/sniffer/filter/backend/backend.factor rename to unmaintained/sniffer/io/filter/backend/backend.factor diff --git a/extra/io/sniffer/filter/bsd/authors.txt b/unmaintained/sniffer/io/filter/bsd/authors.txt similarity index 100% rename from extra/io/sniffer/filter/bsd/authors.txt rename to unmaintained/sniffer/io/filter/bsd/authors.txt diff --git a/extra/io/sniffer/filter/bsd/bsd.factor b/unmaintained/sniffer/io/filter/bsd/bsd.factor similarity index 100% rename from extra/io/sniffer/filter/bsd/bsd.factor rename to unmaintained/sniffer/io/filter/bsd/bsd.factor diff --git a/extra/io/sniffer/filter/filter.factor b/unmaintained/sniffer/io/filter/filter.factor similarity index 100% rename from extra/io/sniffer/filter/filter.factor rename to unmaintained/sniffer/io/filter/filter.factor diff --git a/extra/io/sniffer/sniffer.factor b/unmaintained/sniffer/io/sniffer.factor similarity index 100% rename from extra/io/sniffer/sniffer.factor rename to unmaintained/sniffer/io/sniffer.factor diff --git a/vm/io.c b/vm/io.c index d3a29abe72..faf681bbef 100755 --- a/vm/io.c +++ b/vm/io.c @@ -102,21 +102,46 @@ DEFINE_PRIMITIVE(fread) } else { - dpush(tag_object(memory_to_char_string( - (char *)(buf + 1),c))); + if(c != size) + { + REGISTER_UNTAGGED(buf); + F_BYTE_ARRAY *new_buf = allot_byte_array(c); + UNREGISTER_UNTAGGED(buf); + memcpy(new_buf + 1, buf + 1,c); + buf = new_buf; + } + dpush(tag_object(buf)); break; } } } +DEFINE_PRIMITIVE(fputc) +{ + FILE *file = unbox_alien(); + F_FIXNUM ch = to_fixnum(dpop()); + + for(;;) + { + if(fputc(ch,file) == EOF) + { + io_error(); + + /* Still here? EINTR */ + } + else + break; + } +} + DEFINE_PRIMITIVE(fwrite) { - FILE* file = unbox_alien(); - F_STRING* text = untag_string(dpop()); - F_FIXNUM length = untag_fixnum_fast(text->length); - char* string = to_char_string(text,false); + FILE *file = unbox_alien(); + F_BYTE_ARRAY *text = untag_byte_array(dpop()); + F_FIXNUM length = array_capacity(text); + char *string = (char *)(text + 1); - if(string_capacity(text) == 0) + if(length == 0) return; for(;;) diff --git a/vm/io.h b/vm/io.h index 39e7390c3e..a19da3887c 100755 --- a/vm/io.h +++ b/vm/io.h @@ -3,11 +3,12 @@ void io_error(void); int err_no(void); DECLARE_PRIMITIVE(fopen); +DECLARE_PRIMITIVE(fgetc); +DECLARE_PRIMITIVE(fread); +DECLARE_PRIMITIVE(fputc); DECLARE_PRIMITIVE(fwrite); DECLARE_PRIMITIVE(fflush); DECLARE_PRIMITIVE(fclose); -DECLARE_PRIMITIVE(fgetc); -DECLARE_PRIMITIVE(fread); /* Platform specific primitives */ DECLARE_PRIMITIVE(open_file); diff --git a/vm/primitives.c b/vm/primitives.c index a5cdb4f1ef..1b29dc65b7 100755 --- a/vm/primitives.c +++ b/vm/primitives.c @@ -162,6 +162,7 @@ void *primitives[] = { primitive_fopen, primitive_fgetc, primitive_fread, + primitive_fputc, primitive_fwrite, primitive_fflush, primitive_fclose,