module MenuF(simpleMenuF, menuAltsF, menuF, oldMenuF, buttonMenuF, buttonMenuF', grabberF, MenuState,menuDown,EqSnd(..),fstEqSnd,sndEqSnd,toEqSnd) where
import Command
import Event
import Geometry(pP,Point(..),Size,inRect,Rect(..))
import Message(message )--Message(..),
import Fudget
import FRequest
import FudgetIO
import StreamProcIO
import Xcommand
import NullF
import CompOps((>^=<), (>=^<), (>=^^<), (>^^=<),(>+<))
import Dlayout(groupF)
import SerCompF(bypassF)--,idRightF
import Loops(loopCompThroughRightF)
import LayoutDir(LayoutDir(..))
import LayoutF(listLF)
import LayoutRequest(LayoutResponse(..))
import Placers
import Spacers() -- synonym Distance, for hbc
import MenuButtonF
import MenuPopupF
import Spops(nullSP)
import MapstateK
import SpEither(filterRightSP)
import EitherUtils(mapEither)--stripEither
import Xtypes
import Defaults(menuFont)
import CmdLineEnv(argFlag)
import Graphic
import Data.Array
--import DialogueIO hiding (IOError)
import ShowCommandF(showCommandF)
import Debug.Trace(trace)

data EqSnd a b = EqSnd a b

instance (Eq b) => Eq (EqSnd a b) where
    EqSnd a
a1 b
b1 == :: EqSnd a b -> EqSnd a b -> Bool
== EqSnd a
a2 b
b2  =  b
b1 forall a. Eq a => a -> a -> Bool
== b
b2

fstEqSnd :: EqSnd a b -> a
fstEqSnd (EqSnd a
a b
b) = a
a
sndEqSnd :: EqSnd a b -> b
sndEqSnd (EqSnd a
a b
b) = b
b
toEqSnd :: [(a, b)] -> [EqSnd a b]
toEqSnd [(a, b)]
x = forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a b. a -> b -> EqSnd a b
EqSnd) [(a, b)]
x

menuF :: (Graphic mlbl,Graphic albl) => mlbl -> [(alt,albl)] -> F alt alt
menuF :: forall mlbl albl alt.
(Graphic mlbl, Graphic albl) =>
mlbl -> [(alt, albl)] -> F alt alt
menuF mlbl
name [(alt, albl)]
altlbls =
    forall a. F a a -> F a a
bypassF ((Array Int alt
naltsforall i e. Ix i => Array i e -> i -> e
!) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a} {b}. EqSnd a b -> b
sndEqSnd forall a b e. (a -> b) -> F e a -> F e b
>^=< 
      forall {b} {c} {a}.
(Eq b, Graphic c, Graphic a) =>
FontName -> a -> [b] -> (b -> c) -> F a b
simpleMenuF FontName
menuFont mlbl
name [EqSnd albl Int]
lblns forall {a} {b}. EqSnd a b -> a
fstEqSnd forall c d e. F c d -> SP e c -> F e d
>=^^< forall a b. SP a b
nullSP)
  where
    ([alt]
alts,[albl]
lbls) = forall a b. [(a, b)] -> ([a], [b])
unzip [(alt, albl)]
altlbls
    lblns :: [EqSnd albl Int]
lblns = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall a b. a -> b -> EqSnd a b
EqSnd [albl]
lbls [Int]
ixs
    n :: Int
n = forall (t :: * -> *) a. Foldable t => t a -> Int
length [alt]
alts
    ixs :: [Int]
ixs =  [Int
1 .. Int
n]
    nalts :: Array Int alt
nalts = forall i e. Ix i => (i, i) -> [(i, e)] -> Array i e
array (Int
1,Int
n) (forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
ixs [alt]
alts)


simpleMenuF :: FontName -> a -> [b] -> (b -> c) -> F a b
simpleMenuF FontName
fname a
name = forall c b a.
(Graphic c, Eq b, Graphic a) =>
FontName -> a -> [(b, [(ModState, FontName)])] -> (b -> c) -> F a b
oldMenuF FontName
fname a
name forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (\b
x -> (b
x,[]))

oldMenuF :: (Graphic c, Eq b, Graphic a) => FontName -> a -> [(b, [(ModState, KeySym)])] -> (b -> c) -> F a b 
oldMenuF :: forall c b a.
(Graphic c, Eq b, Graphic a) =>
FontName -> a -> [(b, [(ModState, FontName)])] -> (b -> c) -> F a b
oldMenuF FontName
fname a
name [(b, [(ModState, FontName)])]
alts b -> c
show_alt =
    forall {b} {a} {d}.
