extended stream output protocol

TODO.FACTOR.txt

@@ -1,5 +1,6 @@
 + 0.80:
 
+- zero-height gadgets mess up hit testing
 - make-image leaks memory
 - does parsing cons excessive amounts of bignums with c-streams
 - -with combinators are awkward

library/bootstrap/boot-stage1.factor

@@ -5,7 +5,7 @@ USING: errors generic hashtables io kernel kernel-internals
 lists math memory namespaces parser prettyprint sequences
 vectors words ;
 
-"Bootstrap stage 1..." print
+"Bootstrap stage 1..." print flush
 
 "/library/bootstrap/primitives.factor" run-resource
 
@@ -63,6 +63,7 @@ vectors words ;
         "/library/io/stream.factor"
         "/library/io/duplex-stream.factor"
         "/library/io/stdio.factor"
+        "/library/io/plain-stream.factor"
         "/library/io/lines.factor"
         "/library/io/string-streams.factor"
         "/library/io/c-streams.factor"

library/bootstrap/boot-stage2.factor

@@ -15,7 +15,7 @@ sequences sequences-internals words ;
         ] when
     ] when
 
-    "Compiling base..." print
+    "Compiling base..." print flush
 
     {
         uncons 1+ 1- + <= > >= mod length
@@ -24,15 +24,15 @@ sequences sequences-internals words ;
         kill-set kill-node (generate)
     } [ compile ] each
 
-    "Compiling system..." print
+    "Compiling system..." print flush
     compile-all
     
     terpri
     "Unless you're working on the compiler, ignore the errors above." print
     "Not every word compiles, by design." print
-    terpri
+    terpri flush
     
-    "Initializing native I/O..." print
+    "Initializing native I/O..." print flush
     "native-io" get [ init-io ] when
 ] when
 
@@ -56,7 +56,7 @@ number>string write " words total" print
 number>string write " ms" print
 
 "Bootstrapping is complete." print
-"Now, you can run ./f factor.image" print
+"Now, you can run ./f factor.image" print flush
 
 "factor.image" save-image
 0 exit

library/bootstrap/image.factor

@@ -301,13 +301,13 @@ M: hashtable ' ( hashtable -- pointer )
 : heap-size image get length header-size - cells ;
 
 : end-image ( quot -- )
-    "Generating words..." print
+    "Generating words..." print flush
     words,
-    "Generating global namespace..." print
+    "Generating global namespace..." print flush
     global,
-    "Generating boot quotation..." print
+    "Generating boot quotation..." print flush
     boot,
-    "Performing some word fixups..." print
+    "Performing some word fixups..." print flush
     fixup-words
     heap-size heap-size-offset fixup
     "Image length: " write image get length .
@@ -327,7 +327,7 @@ M: hashtable ' ( hashtable -- pointer )
     "boot.image." architecture get append ;
 
 : write-image ( image -- )
-    "Writing image to " write dup write "..." print
+    "Writing image to " write dup write "..." print flush
     <file-writer> [ (write-image) ] with-stream ;
 
 : prepare-profile ( arch -- )

library/bootstrap/primitives.factor

@@ -8,7 +8,7 @@ vectors words ;
 ! Some very tricky code creating a bootstrap embryo in the
 ! host image.
 
-"Creating primitives and basic runtime structures..." print
+"Creating primitives and basic runtime structures..." print flush
 
 H{ } clone c-types set
 "/library/alien/primitive-types.factor" parse-resource

library/compiler/compiler.factor

@@ -9,7 +9,8 @@ words ;
 
 : (compile) ( word -- )
     #! Should be called inside the with-compiler scope.
-    "Compiling " write dup . dup word-def precompile generate ;
+    "Compiling " write dup . flush
+    dup word-def precompile generate ;
 
 : compile-postponed ( -- )
     compile-words get dup empty?

library/inference/inference.factor

@@ -19,9 +19,9 @@ TUPLE: inference-error message rstate data-stack call-stack ;
     <inference-error> throw ;
 
 M: inference-error error. ( error -- )
-    "! Inference error:" print
+    "Inference error:" print
     dup inference-error-message print
