Books don't add/remove their children

TODO.FACTOR.txt

@@ -1,5 +1,6 @@
 + 0.85:
 
+- font corruption now that books don't add/remove their children
 - pane output in UI should use less memory
 - signal 4 on datastack underflow on mac intel??
 - buffer-ptr should be an alien
@@ -44,8 +45,6 @@
 - draw-world: bail out if world is 0x0
 - better help result ranking
 - page scrolling should be timer-based too
-- invoking interactor commands when interactor is busy -- still fucked
-  because of grafting and ungrafting
 - x11: scroll up/down wiggles caret
 - roundoff is still not quite right with tracks
 - fix top level window positioning

library/generic/methods.factor

@@ -52,10 +52,11 @@ M: method-spec where*
 M: method-spec subdefs drop f ;
 
 M: generic subdefs
-    dup order [ swap 2array ] map-with ;
+    dup "methods" word-prop hash-keys natural-sort
+    [ swap 2array ] map-with ;
 
 M: class subdefs
-    dup implementors [ 2array ] map-with ;
+    dup implementors natural-sort [ 2array ] map-with ;
 
 M: method-spec forget
     first2 [ remove-hash ] with-methods ;

library/ui/gadgets/books.factor

@@ -4,26 +4,29 @@ IN: gadgets-books
 USING: gadgets gadgets-controls gadgets-panes gadgets-scrolling
 kernel sequences models ;
 
-TUPLE: book pages ;
+TUPLE: book ;
 
-: get-page ( n book -- page ) book-pages nth ;
+: hide-all ( book -- ) gadget-children [ hide-gadget ] each ;
+
+: current-page ( book -- gadget )
+    [ control-model model-value ] keep nth-gadget ;
 
 M: book model-changed ( book -- )
-    [ control-model model-value ] keep
+    dup hide-all
-    [ gadget-child unparent ] keep
+    dup current-page show-gadget
-    [ get-page ] keep
+    dup relayout
-    [ control-self add-gadget ] keep
     request-focus ;
 
 C: book ( pages -- book )
     dup 0 <model> delegate>control
+    [ add-gadgets ] keep
     dup dup set-control-self
-    [ set-book-pages ] keep
     dup model-changed ;
 
-M: book pref-dim* gadget-child pref-dim ;
+M: book pref-dim* gadget-children pref-dims max-dim ;
 
 M: book layout*
-    dup rect-dim swap gadget-child set-layout-dim ;
+    dup rect-dim swap gadget-children
+    [ set-layout-dim ] each-with ;
 
-M: book focusable-child* gadget-child ;
+M: book focusable-child* current-page ;

library/ui/layouts.factor

@@ -41,12 +41,9 @@ DEFER: relayout
     dup gadget-state
     [ drop ] [ dup invalidate add-invalid ] if ;
 
-: show-gadget t over set-gadget-visible? relayout-1 ;
+: show-gadget t swap set-gadget-visible? ;
 
-: hide-gadget f over set-gadget-visible? relayout-1 ;
+: hide-gadget f swap set-gadget-visible? ;
-
-: toggle-visible ( gadget -- )
-    dup gadget-visible? [ hide-gadget ] [ show-gadget ] if ;
 
 : (set-rect-dim) ( dim gadget quot -- )
     >r 2dup rect-dim =

library/ui/tools/tools.factor

@@ -13,8 +13,9 @@ TUPLE: workspace ;
 TUPLE: tool gadget ;
 
 : show-tool ( class workspace -- tool )
-    [ book-pages [ tool-gadget class eq? ] find-with swap ] keep
+    [
-    control-model set-model* ;
+        gadget-children [ tool-gadget class eq? ] find-with swap
+    ] keep control-model set-model* ;
 
 : select-tool ( workspace class -- ) swap show-tool drop ;