module QuitK where
import Command
import Event
import Fudget
import FRequest
import Xcommand
import HaskellIO(haskellIO)
import InternAtom
import NullF
import Spops(nullSP)
import CompFfun(postProcessHighK,preProcessHighK)
import Xtypes
import DialogueIO hiding (IOError)
quitK :: (K (Either String Bool) a -> K (Either String Bool) a) -> K hi ho
quitK K (Either String Bool) a -> K (Either String Bool) a
action =
SP a ho
forall a b. SP a b
nullSP SP a ho -> K (Either String Bool) a -> K (Either String Bool) ho
forall a ho hi. SP a ho -> K hi a -> K hi ho
`postProcessHighK`
Maybe (K (Either String Bool) a -> K (Either String Bool) a)
-> K (Either String Bool) a
forall c.
Maybe (K (Either String Bool) c -> K (Either String Bool) c)
-> K (Either String Bool) c
wmK ((K (Either String Bool) a -> K (Either String Bool) a)
-> Maybe (K (Either String Bool) a -> K (Either String Bool) a)
forall a. a -> Maybe a
Just K (Either String Bool) a -> K (Either String Bool) a
action)
K (Either String Bool) ho -> SP hi (Either String Bool) -> K hi ho
forall c ho hi. K c ho -> SP hi c -> K hi ho
`preProcessHighK` SP hi (Either String Bool)
forall a b. SP a b
nullSP
wmK :: Maybe (K (Either String Bool) c -> K (Either String Bool) c)
-> K (Either String Bool) c
wmK Maybe (K (Either String Bool) c -> K (Either String Bool) c)
optAction =
(Atom -> K (Either String Bool) c) -> K (Either String Bool) c
forall b c. (Atom -> K b c) -> K b c
wmDeleteWindowK ((Atom -> K (Either String Bool) c) -> K (Either String Bool) c)
-> (Atom -> K (Either String Bool) c) -> K (Either String Bool) c
forall a b. (a -> b) -> a -> b
$ \Atom
dw ->
case Maybe (K (Either String Bool) c -> K (Either String Bool) c)
optAction of
Just K (Either String Bool) c -> K (Either String Bool) c
action ->
String
-> Bool
-> (Atom -> K (Either String Bool) c)
-> K (Either String Bool) c
forall b c. String -> Bool -> Cont (K b c) Atom
internAtomK String
"WM_PROTOCOLS" Bool
False ((Atom -> K (Either String Bool) c) -> K (Either String Bool) c)
-> (Atom -> K (Either String Bool) c) -> K (Either String Bool) c
forall a b. (a -> b) -> a -> b
$ \ Atom
pr ->
(FResponse -> K (Either String Bool) c -> K (Either String Bool) c)
-> K (Either String Bool) c
forall o.
(FResponse -> K (Either String Bool) o -> K (Either String Bool) o)
-> K (Either String Bool) o
wmK' ((K (Either String Bool) c -> K (Either String Bool) c)
-> Atom
-> Atom
-> FResponse
-> K (Either String Bool) c
-> K (Either String Bool) c
forall a. (a -> a) -> Atom -> Atom -> FResponse -> a -> a
lowHandler K (Either String Bool) c -> K (Either String Bool) c
action Atom
pr Atom
dw)
Maybe (K (Either String Bool) c -> K (Either String Bool) c)
Nothing -> (FResponse -> K (Either String Bool) c -> K (Either String Bool) c)
-> K (Either String Bool) c
forall o.
(FResponse -> K (Either String Bool) o -> K (Either String Bool) o)
-> K (Either String Bool) o
wmK' ((K (Either String Bool) c -> K (Either String Bool) c)
-> FResponse
-> K (Either String Bool) c
-> K (Either String Bool) c
forall a b. a -> b -> a
const K (Either String Bool) c -> K (Either String Bool) c
forall a. a -> a
id)
where
lowHandler :: (a -> a) -> Atom -> Atom -> FResponse -> a -> a
lowHandler a -> a
action Atom
pr Atom
dw FResponse
event =
case FResponse
event of
XEvt (ClientMessage Atom
a (Long (Int
p : [Int]
_))) | Atom
a Atom -> Atom -> Bool
forall a. Eq a => a -> a -> Bool
== Atom
pr Bool -> Bool -> Bool
&& Int -> Atom
Atom (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
p) Atom -> Atom -> Bool
forall a. Eq a => a -> a -> Bool
== Atom
dw ->
a -> a
action
FResponse
_ -> a -> a
forall a. a -> a
id
wmK' :: (FResponse -> K (Either String Bool) o -> K (Either String Bool) o)
-> K (Either String Bool) o
wmK' FResponse -> K (Either String Bool) o -> K (Either String Bool) o
lowHandler = K (Either String Bool) o
loop
where
loop :: K (Either String Bool) o
loop =
Cont (K (Either String Bool) o) (KEvent (Either String Bool))
forall hi ho. Cont (K hi ho) (KEvent hi)
getK Cont (K (Either String Bool) o) (KEvent (Either String Bool))
-> Cont (K (Either String Bool) o) (KEvent (Either String Bool))
forall a b. (a -> b) -> a -> b
$ \KEvent (Either String Bool)
msg ->
case KEvent (Either String Bool)
msg of
Low FResponse
event -> FResponse -> K (Either String Bool) o -> K (Either String Bool) o
lowHandler FResponse
event K (Either String Bool) o
loop
High (Left String
title) -> XCommand -> K (Either String Bool) o -> K (Either String Bool) o
forall i o. XCommand -> K i o -> K i o
xcommandK (String -> XCommand
StoreName String
title) K (Either String Bool) o
loop
High (Right Bool
True) -> XCommand -> K (Either String Bool) o -> K (Either String Bool) o
forall i o. XCommand -> K i o -> K i o
xcommandK XCommand
MapRaised K (Either String Bool) o
loop
High (Right Bool
False) -> K (Either String Bool) o -> K (Either String Bool) o
forall i o. K i o -> K i o
unmapWindowK K (Either String Bool) o
loop
KEvent (Either String Bool)
_ -> K (Either String Bool) o
loop
exitK :: p -> K b ho
exitK p
cont = Request -> (Response -> K b ho) -> K b ho
forall (f :: * -> * -> *) b ho.
FudgetIO f =>
Request -> (Response -> f b ho) -> f b ho
haskellIO (Int -> Request
Exit Int
0) (K b ho -> Response -> K b ho
forall a b. a -> b -> a
const K b ho
forall hi ho. K hi ho
nullK)
unmapWindowK :: K i o -> K i o
unmapWindowK = XCommand -> K i o -> K i o
forall i o. XCommand -> K i o -> K i o
xcommandK XCommand
UnmapWindow
reportK :: K hi () -> K hi ()
reportK = KCommand () -> K hi () -> K hi ()
forall ho hi. KCommand ho -> K hi ho -> K hi ho
putK (() -> KCommand ()
forall a b. b -> Message a b
High ())
wmDeleteWindowK :: (Atom -> K b c) -> K b c
wmDeleteWindowK Atom -> K b c
cont =
String -> Bool -> (Atom -> K b c) -> K b c
forall b c. String -> Bool -> Cont (K b c) Atom
internAtomK String
"WM_DELETE_WINDOW" Bool
False ((Atom -> K b c) -> K b c) -> (Atom -> K b c) -> K b c
forall a b. (a -> b) -> a -> b
$ \Atom
dw ->
XCommand -> K b c -> K b c
forall i o. XCommand -> K i o -> K i o
xcommandK ([Atom] -> XCommand
SetWMProtocols [Atom
dw]) (K b c -> K b c) -> K b c -> K b c
forall a b. (a -> b) -> a -> b
$
Atom -> K b c
cont Atom
dw