-    "! Recursive state:" print
+    "Recursive state:" print
     inference-error-rstate describe ;
 
 M: value literal-value ( value -- )

library/io/c-streams.factor

@@ -10,13 +10,13 @@ strings threads ;
 ! More elaborate platform-specific I/O code is used on Unix and
 ! Windows; see library/unix and library/win32.
 
-TUPLE: c-stream in out flush? ;
+TUPLE: c-stream in out ;
 
 M: c-stream stream-write1 ( char stream -- )
-    >r ch>string r> c-stream-out fwrite ;
+    >r ch>string r> stream-write ;
 
-M: c-stream stream-format ( str style stream -- )
-    nip c-stream-out fwrite ;
+M: c-stream stream-write ( str stream -- )
+    c-stream-out fwrite ;
 
 M: c-stream stream-read1 ( stream -- char/f )
     c-stream-in dup [ fgetc ] when ;
@@ -24,25 +24,24 @@ M: c-stream stream-read1 ( stream -- char/f )
 M: c-stream stream-flush ( stream -- )
     c-stream-out [ fflush ] when* ;
 
-M: c-stream stream-finish ( stream -- )
-    dup c-stream-flush? [ stream-flush ] [ drop ] if ;
-
 M: c-stream stream-close ( stream -- )
     dup c-stream-in [ fclose ] when*
     c-stream-out [ fclose ] when* ;
 
 : init-io ( -- )
-    13 getenv  14 getenv  t <c-stream> <line-reader> stdio set ;
+    13 getenv f <c-stream> <line-reader>
+    f 14 getenv <c-stream> <plain-writer>
+    <duplex-stream> stdio set ;
 
 : io-multiplex ( ms -- ) drop ;
 
 IN: io
 
 : <file-reader> ( path -- stream )
-    "rb" fopen f f <c-stream> <line-reader> ;
+    "rb" fopen f <c-stream> <line-reader> ;
 
 : <file-writer> ( path -- stream )
-    "wb" fopen f swap f <c-stream> ;
+    "wb" fopen f swap <c-stream> <plain-writer> ;
 
 TUPLE: client-stream host port ;
 

library/io/duplex-stream.factor

@@ -2,15 +2,11 @@
 ! stream more often.
 USING: io kernel ;
 
-TUPLE: duplex-stream in out flush? ;
+TUPLE: duplex-stream in out ;
 
 M: duplex-stream stream-flush
     duplex-stream-out stream-flush ;
 
-M: duplex-stream stream-finish
-    dup duplex-stream-flush?
-    [ duplex-stream-out stream-flush ] [ drop ] if ;
-
 M: duplex-stream stream-readln
     duplex-stream-in stream-readln ;
 
@@ -23,9 +19,21 @@ M: duplex-stream stream-read
 M: duplex-stream stream-write1
     duplex-stream-out stream-write1 ;
 
+M: duplex-stream stream-write
+    duplex-stream-out stream-write ;
+
+M: duplex-stream stream-break
+    duplex-stream-out stream-break ;
+
+M: duplex-stream stream-terpri
+    duplex-stream-out stream-terpri ;
+
 M: duplex-stream stream-format
     duplex-stream-out stream-format ;
 
+M: duplex-stream with-nested-stream
+    duplex-stream-out with-nested-stream ;
+
 M: duplex-stream stream-close
     #! The output stream is closed first, in case both streams
     #! are attached to the same file descriptor, the output

library/io/plain-stream.factor

@@ -0,0 +1,13 @@
+IN: io
+USING: generic kernel ;
+
+! Wrap your stream in this to avoid implementing the extended
+! protocol.
+TUPLE: plain-writer ;
+
+C: plain-writer ( stream -- stream ) [ set-delegate ] keep ;
+
+M: plain-writer stream-break CHAR: \s swap stream-write1 ;
+M: plain-writer stream-terpri CHAR: \n swap stream-write1 ;
+M: plain-writer stream-format nip stream-write ;
+M: plain-writer with-nested-stream rot drop with-stream* ;

library/io/stdio.factor

