UI cleanups

TODO.FACTOR.txt

@@ -4,8 +4,6 @@
   - show currently selected vocab & words
   - scroll to existing won't work
   - initial scroll dim is wrong
-  - show callers
-  - some way to go back/forth between code and docs
 - RT_WORD should refer to XTs not word objects.
 - roundoff is still not quite right with tracks
 - signal 4 on datastack underflow on mac intel??
@@ -13,6 +11,7 @@
 - help gadget should not re-render every time it is grafted
 - apropos and help search
 - alien-indirect
+- operations + tile commands + listener word commands = new abstraction
 
 ========================================================================
 

library/ui/tools/browser.factor

@@ -44,16 +44,14 @@ TUPLE: tile definition gadget ;
     } [ first2 \ find-tile add* <bevel-button> ] map
     make-shelf ;
 
-: tile-theme ( gadget -- )
+: <tile-content> ( definition -- gadget )
-    { 5 5 } over set-grid-gap faint-boundary ;
+    [ see ] make-pane <tile-toolbar> 2array
+    make-pile { 5 5 } over set-pack-gap
+    <default-border> dup faint-boundary ;
 
 C: tile ( definition -- gadget )
     [ set-tile-definition ] 2keep
-    {
+    [ >r <tile-content> r> set-gadget-delegate ] keep ;
-        { [ <tile-toolbar> ] f f @top }
-        { [ [ see ] make-pane ] f f @center }
-    } make-frame*
-    dup tile-theme ;
 
 : show-definition ( definition definitions -- )
     2dup definition-index dup 0 >= [

library/ui/tools/listener.factor

@@ -25,20 +25,21 @@ TUPLE: listener-gadget input output stack ;
     [ >r clear r> init-namespaces listener-thread ] in-thread
     drop ;
 
-: <titled-pane> ( model quot title -- gadget )
+: <labelled-gadget> ( gadget title -- gadget )
     {
         { [ <label> dup reverse-video-theme ] f f @top }
-        { [ <pane-control> <scroller> ] f f @center }
+        { [ ] f f @center }
-    } make-frame* ;
+    } make-frame ;
 
-: <stack-tile> ( model title -- gadget )
+: <labelled-pane> ( model quot title -- gadget )
-    [ stack. ] swap <titled-pane> ;
+    >r <pane-control> <scroller> r> <labelled-gadget> ;
 
 : <listener-input> ( -- gadget )
     gadget get listener-gadget-output <interactor> ;
 
 : <stack-display> ( -- gadget )
-    gadget get listener-gadget-stack "Stack" <stack-tile> ;
+    gadget get listener-gadget-stack
+    [ stack. ] "Stack" <labelled-pane> ;
 
 : init-listener ( listener -- )
     f <model> swap set-listener-gadget-stack ;
@@ -47,7 +48,7 @@ C: listener-gadget ( -- gadget )
     dup init-listener {
         { [ <scrolling-pane> ] set-listener-gadget-output [ <scroller> ] 4/6 }
         { [ <stack-display> ] f f 1/6 }
-        { [ <listener-input> ] set-listener-gadget-input [ <scroller> ] 1/6 }
+        { [ <listener-input> ] set-listener-gadget-input [ <scroller> "Input" <labelled-gadget> ] 1/6 }
     } { 0 1 } make-track* dup start-listener ;
 
 M: listener-gadget focusable-child*

library/ui/tools/walker.factor

@@ -9,27 +9,27 @@ namespaces sequences shells threads vectors ;
 
 : <callstack-display> ( model -- )
     [ [ continuation-call callstack. ] when* ]
-    "Call stack" <titled-pane> ;
+    "Call stack" <labelled-pane> ;
 
 : <datastack-display> ( model -- )
     [ [ continuation-data stack. ] when* ]
-    "Data stack" <titled-pane> ;
+    "Data stack" <labelled-pane> ;
 
 : <retainstack-display> ( model -- )
     [ [ continuation-retain stack. ] when* ]
-    "Retain stack" <titled-pane> ;
+    "Retain stack" <labelled-pane> ;
 
 : <namestack-display> ( model -- )
     [ [ continuation-name stack. ] when* ]
-    "Name stack" <titled-pane> ;
+    "Name stack" <labelled-pane> ;
 
 : <catchstack-display> ( model -- )
     [ [ continuation-catch stack. ] when* ]
-    "Catch stack" <titled-pane> ;
+    "Catch stack" <labelled-pane> ;
 
 : <quotation-display> ( quot -- gadget )
     [ [ first2 callframe. ] when* ]
-    "Current quotation" <titled-pane> ;
+    "Current quotation" <labelled-pane> ;
 
 TUPLE: walker-gadget model quot ns ;
 

library/ui/tools/workspace.factor

@@ -40,7 +40,7 @@ C: workspace ( -- workspace )
     over set-gadget-delegate
     dup dup set-control-self ;
 
-M: workspace pref-dim* delegate pref-dim* { 550 650 } vmax ;
+M: workspace pref-dim* delegate pref-dim* { 500 650 } vmax ;
 
 : <workspace-tabs> ( book -- tabs )
     control-model