Working on new UI inspector

basis/ui/tools/inspector/inspector.factor

@@ -1,51 +1,84 @@
 ! Copyright (C) 2006, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors inspector namespaces kernel
+USING: accessors inspector namespaces kernel models
-ui.tools.browser ui.commands
+models.filter prettyprint sequences mirrors assocs classes
-ui.gadgets ui.gadgets.panes ui.gadgets.scrollers
+io io.styles
-ui.gadgets.slots ui.gadgets.tracks ui.gestures
+ui.tools.browser ui.commands ui.gadgets ui.gadgets.panes
-ui.gadgets.buttons ui.tools.workspace ;
+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 -- )
+SINGLETON: inspector-renderer
-    [ object>> ] [ pane>> ] bi [
-        +editable+ on
-        +number-rows+ on
-        describe
-    ] with-pane ;
 
-: <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
+        swap <model> >>model
-        dup pane>> <scroller> 1 track-add ;
+        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 -- )
+M: inspector-gadget focusable-child*
-    2nip swap >>object refresh ;
+    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 }
+    { T{ update-object } com-refresh }
-    { f &push }
+    { T{ key-down f f "p" } com-push }
-    { f &back }
-    { f &globals }
     { T{ key-down f f "F1" } inspector-help }
 } define-command-map
 
-inspector-gadget "multi-touch" f {
+: inspector-window ( obj -- )
-    { T{ left-action } &back }
+    <inspector-gadget> "Inspector" open-status-window ;
-} define-command-map
-
-M: inspector-gadget tool-scroller
-    pane>> find-scroller ;

basis/ui/tools/listener/listener.factor

@@ -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-error-hook ] error-hook set
-        [ '[ _ ui-inspector-hook ] inspector-hook set ] bi
         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 ;
 

basis/ui/tools/operations/operations.factor

@@ -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
+ui.tools.inspector ui.tools.search ui.tools.traceback
-help.topics stack-checker summary inspector io.pathnames
+ui.tools.workspace generic help.topics stack-checker
-io.styles kernel namespaces parser prettyprint quotations
+summary io.pathnames io.styles kernel namespaces parser
-tools.annotations editors tools.profiler tools.test tools.time
+prettyprint quotations tools.annotations editors
-tools.walker ui.commands ui.gadgets.editors ui.gestures
+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

basis/ui/tools/tools.factor

@@ -12,59 +12,15 @@ 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
 

basis/ui/tools/workspace/workspace.factor

@@ -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 ;
+    [ popup>> ] [ listener>> ] bi or ;
-
-: workspace-page ( workspace -- gadget )
-    book>> current-page ;
-
-M: workspace tool-scroller ( workspace -- scroller )
-    workspace-page tool-scroller ;