Show persistent border on right clicking presentation gadgets
parent
fc7b70a17e
commit
4ce72ddbfb
|
@ -1,13 +1,16 @@
|
||||||
! Copyright (C) 2005, 2009 Slava Pestov.
|
! Copyright (C) 2005, 2009 Slava Pestov.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: accessors kernel namespaces ui.commands ui.gadgets
|
USING: accessors kernel memoize namespaces ui.commands ui.gadgets
|
||||||
ui.gadgets.buttons ui.gadgets.buttons.private ui.gadgets.menus
|
ui.gadgets.borders ui.gadgets.buttons ui.gadgets.buttons.private
|
||||||
ui.gadgets.status-bar ui.gadgets.worlds ui.gestures
|
ui.gadgets.glass ui.gadgets.menus ui.gadgets.status-bar
|
||||||
ui.operations ;
|
ui.gadgets.theme ui.gadgets.worlds ui.gestures
|
||||||
|
ui.operations ui.pens.solid ;
|
||||||
IN: ui.gadgets.presentations
|
IN: ui.gadgets.presentations
|
||||||
|
|
||||||
TUPLE: presentation < button object hook ;
|
TUPLE: presentation < button object hook ;
|
||||||
|
|
||||||
|
TUPLE: presentation-menu < border presentation ;
|
||||||
|
|
||||||
: invoke-presentation ( presentation command -- )
|
: invoke-presentation ( presentation command -- )
|
||||||
[ [ dup hook>> call( presentation -- ) ] [ object>> ] bi ] dip
|
[ [ dup hook>> call( presentation -- ) ] [ object>> ] bi ] dip
|
||||||
invoke-command ;
|
invoke-command ;
|
||||||
|
@ -33,9 +36,26 @@ 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 ;
|
||||||
|
|
||||||
|
MEMO: selected-pen-boundary ( -- button-pen )
|
||||||
|
roll-button-rollover-border <solid> dup dup f f <button-pen> ;
|
||||||
|
|
||||||
|
<PRIVATE
|
||||||
|
: setup-presentation ( presentation -- presentation )
|
||||||
|
selected-pen-boundary >>boundary ;
|
||||||
|
PRIVATE>
|
||||||
|
|
||||||
|
: <presentation-menu> ( presentation target hook -- menu )
|
||||||
|
<operations-menu> presentation-menu new-border
|
||||||
|
swap >>presentation
|
||||||
|
{ 0 0 } >>size ;
|
||||||
|
|
||||||
: show-presentation-menu ( presentation -- )
|
: show-presentation-menu ( presentation -- )
|
||||||
|
setup-presentation dup
|
||||||
[ ] [ object>> ] [ dup hook>> curry ] tri
|
[ ] [ object>> ] [ dup hook>> curry ] tri
|
||||||
show-operations-menu ;
|
<presentation-menu> show-menu ;
|
||||||
|
|
||||||
|
M: presentation-menu hide-glass-hook
|
||||||
|
presentation>> button-pen-boundary >>boundary drop ;
|
||||||
|
|
||||||
presentation H{
|
presentation H{
|
||||||
{ T{ button-down f f 3 } [ show-presentation-menu ] }
|
{ T{ button-down f f 3 } [ show-presentation-menu ] }
|
||||||
|
|
Loading…
Reference in New Issue