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

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