@@ -4,16 +4,24 @@ IN: io
 USING: errors hashtables generic kernel namespaces strings
 styles ;
 
-: flush  ( -- )              stdio get stream-flush ;
+SYMBOL: stdio
+
+: close ( -- ) stdio get stream-close ;
+
 : readln ( -- string/f )     stdio get stream-readln ;
-: read1  ( -- char/f )       stdio get stream-read1 ;
-: read   ( count -- string ) stdio get stream-read ;
-: write  ( string -- )       stdio get stream-write ;
-: write1 ( char -- )         stdio get stream-write1 ;
+: read1 ( -- char/f )       stdio get stream-read1 ;
+: read ( count -- string ) stdio get stream-read ;
+
+: write1 ( char -- ) stdio get stream-write1 ;
+: write ( string -- ) stdio get stream-write ;
+: flush ( -- ) stdio get stream-flush ;
+
+: break ( -- ) stdio get stream-break ;
+: terpri ( -- ) stdio get stream-terpri ;
 : format ( string style -- ) stdio get stream-format ;
-: print  ( string -- )       stdio get stream-print ;
-: terpri ( -- )              stdio get stream-terpri ;
-: close  ( -- )              stdio get stream-close ;
+: with-nesting ( style quot -- ) stdio get with-nested-stream ;
+
+: print ( string -- ) stdio get stream-print ;
 
 : write-outliner ( string object quot -- )
     [ outline set presented set ] make-hash format terpri ;
@@ -26,7 +34,3 @@ styles ;
     #! Close the stream if there is an error.
     [ swap stdio set [ close rethrow ] recover ] with-scope ;
     inline
-
-: contents ( stream -- string )
-    #! Read the entire stream into a string.
-    4096 <sbuf> [ stream-copy ] keep >string ;

library/io/stream.factor

@@ -4,24 +4,25 @@ IN: io
 USING: errors hashtables generic kernel math namespaces
 sequences strings ;
 
-SYMBOL: stdio
-
 ! Stream protocol.
-GENERIC: stream-flush  ( stream -- )
-GENERIC: stream-finish ( stream -- )
-GENERIC: stream-readln ( stream -- string )
-GENERIC: stream-read1  ( stream -- char/f )
-GENERIC: stream-read   ( count stream -- string )
-GENERIC: stream-write1 ( char stream -- )
-GENERIC: stream-format ( string style stream -- )
 GENERIC: stream-close  ( stream -- )
 GENERIC: set-timeout   ( timeout stream -- )
 
-: stream-write ( string stream -- )
-    H{ } swap stream-format ;
+! Input stream protocol.
+GENERIC: stream-readln ( stream -- string )
+GENERIC: stream-read1  ( stream -- char/f )
+GENERIC: stream-read   ( count stream -- string )
 
-: stream-terpri ( stream -- )
-    "\n" over stream-write stream-finish ;
+! Output stream protocol.
+GENERIC: stream-write1 ( char stream -- )
+GENERIC: stream-write  ( string stream -- )
+GENERIC: stream-flush  ( stream -- )
+
+! Extended output protocol.
+GENERIC: stream-break  ( stream -- )
+GENERIC: stream-terpri ( stream -- )
+GENERIC: stream-format ( string style stream -- )
+GENERIC: with-nested-stream ( style stream quot -- )
 
 : stream-print ( string stream -- )
     [ stream-write ] keep stream-terpri ;
@@ -34,11 +35,18 @@ GENERIC: set-timeout   ( timeout stream -- )
     [ 2dup (stream-copy) ] [ stream-close stream-close ] cleanup ;
 
 ! Think '/dev/null'.
-M: f stream-flush drop ;
-M: f stream-finish drop ;
-M: f stream-readln drop f ;
-M: f stream-read 2drop f ;
-M: f stream-read1 drop f ;
-M: f stream-write1 2drop ;
-M: f stream-format 3drop ;
 M: f stream-close drop ;
