Refactor operations-menu code to make it independent of presentations

db4
Slava Pestov 2008-12-18 23:56:41 -06:00
parent acfa7f1ae1
commit 69c64ba803
2 changed files with 15 additions and 14 deletions

View File

@ -1,6 +1,6 @@
! Copyright (C) 2005, 2008 Slava Pestov. ! Copyright (C) 2005, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: locals accessors arrays ui.commands ui.gadgets USING: locals accessors arrays ui.commands ui.operations ui.gadgets
ui.gadgets.buttons ui.gadgets.worlds ui.gestures generic ui.gadgets.buttons ui.gadgets.worlds ui.gestures generic
hashtables kernel math models namespaces opengl sequences hashtables kernel math models namespaces opengl sequences
math.vectors ui.gadgets.theme ui.gadgets.packs math.vectors ui.gadgets.theme ui.gadgets.packs
@ -54,3 +54,9 @@ M: menu-glass layout* gadget-child prefer ;
: show-commands-menu ( target commands -- ) : show-commands-menu ( target commands -- )
[ dup [ ] ] dip <commands-menu> show-menu ; [ dup [ ] ] dip <commands-menu> show-menu ;
: <operations-menu> ( target hook -- menu )
over object-operations <commands-menu> ;
: show-operations-menu ( gadget target -- )
[ ] <operations-menu> show-menu ;

View File

@ -11,8 +11,8 @@ IN: ui.gadgets.presentations
TUPLE: presentation < button object hook ; TUPLE: presentation < button object hook ;
: invoke-presentation ( presentation command -- ) : invoke-presentation ( presentation command -- )
over dup hook>> call [ [ dup hook>> call ] [ object>> ] bi ] dip
[ object>> ] dip invoke-command ; invoke-command ;
: invoke-primary ( presentation -- ) : invoke-primary ( presentation -- )
dup object>> primary-operation dup object>> primary-operation
@ -23,7 +23,7 @@ TUPLE: presentation < button object hook ;
invoke-presentation ; invoke-presentation ;
: show-mouse-help ( presentation -- ) : show-mouse-help ( presentation -- )
dup object>> over show-summary button-update ; [ [ object>> ] keep show-summary ] [ button-update ] bi ;
: <presentation> ( label object -- button ) : <presentation> ( label object -- button )
swap [ invoke-primary ] presentation new-button swap [ invoke-primary ] presentation new-button
@ -35,18 +35,13 @@ M: presentation ungraft*
dup hand-gadget get-global child? [ dup hide-status ] when dup hand-gadget get-global child? [ dup hide-status ] when
call-next-method ; call-next-method ;
: <operations-menu> ( presentation -- menu ) : show-operations-menu ( presentation -- )
[ object>> ] [ ] [ object>> ] [ dup hook>> curry ] tri
[ dup hook>> curry ] <operations-menu> show-menu ;
[ object>> object-operations ]
tri <commands-menu> ;
: operations-menu ( presentation -- )
dup <operations-menu> show-menu ;
presentation H{ presentation H{
{ T{ button-down f f 3 } [ operations-menu ] } { T{ button-down f f 3 } [ show-operations-menu ] }
{ T{ mouse-leave } [ dup hide-status button-update ] } { T{ mouse-leave } [ [ hide-status ] [ button-update ] bi ] }
{ T{ mouse-enter } [ show-mouse-help ] } { T{ mouse-enter } [ show-mouse-help ] }
! Responding to motion too allows nested presentations to ! Responding to motion too allows nested presentations to
! display status help properly, when the mouse leaves a ! display status help properly, when the mouse leaves a