[(b, [(ModState, FontName)])]
-> F (Either a b) (Either MenuState d) -> F b d
grabberF [] (forall {b} {a} {b}.
Graphic b =>
LayoutDir
-> FontName
-> b
-> [(a, [(ModState, FontName)])]
-> F (Either MenuState b) a
-> F (Either MenuState (Either b b)) (Either MenuState a)
buttonMenuF LayoutDir
Horizontal FontName
fname a
name [(b, [(ModState, FontName)])]
alts forall {a1}. F (Either a1 (b, c)) b
menuAltsforall c d e. F c d -> (e -> c) -> F e d
>=^<forall {t1} {a} {t2} {b}.
(t1 -> a) -> (t2 -> b) -> Either t1 t2 -> Either a b
mapEither forall a. a -> a
id forall a b. a -> Either a b
Left)
  where
    menuAlts :: F (Either a1 (b, c)) b
menuAlts = forall {b} {b}.
(Eq b, Graphic b) =>
FontName -> [b] -> (b -> b) -> F (b, b) b
menuAltsF' FontName
fname (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(b, [(ModState, FontName)])]
alts) b -> c
show_alt forall c d e. F c d -> SP e c -> F e d
>=^^< forall {a1} {b}. SP (Either a1 b) b
filterRightSP

menuAltsF' :: FontName -> [b] -> (b -> b) -> F (b, b) b
menuAltsF' FontName
fname [b]
alts b -> b
show_alt =
    forall a b. (a, b) -> a
fst forall a b e. (a -> b) -> F e a -> F e b
>^=< forall {a} {b} {c}.
Eq a =>
Placer -> [(a, F b c)] -> F (a, b) (a, c)
listLF (Int -> Placer
verticalP' Int
0) (forall a b. (a -> b) -> [a] -> [b]
map b -> (b, F b Click)
altButton [b]
alts)
  where
    altButton :: b -> (b, F b Click)
altButton (b
alt{-, keys-}) = (b
alt, forall lbl. Graphic lbl => FontName -> lbl -> F lbl Click
menuButtonF FontName
fname {-keys-} (b -> b
show_alt b
alt))

menuAltsF :: FontName -> [d] -> (d -> b) -> F PopupMenu d
menuAltsF FontName
fname [d]
alts d -> b
show_alt =
   forall {b} {d}. F b d -> F (Either PopupMenu b) d
menuPopupF (forall {b} {b}.
(Eq b, Graphic b) =>
FontName -> [b] -> (b -> b) -> F (b, b) b
menuAltsF' FontName
fname [d]
alts d -> b
show_alt) forall c d e. F c d -> (e -> c) -> F e d
>=^< forall a b. a -> Either a b
Left

grabberF :: [(b, [(ModState, FontName)])]
-> F (Either a b) (Either MenuState d) -> F b d
grabberF [(b, [(ModState, FontName)])]
alts F (Either a b) (Either MenuState d)
mF = forall a b c d.
F (Either (Either a b) c) (Either (Either c d) a) -> F b d
loopCompThroughRightF (forall {a} {b} {c} {d}.
[FRequest] -> K a b -> F c d -> F (Either a c) (Either b d)
groupF [FRequest]
startcmds forall {b} {a}.
K (Either (Either MenuState b) b) (Either (Either a b) b)
grabK0 F (Either a b) (Either MenuState d)
mF)
  where
    startcmds :: [FRequest]
startcmds = forall a b. (a -> b) -> [a] -> [b]
map XCommand -> FRequest
XCmd [XCommand]
transinit
    grabK0 :: K (Either (Either MenuState b) b) (Either (Either a b) b)
grabK0 = forall {b} {a}.
Bool -> K (Either (Either MenuState b) b) (Either (Either a b) b)
grabK Bool
False

    transinit :: [XCommand]
transinit =
        if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(ModState, FontName)]
keys
	then []
        else  [(XEvent -> Maybe XEvent) -> [EventMask] -> XCommand
TranslateEvent XEvent -> Maybe XEvent
tobutton [EventMask
KeyPressMask, EventMask
KeyReleaseMask]]
      where
        keys :: [(ModState, FontName)]
keys = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a b. (a, b) -> b
snd [(b, [(ModState, FontName)])]
alts
        tobutton :: XEvent -> Maybe XEvent
tobutton e :: XEvent
e@(KeyEvent {state :: XEvent -> ModState
state=ModState
s,keySym :: XEvent -> FontName
keySym=FontName
ks}) | (ModState
s, FontName
ks) forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [(ModState, FontName)]
keys = forall a. a -> Maybe a
Just XEvent
e
	tobutton XEvent
_ = forall a. Maybe a
Nothing
    grabK :: Bool -> K (Either (Either MenuState b) b) (Either (Either a b) b)
