Merge branch 'master' of git://factorcode.org/git/factor

diff --cc basis/ui/gadgets/tabs/tabs.factor
index 0000000000000000000000000000000000000000,12031e5911124594b083eb3fa205d25de286fc66..50e2df2e9e3ec90696702325d026f6d672fa5af8
mode 000000,100755..100755
--- /dev/null
--- 2/basis/ui/gadgets/tabs/tabs.factor
+++ b/basis/ui/gadgets/tabs/tabs.factor
@@@ -1,0 -1,61 +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