module MenuPopupF(PopupMenu(..), menuPopupF, menuPopupF') where
import Command
import Cursor
import Shells(unmappedShellF')
import FDefaults() -- synonym Customiser, for hbc
import DShellF(setFocusMgr)
import Event
import Fudget
import FRequest
import Geometry(Point)
import Loops(loopCompThroughRightF,loopThroughRightF)
--import Message(Message(..))
import CompSP(prepostMapSP)
import SerCompF(mapstateF)
import NullF
import Xtypes
import Data.List(union)

data PopupMenu
  = PopupMenu Point XEvent -- Time to pop up the menu.
  | PopupMenuStick	   -- The mouse button has been released, but stay up.
  | PopdownMenu		   -- Time to hide the menu.
  deriving Int -> PopupMenu -> ShowS
[PopupMenu] -> ShowS
PopupMenu -> String
(Int -> PopupMenu -> ShowS)
-> (PopupMenu -> String)
-> ([PopupMenu] -> ShowS)
-> Show PopupMenu
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PopupMenu] -> ShowS
$cshowList :: [PopupMenu] -> ShowS
show :: PopupMenu -> String
$cshow :: PopupMenu -> String
showsPrec :: Int -> PopupMenu -> ShowS
$cshowsPrec :: Int -> PopupMenu -> ShowS
Show
  --deriving (Eq, Ord)

menuPopupF :: F b d -> F (Either PopupMenu b) d
menuPopupF = Bool -> F b d -> F (Either PopupMenu b) d
forall b d. Bool -> F b d -> F (Either PopupMenu b) d
menuPopupF' Bool
False

menuPopupF' :: Bool -> F b d -> F (Either PopupMenu b) d
menuPopupF' Bool
delayed F b d
menu =
    F (Either (Either d (Either PopupMenu b)) (Either Bool b))
  (Either (Either (Either Bool b) d) d)
-> F (Either PopupMenu b) d
forall a b c d.
F (Either (Either a b) c) (Either (Either c d) a) -> F b d
loopCompThroughRightF (F (Either (Either d (Either PopupMenu b)) (Either Bool b))
  (Either (Either (Either Bool b) d) d)
-> F (Either (Either d (Either PopupMenu b)) (Either Bool b))
     (Either (Either (Either Bool b) d) d)
forall hi ho. F hi ho -> F hi ho
dF (F (Either (Either d (Either PopupMenu b)) (Either Bool b))
   (Either (Either (Either Bool b) d) d)
 -> F (Either (Either d (Either PopupMenu b)) (Either Bool b))
      (Either (Either (Either Bool b) d) d))
-> F (Either (Either d (Either PopupMenu b)) (Either Bool b))
     (Either (Either (Either Bool b) d) d)
-> F (Either (Either d (Either PopupMenu b)) (Either Bool b))
     (Either (Either (Either Bool b) d) d)
forall a b. (a -> b) -> a -> b
$ (ShellF -> ShellF)
-> [FRequest]
-> K (Either d (Either PopupMenu b)) (Either (Either Bool b) d)
-> F (Either Bool b) d
-> F (Either (Either d (Either PopupMenu b)) (Either Bool b))
     (Either (Either (Either Bool b) d) d)
forall (t :: * -> *) a b c d.
Foldable t =>
(ShellF -> ShellF)
-> t FRequest -> K a b -> F c d -> F (Either a c) (Either b d)
unmappedShellF' ShellF -> ShellF
pm [FRequest]
startcmds K (Either d (Either PopupMenu b)) (Either (Either Bool b) d)
forall b b.
K (Either b (Either PopupMenu b)) (Either (Either Bool b) b)
popupShellK F (Either Bool b) d
menu')
  where
    dF :: F hi ho -> F hi ho
dF = if Bool
delayed then F hi ho -> F hi ho
forall hi ho. F hi ho -> F hi ho
delayF else F hi ho -> F hi ho
forall a. a -> a
id
    pm :: ShellF -> ShellF
pm = Bool -> ShellF -> ShellF
setFocusMgr Bool
False
    menu' :: F (Either Bool b) d
menu' = F b d -> F (Either Bool b) d
forall b d. F b d -> F (Either Bool b) d
handleButtonMachinesF F b d
menu
    startcmds :: [FRequest]
startcmds = [XCommand -> FRequest
XCmd (XCommand -> FRequest) -> XCommand -> FRequest
forall a b. (a -> b) -> a -> b
$ [WindowAttributes] -> XCommand
ChangeWindowAttributes [WindowAttributes]
wattrs,
		 XCommand -> FRequest
XCmd (XCommand -> FRequest) -> XCommand -> FRequest
forall a b. (a -> b) -> a -> b
$ [WindowChanges] -> XCommand
ConfigureWindow [Int -> WindowChanges
CWBorderWidth Int
1]]
    wattrs :: [WindowAttributes]
wattrs = [[EventMask] -> WindowAttributes
CWEventMask [], Bool -> WindowAttributes
CWSaveUnder Bool
True, Bool -> WindowAttributes
CWOverrideRedirect Bool
True]

popupShellK :: K (Either b (Either PopupMenu b)) (Either (Either Bool b) b)
popupShellK =
    Int
-> K (Either b (Either PopupMenu b)) (Either (Either Bool b) b)
-> K (Either b (Either PopupMenu b)) (Either (Either Bool b) b)
forall a b. Int -> K a b -> K a b
setFontCursor Int
110 K (Either b (Either PopupMenu b)) (Either (Either Bool b) b)
forall b b.
K (Either b (Either PopupMenu b)) (Either (Either Bool b) b)
downK
  where
    mouse :: XEvent -> Bool
mouse (ButtonEvent {}) = Bool
True
    mouse (EnterNotify {}) = Bool
True
    mouse XEvent
_ = Bool
False
    samekey :: XEvent -> String -> Bool
samekey (KeyEvent {keySym :: XEvent -> String
keySym=String
ks}) String
ks' = String
ks String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
ks'
    samekey XEvent
_ String
_ = Bool
False

    toMenu :: b -> Message a (Either (Either a b) b)
toMenu = Either (Either a b) b -> Message a (Either (Either a b) b)
forall a b. b -> Message a b
High (Either (Either a b) b -> Message a (Either (Either a b) b))
-> (b -> Either (Either a b) b)
-> b
-> Message a (Either (Either a b) b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either a b -> Either (Either a b) b
forall a b. a -> Either a b
Left (Either a b -> Either (Either a b) b)
-> (b -> Either a b) -> b -> Either (Either a b) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Either a b
forall a b. b -> Either a b
Right
    toBms :: a -> Message a (Either (Either a b) b)
toBms = Either (Either a b) b -> Message a (Either (Either a b) b)
forall a b. b -> Message a b
High (Either (Either a b) b -> Message a (Either (Either a b) b))
-> (a -> Either (Either a b) b)
-> a
-> Message a (Either (Either a b) b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either a b -> Either (Either a b) b
forall a b. a -> Either a b
Left (Either a b -> Either (Either a b) b)
-> (a -> Either a b) -> a -> Either (Either a b) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either a b
forall a b. a -> Either a b
Left
    out :: b -> Message a (Either a b)
out = Either a b -> Message a (Either a b)
forall a b. b -> Message a b
High (Either a b -> Message a (Either a b))
-> (b -> Either a b) -> b -> Message a (Either a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Either a b
forall a b. b -> Either a b
Right

    popdown :: [Message FRequest b]
popdown = (XCommand -> Message FRequest b)
-> [XCommand] -> [Message FRequest b]
forall a b. (a -> b) -> [a] -> [b]
map (FRequest -> Message FRequest b
forall a b. a -> Message a b
Low (FRequest -> Message FRequest b)
-> (XCommand -> FRequest) -> XCommand -> Message FRequest b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XCommand -> FRequest
XCmd) [XCommand
UnmapWindow]
    popup :: Point -> [Message FRequest (Either (Either Bool b) b)]
popup Point
p = Bool -> Message FRequest (Either (Either Bool b) b)
forall a a b b. a -> Message a (Either (Either a b) b)
toBms Bool
TrueMessage FRequest (Either (Either Bool b) b)
-> [Message FRequest (Either (Either Bool b) b)]
-> [Message FRequest (Either (Either Bool b) b)]
forall a. a -> [a] -> [a]
:(XCommand -> Message FRequest (Either (Either Bool b) b))
-> [XCommand] -> [Message FRequest (Either (Either Bool b) b)]
forall a b. (a -> b) -> [a] -> [b]
map (FRequest -> Message FRequest (Either (Either Bool b) b)
forall a b. a -> Message a b
Low (FRequest -> Message FRequest (Either (Either Bool b) b))
-> (XCommand -> FRequest)
-> XCommand
-> Message FRequest (Either (Either Bool b) b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XCommand -> FRequest
XCmd) [Point -> XCommand
moveWindow Point
p, XCommand
MapRaised]

    downK :: K (Either b (Either PopupMenu b)) (Either (Either Bool b) b)
downK =
      Cont
  (K (Either b (Either PopupMenu b)) (Either (Either Bool b) b))
  (KEvent (Either b (Either PopupMenu b)))
forall hi ho. Cont (K hi ho) (KEvent hi)
getK Cont
  (K (Either b (Either PopupMenu b)) (Either (Either Bool b) b))
  (KEvent (Either b (Either PopupMenu b)))
-> Cont
     (K (Either b (Either PopupMenu b)) (Either (Either Bool b) b))
     (KEvent (Either b (Either PopupMenu b)))
forall a b. (a -> b) -> a -> b
$ \KEvent (Either b (Either PopupMenu b))
msg ->
      case KEvent (Either b (Either PopupMenu b))
msg of
	High (Right (Left (PopupMenu Point
p XEvent
ev))) -> [KCommand (Either (Either Bool b) b)]
-> K (Either b (Either PopupMenu b)) (Either (Either Bool b) b)
-> K (Either b (Either PopupMenu b)) (Either (Either Bool b) b)
forall b a. [KCommand b] -> K a b -> K a b
putsK (Point -> [KCommand (Either (Either Bool b) b)]
forall b b. Point -> [Message FRequest (Either (Either Bool b) b)]
popup Point
p)     (K (Either b (Either PopupMenu b)) (Either (Either Bool b) b)
 -> K (Either b (Either PopupMenu b)) (Either (Either Bool b) b))
-> K (Either b (Either PopupMenu b)) (Either (Either Bool b) b)
-> K (Either b (Either PopupMenu b)) (Either (Either Bool b) b)
forall a b. (a -> b) -> a -> b
$ XEvent
-> K (Either b (Either PopupMenu b)) (Either (Either Bool b) b)
upK XEvent
ev
	High (Right (Right b
x))               -> KCommand (Either (Either Bool b) b)
-> K (Either b (Either PopupMenu b)) (Either (Either Bool b) b)
-> K (Either b (Either PopupMenu b)) (Either (Either Bool b) b)
forall ho hi. KCommand ho -> K hi ho -> K hi ho
putK  (b -> KCommand (Either (Either Bool b) b)
forall b a a b. b -> Message a (Either (Either a b) b)
toMenu b
x)    (K (Either b (Either PopupMenu b)) (Either (Either Bool b) b)
 -> K (Either b (Either PopupMenu b)) (Either (Either Bool b) b))
-> K (Either b (Either PopupMenu b)) (Either (Either Bool b) b)
-> K (Either b (Either PopupMenu b)) (Either (Either Bool b) b)
forall a b. (a -> b) -> a -> b
$ K (Either b (Either PopupMenu b)) (Either (Either Bool b) b)
downK
	High (Left b
x)                        -> KCommand (Either (Either Bool b) b)
-> K (Either b (Either PopupMenu b)) (Either (Either Bool b) b)
-> K (Either b (Either PopupMenu b)) (Either (Either Bool b) b)
forall ho hi. KCommand ho -> K hi ho -> K hi ho
putK  (b -> KCommand (Either (Either Bool b) b)
forall b a a. b -> Message a (Either a b)
out b
x)       (K (Either b (Either PopupMenu b)) (Either (Either Bool b) b)
 -> K (Either b (Either PopupMenu b)) (Either (Either Bool b) b))
-> K (Either b (Either PopupMenu b)) (Either (Either Bool b) b)
-> K (Either b (Either PopupMenu b)) (Either (Either Bool b) b)
forall a b. (a -> b) -> a -> b
$ K (Either b (Either PopupMenu b)) (Either (Either Bool b) b)
downK
	KEvent (Either b (Either PopupMenu b))
_ -> K (Either b (Either PopupMenu b)) (Either (Either Bool b) b)
downK

    upK :: XEvent
-> K (Either b (Either PopupMenu b)) (Either (Either Bool b) b)
upK XEvent
ev =
      Cont
  (K (Either b (Either PopupMenu b)) (Either (Either Bool b) b))
  (KEvent (Either b (Either PopupMenu b)))
forall hi ho. Cont (K hi ho) (KEvent hi)
getK Cont
  (K (Either b (Either PopupMenu b)) (Either (Either Bool b) b))
  (KEvent (Either b (Either PopupMenu b)))
-> Cont
     (K (Either b (Either PopupMenu b)) (Either (Either Bool b) b))
     (KEvent (Either b (Either PopupMenu b)))
forall a b. (a -> b) -> a -> b
$ \KEvent (Either b (Either PopupMenu b))
msg ->
      case KEvent (Either b (Either PopupMenu b))
msg of
	High (Right (Left (PopupMenu Point
p XEvent
ev))) -> [KCommand (Either (Either Bool b) b)]
-> K (Either b (Either PopupMenu b)) (Either (Either Bool b) b)
-> K (Either b (Either PopupMenu b)) (Either (Either Bool b) b)
forall b a. [KCommand b] -> K a b -> K a b
putsK (Point -> [KCommand (Either (Either Bool b) b)]
forall b b. Point -> [Message FRequest (Either (Either Bool b) b)]
popup Point
p)     (K (Either b (Either PopupMenu b)) (Either (Either Bool b) b)
 -> K (Either b (Either PopupMenu b)) (Either (Either Bool b) b))
-> K (Either b (Either PopupMenu b)) (Either (Either Bool b) b)
-> K (Either b (Either PopupMenu b)) (Either (Either Bool b) b)
forall a b. (a -> b) -> a -> b
$ XEvent
-> K (Either b (Either PopupMenu b)) (Either (Either Bool b) b)
upK XEvent
ev
	High (Right (Left PopupMenu
PopdownMenu))      -> [KCommand (Either (Either Bool b) b)]
-> K (Either b (Either PopupMenu b)) (Either (Either Bool b) b)
-> K (Either b (Either PopupMenu b)) (Either (Either Bool b) b)
forall b a. [KCommand b] -> K a b -> K a b
putsK [KCommand (Either (Either Bool b) b)]
forall b. [Message FRequest b]
popdown       (K (Either b (Either PopupMenu b)) (Either (Either Bool b) b)
 -> K (Either b (Either PopupMenu b)) (Either (Either Bool b) b))
-> K (Either b (Either PopupMenu b)) (Either (Either Bool b) b)
-> K (Either b (Either PopupMenu b)) (Either (Either Bool b) b)
forall a b. (a -> b) -> a -> b
$ K (Either b (Either PopupMenu b)) (Either (Either Bool b) b)
downK
	High (Right (Left PopupMenu
PopupMenuStick))   -> KCommand (Either (Either Bool b) b)
-> K (Either b (Either PopupMenu b)) (Either (Either Bool b) b)
-> K (Either b (Either PopupMenu b)) (Either (Either Bool b) b)
forall ho hi. KCommand ho -> K hi ho -> K hi ho
putK  (Bool -> KCommand (Either (Either Bool b) b)
forall a a b b. a -> Message a (Either (Either a b) b)
toBms Bool
False) (K (Either b (Either PopupMenu b)) (Either (Either Bool b) b)
 -> K (Either b (Either PopupMenu b)) (Either (Either Bool b) b))
-> K (Either b (Either PopupMenu b)) (Either (Either Bool b) b)
-> K (Either b (Either PopupMenu b)) (Either (Either Bool b) b)
forall a b. (a -> b) -> a -> b
$ XEvent
-> K (Either b (Either PopupMenu b)) (Either (Either Bool b) b)
upK XEvent
ev
	High (Right (Right b
x))               -> KCommand (Either (Either Bool b) b)
-> K (Either b (Either PopupMenu b)) (Either (Either Bool b) b)
-> K (Either b (Either PopupMenu b)) (Either (Either Bool b) b)
forall ho hi. KCommand ho -> K hi ho -> K hi ho
putK  (b -> KCommand (Either (Either Bool b) b)
forall b a a b. b -> Message a (Either (Either a b) b)
toMenu b
x)    (K (Either b (Either PopupMenu b)) (Either (Either Bool b) b)
 -> K (Either b (Either PopupMenu b)) (Either (Either Bool b) b))
-> K (Either b (Either PopupMenu b)) (Either (Either Bool b) b)
-> K (Either b (Either PopupMenu b)) (Either (Either Bool b) b)
forall a b. (a -> b) -> a -> b
$ XEvent
-> K (Either b (Either PopupMenu b)) (Either (Either Bool b) b)
upK XEvent
ev
	High (Left b
x) ->
	  if XEvent -> Bool
mouse XEvent
ev
	  then [KCommand (Either (Either Bool b) b)]
-> K (Either b (Either PopupMenu b)) (Either (Either Bool b) b)
-> K (Either b (Either PopupMenu b)) (Either (Either Bool b) b)
forall b a. [KCommand b] -> K a b -> K a b
putsK (b -> KCommand (Either (Either Bool b) b)
forall b a a. b -> Message a (Either a b)
out b
x KCommand (Either (Either Bool b) b)
-> [KCommand (Either (Either Bool b) b)]
-> [KCommand (Either (Either Bool b) b)]
forall a. a -> [a] -> [a]
: [KCommand (Either (Either Bool b) b)]
forall b. [Message FRequest b]
popdown) (K (Either b (Either PopupMenu b)) (Either (Either Bool b) b)
 -> K (Either b (Either PopupMenu b)) (Either (Either Bool b) b))
-> K (Either b (Either PopupMenu b)) (Either (Either Bool b) b)
-> K (Either b (Either PopupMenu b)) (Either (Either Bool b) b)
forall a b. (a -> b) -> a -> b
$ K (Either b (Either PopupMenu b)) (Either (Either Bool b) b)
downK
	  else KCommand (Either (Either Bool b) b)
-> K (Either b (Either PopupMenu b)) (Either (Either Bool b) b)
-> K (Either b (Either PopupMenu b)) (Either (Either Bool b) b)
forall ho hi. KCommand ho -> K hi ho -> K hi ho
putK  (b -> KCommand (Either (Either Bool b) b)
forall b a a. b -> Message a (Either a b)
out b
x)           (K (Either b (Either PopupMenu b)) (Either (Either Bool b) b)
 -> K (Either b (Either PopupMenu b)) (Either (Either Bool b) b))
-> K (Either b (Either PopupMenu b)) (Either (Either Bool b) b)
-> K (Either b (Either PopupMenu b)) (Either (Either Bool b) b)
forall a b. (a -> b) -> a -> b
$ XEvent
-> K (Either b (Either PopupMenu b)) (Either (Either Bool b) b)
upK XEvent
ev
	Low (XEvt (KeyEvent {type' :: XEvent -> Pressed
type'=Pressed
Released, keySym :: XEvent -> String
keySym=String
ks})) ->
	  if XEvent -> String -> Bool
samekey XEvent
ev String
ks
	  then [KCommand (Either (Either Bool b) b)]
-> K (Either b (Either PopupMenu b)) (Either (Either Bool b) b)
-> K (Either b (Either PopupMenu b)) (Either (Either Bool b) b)
forall b a. [KCommand b] -> K a b -> K a b
putsK [KCommand (Either (Either Bool b) b)]
forall b. [Message FRequest b]
popdown K (Either b (Either PopupMenu b)) (Either (Either Bool b) b)
downK
	  else XEvent
-> K (Either b (Either PopupMenu b)) (Either (Either Bool b) b)
upK XEvent
ev
	KEvent (Either b (Either PopupMenu b))
_ -> XEvent
-> K (Either b (Either PopupMenu b)) (Either (Either Bool b) b)
upK XEvent
ev

{- handleButtonMachineF fud records the paths of all button machines in fud, so
   that a message can be broadcast to them when the MenuPopup mode changes.
   It also keeps track of the current mode to avoid sending the same mode twice.
-}

handleButtonMachinesF :: F b d -> F (Either Bool b) d
handleButtonMachinesF F b d
fud =
    F (Either (Either Path d) (Either Bool b))
  (Either (Either (Path, Bool) b) d)
-> F (Either (Path, Bool) b) (Either Path d) -> F (Either Bool b) d
forall a b c d. F (Either a b) (Either c d) -> F c a -> F b d
loopThroughRightF F (Either (Either Path d) (Either Bool b))
  (Either (Either (Path, Bool) b) d)
forall b b.
F (Either (Either Path b) (Either Bool b))
  (Either (Either (Path, Bool) b) b)
ctrlF (F b d -> F (Either (Path, Bool) b) (Either Path d)
forall b b. F b b -> F (Either (Path, Bool) b) (Either Path b)
liftbm F b d
fud)
  where
    ctrlF :: F (Either (Either Path b) (Either Bool b))
  (Either (Either (Path, Bool) b) b)
ctrlF = ((Bool, [Path])
 -> Either (Either Path b) (Either Bool b)
 -> ((Bool, [Path]), [Either (Either (Path, Bool) b) b]))
-> (Bool, [Path])
-> F (Either (Either Path b) (Either Bool b))
     (Either (Either (Path, Bool) b) b)
forall t a b. (t -> a -> (t, [b])) -> t -> F a b
mapstateF (Bool, [Path])
-> Either (Either Path b) (Either Bool b)
-> ((Bool, [Path]), [Either (Either (Path, Bool) b) b])
forall a a b b.
(Eq a, Eq a) =>
(a, [a])
-> Either (Either a b) (Either a b)
-> ((a, [a]), [Either (Either (a, a) b) b])
ctrl (Bool
False,[])

    ctrl :: (a, [a])
-> Either (Either a b) (Either a b)
-> ((a, [a]), [Either (Either (a, a) b) b])
ctrl state :: (a, [a])
state@(a
mode,[a]
bms) = (Either a b -> ((a, [a]), [Either (Either (a, a) b) b]))
-> (Either a b -> ((a, [a]), [Either (Either (a, a) b) b]))
-> Either (Either a b) (Either a b)
-> ((a, [a]), [Either (Either (a, a) b) b])
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Either a b -> ((a, [a]), [Either (Either (a, a) b) b])
forall b b. Either a b -> ((a, [a]), [Either (Either (a, a) b) b])
fromLoop Either a b -> ((a, [a]), [Either (Either (a, a) b) b])
forall b b. Either a b -> ((a, [a]), [Either (Either (a, a) b) b])
fromOutside
      where
	fromLoop :: Either a b -> ((a, [a]), [Either (Either (a, a) b) b])
fromLoop (Left a
path) = a -> ((a, [a]), [Either (Either (a, a) b) b])
forall b b. a -> ((a, [a]), [Either (Either (a, a) b) b])
addbm a
path
	fromLoop (Right b
y) = b -> ((a, [a]), [Either (Either (a, a) b) b])
forall b a. b -> ((a, [a]), [Either a b])
out b
y

        fromOutside :: Either a b -> ((a, [a]), [Either (Either (a, a) b) b])
fromOutside (Left a
mode') = a -> ((a, [a]), [Either (Either (a, a) b) b])
forall b b. a -> ((a, [a]), [Either (Either (a, a) b) b])
changeMode a
mode'
	fromOutside (Right b
x) = b -> ((a, [a]), [Either (Either (a, a) b) b])
forall b a b. b -> ((a, [a]), [Either (Either a b) b])
inp b
x

        addbm :: a -> ((a, [a]), [Either (Either (a, a) b) b])
addbm a
path = ((a
mode,[a
path] [a] -> [a] -> [a]
forall a. Eq a => [a] -> [a] -> [a]
`union` [a]
bms),[Either (a, a) b -> Either (Either (a, a) b) b
forall a b. a -> Either a b
Left ((a, a) -> Either (a, a) b
forall a b. a -> Either a b
Left (a
path,a
mode))])
	  -- Tell the new button the current mode. (Needed in case it is
	  -- dynamically created inside a menu.)
        out :: b -> ((a, [a]), [Either a b])
out b
y = ((a, [a])
state,[b -> Either a b
forall a b. b -> Either a b
Right b
y])
	inp :: b -> ((a, [a]), [Either (Either a b) b])
inp b
x = ((a, [a])
state,[Either a b -> Either (Either a b) b
forall a b. a -> Either a b
Left (b -> Either a b
forall a b. b -> Either a b
Right b
x)])

	changeMode :: a -> ((a, [a]), [Either (Either (a, a) b) b])
changeMode a
mode' =
	  if a
mode'a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/=a
mode
	  then ((a
mode',[a]
bms),[Either (a, a) b -> Either (Either (a, a) b) b
forall a b. a -> Either a b
Left ((a, a) -> Either (a, a) b
forall a b. a -> Either a b
Left (a
path,a
mode')) | a
path<-[a]
bms])
	      -- !! This will send msgs also to buttons that have been destroyed
	  else ((a, [a])
state,[])

    liftbm :: F b b -> F (Either (Path, Bool) b) (Either Path b)
liftbm (F FSP b b
sp) = FSP (Either (Path, Bool) b) (Either Path b)
-> F (Either (Path, Bool) b) (Either Path b)
forall hi ho. FSP hi ho -> F hi ho
F (FSP (Either (Path, Bool) b) (Either Path b)
 -> F (Either (Path, Bool) b) (Either Path b))
-> FSP (Either (Path, Bool) b) (Either Path b)
-> F (Either (Path, Bool) b) (Either Path b)
forall a b. (a -> b) -> a -> b
$ (Message (Path, FResponse) (Either (Path, Bool) b)
 -> Message (Path, FResponse) b)
-> (Message (Path, FRequest) b
    -> Message (Path, FRequest) (Either Path b))
-> FSP b b
-> FSP (Either (Path, Bool) b) (Either Path b)
forall t1 a t2 b. (t1 -> a) -> (t2 -> b) -> SP a t2 -> SP t1 b
prepostMapSP Message (Path, FResponse) (Either (Path, Bool) b)
-> Message (Path, FResponse) b
forall a b.
Message (a, FResponse) (Either (a, Bool) b)
-> Message (a, FResponse) b
pre Message (Path, FRequest) b
-> Message (Path, FRequest) (Either Path b)
forall a b.
Message (a, FRequest) b -> Message (a, FRequest) (Either a b)
post FSP b b
sp
      where
	pre :: Message (a, FResponse) (Either (a, Bool) b)
-> Message (a, FResponse) b
pre (High (Left (a
path,Bool
mode))) = (a, FResponse) -> Message (a, FResponse) b
forall a b. a -> Message a b
Low (a
path,XEvent -> FResponse
XEvt (Bool -> XEvent
MenuPopupMode Bool
mode))
	pre (High (Right b
x)) = b -> Message (a, FResponse) b
forall a b. b -> Message a b
High b
x
	pre (Low (a, FResponse)
tevent) = (a, FResponse) -> Message (a, FResponse) b
forall a b. a -> Message a b
Low (a, FResponse)
tevent

	post :: Message (a, FRequest) b -> Message (a, FRequest) (Either a b)
post (Low (a
path,XCmd XCommand
MeButtonMachine)) = Either a b -> Message (a, FRequest) (Either a b)
forall a b. b -> Message a b
High (a -> Either a b
forall a b. a -> Either a b
Left a
path)
	post (Low (a, FRequest)
tcmd) = (a, FRequest) -> Message (a, FRequest) (Either a b)
forall a b. a -> Message a b
Low (a, FRequest)
tcmd
	post (High b
y) = Either a b -> Message (a, FRequest) (Either a b)
forall a b. b -> Message a b
High (b -> Either a b
forall a b. b -> Either a b
Right b
y)