steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

make struct classes print properly in the status bar

Joe Groff 2009-09-15 15:16:53 -05:00
parent eadf1bc9d5
commit 4ee1a4f9e8
1 changed files with 10 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
basis/classes/struct/prettyprint/prettyprint.factor
View File

@ -1,18 +1,13 @@
! (c)Joe Groff bsd license ! (c)Joe Groff bsd license
USING: accessors alien alien.c-types arrays assocs classes USING: accessors alien alien.c-types arrays assocs classes
classes.struct combinators combinators.short-circuit continuations classes.struct combinators combinators.short-circuit continuations
fry kernel libc make math math.parser mirrors prettyprint.backend definitions fry kernel libc make math math.parser mirrors
prettyprint.custom prettyprint.sections see.private sequences prettyprint.backend prettyprint.custom prettyprint.sections
slots strings summary words ; see see.private sequences slots strings summary words ;
IN: classes.struct.prettyprint IN: classes.struct.prettyprint
<PRIVATE <PRIVATE
: struct-definer-word ( class -- word )
struct-slots dup length 2 >=
[ second offset>> 0 = \ UNION-STRUCT: \ STRUCT: ? ]
[ drop \ STRUCT: ] if ;
: struct>assoc ( struct -- assoc ) : struct>assoc ( struct -- assoc )
[ class struct-slots ] [ struct-slot-values ] bi zip ; [ class struct-slots ] [ struct-slot-values ] bi zip ;
@ -39,8 +34,14 @@ IN: classes.struct.prettyprint
PRIVATE> PRIVATE>
M: struct-class definer
struct-slots dup length 2 >=
[ second offset>> 0 = \ UNION-STRUCT: \ STRUCT: ? ]
[ drop \ STRUCT: ] if
\ ; ;
M: struct-class see-class* M: struct-class see-class*
<colon dup struct-definer-word pprint-word dup pprint-word <colon dup definer drop pprint-word dup pprint-word
<block struct-slots [ pprint-struct-slot ] each <block struct-slots [ pprint-struct-slot ] each
block> pprint-; block> ; block> pprint-; block> ;