core/io/nested-style.factor

   1 ! Copyright (C) 2006 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 IN: io
   4 USING: arrays generic hashtables kernel namespaces strings ;
   5
   6 TUPLE: nested-style-stream style ;
   7
   8 : (with-stream-style) ( quot style stream -- )
   9     <nested-style-stream> swap with-stream* ; inline
  10
  11 : do-nested-style ( style stream -- style delegate )
  12     [ nested-style-stream-style swap hash-union ] keep
  13     delegate ;
  14
  15 C: nested-style-stream ( style delegate -- stream )
  16     [ set-delegate ] keep
  17     [ set-nested-style-stream-style ] keep ;
  18
  19 M: nested-style-stream stream-format
  20     do-nested-style stream-format ;
  21
  22 M: nested-style-stream stream-write
  23     H{ } swap do-nested-style stream-format ;
  24
  25 M: nested-style-stream stream-write1
  26     >r ch>string r> H{ } swap do-nested-style stream-format ;
  27
  28 : do-nested-quot ( quot style stream -- quot style stream )
  29     tuck >r >r
  30     nested-style-stream-style swap \ with-style
  31     3array >quotation
  32     r> r> do-nested-style ;
  33
  34 M: nested-style-stream with-stream-style
  35     do-nested-style with-stream-style ;
  36
  37 M: nested-style-stream with-nested-stream
  38     do-nested-quot with-nested-stream ;
  39
  40 M: nested-style-stream with-stream-table
  41     do-nested-quot with-stream-table ;