Pane, track, toolbar fixes

diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt
index 46ea11c0265ecddeb9d31d2a78d08c495248e650..319966a0d575ec9ae0197405083b2cfd38970793 100644 (file)
--- a/TODO.FACTOR.txt
+++ b/TODO.FACTOR.txt
@@ -10,7 +10,6 @@
 - slider needs to be modelized
 - some way of intercepting all gestures
 - better help result ranking
-- track add/remove weirdness
 - minibuffer should show a title
 
 + ui:

diff --git a/library/ui/gadgets/panes.factor b/library/ui/gadgets/panes.factor
index ce7778c5bbed6085c0b38c6e7bad255b496608e3..31f3f1b321d775626c839d6a6f5bca2f40df03a4 100644 (file)
--- a/library/ui/gadgets/panes.factor
+++ b/library/ui/gadgets/panes.factor
@@ -25,6 +25,13 @@ C: pane ( -- pane )
     <pile> <incremental> over add-output
     dup prepare-line ;
 
+! Panes are streams.
+
+: scroll-pane ( pane -- )
+    dup pane-scrolls? [ scroll>bottom ] [ drop ] if ;
+
+TUPLE: pane-stream pane ;
+
 : prepare-print ( current -- gadget )
     #! Optimization: if line has 1 child, add the child.
     dup gadget-children {
@@ -33,30 +40,24 @@ C: pane ( -- pane )
         { [ t ] [ drop ] }
     } cond ;
 
+: pane-terpri ( pane -- )
+    dup pane-current dup unparent prepare-print
+    over pane-output add-incremental
+    prepare-line ;
+
 : pane-write ( pane seq -- )
     [ over pane-current stream-write ]
-    [ dup stream-terpri ] interleave drop ;
+    [ dup pane-terpri ] interleave drop ;
 
 : pane-format ( style pane seq -- )
     [ pick pick pane-current stream-format ]
-    [ dup stream-terpri ] interleave 2drop ;
-
-! Panes are streams.
-
-: scroll-pane ( pane -- )
-    dup pane-scrolls? [ scroll>bottom ] [ drop ] if ;
-
-TUPLE: pane-stream pane ;
+    [ dup pane-terpri ] interleave 2drop ;
 
 : do-pane-stream ( pane-stream quot -- )
     >r pane-stream-pane r> over slip scroll-pane ; inline
 
 M: pane-stream stream-terpri
-    [
-        dup pane-current dup unparent prepare-print
-        over pane-output add-incremental
-        prepare-line
-    ] do-pane-stream ;
+    [ pane-terpri ] do-pane-stream ;
 
 M: pane-stream stream-write1
     [ pane-current stream-write1 ] do-pane-stream ;

diff --git a/library/ui/gadgets/tracks.factor b/library/ui/gadgets/tracks.factor
index 1c2eb251cd6ad28c05b47709481d3e1b8a387d6b..810990fe3d1ffdb66a4add4d2f2261637e5eefc1 100644 (file)
--- a/library/ui/gadgets/tracks.factor
+++ b/library/ui/gadgets/tracks.factor
@@ -116,15 +116,19 @@ C: divider ( -- divider )
     dup add-divider [ add-gadget ] keep
     dup track-sizes track-add-size swap set-track-sizes ;
 
+: remove-divider ( n track -- )
+    2dup gadget-children length = [ >r 1- r> ] when
+    nth-gadget unparent ;
+
+: track-remove-size ( n track -- )
+    [ >r 2 /i r> track-sizes remove-nth normalize-sizes ] keep
+    set-track-sizes ;
+
 : track-remove@ ( n track -- )
-    #! Remove the divider if this is not the last child.
     2dup nth-gadget unparent
-    dup gadget-children empty? [
-        2dup gadget-children length = [ >r 1- r> ] when
-        2dup nth-gadget unparent
-    ] unless
-    [ >r 2 /i r> track-sizes remove-nth normalize-sizes ] keep
-    [ set-track-sizes ] keep relayout-1 ;
+    dup gadget-children empty? [ 2dup remove-divider ] unless
+    [ track-remove-size ] keep
+    relayout-1 ;
 
 : track-remove ( gadget track -- )
     [ gadget-children index ] keep track-remove@ ;

diff --git a/library/ui/load.factor b/library/ui/load.factor
index e56f78114663ecf35b5a363566762036b3223638..f9c3472a43e1a628d954514368e8b83d4edc1f7d 100644 (file)
--- a/library/ui/load.factor
+++ b/library/ui/load.factor
@@ -56,4 +56,5 @@ PROVIDE: library/ui {
     "test/commands.factor"
     "test/panes.factor"
     "test/editor.factor"
+    "test/tracks.factor"
 } ;

