From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Mon, 11 Aug 2008 06:40:35 +0000 (-0500)
Subject: Merge branch 'master' of git://factorforge.org/git/william42
X-Git-Tag: 0.94~2439^2~194^2~13
X-Git-Url: https://gitweb.factorcode.org/gitweb.cgi?p=factor.git;a=commitdiff_plain;h=58a40025f4cbbedd8cc9f8670b68d69ed1414bb9

Merge branch 'master' of git://factorforge.org/git/william42
---

58a40025f4cbbedd8cc9f8670b68d69ed1414bb9
diff --cc basis/ui/gadgets/tabs/tabs.factor
index 12031e5911,0000000000..50e2df2e9e
mode 100755,000000..100755
--- a/basis/ui/gadgets/tabs/tabs.factor
+++ b/basis/ui/gadgets/tabs/tabs.factor
@@@ -1,61 -1,0 +1,62 @@@
 +! Copyright (C) 2008 William Schlieper
 +! See http://factorcode.org/license.txt for BSD license.
 +
 +USING: accessors kernel fry math math.vectors sequences arrays vectors assocs
 +       hashtables models models.range models.compose combinators
 +       ui ui.gadgets ui.gadgets.buttons ui.gadgets.frames ui.gadgets.packs
 +       ui.gadgets.grids ui.gadgets.viewports ui.gadgets.books locals ;
 +
 +IN: ui.gadgets.tabs
 +
 +TUPLE: tabbed < frame names toggler content ;
 +
 +DEFER: (del-page)
 +
 +:: add-toggle ( model n name toggler -- )
 +  <frame>
 +    n name toggler parent>> '[ , , , (del-page) ] "X" swap <bevel-button>
 +      @right grid-add
 +    n model name <toggle-button> @center grid-add
 +  toggler swap add-gadget drop ;
 +
 +: redo-toggler ( tabbed -- )
 +     [ names>> ] [ model>> ] [ toggler>> ] tri
 +     [ clear-gadget ] keep
 +     [ [ length ] keep ] 2dip
 +    '[ , _ _ , add-toggle ] 2each ;
 +
 +: refresh-book ( tabbed -- )
 +    model>> [ ] change-model ;
 +
 +: (del-page) ( n name tabbed -- )
 +    { [ [ remove ] change-names redo-toggler ]
 +      [ dupd [ names>> length ] [ model>> ] bi
 +        [ [ = ] keep swap [ 1- ] when
 +          [ < ] keep swap [ 1- ] when ] change-model ]
 +      [ content>> nth-gadget unparent ]
 +      [ refresh-book ]
 +    } cleave ;
 +
 +: add-page ( page name tabbed -- )
 +    [ names>> push ] 2keep
 +    [ [ model>> swap ]
 +      [ names>> length 1 - swap ]
 +      [ toggler>> ] tri add-toggle ]
 +    [ content>> swap add-gadget drop ]
 +    [ refresh-book ] tri ;
 +
 +: del-page ( name tabbed -- )
 +    [ names>> index ] 2keep (del-page) ;
 +
- : <tabbed> ( assoc -- tabbed )
-   tabbed new-frame
++: new-tabbed ( assoc class -- tabbed )
++    new-frame
 +    0 <model> >>model
 +    <pile> 1 >>fill >>toggler
 +    dup toggler>> @left grid-add
 +    swap
 +      [ keys >vector >>names ]
 +      [ values over model>> <book> >>content dup content>> @center grid-add ]
 +    bi
 +    dup redo-toggler ;
 +    
++: <tabbed> ( assoc -- tabbed ) tabbed new-tabbed ;