Working on new UI inspector
Slava Pestov
parent
76e89f72ba
commit
e6ed70c791
|
|
@ -1,51 +1,84 @@
|
|||
! Copyright (C) 2006, 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors inspector namespaces kernel
|
||||
ui.tools.browser ui.commands
|
||||
ui.gadgets ui.gadgets.panes ui.gadgets.scrollers
|
||||
ui.gadgets.slots ui.gadgets.tracks ui.gestures
|
||||
ui.gadgets.buttons ui.tools.workspace ;
|
||||
USING: accessors inspector namespaces kernel models
|
||||
models.filter prettyprint sequences mirrors assocs classes
|
||||
io io.styles
|
||||
ui.tools.browser ui.commands 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 ;
|
||||
IN: ui.tools.inspector
|
||||
|
||||
TUPLE: inspector-gadget < track object pane ;
|
||||
TUPLE: inspector-gadget < track table ;
|
||||
|
||||
: refresh ( inspector -- )
|
||||
[ object>> ] [ pane>> ] bi [
|
||||
+editable+ on
|
||||
+number-rows+ on
|
||||
describe
|
||||
] with-pane ;
|
||||
SINGLETON: inspector-renderer
|
||||
|
||||
: <inspector-gadget> ( -- gadget )
|
||||
M: inspector-renderer row-columns
|
||||
drop [ unparse-short ] map ;
|
||||
|
||||
: <summary-gadget> ( model -- gadget )
|
||||
[
|
||||
standard-table-style [
|
||||
[
|
||||
[
|
||||
[ "Class:" write ] with-cell
|
||||
[ class . ] with-cell
|
||||
] with-row
|
||||
]
|
||||
[
|
||||
[
|
||||
[ "Object:" write ] with-cell
|
||||
[ short. ] with-cell
|
||||
] with-row
|
||||
]
|
||||
[
|
||||
[
|
||||
[ "Summary:" write ] with-cell
|
||||
[ summary. ] with-cell
|
||||
] with-row
|
||||
] tri
|
||||
] tabular-output
|
||||
] <pane-control> ;
|
||||
|
||||
DEFER: inspector-window
|
||||
|
||||
: <inspector-table> ( model -- table )
|
||||
[ make-mirror >alist ] <filter> <table>
|
||||
[ second inspector-window ] >>action
|
||||
inspector-renderer >>renderer
|
||||
monospace-font >>font ;
|
||||
|
||||
: <inspector-gadget> ( obj -- gadget )
|
||||
{ 0 1 } inspector-gadget new-track
|
||||
add-toolbar
|
||||
<pane> >>pane
|
||||
dup pane>> <scroller> 1 track-add ;
|
||||
swap <model> >>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 ;
|
||||
|
||||
: inspect-object ( obj mirror keys inspector -- )
|
||||
2nip swap >>object refresh ;
|
||||
M: inspector-gadget focusable-child*
|
||||
table>> ;
|
||||
|
||||
\ &push H{ { +nullary+ t } { +listener+ t } } define-command
|
||||
M: inspector-gadget pref-dim*
|
||||
drop { 500 300 } ;
|
||||
|
||||
\ &back H{ { +nullary+ t } { +listener+ t } } define-command
|
||||
: com-refresh ( inspector -- )
|
||||
model>> notify-connections ;
|
||||
|
||||
\ &globals H{ { +nullary+ t } { +listener+ t } } define-command
|
||||
: com-push ( inspector -- obj )
|
||||
control-value ;
|
||||
|
||||
\ com-push H{ { +listener+ t } } define-command
|
||||
|
||||
: inspector-help ( -- ) "ui-inspector" com-follow ;
|
||||
|
||||
\ inspector-help H{ { +nullary+ t } } define-command
|
||||
|
||||
inspector-gadget "toolbar" f {
|
||||
{ T{ update-object } refresh }
|
||||
{ f &push }
|
||||
{ f &back }
|
||||
{ f &globals }
|
||||
{ T{ update-object } com-refresh }
|
||||
{ T{ key-down f f "p" } com-push }
|
||||
{ T{ key-down f f "F1" } inspector-help }
|
||||
} define-command-map
|
||||
|
||||
inspector-gadget "multi-touch" f {
|
||||
{ T{ left-action } &back }
|
||||
} define-command-map
|
||||
|
||||
M: inspector-gadget tool-scroller
|
||||
pane>> find-scroller ;
|
||||
: inspector-window ( obj -- )
|
||||
<inspector-gadget> "Inspector" open-status-window ;
|
||||
|
|
@ -1,6 +1,6 @@
|
|||
! Copyright (C) 2005, 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: inspector help help.markup io io.styles kernel models
|
||||
USING: inspector help help.markup io io.styles kernel models strings
|
||||
namespaces parser quotations sequences vocabs words prettyprint
|
||||
listener debugger threads boxes concurrency.flags math arrays
|
||||
generic accessors combinators assocs fry ui.commands ui.gadgets
|
||||
|
|
@ -27,12 +27,6 @@ TUPLE: listener-gadget < track input output ;
|
|||
M: listener-gadget focusable-child*
|
||||
input>> ;
|
||||
|
||||
M: listener-gadget call-tool* ( input listener -- )
|
||||
[ string>> ] dip input>> set-editor-string ;
|
||||
|
||||
M: listener-gadget tool-scroller
|
||||
output>> find-scroller ;
|
||||
|
||||
: wait-for-listener ( listener -- )
|
||||
#! Wait for the listener to start.
|
||||
input>> flag>> wait-for-flag ;
|
||||
|
|
@ -40,7 +34,11 @@ M: listener-gadget tool-scroller
|
|||
: workspace-busy? ( workspace -- ? )
|
||||
listener>> input>> interactor-busy? ;
|
||||
|
||||
: listener-input ( string -- )
|
||||
GENERIC: listener-input ( obj -- )
|
||||
|
||||
M: input listener-input string>> listener-input ;
|
||||
|
||||
M: string listener-input
|
||||
get-workspace listener>> input>>
|
||||
[ set-editor-string ] [ request-focus ] bi ;
|
||||
|
||||
|
|
@ -114,15 +112,10 @@ M: engine-word word-completion-string
|
|||
: ui-error-hook ( error listener -- )
|
||||
find-workspace debugger-popup ;
|
||||
|
||||
: ui-inspector-hook ( obj listener -- )
|
||||
find-workspace inspector-gadget
|
||||
swap show-tool inspect-object ;
|
||||
|
||||
: listener-thread ( listener -- )
|
||||
dup listener-streams [
|
||||
[ com-follow ] help-hook set
|
||||
[ '[ _ ui-error-hook ] error-hook set ]
|
||||
[ '[ _ ui-inspector-hook ] inspector-hook set ] bi
|
||||
'[ _ ui-error-hook ] error-hook set
|
||||
welcome.
|
||||
listener
|
||||
] with-streams* ;
|
||||
|
|
@ -182,10 +175,6 @@ listener-gadget "toolbar" f {
|
|||
{ T{ key-down f { C+ } "d" } com-end }
|
||||
} define-command-map
|
||||
|
||||
M: listener-gadget handle-gesture ( gesture gadget -- ? )
|
||||
2dup find-workspace workspace-page handle-gesture
|
||||
[ call-next-method ] [ 2drop f ] if ;
|
||||
|
||||
M: listener-gadget graft*
|
||||
[ call-next-method ] [ restart-listener ] bi ;
|
||||
|
||||
|
|
|
|||
|
|
@ -1,12 +1,13 @@
|
|||
! Copyright (C) 2006, 2007 Slava Pestov.
|
||||
! Copyright (C) 2006, 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: continuations definitions ui.tools.browser
|
||||
ui.tools.interactor ui.tools.listener ui.tools.profiler
|
||||
ui.tools.search ui.tools.traceback ui.tools.workspace generic
|
||||
help.topics stack-checker summary inspector io.pathnames
|
||||
io.styles kernel namespaces parser prettyprint quotations
|
||||
tools.annotations editors tools.profiler tools.test tools.time
|
||||
tools.walker ui.commands ui.gadgets.editors ui.gestures
|
||||
ui.tools.inspector ui.tools.search ui.tools.traceback
|
||||
ui.tools.workspace generic help.topics stack-checker
|
||||
summary io.pathnames io.styles kernel namespaces parser
|
||||
prettyprint quotations tools.annotations editors
|
||||
tools.profiler tools.test tools.time tools.walker
|
||||
ui.commands ui.gadgets.editors ui.gestures
|
||||
ui.operations ui.tools.deploy vocabs vocabs.loader words
|
||||
sequences tools.vocabs classes compiler.units accessors
|
||||
vocabs.parser ;
|
||||
|
|
@ -15,7 +16,7 @@ IN: ui.tools.operations
|
|||
V{ } clone operations set-global
|
||||
|
||||
! Objects
|
||||
[ drop t ] \ inspect H{
|
||||
[ drop t ] \ inspector-window H{
|
||||
{ +primary+ t }
|
||||
{ +listener+ t }
|
||||
} define-operation
|
||||
|
|
|
|||
|
|
@ -11,60 +11,16 @@ tools.test tools.vocabs ui.gadgets.buttons ui.gadgets.status-bar
|
|||
mirrors fry inspector io kernel math models namespaces
|
||||
prettyprint quotations sequences ;
|
||||
IN: ui.tools
|
||||
|
||||
: <workspace-tabs> ( workspace -- tabs )
|
||||
model>>
|
||||
"tool-switching" workspace command-map commands>>
|
||||
[ command-string ] { } assoc>map <enum> >alist
|
||||
<toggle-buttons> ;
|
||||
|
||||
: <workspace-book> ( workspace -- gadget )
|
||||
<gadget>
|
||||
<inspector-gadget>
|
||||
2array
|
||||
swap model>> <book> ;
|
||||
|
||||
: <workspace> ( -- workspace )
|
||||
{ 0 1 } workspace new-track
|
||||
0 <model> >>model
|
||||
<listener-gadget> >>listener
|
||||
dup <workspace-book> >>book
|
||||
|
||||
dup <workspace-tabs> f track-add
|
||||
dup book>> 0 track-add
|
||||
dup listener>> 1 track-add
|
||||
add-toolbar ;
|
||||
|
||||
: resize-workspace ( workspace -- )
|
||||
dup sizes>> over control-value 0 = [
|
||||
0 over set-second
|
||||
1 swap set-third
|
||||
] [
|
||||
2/3 over set-second
|
||||
1/3 swap set-third
|
||||
] if relayout ;
|
||||
|
||||
M: workspace model-changed
|
||||
nip
|
||||
dup listener>> output>> scroll>bottom
|
||||
dup resize-workspace
|
||||
request-focus ;
|
||||
|
||||
[ workspace-window ] ui-hook set-global
|
||||
|
||||
: select-tool ( workspace n -- ) swap book>> model>> set-model ;
|
||||
|
||||
: com-listener ( workspace -- ) 0 select-tool ;
|
||||
|
||||
: com-inspector ( workspace -- ) 1 select-tool ;
|
||||
|
||||
workspace "tool-switching" f {
|
||||
{ T{ key-down f { A+ } "1" } com-listener }
|
||||
{ T{ key-down f { A+ } "2" } com-inspector }
|
||||
} define-command-map
|
||||
|
||||
workspace "multi-touch" f {
|
||||
{ T{ zoom-out-action } com-listener }
|
||||
{ T{ up-action } refresh-all }
|
||||
} define-command-map
|
||||
|
||||
|
|
|
|||
|
|
@ -9,7 +9,7 @@ ui.gadgets.presentations ui.gadgets.status-bar ui.commands
|
|||
ui.gestures ;
|
||||
IN: ui.tools.workspace
|
||||
|
||||
TUPLE: workspace < track book listener popup ;
|
||||
TUPLE: workspace < track listener popup ;
|
||||
|
||||
: find-workspace ( gadget -- workspace ) [ workspace? ] find-parent ;
|
||||
|
||||
|
|
@ -19,19 +19,6 @@ SYMBOL: workspace-window-hook
|
|||
|
||||
: workspace-window ( -- ) workspace-window* drop ;
|
||||
|
||||
GENERIC: call-tool* ( arg tool -- )
|
||||
|
||||
GENERIC: tool-scroller ( tool -- scroller )
|
||||
|
||||
M: gadget tool-scroller drop f ;
|
||||
|
||||
: find-tool ( class workspace -- index tool )
|
||||
book>> children>> [ class eq? ] with find ;
|
||||
|
||||
: show-tool ( class workspace -- tool )
|
||||
[ find-tool swap ] keep book>> model>>
|
||||
set-model ;
|
||||
|
||||
: get-workspace* ( quot -- workspace )
|
||||
'[ dup workspace? _ [ drop f ] if ] find-window
|
||||
[ dup raise-window gadget-child ]
|
||||
|
|
@ -39,12 +26,6 @@ M: gadget tool-scroller drop f ;
|
|||
|
||||
: get-workspace ( -- workspace ) [ drop t ] get-workspace* ;
|
||||
|
||||
: call-tool ( arg class -- )
|
||||
get-workspace show-tool call-tool* ;
|
||||
|
||||
: get-tool ( class -- gadget )
|
||||
get-workspace find-tool nip ;
|
||||
|
||||
: hide-popup ( workspace -- )
|
||||
dup popup>> track-remove
|
||||
f >>popup
|
||||
|
|
@ -72,12 +53,6 @@ SYMBOL: workspace-dim
|
|||
M: workspace pref-dim* call-next-method workspace-dim get vmax ;
|
||||
|
||||
M: workspace focusable-child*
|
||||
dup popup>> [ ] [ listener>> ] ?if ;
|
||||
|
||||
: workspace-page ( workspace -- gadget )
|
||||
book>> current-page ;
|
||||
|
||||
M: workspace tool-scroller ( workspace -- scroller )
|
||||
workspace-page tool-scroller ;
|
||||
[ popup>> ] [ listener>> ] bi or ;
|
||||
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue