From e6ed70c791fe0767b7dc5e57ce3ecc94f685ffa0 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Tue, 6 Jan 2009 16:53:08 -0600
Subject: [PATCH] Working on new UI inspector
---
basis/ui/tools/inspector/inspector.factor | 93 ++++++++++++++-------
basis/ui/tools/listener/listener.factor | 25 ++----
basis/ui/tools/operations/operations.factor | 15 ++--
basis/ui/tools/tools.factor | 44 ----------
basis/ui/tools/workspace/workspace.factor | 29 +------
5 files changed, 80 insertions(+), 126 deletions(-)
diff --git a/basis/ui/tools/inspector/inspector.factor b/basis/ui/tools/inspector/inspector.factor
index ec59f27119..790275294c 100644
--- a/basis/ui/tools/inspector/inspector.factor
+++ b/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
-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 ;
\ No newline at end of file
diff --git a/basis/ui/tools/listener/listener.factor b/basis/ui/tools/listener/listener.factor
index c2a83efaab..f12549b32b 100644
--- a/basis/ui/tools/listener/listener.factor
+++ b/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-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 ;
diff --git a/basis/ui/tools/operations/operations.factor b/basis/ui/tools/operations/operations.factor
index c91aad7462..83357d762d 100644
--- a/basis/ui/tools/operations/operations.factor
+++ b/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
-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
diff --git a/basis/ui/tools/tools.factor b/basis/ui/tools/tools.factor
index f5bb8e64a6..480f38c466 100644
--- a/basis/ui/tools/tools.factor
+++ b/basis/ui/tools/tools.factor
@@ -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
diff --git a/basis/ui/tools/workspace/workspace.factor b/basis/ui/tools/workspace/workspace.factor
index 9c696ba60f..a4d175e451 100644
--- a/basis/ui/tools/workspace/workspace.factor
+++ b/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 ;
-
-: workspace-page ( workspace -- gadget )
- book>> current-page ;
-
-M: workspace tool-scroller ( workspace -- scroller )
- workspace-page tool-scroller ;
+ [ popup>> ] [ listener>> ] bi or ;