grabK Bool
up = forall {hi} {ho}. Cont (K hi ho) (KEvent hi)
getK forall a b. (a -> b) -> a -> b
$ forall {t1} {t2} {t3}.
(t1 -> t2) -> (t3 -> t2) -> Message t1 t3 -> t2
message FResponse
-> K (Either (Either MenuState b) b) (Either (Either a b) b)
low Either (Either MenuState b) b
-> K (Either (Either MenuState b) b) (Either (Either a b) b)
high
      where
	keyalts :: [((ModState, FontName), b)]
keyalts = [((ModState, FontName)
k,b
a)|(b
a,[(ModState, FontName)]
ks)<-[(b, [(ModState, FontName)])]
alts,(ModState, FontName)
k<-[(ModState, FontName)]
ks]
	same :: K (Either (Either MenuState b) b) (Either (Either a b) b)
same = Bool -> K (Either (Either MenuState b) b) (Either (Either a b) b)
grabK Bool
up
	popdown :: K (Either (Either MenuState b) b) (Either (Either a b) b)
popdown = Bool -> K (Either (Either MenuState b) b) (Either (Either a b) b)
grabK Bool
False
	popup :: K (Either (Either MenuState b) b) (Either (Either a b) b)
popup = Bool -> K (Either (Either MenuState b) b) (Either (Either a b) b)
grabK Bool
True
	low :: FResponse
-> K (Either (Either MenuState b) b) (Either (Either a b) b)
low FResponse
event =
	  case FResponse
event of
	    XEvt (KeyEvent {state :: XEvent -> ModState
state=ModState
s,keySym :: XEvent -> FontName
keySym=FontName
ks,type' :: XEvent -> Pressed
type'=Pressed
Pressed}) ->
		forall {t :: * -> *} {sp :: * -> * -> *} {a} {i}.
(Foldable t, StreamProcIO sp) =>
t a -> sp i a -> sp i a
puts [forall a b. a -> Either a b
Left (forall a b. b -> Either a b
Right b
alt)|((ModState, FontName)
key,b
alt)<-[((ModState, FontName), b)]
keyalts,(ModState
s,FontName
ks)forall a. Eq a => a -> a -> Bool
==(ModState, FontName)
key] K (Either (Either MenuState b) b) (Either (Either a b) b)
same
	    FResponse
_ ->  K (Either (Either MenuState b) b) (Either (Either a b) b)
same
	high :: Either (Either MenuState b) b
-> K (Either (Either MenuState b) b) (Either (Either a b) b)
high = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Either MenuState b
-> K (Either (Either MenuState b) b) (Either (Either a b) b)
fromLoop b -> K (Either (Either MenuState b) b) (Either (Either a b) b)
fromOutside
	fromLoop :: Either MenuState b
-> K (Either (Either MenuState b) b) (Either (Either a b) b)
fromLoop = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either MenuState
-> K (Either (Either MenuState b) b) (Either (Either a b) b)
menuCoordination b -> K (Either (Either MenuState b) b) (Either (Either a b) b)
menuSelection
	fromOutside :: b -> K (Either (Either MenuState b) b) (Either (Either a b) b)
fromOutside b
x = forall {f :: * -> * -> *} {ho} {hi}.
FudgetIO f =>
ho -> f hi ho -> f hi ho
putHigh (forall a b. a -> Either a b
Left (forall a b. b -> Either a b
Right b
x)) K (Either (Either MenuState b) b) (Either (Either a b) b)
same
	menuSelection :: b -> K (Either (Either MenuState b) b) (Either (Either a b) b)
menuSelection b
x = forall {f :: * -> * -> *} {ho} {hi}.
FudgetIO f =>
ho -> f hi ho -> f hi ho
putHigh (forall a b. b -> Either a b
Right b
x) K (Either (Either MenuState b) b) (Either (Either a b) b)
same
	menuCoordination :: MenuState
-> K (Either (Either MenuState b) b) (Either (Either a b) b)
menuCoordination MenuState
newState =
	  case (Bool
up,MenuState
newState) of
	    (Bool
False,MenuUp Bool
_) ->
	      --trace "grabberF: GrabEvents False" $
	      forall {i} {o}. XCommand -> K i o -> K i o
xcommandK (Bool -> XCommand
GrabEvents Bool
False) K (Either (Either MenuState b) b) (Either (Either a b) b)
popup
	    (Bool
True,MenuState
MenuDown) ->
	      --trace "grabberF: UngrabEvents" $
	      forall {i} {o}. XCommand -> K i o -> K i o
xcommandK XCommand
UngrabEvents K (Either (Either MenuState b) b) (Either (Either a b) b)
popdown
	    (Bool, MenuState)
_ -> K (Either (Either MenuState b) b) (Either (Either a b) b)
same

