2005-07-21 23:36:40 -04:00
|
|
|
! Copyright (C) 2003, 2005 Slava Pestov.
|
|
|
|
! See http://factor.sf.net/license.txt for BSD license.
|
|
|
|
IN: io
|
2005-06-19 18:31:02 -04:00
|
|
|
USING: io kernel math namespaces sequences strings ;
|
|
|
|
|
|
|
|
! String buffers support the stream output protocol.
|
2005-07-17 14:48:55 -04:00
|
|
|
M: sbuf stream-write1 push ;
|
2005-12-16 21:12:35 -05:00
|
|
|
M: sbuf stream-write swap nappend ;
|
2005-06-19 18:31:02 -04:00
|
|
|
M: sbuf stream-close drop ;
|
|
|
|
M: sbuf stream-flush drop ;
|
2005-12-16 21:12:35 -05:00
|
|
|
|
|
|
|
: <string-writer> ( -- stream )
|
|
|
|
512 <sbuf> <plain-writer> ;
|
2005-06-19 18:31:02 -04:00
|
|
|
|
|
|
|
: string-out ( quot -- str )
|
2006-01-21 02:37:39 -05:00
|
|
|
<string-writer> [ call stdio get >string ] with-stream* ;
|
|
|
|
inline
|
2005-06-19 18:31:02 -04:00
|
|
|
|
2006-06-09 18:20:20 -04:00
|
|
|
: format-column ( seq ? -- seq )
|
|
|
|
[
|
|
|
|
[ 0 [ length max ] reduce ] keep
|
|
|
|
[ swap CHAR: \s pad-right ] map-with
|
|
|
|
] unless ;
|
|
|
|
|
2006-08-15 16:29:35 -04:00
|
|
|
: map-last ( seq quot -- seq )
|
2006-06-09 18:20:20 -04:00
|
|
|
swap dup length <reversed>
|
2006-06-09 18:22:37 -04:00
|
|
|
[ zero? rot [ call ] keep swap ] 2map nip ; inline
|
2006-06-07 23:04:37 -04:00
|
|
|
|
2006-08-15 03:01:24 -04:00
|
|
|
M: plain-writer with-stream-table
|
2006-06-14 02:16:53 -04:00
|
|
|
[
|
2006-06-14 02:27:57 -04:00
|
|
|
drop swap
|
2006-06-14 02:16:53 -04:00
|
|
|
[ [ swap string-out ] map-with ] map-with
|
|
|
|
flip [ format-column ] map-last
|
|
|
|
flip [ " " join ] map
|
|
|
|
[ print ] each
|
|
|
|
] with-stream* ;
|
2006-06-07 23:04:37 -04:00
|
|
|
|
2005-06-19 18:31:02 -04:00
|
|
|
! Reversed string buffers support the stream input protocol.
|
2006-08-15 03:01:24 -04:00
|
|
|
M: sbuf stream-read1
|
2005-09-24 15:21:17 -04:00
|
|
|
dup empty? [ drop f ] [ pop ] if ;
|
2005-06-19 18:31:02 -04:00
|
|
|
|
2006-08-15 03:01:24 -04:00
|
|
|
M: sbuf stream-read
|
2005-06-19 18:31:02 -04:00
|
|
|
dup empty? [
|
|
|
|
2drop f
|
|
|
|
] [
|
2005-12-25 21:05:31 -05:00
|
|
|
swap over length min 0 <string>
|
2006-07-15 14:06:26 -04:00
|
|
|
[ [ drop pop ] inject-with ] keep
|
2005-09-24 15:21:17 -04:00
|
|
|
] if ;
|
2005-06-19 18:31:02 -04:00
|
|
|
|
|
|
|
: <string-reader> ( string -- stream )
|
2005-07-16 22:16:18 -04:00
|
|
|
<reversed> >sbuf <line-reader> ;
|
2005-06-19 18:31:02 -04:00
|
|
|
|
|
|
|
: string-in ( str quot -- )
|
2005-12-16 21:12:35 -05:00
|
|
|
>r <string-reader> r> with-stream ; inline
|
|
|
|
|
|
|
|
: contents ( stream -- string )
|
|
|
|
#! Read the entire stream into a string.
|
|
|
|
<string-writer> [ stream-copy ] keep >string ;
|