factor/library/ui/inspector.factor

69 lines
1.9 KiB
Factor
Raw Normal View History

2005-03-01 22:11:08 -05:00
! Copyright (C) 2005 Slava Pestov.
! See http://factor.sf.net/license.txt for BSD license.
IN: gadgets
2005-03-01 00:45:50 -05:00
USING: gadgets generic hashtables kernel kernel-internals lists
namespaces unparser vectors words ;
: label-box ( list -- gadget )
2005-03-01 18:55:25 -05:00
<line-pile> swap [ <presentation> over add-gadget ] each ;
2005-03-01 00:45:50 -05:00
: alist>sheet ( assoc -- sheet )
unzip swap
<default-shelf>
[ >r label-box r> add-gadget ] keep
[ >r label-box r> add-gadget ] keep ;
: <titled> ( gadget title -- )
<line-pile> swap <label> over add-gadget
[ >r empty-border r> add-gadget ] keep ;
: top-sheet ( obj -- sheet )
dup class word-name <label> "Class:" <titled>
swap unparse <label> "Object:" <titled>
<line-pile> [ add-gadget ] keep [ add-gadget ] keep ;
: object>alist ( obj -- assoc )
dup class "slots" word-property [
cdr car [ execute ] keep swons
] map-with ;
: slot-sheet ( obj -- sheet )
object>alist alist>sheet "Slots:" <titled> ;
GENERIC: custom-sheet ( obj -- gadget )
: <inspector> ( obj -- gadget )
0 default-gap 0 <pile>
over top-sheet over add-gadget
over slot-sheet over add-gadget
swap custom-sheet over add-gadget ;
M: object custom-sheet drop <empty-gadget> ;
M: array custom-sheet ( array -- gadget )
[ array-capacity [ count ] keep ] keep array>list zip
alist>sheet
"Elements:" <titled> ;
M: vector custom-sheet ( array -- gadget )
dup vector-length count swap vector>list zip alist>sheet
"Elements:" <titled> ;
M: hashtable custom-sheet ( array -- gadget )
hash>alist alist>sheet "Entries:" <titled> ;
M: word custom-sheet ( word -- gadget )
word-props <inspector> empty-border "Properties:" <titled> ;
M: tuple custom-sheet ( tuple -- gadget )
tuple-delegate [
<inspector> empty-border "Delegate:" <titled>
] [
<empty-gadget>
] ifte* ;
: inspect ( obj -- )
<inspector> ( <scroller> )
2005-03-01 18:55:25 -05:00
line-border dup moving-actions world get add-gadget ;
2005-03-01 00:45:50 -05:00