! Copyright (C) 2006, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors inspector namespaces kernel models fry
-models.filter prettyprint sequences mirrors assocs classes
-io io.styles arrays hashtables math.order sorting refs fonts
-ui.tools.browser ui.commands ui.operations ui.gadgets ui.gadgets.panes
-ui.gadgets.scrollers ui.gadgets.slots ui.gadgets.tracks
-ui.gestures ui.gadgets.buttons ui.gadgets.tables
-ui.gadgets.status-bar ui.gadgets.theme ui.gadgets.labelled
-ui.tools.common ui ;
+USING: accessors colors inspector namespaces kernel models fry
+colors.constants models.arrow prettyprint sequences mirrors
+assocs classes io io.styles arrays hashtables math.order sorting
+refs fonts ui.tools.browser ui.commands ui.operations ui.gadgets
+ui.gadgets.panes ui.gadgets.scrollers ui.gadgets.slots
+ui.gadgets.theme ui.gadgets.tracks ui.gestures
+ui.gadgets.buttons ui.gadgets.tables ui.theme ui.gadgets.toolbar
+ui.gadgets.status-bar ui.gadgets.labeled ui.tools.common ui
+combinators ui.gadgets.worlds ;
IN: ui.tools.inspector
TUPLE: inspector-gadget < tool table ;
-{ 500 300 } inspector-gadget set-tool-dim
-
TUPLE: slot-description key key-string value value-string ;
: <slot-description> ( key value -- slot-description )
M: inspector-renderer row-value
drop value>> ;
+M: inspector-renderer column-titles
+ drop { "Key" "Value" } ;
+
: <summary-gadget> ( model -- gadget )
[
standard-table-style [
- [
+ {
+ [
+ [
+ [ "Class:" write ] with-cell
+ [ class-of pprint ] with-cell
+ ] with-row
+ ]
[
- [ "Class:" write ] with-cell
- [ class . ] with-cell
- ] with-row
- ]
- [
+ [
+ [ "Object:" write ] with-cell
+ [ pprint-short ] with-cell
+ ] with-row
+ ]
[
- [ "Object:" write ] with-cell
- [ short. ] with-cell
- ] with-row
- ]
- [
+ [
+ [ "Summary:" write ] with-cell
+ [ print-summary ] with-cell
+ ] with-row
+ ]
[
- [ "Summary:" write ] with-cell
- [ summary. ] with-cell
- ] with-row
- ] tri
+ content-gadget [
+ [
+ [ "Content:" write ] with-cell
+ [ output-stream get write-gadget ] with-cell
+ ] with-row
+ ] when*
+ ]
+ } cleave
] tabular-output
] <pane-control> ;
make-mirror [ <slot-description> ] { } assoc>map ;
M: hashtable make-slot-descriptions
- call-next-method [ [ key-string>> ] compare ] sort ;
+ call-next-method [ key-string>> ] sort-with ;
: <inspector-table> ( model -- table )
- [ make-slot-descriptions ] <filter> <table>
- [ dup primary-operation invoke-command ] >>action
- inspector-renderer >>renderer
- monospace-font >>font ;
+ [ make-slot-descriptions ] <arrow> inspector-renderer <table>
+ [ invoke-primary-operation ] >>action
+ monospace-font >>font theme-font-colors
+ line-color >>column-line-color
+ 6 >>gap
+ 15 >>min-rows
+ 15 >>max-rows
+ 40 >>min-cols
+ 40 >>max-cols ;
: <inspector-gadget> ( model -- gadget )
- vertical inspector-gadget new-track
+ vertical inspector-gadget new-track with-lines
add-toolbar
swap >>model
dup model>> <inspector-table> >>table
- dup model>> <summary-gadget> "Object" <labelled-gadget> f track-add
- dup table>> <scroller> "Contents" <labelled-gadget> 1 track-add ;
+ dup model>> <summary-gadget> margins white-interior "Object" object-color <labeled> f track-add
+ dup table>> <scroller> margins white-interior "Contents" contents-color <labeled> 1 track-add ;
M: inspector-gadget focusable-child*
table>> ;
\ com-push H{ { +listener+ t } } define-command
: slot-editor-window ( close-hook update-hook assoc key key-string -- )
- [ <value-ref> <slot-editor> ] [ "Slot editor: " prepend ] bi*
- open-window ;
+ [ <value-ref> <slot-editor> ]
+ [
+ <world-attributes>
+ swap "Slot editor: " prepend >>title
+ [ { dialog-window } append ] change-window-controls
+ ] bi*
+ open-status-window ;
: com-edit-slot ( inspector -- )
[ close-window ] swap
[ table>> (selected-row) ] tri [
[ key>> ] [ key-string>> ] bi
slot-editor-window
- ] [ 2drop 2drop ] if ;
+ ] [ 4drop ] if ;
-: inspector-help ( -- ) "ui-inspector" com-follow ;
+: inspector-help ( -- ) "ui-inspector" com-browse ;
\ inspector-help H{ { +nullary+ t } } define-command
: inspector ( obj -- )
<model> inspect-model ;
+
+{ 550 400 } inspector-gadget set-tool-dim