steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Updating help gadget

darcs
slava 2006-06-29 07:54:30 +00:00
parent 3ddcb4d2f3
commit 5f26260396
8 changed files with 61 additions and 49 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
library/ui/gadgets/grids.factor
View File

@ -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 ;

12
library/ui/gadgets/sliders.factor
View File

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

4
library/ui/gadgets/tracks.factor
View File

@ -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 )

11
library/ui/hierarchy.factor
View File

@ -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
r> call gadget get r> r> call ; inline
[
over first %
over second [ [ dup gadget get ] % , ] when*
over third %
[ gadget get ] %
swap fourth ,
%
] [ ] make call ;
: (parents) ( gadget vector -- )
over

3
library/ui/tools/browser.factor
View File

@ -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> ,

70
library/ui/tools/help.factor
View File

@ -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
gadgets-scrolling gadgets-search gadgets-tiles
gadgets-tracks help io kernel 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 ;
USING: gadgets gadgets-buttons gadgets-frames gadgets-panes
gadgets-presentations gadgets-scrolling gadgets-search
gadgets-tiles gadgets-tracks help io kernel models namespaces
sequences words ;
TUPLE: help-gadget showing history pane ;
C: help-gadget ( -- gadget )
{
{ [ <history> ] set-help-gadget-history f 1/4 }
{ [ <pane> ] set-help-gadget-pane [ <scroller> ] 3/4 }
} { 1 0 } make-track* ;
: find-help-gadget [ help-gadget? ] find-parent ;
M: help-gadget gadget-title
"Help - " swap help-gadget-showing article-title append ;
: go-back ( help -- )
dup help-gadget-history dup empty? [
2drop
] [
pop swap help-gadget-showing set-model
] if ;
: add-history ( help -- )
dup help-gadget-history
swap help-gadget-showing dup
[ over history-seq push-new update-history ] [ 2drop ] if ;
dup help-gadget-showing model-value dup [
swap help-gadget-history push
] [
2drop
] if ;
: show-help ( link help -- )
dup add-history
[ set-help-gadget-showing ] 2keep
dup update-title
help-gadget-pane [ help ] with-pane ;
[ help-gadget-showing set-model ] keep
dup update-title ;
: 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? ]

2
library/ui/tools/search.factor
View File

@ -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* ;

6
library/ui/ui.factor
View File

@ -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