1 ! Copyright (C) 2003, 2009 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: arrays accessors assocs colors combinators grouping io
4 io.streams.string io.styles kernel make math math.parser namespaces
5 parser prettyprint.backend prettyprint.config prettyprint.custom
6 prettyprint.sections quotations sequences sorting strings vocabs
7 vocabs.prettyprint words sets ;
10 : with-use ( obj quot -- )
11 make-pprint (pprint-manifest
12 [ pprint-manifest) ] [ [ drop nl ] unless-empty ] bi
15 : with-in ( obj quot -- )
16 make-pprint current-vocab>> [ pprint-in bl ] when* do-pprint ; inline
18 : pprint ( obj -- ) [ pprint* ] with-pprint ;
20 : . ( obj -- ) pprint nl ;
22 : pprint-use ( obj -- ) [ pprint* ] with-use ;
24 : unparse ( obj -- str ) [ pprint ] with-string-writer ;
26 : unparse-use ( obj -- str ) [ pprint-use ] with-string-writer ;
28 : pprint-short ( obj -- )
35 } clone [ pprint ] bind ;
37 : unparse-short ( obj -- str )
38 [ pprint-short ] with-string-writer ;
40 : short. ( obj -- ) pprint-short nl ;
42 : .b ( n -- ) >bin print ;
43 : .o ( n -- ) >oct print ;
44 : .h ( n -- ) >hex print ;
46 : stack. ( seq -- ) [ short. ] each ;
48 : .s ( -- ) datastack stack. ;
49 : .r ( -- ) retainstack stack. ;
56 { { foreground T{ rgba f 1 1 1 1 } } { background T{ rgba f 0 0 0 1 } } }
57 "word-style" set-word-prop
59 : remove-step-into ( word -- )
60 building get [ nip pop wrapped>> ] unless-empty , ;
62 : (remove-breakpoints) ( quot -- newquot )
66 { [ dup word? not ] [ , ] }
67 { [ dup "break?" word-prop ] [ drop ] }
68 { [ dup "step-into?" word-prop ] [ remove-step-into ] }
74 : remove-breakpoints ( quot pos -- quot' )
76 1 + cut [ (remove-breakpoints) ] bi@
84 : callstack. ( callstack -- )
85 callstack>array 2 <groups> [
94 : .c ( -- ) callstack callstack. ;
96 : pprint-cell ( obj -- ) [ pprint-short ] with-cell ;
98 SYMBOL: pprint-string-cells?
100 : simple-table. ( values -- )
101 standard-table-style [
105 dup string? pprint-string-cells? get not and
106 [ [ write ] with-cell ]
112 ] tabular-output nl ;