+M: f set-timeout drop ;
+
+M: f stream-readln drop f ;
+M: f stream-read1 drop f ;
+M: f stream-read 2drop f ;
+
+M: f stream-write1 2drop ;
+M: f stream-write 2drop ;
+M: f stream-terpri drop ;
+M: f stream-flush drop ;
+
+M: f stream-format 3drop ;
+M: f stream-break drop ;
+M: f with-nested-stream rot drop with-stream* ;

library/io/string-streams.factor

@@ -5,14 +5,17 @@ USING: io kernel math namespaces sequences strings ;
 
 ! String buffers support the stream output protocol.
 M: sbuf stream-write1 push ;
-M: sbuf stream-format rot nappend drop ;
+M: sbuf stream-write swap nappend ;
 M: sbuf stream-close drop ;
 M: sbuf stream-flush drop ;
-M: sbuf stream-finish drop ;
+
+: <string-writer> ( -- stream )
+    512 <sbuf> <plain-writer> ;
 
 : string-out ( quot -- str )
-    [ 512 <sbuf> stdio set call stdio get >string ] with-scope ;
-    inline
+    [
+        <string-writer> stdio set call stdio get >string
+    ] with-scope ; inline
 
 ! Reversed string buffers support the stream input protocol.
 M: sbuf stream-read1 ( sbuf -- char/f )
@@ -30,4 +33,8 @@ M: sbuf stream-read ( count sbuf -- string )
     <reversed> >sbuf <line-reader> ;
 
 : string-in ( str quot -- )
-    [ swap <string-reader> stdio set call ] with-scope ; inline
+    >r <string-reader> r> with-stream ; inline
+
+: contents ( stream -- string )
+    #! Read the entire stream into a string.
+    <string-writer> [ stream-copy ] keep >string ;

library/styles.factor

@@ -12,6 +12,8 @@ IN: styles
 : green      { 0.0 1.0 0.0 1.0 } ;
 : blue       { 0.0 0.0 1.0 1.0 } ;
 
+! Character styles
+
 SYMBOL: foreground ! Used for text and outline shapes.
 SYMBOL: background ! Used for filled shapes.
 
@@ -31,3 +33,9 @@ SYMBOL: file
 
 ! A quotation that writes an outline expansion to stdio
 SYMBOL: outline
+
+! Paragraph styles
+SYMBOL: border-color
+SYMBOL: border-width
+SYMBOL: padding
+SYMBOL: word-wrap

library/syntax/parse-stream.factor

@@ -17,7 +17,7 @@ USING: errors io kernel lists math namespaces sequences words ;
 : parse-stream ( stream name -- quot )
     [ file set file-vocabs lines parse-lines ] with-scope ;
 
-: parsing-file ( file -- ) "Loading " write print ;
+: parsing-file ( file -- ) "Loading " write print flush ;
 
 : parse-file ( file -- quot )
     dup parsing-file

library/test/test.factor

@@ -21,7 +21,7 @@ M: assert error.
     #! Evaluates the given code and prints the time taken to
     #! execute it.
     millis >r gc-time >r call gc-time r> - millis r> -
