1 ! Copyright (C) 2006, 2009 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors inspector namespaces kernel models fry
4 models.filter prettyprint sequences mirrors assocs classes
5 io io.styles arrays hashtables math.order sorting refs fonts
6 ui.tools.browser ui.commands ui.operations ui.gadgets ui.gadgets.panes
7 ui.gadgets.scrollers ui.gadgets.slots ui.gadgets.tracks
8 ui.gestures ui.gadgets.buttons ui.gadgets.tables
9 ui.gadgets.status-bar ui.gadgets.labeled
11 IN: ui.tools.inspector
13 TUPLE: inspector-gadget < tool table ;
15 { 500 300 } inspector-gadget set-tool-dim
17 TUPLE: slot-description key key-string value value-string ;
19 : <slot-description> ( key value -- slot-description )
20 [ dup unparse-short ] bi@ slot-description boa ;
22 SINGLETON: inspector-renderer
24 M: inspector-renderer row-columns
25 drop [ key-string>> ] [ value-string>> ] bi 2array ;
27 M: inspector-renderer row-value
30 M: inspector-renderer column-titles
31 drop { "Key" "Value" } ;
33 : <summary-gadget> ( model -- gadget )
35 standard-table-style [
38 [ "Class:" write ] with-cell
44 [ "Object:" write ] with-cell
50 [ "Summary:" write ] with-cell
51 [ summary. ] with-cell
57 GENERIC: make-slot-descriptions ( obj -- seq )
59 M: object make-slot-descriptions
60 make-mirror [ <slot-description> ] { } assoc>map ;
62 M: hashtable make-slot-descriptions
63 call-next-method [ [ key-string>> ] compare ] sort ;
65 : <inspector-table> ( model -- table )
66 [ make-slot-descriptions ] <filter> inspector-renderer <table>
67 [ dup primary-operation invoke-command ] >>action
68 monospace-font >>font ;
70 : <inspector-gadget> ( model -- gadget )
71 vertical inspector-gadget new-track
75 dup model>> <inspector-table> >>table
76 dup model>> <summary-gadget> "Object" <labeled-gadget> f track-add
77 dup table>> <scroller> "Contents" <labeled-gadget> 1 track-add ;
79 M: inspector-gadget focusable-child*
82 : com-refresh ( inspector -- )
83 model>> notify-connections ;
85 : com-push ( inspector -- obj )
88 \ com-push H{ { +listener+ t } } define-command
90 : slot-editor-window ( close-hook update-hook assoc key key-string -- )
91 [ <value-ref> <slot-editor> ] [ "Slot editor: " prepend ] bi*
94 : com-edit-slot ( inspector -- )
96 [ '[ _ com-refresh ] ]
97 [ control-value make-mirror ]
98 [ table>> (selected-row) ] tri [
99 [ key>> ] [ key-string>> ] bi
101 ] [ 2drop 2drop ] if ;
103 : inspector-help ( -- ) "ui-inspector" com-follow ;
105 \ inspector-help H{ { +nullary+ t } } define-command
107 inspector-gadget "toolbar" f {
108 { T{ update-object } com-refresh }
109 { T{ key-down f f "p" } com-push }
110 { T{ key-down f f "e" } com-edit-slot }
111 { T{ key-down f f "F1" } inspector-help }
114 inspector-gadget "multi-touch" f {
115 { up-action com-refresh }
118 : inspect-model ( model -- )
119 <inspector-gadget> "Inspector" open-status-window ;
121 : inspector ( obj -- )
122 <model> inspect-model ;