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