diff --git a/library/ui/test/tracks.factor b/library/ui/test/tracks.factor
new file mode 100644 (file)
index 0000000..d4d18b8
--- /dev/null
+++ b/library/ui/test/tracks.factor
@@ -0,0 +1,48 @@
+IN: temporary
+USING: gadgets-tracks gadgets test kernel namespaces math
+sequences ;
+
+[ { 1/3 1/2 1/6 } ] [
+    { 1/3 1/2 1/6 } track-add-size 1 head* normalize-sizes
+] unit-test
+
+{
+    {
+        [ <gadget> { 100 200 } over set-rect-dim ]
+        f
+        f
+        1/2
+    }
+    {
+        [ <gadget> { 100 100 } over set-rect-dim ]
+        f
+        f
+        1/4
+    }
+    {
+        [ <gadget> { 100 100 } over set-rect-dim ]
+        f
+        f
+        1/4
+    }
+} { 0 1 } make-track "track" set
+
+"track" get dup prefer layout
+
+[ { 100 416 } ] [ "track" get rect-dim ] unit-test
+
+[ V{ { 100 200 } { 100 8 } { 100 100 } { 100 8 } { 100 100 } } ]
+[ "track" get gadget-children [ rect-dim ] map ] unit-test
+
+[ { 1/2 1/4 1/4 } ] [ "track" get track-sizes ] unit-test
+
+<gadget> { 70 70 } over set-rect-dim "track" get track-add
+"track" get layout
+[ { 3/8 3/16 3/16 1/4 } ] [ "track" get track-sizes ] unit-test
+
+"track" get [ gadget-children length 1- ] keep track-remove@
+"track" get layout
+[ { 1/2 1/4 1/4 } ] [ "track" get track-sizes ] unit-test
+
+[ V{ { 100 200 } { 100 8 } { 100 100 } { 100 8 } { 100 100 } } ]
+[ "track" get gadget-children [ rect-dim ] map ] unit-test

diff --git a/library/ui/tools/browser.factor b/library/ui/tools/browser.factor
index 69f176f3f6cf50df1a9222b412b20a478273bcfc..09053fee4f3490503b9eac3c76a6b0730c6881a0 100644 (file)
--- a/library/ui/tools/browser.factor
+++ b/library/ui/tools/browser.factor
@@ -104,7 +104,7 @@ M: browser focusable-child* browser-search ;
 : clear-browser ( browser -- )
     browser-definitions close-definitions ;
 
