Refactor operations-menu code to make it independent of presentations
parent
acfa7f1ae1
commit
69c64ba803
|
@ -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 ;
|
|
@ -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
|
||||||
|
|
Loading…
Reference in New Issue