More updates for encodings
parent
4ad96fc4ea
commit
44f4aa4c69
|
@ -10,8 +10,8 @@ HOOK: init-io io-backend ( -- )
|
|||
HOOK: (init-stdio) io-backend ( -- stdin stdout stderr )
|
||||
|
||||
: init-stdio ( -- )
|
||||
(init-stdio) utf8 <encoded> stderr set-global
|
||||
utf8 <encoded-duplex> stdio set-global ;
|
||||
(init-stdio) utf8 <encoder> stderr set-global
|
||||
utf8 <encoder-duplex> stdio set-global ;
|
||||
|
||||
HOOK: io-multiplex io-backend ( ms -- )
|
||||
|
||||
|
@ -23,8 +23,8 @@ HOOK: normalize-pathname io-backend ( str -- newstr )
|
|||
|
||||
M: object normalize-pathname ;
|
||||
|
||||
: set-io-backend ( backend -- )
|
||||
io-backend set-global init-io init-stdio ;
|
||||
: set-io-backend ( io-backend -- )
|
||||
io-backend set-global init-io init-stdio die ;
|
||||
|
||||
[ init-io embedded? [ init-stdio ] unless ]
|
||||
"io.backend" add-init-hook
|
||||
|
|
|
@ -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." } ;
|
||||
|
|
|
@ -54,7 +54,7 @@ GENERIC: decode-step ( buf byte ch state encoding -- buf ch state )
|
|||
decode-read-loop ;
|
||||
|
||||
TUPLE: decoded code cr ;
|
||||
: <decoded> ( stream decoding-class -- decoded-stream )
|
||||
: <decoder> ( stream decoding-class -- decoded-stream )
|
||||
dup binary eq? [ drop ] [
|
||||
construct-empty { set-delegate set-decoded-code }
|
||||
decoded construct
|
||||
|
@ -126,7 +126,7 @@ TUPLE: encode-error ;
|
|||
: encode-error ( -- * ) \ encode-error construct-empty throw ;
|
||||
|
||||
TUPLE: encoded code ;
|
||||
: <encoded> ( stream encoding-class -- encoded-stream )
|
||||
: <encoder> ( stream encoding-class -- encoded-stream )
|
||||
dup binary eq? [ drop ] [
|
||||
construct-empty { set-delegate set-encoded-code }
|
||||
encoded construct
|
||||
|
@ -148,12 +148,12 @@ INSTANCE: encoded plain-writer
|
|||
! Rebinding duplex streams which have not read anything yet
|
||||
|
||||
: reencode ( stream encoding -- newstream )
|
||||
over encoded? [ >r delegate r> ] when <encoded> ;
|
||||
over encoded? [ >r delegate r> ] when <encoder> ;
|
||||
|
||||
: redecode ( stream encoding -- newstream )
|
||||
over decoded? [ >r delegate r> ] when <decoded> ;
|
||||
over decoded? [ >r delegate r> ] when <decoder> ;
|
||||
|
||||
: <encoded-duplex> ( stream-in stream-out encoding -- duplex-stream )
|
||||
: <encoder-duplex> ( stream-in stream-out encoding -- duplex-stream )
|
||||
tuck reencode >r redecode r> <duplex-stream> ;
|
||||
|
||||
! The null encoding does nothing
|
||||
|
|
|
@ -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. You can pass this class symbol as an encoding descriptor to words like " { $link <file-reader> } " and " { $link encode-string } "." } ;
|
||||
|
||||
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." } ;
|
||||
|
|
|
@ -1,11 +1,11 @@
|
|||
USING: io.encodings.utf8 tools.test sbufs kernel io io.encodings
|
||||
sequences strings arrays unicode ;
|
||||
sequences strings arrays unicode io.streams.byte-array ;
|
||||
|
||||
: decode-utf8-w/stream ( array -- newarray )
|
||||
>sbuf dup reverse-here utf8 <decoded> contents ;
|
||||
utf8 <byte-reader> contents >array ;
|
||||
|
||||
: encode-utf8-w/stream ( array -- newarray )
|
||||
SBUF" " clone tuck utf8 <encoded> stream-write >array ;
|
||||
utf8 [ write ] with-byte-writer >array ;
|
||||
|
||||
[ { CHAR: replacement-character } ] [ { BIN: 11110101 BIN: 10111111 BIN: 10000000 BIN: 11111111 } decode-utf8-w/stream >array ] unit-test
|
||||
|
||||
|
|
|
@ -17,13 +17,13 @@ HOOK: (file-writer) io-backend ( path -- stream )
|
|||
HOOK: (file-appender) io-backend ( path -- stream )
|
||||
|
||||
: <file-reader> ( path encoding -- stream )
|
||||
swap (file-reader) swap <decoded> ;
|
||||
swap (file-reader) swap <decoder> ;
|
||||
|
||||
: <file-writer> ( path encoding -- stream )
|
||||
swap (file-writer) swap <encoded> ;
|
||||
swap (file-writer) swap <encoder> ;
|
||||
|
||||
: <file-appender> ( path encoding -- stream )
|
||||
swap (file-appender) swap <encoded> ;
|
||||
swap (file-appender) swap <encoder> ;
|
||||
|
||||
HOOK: delete-file io-backend ( path -- )
|
||||
|
||||
|
@ -171,4 +171,4 @@ M: pathname <=> [ pathname-string ] compare ;
|
|||
[ dup make-directory ]
|
||||
when ;
|
||||
|
||||
: temp-file ( name -- path ) temp-directory swap path+ ;
|
||||
: temp-file ( name -- path ) temp-directory swap path+ ;
|
||||
|
|
|
@ -1,5 +1,5 @@
|
|||
USING: arrays io io.files kernel math parser strings system
|
||||
tools.test words namespaces io.encodings.latin1 io.encodings.binary ;
|
||||
tools.test words namespaces io.encodings.ascii io.encodings.binary ;
|
||||
IN: temporary
|
||||
|
||||
[ f ] [
|
||||
|
@ -8,7 +8,7 @@ IN: temporary
|
|||
] unit-test
|
||||
|
||||
: <resource-reader> ( resource -- stream )
|
||||
resource-path latin1 <file-reader> ;
|
||||
resource-path ascii <file-reader> ;
|
||||
|
||||
[
|
||||
"This is a line.\rThis is another line.\r"
|
||||
|
|
|
@ -3,14 +3,14 @@ sequences io namespaces ;
|
|||
IN: io.streams.byte-array
|
||||
|
||||
: <byte-writer> ( encoding -- stream )
|
||||
512 <byte-vector> swap <encoded> ;
|
||||
512 <byte-vector> swap <encoder> ;
|
||||
|
||||
: with-byte-writer ( encoding quot -- byte-array )
|
||||
>r <byte-writer> r> [ stdio get ] compose with-stream*
|
||||
>byte-array ; inline
|
||||
|
||||
: <byte-reader> ( byte-array encoding -- stream )
|
||||
>r >byte-vector dup reverse-here r> <decoded> ;
|
||||
>r >byte-vector dup reverse-here r> <decoder> ;
|
||||
|
||||
: with-byte-reader ( byte-array encoding quot -- )
|
||||
>r <byte-reader> r> with-stream ; inline
|
||||
|
|
|
@ -50,7 +50,7 @@ M: growable stream-read-partial
|
|||
stream-read ;
|
||||
|
||||
: <string-reader> ( str -- stream )
|
||||
>sbuf dup reverse-here null-encoding <decoded> ;
|
||||
>sbuf dup reverse-here null-encoding <decoder> ;
|
||||
|
||||
: with-string-reader ( str quot -- )
|
||||
>r <string-reader> r> with-stream ; inline
|
||||
|
|
|
@ -1,11 +1,11 @@
|
|||
USING: kernel tools.test io.encodings.utf16 arrays sbufs sequences io.encodings
|
||||
io unicode ;
|
||||
USING: kernel tools.test io.encodings.utf16 arrays sbufs
|
||||
sequences io.encodings io unicode io.streams.byte-array ;
|
||||
|
||||
: decode-w/stream ( array encoding -- newarray )
|
||||
>r >sbuf dup reverse-here r> <decoded> contents >array ;
|
||||
<byte-reader> contents >array ;
|
||||
|
||||
: encode-w/stream ( array encoding -- newarray )
|
||||
>r SBUF" " clone tuck r> <encoded> stream-write >array ;
|
||||
[ write ] with-byte-writer >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
|
||||
|
|
|
@ -127,7 +127,7 @@ TUPLE: process-stream process ;
|
|||
|
||||
: <process-stream> ( desc encoding -- stream )
|
||||
swap >descriptor
|
||||
[ (process-stream) >r rot <encoded-duplex> r> ] keep
|
||||
[ (process-stream) >r rot <encoder-duplex> r> ] keep
|
||||
+timeout+ swap at [ over set-timeout ] when*
|
||||
{ set-delegate set-process-stream-process }
|
||||
process-stream construct ;
|
||||
|
|
|
@ -45,7 +45,7 @@ GENERIC: close-handle ( handle -- )
|
|||
output-port <buffered-port> ;
|
||||
|
||||
: <reader&writer> ( read-handle write-handle -- input-port output-port )
|
||||
swap <reader> [ swap <writer> ] [ dispose ] cleanup ;
|
||||
swap <reader> [ swap <writer> ] [ ] [ dispose drop ] cleanup ;
|
||||
|
||||
: pending-error ( port -- )
|
||||
dup port-error f rot set-port-error [ throw ] when* ;
|
||||
|
|
|
@ -100,12 +100,12 @@ HELP: <client>
|
|||
} ;
|
||||
|
||||
HELP: <server>
|
||||
{ $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: <server>
|
|||
|
||||
HELP: accept
|
||||
{ $values { "server" "a handle" } { "client" "a bidirectional stream" } }
|
||||
{ $description "Waits for a connection to a server socket created by " { $link <server> } ", and outputs a bidirectional stream when the connection has been established."
|
||||
{ $description "Waits for a connection to a server socket created by " { $link <server> } ", 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: <datagram>
|
|||
"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." } ;
|
||||
|
||||
|
|
|
@ -33,7 +33,7 @@ M: array client* [ (client) ] attempt-all ;
|
|||
M: object client* (client) ;
|
||||
|
||||
: <client> ( addrspec encoding -- stream )
|
||||
[ >r client* r> <encoded-duplex> ] keep <client-stream> ;
|
||||
[ >r client* r> <encoder-duplex> ] keep <client-stream> ;
|
||||
|
||||
HOOK: (server) io-backend ( addrspec -- handle )
|
||||
|
||||
|
@ -43,7 +43,7 @@ HOOK: (server) io-backend ( addrspec -- handle )
|
|||
HOOK: (accept) io-backend ( server -- stream-in stream-out )
|
||||
|
||||
: accept ( server -- client )
|
||||
[ (accept) ] keep server-port-encoding <encoded-duplex> ;
|
||||
[ (accept) ] keep server-port-encoding <encoder-duplex> ;
|
||||
|
||||
HOOK: <datagram> io-backend ( addrspec -- datagram )
|
||||
|
||||
|
|
Loading…
Reference in New Issue