data MenuState = MenuDown | MenuUp MenuMode deriving (Int -> MenuState -> ShowS
[MenuState] -> ShowS
MenuState -> FontName
forall a.
(Int -> a -> ShowS) -> (a -> FontName) -> ([a] -> ShowS) -> Show a
showList :: [MenuState] -> ShowS
$cshowList :: [MenuState] -> ShowS
show :: MenuState -> FontName
$cshow :: MenuState -> FontName
showsPrec :: Int -> MenuState -> ShowS
$cshowsPrec :: Int -> MenuState -> ShowS
Show)
type MenuMode = Bool -- True = sticky
menuDown :: MenuState
menuDown = MenuState
MenuDown
menuUpSticky :: MenuState
menuUpSticky = Bool -> MenuState
MenuUp Bool
True
menuUpMPopup :: MenuState
menuUpMPopup = Bool -> MenuState
MenuUp Bool
False
-- Invariant: menu state never changes directly from MenuDown to menuUpSticky,
-- i.e., when a menu first pops up, it always outputs menuUpMPopup

data ButtonMenuState =
  S { ButtonMenuState -> Bool
mpopup,ButtonMenuState -> Bool
othermpopup,ButtonMenuState -> Bool
sticky,ButtonMenuState -> Bool
debug::Bool, ButtonMenuState -> Size
size::Size } deriving (Int -> ButtonMenuState -> ShowS
[ButtonMenuState] -> ShowS
ButtonMenuState -> FontName
forall a.
(Int -> a -> ShowS) -> (a -> FontName) -> ([a] -> ShowS) -> Show a
showList :: [ButtonMenuState] -> ShowS
$cshowList :: [ButtonMenuState] -> ShowS
show :: ButtonMenuState -> FontName
$cshow :: ButtonMenuState -> FontName
showsPrec :: Int -> ButtonMenuState -> ShowS
$cshowsPrec :: Int -> ButtonMenuState -> ShowS
Show)
bstate0 :: ButtonMenuState
bstate0 = Bool -> Bool -> Bool -> Bool -> Size -> ButtonMenuState
S Bool
False Bool
False Bool
False Bool
False Size
0

{-
buttonMenuF :: (Graphic a) =>
	 LayoutDir -> FontName -> a ->
	 [(b, [(ModState, KeySym)])] ->
	 F (Either MenuState b) b ->
	 F (Either MenuState (Either a b)) (Either MenuState b)
-}
buttonMenuF :: LayoutDir
-> FontName
-> b
-> [(a, [(ModState, FontName)])]
-> F (Either MenuState b) a
-> F (Either MenuState (Either b b)) (Either MenuState a)
buttonMenuF LayoutDir
x = forall {b} {a} {b}.
Graphic b =>
Bool
-> LayoutDir
-> FontName
-> b
-> [(a, [(ModState, FontName)])]
-> F (Either MenuState b) a
-> F (Either MenuState (Either b b)) (Either MenuState a)
buttonMenuF' Bool
False LayoutDir
x
buttonMenuF' :: Bool
-> LayoutDir
-> FontName
-> b
-> [(a, [(ModState, FontName)])]
-> F (Either MenuState b) a
-> F (Either MenuState (Either b b)) (Either MenuState a)
buttonMenuF' Bool
delayed LayoutDir
dir FontName
fname b
name [(a, [(ModState, FontName)])]
alts F (Either MenuState b) a
menuAltsF =
    forall a b c d.
F (Either (Either a b) c) (Either (Either c d) a) -> F b d
loopCompThroughRightF forall a b. (a -> b) -> a -> b
$
    forall a b. FontName -> F a b -> F a b
showCommandF FontName
"buttonMenuF" forall a b. (a -> b) -> a -> b
$
    forall {a} {b} {c} {d}.
[FRequest] -> K a b -> F c d -> F (Either a c) (Either b d)
groupF [FRequest]
startcmds
	   (forall {t} {hi} {ho}.
(t -> KEvent hi -> (t, [KCommand ho])) -> t -> K hi ho
mapstateK forall {b} {b} {a}.
ButtonMenuState
-> Message FResponse (Either a (Either MenuState (Either b b)))
-> (ButtonMenuState,
    [Message
       a
       (Either
          (Either (Either Bool b) (Either PopupMenu (Either MenuState b)))
          (Either MenuState a))])
proc ButtonMenuState
bstate0)
	   (forall {a1} {b}. SP (Either a1 b) b
filterRightSP forall a b e. SP a b -> F e a -> F e b
>^^=< (forall lbl.
Graphic lbl =>
FontName -> lbl -> F (Either Bool lbl) (GfxEvent [Int])
menuLabelF FontName
fname b
name forall {a} {b} {c} {d}.
F a b -> F c d -> F (Either a c) (Either b d)
>+< F (Either PopupMenu (Either MenuState b)) a
theMenuF))
  where
    theMenuF :: F (Either PopupMenu (Either MenuState b)) a
theMenuF = forall {b} {d}. Bool -> F b d -> F (Either PopupMenu b) d
menuPopupF' Bool
delayed F (Either MenuState b) a
menuAltsF
    topopup :: a -> Message a (Either (Either a (Either a b)) b)
