2006-06-14 01:47:28 -04:00
|
|
|
! Copyright (C) 2006 Slava Pestov.
|
|
|
|
! See http://factorcode.org/license.txt for BSD license.
|
|
|
|
IN: io
|
2006-06-14 02:16:53 -04:00
|
|
|
USING: arrays generic hashtables kernel namespaces strings ;
|
2006-06-14 01:47:28 -04:00
|
|
|
|
|
|
|
TUPLE: nested-style-stream style ;
|
|
|
|
|
2006-06-14 02:16:53 -04:00
|
|
|
: with-style ( style quot -- )
|
|
|
|
>r stdio get <nested-style-stream> r> with-stream* ; inline
|
|
|
|
|
2006-06-14 01:47:28 -04:00
|
|
|
: do-nested-style ( style stream -- style delegate )
|
2006-06-16 23:12:40 -04:00
|
|
|
[ nested-style-stream-style swap hash-union ] keep
|
|
|
|
delegate ;
|
2006-06-14 01:47:28 -04:00
|
|
|
|
|
|
|
: collapse-nested-style ( style delegate -- style delegate )
|
|
|
|
dup nested-style-stream? [ do-nested-style ] when ;
|
|
|
|
|
|
|
|
C: nested-style-stream ( style delegate -- stream )
|
|
|
|
>r collapse-nested-style r>
|
|
|
|
[ set-delegate ] keep
|
|
|
|
[ set-nested-style-stream-style ] keep ;
|
|
|
|
|
|
|
|
M: nested-style-stream stream-format
|
|
|
|
do-nested-style stream-format ;
|
|
|
|
|
|
|
|
M: nested-style-stream stream-write
|
|
|
|
H{ } swap do-nested-style stream-format ;
|
|
|
|
|
|
|
|
M: nested-style-stream stream-write1
|
|
|
|
>r ch>string r> H{ } swap do-nested-style stream-format ;
|
|
|
|
|
2006-06-14 02:16:53 -04:00
|
|
|
: do-nested-quot ( quot style stream -- quot style stream )
|
|
|
|
do-nested-style
|
|
|
|
>r [ swap \ with-style 3array >quotation ] keep r> ;
|
|
|
|
|
2006-06-14 01:47:28 -04:00
|
|
|
M: nested-style-stream with-nested-stream
|
2006-06-14 02:16:53 -04:00
|
|
|
do-nested-quot with-nested-stream ;
|
2006-06-14 01:47:28 -04:00
|
|
|
|
|
|
|
M: nested-style-stream with-stream-table
|
2006-06-14 02:16:53 -04:00
|
|
|
do-nested-quot with-stream-table ;
|