-    [ # " ms run / " % # " ms GC time" % ] "" make print ;
+    [ # " ms run / " % # " ms GC time" % ] "" make print flush ;
 
 : unit-test ( output input -- )
     [
@@ -52,7 +52,7 @@ SYMBOL: failures
 
 : test ( name -- ? )
     [
-        "=====> " write dup write "..." print
+        "=====> " write dup write "..." print flush
         test-path [
             [ [ run-resource ] with-scope ] keep
         ] assert-depth drop

library/tools/debugger.factor

@@ -114,7 +114,8 @@ M: object error. ( error -- ) . ;
 
 : debug-help ( -- )
     ":s :r show stacks at time of error." print
-    ":get ( var -- value ) inspects the error namestack." print ;
+    ":get ( var -- value ) inspects the error namestack." print
+    flush ;
 
 : flush-error-handler ( -- )
     #! Last resort.

library/ui/panes.factor

@@ -1,7 +1,6 @@
 ! Copyright (C) 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: gadgets-presentations
-DEFER: <presentation>
 DEFER: gadget.
 
 IN: gadgets-panes
@@ -15,15 +14,19 @@ prettyprint sequences strings styles threads ;
 ! output: pile
 ! current: shelf
 ! input: editor
-TUPLE: pane output active current input continuation scrolls? ;
+TUPLE: pane output active current input prototype
+continuation scrolls? ;
 
 : add-output 2dup set-pane-output add-gadget ;
 
 : <active-line> ( current input -- line )
     [ 2array ] [ 1array ] if* make-shelf ;
 
-: init-active-line ( pane -- )
-    dup pane-active unparent
+: init-line ( pane -- )
+    dup pane-prototype clone swap set-pane-current ;
+
+: prepare-line ( pane -- )
+    dup init-line dup pane-active unparent
     [ dup pane-current swap pane-input <active-line> ] keep
     2dup set-pane-active add-gadget ;
 
@@ -86,23 +89,15 @@ C: pane ( input? scrolls? -- pane )
     #! set, the pane will scroll to the bottom when input is
     #! added.
     [ set-pane-scrolls? ] keep
+    <shelf> over set-pane-prototype
     <pile> over set-delegate
     <pile> <incremental> over add-output
-    <shelf> over set-pane-current
     swap [ "" <editor> over set-pane-input ] when
-    dup init-active-line
-    dup pane-actions ;
+    dup prepare-line dup pane-actions ;
 
 M: pane focusable-child* ( pane -- editor )
     pane-input [ t ] unless* ;
 
-: pane-write-1 ( style text pane -- )
-    pick hash-empty? pick empty? and [
-        3drop
-    ] [
-        >r <presentation> r> pane-current add-gadget
-    ] if ;
-
 : prepare-print ( current -- gadget )
     #! Optimization: if line has 1 child, add the child.
     dup gadget-children {
@@ -111,22 +106,22 @@ M: pane focusable-child* ( pane -- editor )
         { [ t ] [ drop ] }
     } cond ;
 
-: pane-print-1 ( current pane -- )
-    >r prepare-print r> pane-output add-incremental ;
+M: pane stream-terpri ( pane -- )
+    dup pane-current prepare-print
+    over pane-output add-incremental
+    prepare-line ;
 
-: pane-terpri ( pane -- )
-    dup pane-current over pane-print-1
-    <shelf> over set-pane-current init-active-line ;
+: pane-write ( pane list -- )
+    2dup car swap pane-current stream-write cdr dup
+    [ over stream-terpri pane-write ] [ 2drop ] if ;
 
-: pane-write ( style pane list -- )
-    3dup car swap pane-write-1 cdr dup
-    [ over pane-terpri pane-write ] [ 3drop ] if ;
+: pane-format ( style pane list -- )
+    3dup car -rot pane-current stream-format cdr dup
+    [ over stream-terpri pane-format ] [ 3drop ] if ;
 
 ! Panes are streams.
 M: pane stream-flush ( pane -- ) drop ;
 
-M: pane stream-finish ( pane -- ) drop ;
-
 M: pane stream-readln ( pane -- line )
     [ over set-pane-continuation stop ] callcc1 nip ;
 
@@ -134,19 +129,31 @@ M: pane stream-readln ( pane -- line )
     dup pane-scrolls? [ pane-input scroll>caret ] [ drop ] if ;
 
 M: pane stream-write1 ( char pane -- )
-    [ >r ch>string <label> r> pane-current add-gadget ] keep
-    scroll-pane ;
+    [ pane-current stream-write1 ] keep scroll-pane ;
+
+M: pane stream-write ( string style pane -- )
+    [ rot "\n" split pane-write ] keep scroll-pane ;
 
 M: pane stream-format ( string style pane -- )
-    [ rot "\n" split pane-write ] keep scroll-pane ;
+    [ rot "\n" split pane-format ] keep scroll-pane ;
+
+M: pane stream-break ( pane -- ) pane-current stream-break ;
 
 M: pane stream-close ( pane -- ) drop ;
 
+: ?pane-terpri ( pane -- )
+    dup pane-current gadget-children empty?
+    [ dup stream-terpri ] unless drop ;
+
 : make-pane ( quot -- pane )
     #! Execute the quotation with output to an output-only pane.
-    f f <pane> [ swap with-stream ] keep ; inline
+    f f <pane> [ swap with-stream ] keep
+    dup ?pane-terpri pane-output ; inline
 
 : with-pane ( pane quot -- )
     #! Clear the pane and run the quotation in a scope with
     #! stdio set to the pane.
     >r dup pane-clear r> with-stream* ; inline
+
+M: pane with-nested-stream ( style stream quot -- )
+    -rot >r >r make-pane r> drop r> pane-current add-gadget ;

library/ui/paragraphs.factor

@@ -0,0 +1,55 @@
+IN: gadgets-layouts
+USING: arrays gadgets gadgets-labels generic kernel math
+namespaces sequences ;
+
+! A word break gadget
+TUPLE: break ;
+
+C: break ( -- gadget ) " " <label> over set-delegate ;
+
+! A gadget that arranges its children in a word-wrap style.
+TUPLE: paragraph margin ;
+
+C: paragraph ( margin -- gadget )
+    [ set-paragraph-margin ] keep dup delegate>gadget ;
+
+SYMBOL: x SYMBOL: max-x
+
+SYMBOL: y SYMBOL: max-y
+
+SYMBOL: margin
+
+: overrun? ( width -- ? ) x get + margin get >= ;
+
+: wrap-line ( height -- ) 0 x set y [ + ] change ;
+
+: wrap-pos ( -- pos ) x get y get 0 3array ;
+
+: advance-x ( x -- ) x [ + dup ] change max-x [ max ] change ;
+
+: advance-y ( y -- ) y get + max-y [ max ] change ;
+
+: wrap-step ( quot child -- | quot: pos child -- )
+    dup pref-dim [
+        over break? [
+            dup first overrun? [ dup second wrap-line ] when
+        ] unless drop wrap-pos rot call
+    ] keep first2 advance-y advance-x ; inline
+
+: wrap-dim ( -- dim ) max-x get max-y get 0 3array ;
+
+: init-wrap ( paragraph -- )
+    paragraph-margin margin set
+    0 { x max-x y max-y } [ set ] each-with ;
+
+: do-wrap ( paragraph quot -- dim | quot: pos child -- )
+    [
+        swap dup init-wrap
+        gadget-children [ wrap-step ] each-with wrap-dim
+    ] with-scope ;
+
+M: paragraph pref-dim ( paragraph -- dim )
+    [ 2drop ] do-wrap ;
+
+M: paragraph layout* ( paragraph -- )
+    [ swap dup prefer set-rect-loc ] do-wrap drop ;

library/ui/presentations.factor

@@ -2,10 +2,10 @@
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: gadgets-presentations
 USING: arrays compiler gadgets gadgets-buttons gadgets-labels
-gadgets-menus gadgets-outliner gadgets-panes gadgets-theme
-generic hashtables inference inspector io jedit kernel lists
-memory namespaces parser prettyprint sequences strings styles
-words ;
+gadgets-layouts gadgets-menus gadgets-outliner gadgets-panes
+gadgets-theme generic hashtables inference inspector io jedit
+kernel lists memory namespaces parser prettyprint sequences
+strings styles words ;
 
 SYMBOL: commands
 
@@ -63,6 +63,26 @@ M: command-button gadget-help ( button -- string )
     "This stream does not support live gadgets"
     swap format terpri ;
 
+UNION: gadget-stream pack paragraph ;
+
+M: gadget-stream stream-write ( string stream -- )
+    over empty? [ 2drop ] [ >r <label> r> add-gadget ] if ;
+
+M: gadget-stream stream-write1 ( char stream -- )
+    >r ch>string r> stream-write ;
+
+M: gadget-stream stream-format ( string style stream -- )
+    pick empty? pick hash-empty? and [
+        3drop
+    ] [
+        >r swap <presentation> r> add-gadget
+    ] if ;
+
+M: gadget-stream stream-break ( stream -- )
+    <break> swap add-gadget ;
+
+M: gadget-stream stream-close ( stream -- ) drop ;
+
 [ drop t ] "Prettyprint" [ . ] define-command
 [ drop t ] "Describe" [ describe ] define-command
 [ drop t ] "Push on data stack" [ ] define-command

library/unix/io.factor

@@ -234,7 +234,7 @@ M: port stream-read1 ( stream -- char/f )
     dup io-error ;
 
 : <writer> ( fd -- writer )
-    buffered-port output over set-port-type ;
+    buffered-port output over set-port-type <plain-writer> ;
 
 : write-step ( port -- )
     dup >port< dup buffer@ swap buffer-length write dup 0 >= [
@@ -283,8 +283,6 @@ M: port stream-flush ( stream -- )
     dup output check-port
     [ swap <write-task> add-write-io-task stop ] callcc0 drop ;
 
-M: port stream-finish ( stream -- ) output check-port ;
-
 : wait-to-write ( len port -- )
     tuck can-write? [ dup stream-flush ] unless pending-error ;
 
@@ -292,9 +290,9 @@ M: port stream-write1 ( char writer -- )
     dup output check-port
     1 over wait-to-write ch>buffer ;
 
-M: port stream-format ( string style writer -- )
+M: port stream-write ( string writer -- )
     dup output check-port
-    nip over length over wait-to-write >buffer ;
+    over length over wait-to-write >buffer ;
 
 M: port stream-close ( stream -- )
     dup port-type closed eq? [
@@ -307,8 +305,8 @@ M: port stream-close ( stream -- )
 
 ! Make a duplex stream for reading/writing a pair of fds
 
-: <fd-stream> ( infd outfd flush? -- stream )
-    >r >r <reader> r> <writer> r> <duplex-stream> ;
+: <fd-stream> ( infd outfd -- stream )
+    >r <reader> r> <writer> <duplex-stream> ;
 
 USE: io
 
@@ -320,5 +318,5 @@ USE: io
         FD_SETSIZE <c-object> read-fdset set
         H{ } clone write-tasks set
         FD_SETSIZE <c-object> write-fdset set
-        0 1 t <fd-stream> stdio set
+        0 1 <fd-stream> stdio set
     ] bind ;

library/unix/sockets.factor

@@ -7,9 +7,6 @@ IN: io-internals
 USING: alien errors generic io kernel math namespaces parser
 threads unix-internals ;
 
-: <socket-stream> ( fd -- stream )
-    dup f <fd-stream> ;
-
 : init-sockaddr ( port -- sockaddr )
     <sockaddr-in>
     [ AF_INET swap set-sockaddr-in-family ] keep
@@ -55,13 +52,13 @@ threads unix-internals ;
 IN: io
 
 C: client-stream ( host port fd -- stream )
-    [ >r <socket-stream> r> set-delegate ] keep
+    [ >r dup <fd-stream> r> set-delegate ] keep
     [ set-client-stream-port ] keep
     [ set-client-stream-host ] keep ;
 
 : <client> ( host port -- stream )
     #! Connect to a port number on a TCP/IP host.
-    client-socket <socket-stream> ;
+    client-socket dup <fd-stream> ;
 
 TUPLE: server client ;
 

library/win32/win32-stream.factor

@@ -119,8 +119,8 @@ M: string do-write ( str -- )
 : peek-input ( -- str )
     1 in-buffer get buffer-first-n ;
 
-M: win32-stream stream-format ( str style stream -- )
-    win32-stream-this nip [ do-write ] bind ;
+M: win32-stream stream-write ( str stream -- )
+    win32-stream-this [ do-write ] bind ;
 
 M: win32-stream stream-read ( count stream -- str )
     win32-stream-this [ dup <sbuf> swap do-read-count ] bind ;
@@ -133,9 +133,6 @@ M: win32-stream stream-read1 ( stream -- str )
 M: win32-stream stream-flush ( stream -- )
     win32-stream-this [ maybe-flush-output ] bind ;
 
-M: win32-stream stream-finish ( stream -- )
-    drop ;
-
 M: win32-stream stream-close ( stream -- )
     win32-stream-this [
         maybe-flush-output