topopup = forall a b. b -> Message a b
High forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left
    tosubmenus :: a -> Message a (Either (Either a (Either a (Either a b))) b)
tosubmenus = forall a b. b -> Message a b
High forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left
    inputtosubmenus :: a -> Message a (Either (Either a (Either a (Either a a))) b)
inputtosubmenus = forall a b. b -> Message a b
High forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right
    out :: a -> Message a (Either a (Either a a))
out = forall a b. b -> Message a b
High forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right
    othermenu :: a -> Message a (Either a (Either a b))
othermenu = forall a b. b -> Message a b
High forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left
    toDisp :: a -> Message a (Either (Either a b) b)
toDisp = forall a b. b -> Message a b
High forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left
    relabel :: a -> Message a (Either (Either (Either a a) b) b)
relabel = forall {a} {a} {b} {b}. a -> Message a (Either (Either a b) b)
toDisp forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right
    adjust :: Size -> Size
adjust =
	case LayoutDir
dir of
	  LayoutDir
Vertical -> \ (Point Int
w Int
_) -> Int -> Int -> Size
pP Int
w (-Int
1)
	  LayoutDir
Horizontal -> \ (Point Int
_ Int
h) -> Int -> Int -> Size
pP (-Int
1) Int
h
    proc :: ButtonMenuState
-> Message FResponse (Either a (Either MenuState (Either b b)))
-> (ButtonMenuState,
    [Message
       a
       (Either
          (Either (Either Bool b) (Either PopupMenu (Either MenuState b)))
          (Either MenuState a))])
proc state :: ButtonMenuState
state@(S{mpopup :: ButtonMenuState -> Bool
mpopup=Bool
mpopup,othermpopup :: ButtonMenuState -> Bool
othermpopup=Bool
othermpopup,sticky :: ButtonMenuState -> Bool
sticky=Bool
sticky,size :: ButtonMenuState -> Size
size=Size
size,debug :: ButtonMenuState -> Bool
debug=Bool
debug}) =
	forall {t1} {t2} {t3}.
(t1 -> t2) -> (t3 -> t2) -> Message t1 t3 -> t2
message forall {a} {b} {b}.
FResponse
-> (ButtonMenuState,
    [Message
       a
       (Either
          (Either (Either Bool b) (Either PopupMenu (Either MenuState b)))
          (Either MenuState a))])
low forall {a} {a} {b} {a} {a}.
Either a (Either MenuState (Either a b))
-> (ButtonMenuState,
    [Message
       a
       (Either
          (Either (Either a a) (Either PopupMenu (Either MenuState b)))
          (Either MenuState a))])
high
      where
	dbg :: FontName -> a -> a
dbg FontName
x = if Bool
debug then forall a. FontName -> a -> a
trace (FontName
"buttonMenuF "forall a. [a] -> [a] -> [a]
++FontName
x) else forall a. a -> a
id

	popdownyield :: (ButtonMenuState,
 [Message
    a (Either (Either a (Either PopupMenu (Either MenuState b))) b)])
popdownyield = forall {a} {a} {b} {b}.
Bool
-> [Message
      a (Either (Either a (Either PopupMenu (Either MenuState b))) b)]
-> (ButtonMenuState,
    [Message
       a (Either (Either a (Either PopupMenu (Either MenuState b))) b)])
popdown' Bool
True [] --pop down because other menu popped up
	popdownlast :: (ButtonMenuState,
 [Message
    a
    (Either
       (Either a (Either PopupMenu (Either MenuState b)))
       (Either MenuState b))])
popdownlast = -- pop down, no other menu is up
	  forall a. FontName -> a -> a
dbg FontName
"popdownlast" forall a b. (a -> b) -> a -> b
$
	  forall {a} {a} {b} {b}.
Bool
-> [Message
      a (Either (Either a (Either PopupMenu (Either MenuState b))) b)]
-> (ButtonMenuState,
    [Message
       a (Either (Either a (Either PopupMenu (Either MenuState b))) b)])
popdown' Bool
False [forall {a} {a} {a} {b}. a -> Message a (Either a (Either a b))
othermenu MenuState
MenuDown]
	popdown' :: Bool
-> [Message
      a (Either (Either a (Either PopupMenu (Either MenuState b))) b)]
-> (ButtonMenuState,
    [Message
       a (Either (Either a (Either PopupMenu (Either MenuState b))) b)])
popdown' Bool
mpopup' [Message
   a (Either (Either a (Either PopupMenu (Either MenuState b))) b)]
