Updating help gadget

library/ui/gadgets/grids.factor

@@ -72,4 +72,4 @@ M: grid layout* ( frame -- dim )
     #! Specs is an array of quadruples { quot post setter loc }.
     #! The setter has stack effect ( new gadget -- ),
     #! the loc is @center, @top, etc.
-    [ [ [ execute grid-add ] add-spec ] each ] with-gadget ;
+    swap [ [ [ grid-add ] add-spec ] each ] with-gadget ;

library/ui/gadgets/sliders.factor

@@ -128,9 +128,9 @@ M: elevator layout* ( elevator -- )
 
 : build-x-slider ( slider -- slider )
     {
-        { [ <left-button> ] f @left }
+        { [ <left-button> ] f f @left }
-        { [ { 0 1 } <elevator> ] set-slider-elevator @center }
+        { [ { 0 1 } <elevator> ] set-slider-elevator f @center }
-        { [ <right-button> ] f @right }
+        { [ <right-button> ] f f @right }
     } build-grid ;
 
 : <up-button> { 1 0 } arrow-up -1 <slide-button> ;
@@ -138,9 +138,9 @@ M: elevator layout* ( elevator -- )
 
 : build-y-slider ( slider -- slider )
     {
-        { [ <up-button> ] f @top }
+        { [ <up-button> ] f f @top }
-        { [ { 1 0 } <elevator> ] set-slider-elevator @center }
+        { [ { 1 0 } <elevator> ] set-slider-elevator f @center }
-        { [ <down-button> ] f @bottom }
+        { [ <down-button> ] f f @bottom }
     } build-grid ;
 
 : add-thumb ( slider vector -- )

library/ui/gadgets/tracks.factor

@@ -136,9 +136,9 @@ C: divider ( -- divider )
     #! Specs is an array of quadruples { quot post setter loc }.
     #! The setter has stack effect ( new gadget -- ),
     #! the loc is a ratio from 0 to 1.
-    [
+    swap [
         [ [ [ drop track-add ] add-spec ] each ] keep
-        [ third ] map gadget get set-track-sizes
+        [ peek ] map gadget get set-track-sizes
     ] with-gadget ;
 
 : make-track ( specs orientation -- gadget )

library/ui/hierarchy.factor

@@ -53,9 +53,14 @@ M: gadget remove-notify* drop ;
     swap [ over (add-gadget) ] each relayout ;
 
 : add-spec ( { quot setter post loc } quot -- )
-    >r first4 >r >r >r call dup r>
+    [
-    dup [ gadget get execute ] [ 2drop ] if
+        over first %
-    r> call gadget get r> r> call ; inline
+        over second [ [ dup gadget get ] % , ] when*
+        over third %
+        [ gadget get ] %
+        swap fourth ,
+        %
+    ] [ ] make call ;
 
 : (parents) ( gadget vector -- )
     over

library/ui/tools/browser.factor

@@ -137,9 +137,6 @@ C: browser-tracks ( browser -- browser-track )
     browser-tabs dup length [ swap first 2array ] 2map
     <radio-box> ;
 
-: make-toolbar ( quot -- gadget )
-    { } make make-shelf dup highlight-theme ; inline
-
 : <browser-toolbar> ( browser -- toolbar )
     [
         <browser-tabs> ,

library/ui/tools/help.factor

@@ -1,45 +1,55 @@
 ! Copyright (C) 2006 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 IN: gadgets-help
-USING: gadgets gadgets-panes gadgets-presentations
+USING: gadgets gadgets-buttons gadgets-frames gadgets-panes
-gadgets-scrolling gadgets-search gadgets-tiles
+gadgets-presentations gadgets-scrolling gadgets-search
-gadgets-tracks help io kernel sequences words ;
+gadgets-tiles gadgets-tracks help io kernel models namespaces
-
+sequences words ;
-TUPLE: history pane seq ;
-
-C: history ( -- gadget )
-    V{ } clone over set-history-seq
-    <pane> dup pick set-history-pane
-    <scroller> "History" f <tile> over set-gadget-delegate ;
-
-: update-history ( history -- )
-    dup history-seq swap history-pane [
-        <reversed> [
-            [ article-title ] keep write-object terpri
-        ] each
-    ] with-pane ;
 
 TUPLE: help-gadget showing history pane ;
 
-C: help-gadget ( -- gadget )
+: find-help-gadget [ help-gadget? ] find-parent ;
-    {
-        { [ <history> ] set-help-gadget-history f 1/4 }
-        { [ <pane> ] set-help-gadget-pane [ <scroller> ] 3/4 }
-    } { 1 0 } make-track* ;
 
-M: help-gadget gadget-title
+: go-back ( help -- )
-    "Help - " swap help-gadget-showing article-title append ;
+    dup help-gadget-history dup empty? [
+        2drop
+    ] [
+        pop swap help-gadget-showing set-model
+    ] if ;
 
 : add-history ( help -- )
-    dup help-gadget-history
+    dup help-gadget-showing model-value dup [
-    swap help-gadget-showing dup
+        swap help-gadget-history push
-    [ over history-seq push-new update-history ] [ 2drop ] if ;
+    ] [
+        2drop
+    ] if ;
 
 : show-help ( link help -- )
     dup add-history
-    [ set-help-gadget-showing ] 2keep
+    [ help-gadget-showing set-model ] keep
-    dup update-title
+    dup update-title ;
-    help-gadget-pane [ help ] with-pane ;
+
+: go-home ( help -- ) "handbook" swap show-help ;
+
+: <help-toolbar> ( -- gadget )
+    [
+        "Back" [ find-help-gadget go-back ] <bevel-button> ,
+        "Home" [ find-help-gadget go-home ] <bevel-button> ,
+    ] make-toolbar ;
+
+: <help-pane> ( -- gadget )
+    gadget get help-gadget-showing [ help ] <pane-control> ;
+
+C: help-gadget ( -- gadget )
+    V{ } over set-help-gadget-history
+    f <model> over set-help-gadget-showing {
+        { [ <help-toolbar> ] f f @top }
+        { [ <help-pane> <scroller> ] f f @center }
+    } make-frame* ;
+
+M: help-gadget gadget-title
+    "Help - " swap help-gadget-showing model-value
+    article-title append ;
 
 : help-tool
     [ help-gadget? ]

library/ui/tools/search.factor

@@ -22,7 +22,7 @@ M: search-gadget gadget-gestures
 
 C: search-gadget ( quot -- )
     [ set-search-gadget-quot ] keep {
-        { [ <pane> ] set-search-gadget-scroller [ <scroller> ] @center }
+        { [ <pane> ] set-search-gadget-pane [ <scroller> ] @center }
         { [ "" <editor> ] set-search-gadget-input f @top }
     } make-frame* ;
 

library/ui/ui.factor

@@ -22,9 +22,6 @@ SYMBOL: windows
     windows get-global [ second eq? ] find-with drop
     windows get-global [ length 1- ] keep exchange ;
 
-: frontmost-window ( -- world )
-    windows get dup empty? [ drop f ] [ peek second ] if ;
-
 : update-hand ( gadget -- )
     find-world [
         dup hand-gadget get-global find-world eq?
@@ -141,3 +138,6 @@ C: titled-gadget ( gadget title -- )
 
 : restore-windows? ( -- ? )
     windows get [ empty? not ] [ f ] if* ;
+
+: make-toolbar ( quot -- gadget )
+    { } make make-shelf dup highlight-theme ; inline