Books don't add/remove their children

darcs
slava 2006-09-16 20:31:40 +00:00
parent f89254bfb5
commit c2c4417be5
5 changed files with 22 additions and 21 deletions

View File

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

View File

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

View File

@ -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
[ gadget-child unparent ] keep
[ get-page ] keep
[ control-self add-gadget ] keep
dup hide-all
dup current-page show-gadget
dup relayout
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 ;

View File

@ -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 ;
: toggle-visible ( gadget -- )
dup gadget-visible? [ hide-gadget ] [ show-gadget ] if ;
: hide-gadget f swap set-gadget-visible? ;
: (set-rect-dim) ( dim gadget quot -- )
>r 2dup rect-dim =

View File

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