Show persistent border on right clicking presentation gadgets

basis/ui/gadgets/presentations/presentations.factor

@@ -1,13 +1,16 @@
 ! Copyright (C) 2005, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors kernel namespaces ui.commands ui.gadgets
-ui.gadgets.buttons ui.gadgets.buttons.private ui.gadgets.menus
-ui.gadgets.status-bar ui.gadgets.worlds ui.gestures
-ui.operations ;
+USING: accessors kernel memoize namespaces ui.commands ui.gadgets
+ui.gadgets.borders ui.gadgets.buttons ui.gadgets.buttons.private
+ui.gadgets.glass ui.gadgets.menus ui.gadgets.status-bar
+ui.gadgets.theme ui.gadgets.worlds ui.gestures
+ui.operations ui.pens.solid ;
 IN: ui.gadgets.presentations
 
 TUPLE: presentation < button object hook ;
 
+TUPLE: presentation-menu < border presentation ;
+
 : invoke-presentation ( presentation command -- )
     [ [ dup hook>> call( presentation -- ) ] [ object>> ] bi ] dip
     invoke-command ;
@@ -33,9 +36,26 @@ M: presentation ungraft*
     dup hand-gadget get-global child? [ dup hide-status ] when
     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 -- )
+    setup-presentation dup
     [ ] [ 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{
     { T{ button-down f f 3 } [ show-presentation-menu ] }