msgs =
	  (ButtonMenuState
state{othermpopup :: Bool
othermpopup=Bool
mpopup'},
	   [Message
   a (Either (Either a (Either PopupMenu (Either MenuState b))) b)]
msgsforall a. [a] -> [a] -> [a]
++[forall {a} {a} {a} {a} {b} {b}.
a -> Message a (Either (Either a (Either a (Either a b))) b)
tosubmenus MenuState
menuDown,forall {a} {a} {a} {b} {b}.
a -> Message a (Either (Either a (Either a b)) b)
topopup PopupMenu
PopdownMenu])

	stickyMode :: (ButtonMenuState,
 [Message
    a (Either (Either a (Either PopupMenu b)) (Either MenuState b))])
stickyMode =
	  forall a. FontName -> a -> a
dbg FontName
"othermenu menuUpSticky" forall a b. (a -> b) -> a -> b
$
	  (ButtonMenuState
state{sticky :: Bool
sticky=Bool
True},
	   [forall {a} {a} {a} {b}. a -> Message a (Either a (Either a b))
othermenu MenuState
menuUpSticky,forall {a} {a} {a} {b} {b}.
a -> Message a (Either (Either a (Either a b)) b)
topopup PopupMenu
PopupMenuStick])

	mPopupMode :: Bool -> (ButtonMenuState, [a])
mPopupMode Bool
b = (ButtonMenuState
state{mpopup :: Bool
mpopup=Bool
b},[])
	highlight :: a -> Message a (Either (Either (Either a b) b) b)
highlight = forall {a} {a} {b} {b}. a -> Message a (Either (Either a b) b)
toDisp forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left
	put :: b -> (ButtonMenuState, b)
put b
msgs = (ButtonMenuState
state,b
msgs)

	high :: Either a (Either MenuState (Either a b))
-> (ButtonMenuState,
    [Message
       a
       (Either
          (Either (Either a a) (Either PopupMenu (Either MenuState b)))
          (Either MenuState a))])
high = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall {b} {a} {a} {a} {b}.
b
-> (ButtonMenuState,
    [Message
       a
       (Either
          (Either a (Either a (Either MenuState b))) (Either MenuState b))])
fromMenu (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall {a} {a} {b} {b}.
MenuState
-> (ButtonMenuState,
    [Message
       a (Either (Either a (Either PopupMenu (Either MenuState b))) b)])
fromOtherMenu forall {a} {b} {a} {a} {a} {a} {b}.
Either a b
-> (ButtonMenuState,
    [Message
       a (Either (Either (Either a a) (Either a (Either a b))) b)])
fromOutside)
	fromOutside :: Either a b
-> (ButtonMenuState,
    [Message
       a (Either (Either (Either a a) (Either a (Either a b))) b)])
fromOutside = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall {a} {a} {a} {b} {b}.
a
-> (ButtonMenuState,
    [Message a (Either (Either (Either a a) b) b)])
newLabel forall {a} {a} {a} {a} {a} {b}.
a
-> (ButtonMenuState,
    [Message a (Either (Either a (Either a (Either a a))) b)])
altInput
	newLabel :: a
-> (ButtonMenuState,
    [Message a (Either (Either (Either a a) b) b)])
newLabel a
lbl = (ButtonMenuState
state,[forall {a} {a} {a} {b} {b}.
a -> Message a (Either (Either (Either a a) b) b)
relabel a
lbl])
	altInput :: a
-> (ButtonMenuState,
    [Message a (Either (Either a (Either a (Either a a))) b)])
altInput a
x = (ButtonMenuState
state,[forall {a} {a} {a} {a} {a} {b}.
a -> Message a (Either (Either a (Either a (Either a a))) b)
inputtosubmenus a
x])

	fromOtherMenu :: MenuState
-> (ButtonMenuState,
    [Message
       a (Either (Either a (Either PopupMenu (Either MenuState b))) b)])
fromOtherMenu MenuState
newMode =
	  forall a. FontName -> a -> a
dbg (FontName
"fromOtherMenu "forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> FontName
show MenuState
newMode) forall a b. (a -> b) -> a -> b
$
	  case MenuState
newMode of
	    MenuUp Bool
False -> forall {a} {a} {b} {b}.
(ButtonMenuState,
 [Message
    a (Either (Either a (Either PopupMenu (Either MenuState b))) b)])
popdownyield -- other menu popped up, pop down
	    MenuUp Bool
True -> (ButtonMenuState
state{othermpopup :: Bool
othermpopup=Bool
False},[])
	    MenuState
MenuDown -> forall {a} {a} {b} {b}.
Bool
-> [Message
      a (Either (Either a (Either PopupMenu (Either MenuState b))) b)]
-> (ButtonMenuState,
    [Message
       a (Either (Either a (Either PopupMenu (Either MenuState b))) b)])
popdown' Bool
False []

	fromMenu :: b
-> (ButtonMenuState,
    [Message
       a
       (Either
          (Either a (Either a (Either MenuState b))) (Either MenuState b))])
fromMenu b
alt =
	  (ButtonMenuState
state{sticky :: Bool
sticky=Bool
False},
	   [forall {a} {a} {a} {a} {b} {b}.
a -> Message a (Either (Either a (Either a (Either a b))) b)
tosubmenus MenuState
menuDown,forall {a} {a} {a} {b}. a -> Message a (Either a (Either a b))
othermenu MenuState
menuDown,forall {a} {a} {a} {a}. a -> Message a (Either a (Either a a))
out b
alt])
	low :: FResponse
-> (ButtonMenuState,
    [Message
       a
       (Either
          (Either (Either Bool b) (Either PopupMenu (Either MenuState b)))
          (Either MenuState a))])
low FResponse
resp =
	  forall a. FontName -> a -> a
dbg ([FontName] -> FontName
unlines [forall a. Show a => a -> FontName
show ButtonMenuState
state, forall a. Show a => a -> FontName
show FResponse
resp,FontName
""]) forall a b. (a -> b) -> a -> b
$
	  case FResponse
resp of
	    XEvt XEvent
event ->
	      case XEvent
event of
		ButtonEvent {button :: XEvent -> Button
button=Button Int
2,type' :: XEvent -> Pressed
type'=Pressed
Pressed,state :: XEvent -> ModState
state=ModState
mods} ->
		  forall a. FontName -> a -> a
trace FontName
"Button 2" forall a b. (a -> b) -> a -> b
$
		  (ButtonMenuState
state{debug :: Bool
debug=Modifiers
Control forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ModState
mods},[])
		--ButtonEvent _ winpos rootpos mods Pressed (Button 1) ->
		ButtonEvent {pos :: XEvent -> Size
pos=Size
winpos,rootPos :: XEvent -> Size
rootPos=Size
rootpos,state :: XEvent -> ModState
state=ModState
mods,type' :: XEvent -> Pressed
type'=Pressed
Pressed,button :: XEvent -> Button
button=Button Int
1} ->
		  forall a. FontName -> a -> a
dbg FontName
"output othermenu True" forall a b. (a -> b) -> a -> b
$
		  (ButtonMenuState
state{sticky :: Bool
sticky=Bool
False},
		   [forall {a} {a} {a} {b}. a -> Message a (Either a (Either a b))
othermenu MenuState
menuUpMPopup, -- tell other menus to pop down
		    forall {a} {a} {a} {b} {b}.
a -> Message a (Either (Either a (Either a b)) b)
topopup (Size -> XEvent -> PopupMenu
PopupMenu (Size
rootposforall a. Num a => a -> a -> a
-Size
winposforall a. Num a => a -> a -> a
+Size -> Size
adjust Size
size) XEvent
event)
		    --highlight True,
		    --Low (GrabEvents False)
		    ])
		LeaveNotify {mode :: XEvent -> Mode
mode=Mode
NotifyUngrab,detail :: XEvent -> Detail
detail=Detail
NotifyInferior}
		    | Bool
stickyMenus Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
mpopup -> forall {a} {a} {b} {b}.
(ButtonMenuState,
 [Message
    a (Either (Either a (Either PopupMenu b)) (Either MenuState b))])
stickyMode
		LeaveNotify {mode :: XEvent -> Mode
mode=Mode
NotifyUngrab} {-  | not sticky-} -> forall {a} {a} {b} {b}.
(ButtonMenuState,
 [Message
    a
    (Either
       (Either a (Either PopupMenu (Either MenuState b)))
       (Either MenuState b))])
popdownlast
		--  ^^ these events get lost in focusMgr it seems
		ButtonEvent {pos :: XEvent -> Size
pos=Size
pos,button :: XEvent -> Button
button=Button Int
1,type' :: XEvent -> Pressed
type'=Pressed
Released}
		    | Bool -> Bool
not (Bool
stickyMenus Bool -> Bool -> Bool
&& Size
pos Size -> Rect -> Bool
`inRect` (Size -> Size -> Rect
Rect Size
0 Size
size)) -> forall {a} {a} {b} {b}.
(ButtonMenuState,
 [Message
    a
    (Either
       (Either a (Either PopupMenu (Either MenuState b)))
       (Either MenuState b))])
popdownlast
			     --workaround
		LeaveNotify {detail :: XEvent -> Detail
detail=Detail
detail}
		    | Detail
detailforall a. Eq a => a -> a -> Bool
/=Detail
NotifyInferior ->
			if Bool
False --mpopup
			then forall {a} {a} {b} {b}.
(ButtonMenuState,
 [Message
    a
    (Either
       (Either a (Either PopupMenu (Either MenuState b)))
       (Either MenuState b))])
popdownlast
			else forall {b}. b -> (ButtonMenuState, b)
put [forall {a} {a} {b} {b} {b}.
a -> Message a (Either (Either (Either a b) b) b)
highlight Bool
False]
		EnterNotify {rootPos :: XEvent -> Size
rootPos=Size
rootpos,pos :: XEvent -> Size
pos=Size
winpos,mode :: XEvent -> Mode
mode=Mode
NotifyNormal}
		  | Bool
mpopup Bool -> Bool -> Bool
|| Bool
othermpopup ->
		      forall a. FontName -> a -> a
dbg FontName
"output othermenu True" forall a b. (a -> b) -> a -> b
$
		      (ButtonMenuState
state{sticky :: Bool
sticky=Bool
False},
		       [forall {a} {a} {a} {b}. a -> Message a (Either a (Either a b))
othermenu MenuState
menuUpMPopup, -- tell other menus to pop down
			forall {a} {a} {a} {b} {b}.
a -> Message a (Either (Either a (Either a b)) b)
topopup (Size -> XEvent -> PopupMenu
PopupMenu (Size
rootposforall a. Num a => a -> a -> a
-Size
winposforall a. Num a => a -> a -> a
+Size -> Size
adjust Size
size) XEvent
event),
			forall {a} {a} {b} {b} {b}.
a -> Message a (Either (Either (Either a b) b) b)
highlight Bool
True])
		  | Bool
otherwise -> forall {b}. b -> (ButtonMenuState, b)
put [forall {a} {a} {b} {b} {b}.
a -> Message a (Either (Either (Either a b) b) b)
highlight Bool
True]
		KeyEvent {state :: XEvent -> ModState
state=ModState
s,type' :: XEvent -> Pressed
type'=Pressed
Pressed,keySym :: XEvent -> FontName
keySym=FontName
ks} ->
		  case [ a
a | (a
a,[(ModState, FontName)]
keys) <- [(a, [(ModState, FontName)])]
alts, (ModState
s,FontName
ks) forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [(ModState, FontName)]
keys] of
		    a
a:[a]
_ -> forall {b}. b -> (ButtonMenuState, b)
put [forall {a} {a} {a} {a}. a -> Message a (Either a (Either a a))
out a
a]
		    [a]
_ -> forall a. HasCallStack => FontName -> a
error FontName
"MenuF.clickF bug"
		MenuPopupMode Bool
b -> forall {a}. Bool -> (ButtonMenuState, [a])
mPopupMode Bool
b
		XEvent
_ -> (ButtonMenuState
state,[])
	    LEvt (LayoutSize Size
size') -> (ButtonMenuState
state{size :: Size
size=Size
size'},[])
	    FResponse
_ -> (ButtonMenuState
state,[])

    startcmds :: [FRequest]
startcmds = forall a b. (a -> b) -> [a] -> [b]
map XCommand -> FRequest
XCmd (XCommand
MeButtonMachine forall a. a -> [a] -> [a]
: [XCommand]
grab forall a. [a] -> [a] -> [a]
++
	                  [[WindowChanges] -> XCommand
ConfigureWindow [Int -> WindowChanges
CWBorderWidth Int
1],
			   [WindowAttributes] -> XCommand
ChangeWindowAttributes [WindowAttributes]
wattrs] forall a. [a] -> [a] -> [a]
++
			  [XCommand]
transinit)
    grab :: [XCommand]
grab = [Bool -> Button -> ModState -> [EventMask] -> XCommand
GrabButton Bool
True (Int -> Button
Button Int
1) [] [EventMask]
ptrmask]
    ptrmask :: [EventMask]
ptrmask = [EventMask
ButtonPressMask, EventMask
ButtonReleaseMask]
    wattrs :: [WindowAttributes]
wattrs = [[EventMask] -> WindowAttributes
CWEventMask [EventMask]
eventmask]
    eventmask :: [EventMask]
eventmask = [EventMask
LeaveWindowMask, EventMask
EnterWindowMask,
		 EventMask
ButtonPressMask -- Button 2 press, for debuggin only!
		]

    keys :: [(ModState, FontName)]
keys = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a b. (a, b) -> b
snd [(a, [(ModState, FontName)])]
alts

    transinit :: [XCommand]
transinit =
        if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(ModState, FontName)]
keys
	then []
        else  [(XEvent -> Maybe XEvent) -> [EventMask] -> XCommand
TranslateEvent XEvent -> Maybe XEvent
tobutton [EventMask
KeyPressMask, EventMask
KeyReleaseMask]]
      where
        tobutton :: XEvent -> Maybe XEvent
tobutton e :: XEvent
e@(KeyEvent {state :: XEvent -> ModState
state=ModState
s,keySym :: XEvent -> FontName
keySym=FontName
ks}) | (ModState
s, FontName
ks) forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [(ModState, FontName)]
keys = forall a. a -> Maybe a
Just XEvent
e
	tobutton XEvent
_ = forall a. Maybe a
Nothing

stickyMenus :: Bool
stickyMenus = FontName -> Bool -> Bool
argFlag FontName
"stickymenus" Bool
False