-browser "Browser commands" {
+browser "Toolbar" {
     { "Clear" T{ key-down f f "CLEAR" } [ clear-browser ] }
 } define-commands
 

diff --git a/library/ui/tools/dataflow.factor b/library/ui/tools/dataflow.factor
index a31600e4e88deb99d9b744ee4bef2c35c3a152cc..4c22eec4f472910a6ce16b2d6d4fa25a36119dd7 100644 (file)
--- a/library/ui/tools/dataflow.factor
+++ b/library/ui/tools/dataflow.factor
@@ -188,7 +188,7 @@ DEFER: (compute-heights)
 ! The UI tool
 TUPLE: dataflow-gadget history search ;
 
-dataflow-gadget "History commands" {
+dataflow-gadget "Toolbar" {
     { "Back" T{ key-down f { C+ } "b" } [ dataflow-gadget-history go-back ] }
     { "Forward" T{ key-down f { C+ } "f" } [ dataflow-gadget-history go-forward ] }
 } define-commands

diff --git a/library/ui/tools/help.factor b/library/ui/tools/help.factor
index e83b5f3138c513cec1f750b8ab89cd22e670917b..b48a0512d50a6ec461ecaac340c589b4638d272e 100644 (file)
--- a/library/ui/tools/help.factor
+++ b/library/ui/tools/help.factor
@@ -37,8 +37,12 @@ M: help-gadget tool-help drop "ui-help" ;
 : help-action ( help-gadget -- link )
     help-gadget-history model-value >link ;
 
-help-gadget "History commands" {
+help-gadget "Toolbar" {
     { "Back" T{ key-down f { C+ } "b" } [ help-gadget-history go-back ] }
     { "Forward" T{ key-down f { C+ } "f" } [ help-gadget-history go-forward ] }
     { "Home" T{ key-down f { C+ } "h" } [ go-home ] }
-} define-commands
+}
+link class-operations [ help-action ] modify-operations
+[ command-name "Follow" = not ] subset
+append
+define-commands

diff --git a/library/ui/tools/listener.factor b/library/ui/tools/listener.factor
index 083d71e43afefd748be1ff0e0559172b6be3c060..dc315074f5ba616b0bcc3c1f05f939e1c0f3b738 100644 (file)
--- a/library/ui/tools/listener.factor
+++ b/library/ui/tools/listener.factor
@@ -135,9 +135,8 @@ M: listener-gadget tool-help
     [ [ hash-values [ dup set ] each ] each ] make-hash
     hash-values natural-sort ;
 
-listener-gadget "Listener commands" {
+listener-gadget "Toolbar" {
     { "Restart" T{ key-down f { C+ } "r" } [ start-listener ] }
-    { "Send EOF" T{ key-down f { C+ } "d" } [ listener-eof ] }
     {
         "History"
         T{ key-down f { C+ } "h" }
@@ -153,6 +152,10 @@ listener-gadget "Listener commands" {
         T{ key-down f { C+ } "CLEAR" }
         [ clear-listener-stack ]
     }
+    { "Send EOF" T{ key-down f { C+ } "d" } [ listener-eof ] }
+} define-commands
+
+listener-gadget "Listener commands" {
     {
         "Complete word (used vocabs)"
         T{ key-down f f "TAB" }

diff --git a/library/ui/tools/messages.factor b/library/ui/tools/messages.factor
index 06561fb3951fa4d6c43261d18a1bcf7c6debc7f8..261d0a600167c4445bbd8f558cc930bda36c6f2f 100644 (file)
--- a/library/ui/tools/messages.factor
+++ b/library/ui/tools/messages.factor
@@ -2,7 +2,8 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: compiler kernel gadgets-tracks gadgets-scrolling
 gadgets-workspace gadgets-panes gadgets-presentations
-gadgets-buttons inference errors io math gadgets namespaces ;
+gadgets-buttons inference errors io math gadgets namespaces
+generic ;
 IN: gadgets-messages
 
 TUPLE: messages counter errors errors# warnings warnings# ;
@@ -22,13 +23,13 @@ M: messages compile-begins
 : messages-warnings+
     dup messages-warnings# 1+ swap set-messages-warnings# ;
 
+M: object inference-error-major? drop t ;
+
 M: messages compile-error
-    over inference-error?
-    [ over inference-error-major? ]
-    [ t ] if
+    over inference-error-major?
     [ dup messages-errors+ messages-errors ]
     [ dup messages-warnings+ messages-warnings ] if
-    [ error. ] with-stream ;
+    <pane-stream> [ error. ] with-stream ;
 
 : <messages-button> ( -- gadget )
     "Compiler messages"

diff --git a/library/ui/tools/operations.factor b/library/ui/tools/operations.factor
index 4c43986e4aebfcec22877f815b539b747f4f7f4a..aa6d4bb47301fd7fb005086d3a83217d144bf76c 100644 (file)
--- a/library/ui/tools/operations.factor
+++ b/library/ui/tools/operations.factor
@@ -211,9 +211,3 @@ interactor "Quotation commands"
 quotation class-operations
 [ quot-action ] modify-listener-operations
 define-commands
-
-! Help commands
-help-gadget "Link commands"
-link class-operations [ help-action ] modify-operations
-[ command-name "Follow" = not ] subset
-define-commands

diff --git a/library/ui/tools/walker.factor b/library/ui/tools/walker.factor
index 7a7abe94fbeb68ae0334b6a1ef4b3d0377e78126..05ec4b6701236aa7e29796ad0360ad512a7dd08a 100644 (file)
--- a/library/ui/tools/walker.factor
+++ b/library/ui/tools/walker.factor
@@ -77,7 +77,7 @@ M: walker-gadget tool-help drop "ui-walker" ;
     dup [ step-all ] walker-command reset-walker
     find-workspace listener-gadget select-tool ;
 
-walker-gadget "Walker commands" {
+walker-gadget "Toolbar" {
     { "Step" T{ key-down f f "s" } [ walker-step ] }
     { "Step in" T{ key-down f f "i" } [ walker-step-in ] }
     { "Step out" T{ key-down f f "o" } [ walker-step-out ] }

diff --git a/library/ui/ui.factor b/library/ui/ui.factor
index 1b663903776b9dab872f6405f5adef6c3ca43a23..bc81e37a0037d5afa2f72729ccaadf22afd0b24b 100644 (file)
--- a/library/ui/ui.factor
+++ b/library/ui/ui.factor
@@ -120,7 +120,7 @@ C: titled-gadget ( gadget title -- )
     windows get [ empty? not ] [ f ] if* ;
 
 : <toolbar> ( target classes -- toolbar )
-    [ [ commands hash-values [ % ] each ] each ] { } make
+    [ commands "Toolbar" swap hash ] map concat
     [ <command-presentation> ] map-with
     make-shelf ;