module FocusMgr(focusMgr) where
import Data.List((\\),sortBy)
import Data.Maybe(listToMaybe)
import Command
import Dlayout(invisibleGroupF)
import Event
import Fudget
import FRequest
import LoopLow
import HbcUtils(union)
import Path
import PathTree hiding (pos)
import Spops
import CompSP
import Utils
import CmdLineEnv(argKey,argReadKey)
import WindowF(kernelTag,autumnize)
import Xtypes
import Maptrace
getEventMask :: [WindowAttributes] -> Maybe [EventMask]
getEventMask [] = Maybe [EventMask]
forall a. Maybe a
Nothing
getEventMask (CWEventMask [EventMask]
m : [WindowAttributes]
_) = [EventMask] -> Maybe [EventMask]
forall a. a -> Maybe a
Just [EventMask]
m
getEventMask (WindowAttributes
_ : [WindowAttributes]
l) = [WindowAttributes] -> Maybe [EventMask]
getEventMask [WindowAttributes]
l
setEventMask :: [EventMask] -> [WindowAttributes] -> [WindowAttributes]
setEventMask [EventMask]
em [] = [[EventMask] -> WindowAttributes
CWEventMask [EventMask]
em]
setEventMask [EventMask]
em (CWEventMask [EventMask]
m : [WindowAttributes]
l) = [EventMask] -> WindowAttributes
CWEventMask [EventMask]
em WindowAttributes -> [WindowAttributes] -> [WindowAttributes]
forall a. a -> [a] -> [a]
: [WindowAttributes]
l
setEventMask [EventMask]
em (WindowAttributes
wa : [WindowAttributes]
l) = WindowAttributes
wa WindowAttributes -> [WindowAttributes] -> [WindowAttributes]
forall a. a -> [a] -> [a]
: [EventMask] -> [WindowAttributes] -> [WindowAttributes]
setEventMask [EventMask]
em [WindowAttributes]
l
focusBtn :: Button
focusBtn = Int -> Button
Button Int
1
focusMods :: [a]
focusMods = []
rotMods :: ModState
rotMods = [Char] -> ModState -> ModState
forall p. (Read p, Show p) => [Char] -> p -> p
argReadKey [Char]
"rotmods" [] :: ModState
rotKs :: [Char]
rotKs = [Char] -> [Char] -> [Char]
argKey [Char]
"rotkey" [Char]
"Tab" :: KeySym
entrymask :: [EventMask]
entrymask = [EventMask
KeyPressMask, EventMask
EnterWindowMask, EventMask
LeaveWindowMask]
mask :: [EventMask]
mask = [EventMask
KeyPressMask, EventMask
KeyReleaseMask, EventMask
EnterWindowMask, EventMask
LeaveWindowMask]
mkFocusEvent :: (Detail -> Mode -> t) -> t
mkFocusEvent Detail -> Mode -> t
io = Detail -> Mode -> t
io Detail
NotifyNonlinearVirtual Mode
NotifyNormal
focusMgr :: Sizing -> Bool -> F i o -> F i o
focusMgr Sizing
sizing Bool
ctt F i o
f = SP (Either TCommand TEvent) (Either TCommand TEvent)
-> F i o -> F i o
forall i o.
SP (Either TCommand TEvent) (Either TCommand TEvent)
-> F i o -> F i o
loopThroughLowF SP (Either TCommand TEvent) (Either TCommand TEvent)
focusK0 F i o
igF
where
igF :: F i o
igF = Sizing -> [FRequest] -> [WindowAttributes] -> F i o -> F i o
forall b ho.
Sizing -> [FRequest] -> [WindowAttributes] -> F b ho -> F b ho
invisibleGroupF Sizing
sizing [] [[EventMask] -> WindowAttributes
CWEventMask [EventMask]
mask] F i o
f
focusK0 :: SP (Either TCommand TEvent) (Either TCommand TEvent)
focusK0 = (Either TCommand TEvent -> (Path, Either FRequest FResponse))
-> ((Path, Either FRequest FResponse) -> Either TCommand TEvent)
-> SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
-> SP (Either TCommand TEvent) (Either TCommand TEvent)
forall t1 a t2 b. (t1 -> a) -> (t2 -> b) -> SP a t2 -> SP t1 b
prepostMapSP Either TCommand TEvent -> (Path, Either FRequest FResponse)
forall a a b. Either (a, a) (a, b) -> (a, Either a b)
pre (Path, Either FRequest FResponse) -> Either TCommand TEvent
forall a b b. (a, Either b b) -> Either (a, b) (a, b)
post
(Bool
-> PathTree Bool
-> Bool
-> [(Bool, Path)]
-> [EventMask]
-> [(Path, XEvent -> Maybe XEvent)]
-> [Path]
-> [(Bool, Path)]
-> SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
focusK' Bool
False PathTree Bool
forall n. PathTree n
emptyPathTree Bool
False [] [EventMask]
mask [] [] []) where
pre :: Either (a, a) (a, b) -> (a, Either a b)
pre (Left (a
t,a
m)) = (a
t,a -> Either a b
forall a b. a -> Either a b
Left a
m)
pre (Right (a
t,b
m)) = (a
t,b -> Either a b
forall a b. b -> Either a b
Right b
m)
post :: (a, Either b b) -> Either (a, b) (a, b)
post (a
t,Left b
m) = (a, b) -> Either (a, b) (a, b)
forall a b. a -> Either a b
Left (a
t,b
m)
post (a
t,Right b
m) = (a, b) -> Either (a, b) (a, b)
forall a b. b -> Either a b
Right (a
t,b
m)
focusK' :: Bool
-> PathTree Bool
-> Bool
-> [(Bool, Path)]
-> [EventMask]
-> [(Path, XEvent -> Maybe XEvent)]
-> [Path]
-> [(Bool, Path)]
-> SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
focusK' Bool
focusin PathTree Bool
mapped Bool
inw [(Bool, Path)]
grab [EventMask]
mask [(Path, XEvent -> Maybe XEvent)]
tt [Path]
shellTags [(Bool, Path)]
etags = SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
same where
focusK :: Bool
-> [(Bool, Path)]
-> [EventMask]
-> [(Path, XEvent -> Maybe XEvent)]
-> [Path]
-> [(Bool, Path)]
-> SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
focusK = Bool
-> PathTree Bool
-> Bool
-> [(Bool, Path)]
-> [EventMask]
-> [(Path, XEvent -> Maybe XEvent)]
-> [Path]
-> [(Bool, Path)]
-> SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
focusK' Bool
focusin PathTree Bool
mapped
focusm :: [Path]
-> [(Bool, Path)]
-> SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
focusm = Bool
-> [(Bool, Path)]
-> [EventMask]
-> [(Path, XEvent -> Maybe XEvent)]
-> [Path]
-> [(Bool, Path)]
-> SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
focusK Bool
inw [(Bool, Path)]
grab [EventMask]
mask [(Path, XEvent -> Maybe XEvent)]
tt
modMapped :: Path
-> Bool
-> SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
modMapped Path
tag Bool
raised = PathTree Bool
-> (SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
-> SP
(Path, Either FRequest FResponse)
(Path, Either FRequest FResponse))
-> [(Bool, Path)]
-> SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
forall a a.
PathTree Bool
-> (SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
-> SP a (Path, Either a FResponse))
-> [(Bool, Path)]
-> SP a (Path, Either a FResponse)
changeFocusc' PathTree Bool
mapped' SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
-> SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
forall a. a -> a
id
[([Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and (PathTree Bool -> Path -> [Bool]
forall a. PathTree a -> Path -> [a]
spineVals PathTree Bool
mapped' Path
t),Path
t) | (Bool
_,Path
t) <- [(Bool, Path)]
etags]
where mapped' :: PathTree Bool
mapped' = (Bool -> Bool)
-> Bool -> PathTree Bool -> Path -> (Bool -> Bool) -> PathTree Bool
forall n.
(n -> n) -> n -> PathTree n -> Path -> (n -> n) -> PathTree n
updateNode Bool -> Bool
forall a. a -> a
id Bool
True PathTree Bool
mapped (Path -> Path
forall a. [a] -> [a]
autumnize Path
tag) (Bool -> Bool -> Bool
forall a b. a -> b -> a
const Bool
raised)
changeFocusc' :: PathTree Bool
-> (SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
-> SP a (Path, Either a FResponse))
-> [(Bool, Path)]
-> SP a (Path, Either a FResponse)
changeFocusc' PathTree Bool
mapped' SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
-> SP a (Path, Either a FResponse)
c [(Bool, Path)]
netags =
Bool
inw Bool -> Bool -> Bool
&& [Path] -> Maybe Path
forall a. [a] -> Maybe a
listToMaybe ([(Bool, Path)] -> [Path]
forall a. [(Bool, a)] -> [a]
mappedtags [(Bool, Path)]
etags) Maybe Path -> Maybe Path -> Bool
forall a. Eq a => a -> a -> Bool
/= [Path] -> Maybe Path
forall a. [a] -> Maybe a
listToMaybe ([(Bool, Path)] -> [Path]
forall a. [(Bool, a)] -> [a]
mappedtags [(Bool, Path)]
netags)
Bool
-> (SP a (Path, Either a FResponse)
-> SP a (Path, Either a FResponse))
-> SP a (Path, Either a FResponse)
-> SP a (Path, Either a FResponse)
forall a. Bool -> (a -> a) -> a -> a
`thenC` ([(Bool, Path)]
-> SP a (Path, Either a FResponse)
-> SP a (Path, Either a FResponse)
forall a a a.
[(Bool, a)]
-> SP a (a, Either a FResponse) -> SP a (a, Either a FResponse)
leaveFocus [(Bool, Path)]
etags (SP a (Path, Either a FResponse)
-> SP a (Path, Either a FResponse))
-> (SP a (Path, Either a FResponse)
-> SP a (Path, Either a FResponse))
-> SP a (Path, Either a FResponse)
-> SP a (Path, Either a FResponse)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Bool, Path)]
-> SP a (Path, Either a FResponse)
-> SP a (Path, Either a FResponse)
forall a a a.
[(Bool, a)]
-> SP a (a, Either a FResponse) -> SP a (a, Either a FResponse)
enterFocus [(Bool, Path)]
netags) (SP a (Path, Either a FResponse)
-> SP a (Path, Either a FResponse))
-> SP a (Path, Either a FResponse)
-> SP a (Path, Either a FResponse)
forall a b. (a -> b) -> a -> b
$
SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
-> SP a (Path, Either a FResponse)
c (SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
-> SP a (Path, Either a FResponse))
-> SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
-> SP a (Path, Either a FResponse)
forall a b. (a -> b) -> a -> b
$
Bool
-> PathTree Bool
-> Bool
-> [(Bool, Path)]
-> [EventMask]
-> [(Path, XEvent -> Maybe XEvent)]
-> [Path]
-> [(Bool, Path)]
-> SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
focusK' Bool
focusin PathTree Bool
mapped' Bool
inw [(Bool, Path)]
grab [EventMask]
mask [(Path, XEvent -> Maybe XEvent)]
tt [Path]
shellTags [(Bool, Path)]
netags
changeFocusc :: (SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
-> SP a (Path, Either a FResponse))
-> [(Bool, Path)] -> SP a (Path, Either a FResponse)
changeFocusc = PathTree Bool
-> (SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
-> SP a (Path, Either a FResponse))
-> [(Bool, Path)]
-> SP a (Path, Either a FResponse)
forall a a.
PathTree Bool
-> (SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
-> SP a (Path, Either a FResponse))
-> [(Bool, Path)]
-> SP a (Path, Either a FResponse)
changeFocusc' PathTree Bool
mapped
changeFocus :: [(Bool, Path)]
-> SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
changeFocus = (SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
-> SP
(Path, Either FRequest FResponse)
(Path, Either FRequest FResponse))
-> [(Bool, Path)]
-> SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
forall a a.
(SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
-> SP a (Path, Either a FResponse))
-> [(Bool, Path)] -> SP a (Path, Either a FResponse)
changeFocusc SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
-> SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
forall a. a -> a
id
rotate :: [(Bool, b)] -> [(Bool, b)]
rotate [(Bool, b)]
ts = case ((Bool, b) -> Bool) -> [(Bool, b)] -> ([(Bool, b)], [(Bool, b)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Bool, b) -> Bool
forall a b. (a, b) -> a
fst [(Bool, b)]
ts of
([(Bool, b)]
unmapped,[]) -> [(Bool, b)]
ts
([(Bool, b)]
unmapped,(Bool, b)
t:[(Bool, b)]
mapped) -> [(Bool, b)]
mapped [(Bool, b)] -> [(Bool, b)] -> [(Bool, b)]
forall a. [a] -> [a] -> [a]
++ [(Bool, b)]
unmapped [(Bool, b)] -> [(Bool, b)] -> [(Bool, b)]
forall a. [a] -> [a] -> [a]
++ [(Bool, b)
t]
nexttag :: [(Bool, Path)]
nexttag = [(Bool, Path)] -> [(Bool, Path)]
forall b. [(Bool, b)] -> [(Bool, b)]
rotate [(Bool, Path)]
etags
prevtag :: [(Bool, Path)]
prevtag = [(Bool, Path)] -> [(Bool, Path)]
forall a. [a] -> [a]
reverse ([(Bool, Path)] -> [(Bool, Path)]
forall b. [(Bool, b)] -> [(Bool, b)]
rotate ([(Bool, Path)] -> [(Bool, Path)]
forall a. [a] -> [a]
reverse [(Bool, Path)]
etags))
enterFocus :: [(Bool, a)]
-> SP a (a, Either a FResponse) -> SP a (a, Either a FResponse)
enterFocus [(Bool, a)]
et = [(Bool, a)]
-> (Detail -> Mode -> XEvent)
-> SP a (a, Either a FResponse)
-> SP a (a, Either a FResponse)
forall a a a.
[(Bool, a)]
-> (Detail -> Mode -> XEvent)
-> SP a (a, Either a FResponse)
-> SP a (a, Either a FResponse)
putFocus [(Bool, a)]
et Detail -> Mode -> XEvent
FocusIn (SP a (a, Either a FResponse) -> SP a (a, Either a FResponse))
-> Bool
-> SP a (a, Either a FResponse)
-> SP a (a, Either a FResponse)
forall a. (a -> a) -> Bool -> a -> a
`ifC` Bool
inw
leaveFocus :: [(Bool, a)]
-> SP a (a, Either a FResponse) -> SP a (a, Either a FResponse)
leaveFocus [(Bool, a)]
et = [(Bool, a)]
-> (Detail -> Mode -> XEvent)
-> SP a (a, Either a FResponse)
-> SP a (a, Either a FResponse)
forall a a a.
[(Bool, a)]
-> (Detail -> Mode -> XEvent)
-> SP a (a, Either a FResponse)
-> SP a (a, Either a FResponse)
putFocus [(Bool, a)]
et Detail -> Mode -> XEvent
FocusOut (SP a (a, Either a FResponse) -> SP a (a, Either a FResponse))
-> Bool
-> SP a (a, Either a FResponse)
-> SP a (a, Either a FResponse)
forall a. (a -> a) -> Bool -> a -> a
`ifC` Bool
inw
putFocus :: [(Bool, a)]
-> (Detail -> Mode -> XEvent)
-> SP a (a, Either a FResponse)
-> SP a (a, Either a FResponse)
putFocus [(Bool, a)]
et Detail -> Mode -> XEvent
f = [(Bool, a)]
-> XEvent
-> SP a (a, Either a FResponse)
-> SP a (a, Either a FResponse)
forall a a a.
[(Bool, a)]
-> XEvent
-> SP a (a, Either a FResponse)
-> SP a (a, Either a FResponse)
putFocus' [(Bool, a)]
et ((Detail -> Mode -> XEvent) -> XEvent
forall t. (Detail -> Mode -> t) -> t
mkFocusEvent Detail -> Mode -> XEvent
f)
mappedtags :: [(Bool, a)] -> [a]
mappedtags [(Bool, a)]
et = [a
t |(Bool
True,a
t)<- [(Bool, a)]
et]
putFocus' :: [(Bool, a)]
-> XEvent
-> SP a (a, Either a FResponse)
-> SP a (a, Either a FResponse)
putFocus' [(Bool, a)]
et XEvent
ev = case [(Bool, a)] -> [a]
forall a. [(Bool, a)] -> [a]
mappedtags [(Bool, a)]
et of
[] -> SP a (a, Either a FResponse) -> SP a (a, Either a FResponse)
forall a. a -> a
id
(a
t:[a]
_) -> (a, Either a FResponse)
-> SP a (a, Either a FResponse) -> SP a (a, Either a FResponse)
forall b a. b -> SP a b -> SP a b
putSP (a
t, FResponse -> Either a FResponse
forall a b. b -> Either a b
Right (XEvent -> FResponse
XEvt XEvent
ev))
same :: SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
same = Cont
(SP
(Path, Either FRequest FResponse)
(Path, Either FRequest FResponse))
(Path, Either FRequest FResponse)
forall a b. Cont (SP a b) a
getSP (Path, Either FRequest FResponse)
-> SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
focushandle
focushandle :: (Path, Either FRequest FResponse)
-> SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
focushandle tmsg :: (Path, Either FRequest FResponse)
tmsg@(Path
tag,Either FRequest FResponse
msg) = case Either FRequest FResponse
msg of
Left FRequest
cmd ->
case FRequest
cmd of
XCmd XCommand
xcmd -> case XCommand
xcmd of
GrabEvents Bool
t -> (Path, Either FRequest FResponse)
-> SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
-> SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
forall b a. b -> SP a b -> SP a b
putSP (Path
tag, FRequest -> Either FRequest FResponse
forall a b. a -> Either a b
Left (XCommand -> FRequest
XCmd (XCommand -> FRequest) -> XCommand -> FRequest
forall a b. (a -> b) -> a -> b
$ Bool -> XCommand
GrabEvents (Bool
t Bool -> Bool -> Bool
|| Bool
stag))) (SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
-> SP
(Path, Either FRequest FResponse)
(Path, Either FRequest FResponse))
-> SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
-> SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
forall a b. (a -> b) -> a -> b
$
Bool
stag Bool
-> (SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
-> SP
(Path, Either FRequest FResponse)
(Path, Either FRequest FResponse))
-> SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
-> SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
forall a. Bool -> (a -> a) -> a -> a
`thenC` ([(Bool, Path)]
-> SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
-> SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
forall a a a.
[(Bool, a)]
-> SP a (a, Either a FResponse) -> SP a (a, Either a FResponse)
leaveFocus [(Bool, Path)]
etags (SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
-> SP
(Path, Either FRequest FResponse)
(Path, Either FRequest FResponse))
-> (SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
-> SP
(Path, Either FRequest FResponse)
(Path, Either FRequest FResponse))
-> SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
-> SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
[(Bool, Path)]
-> SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
-> SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
forall a a a.
[(Bool, a)]
-> SP a (a, Either a FResponse) -> SP a (a, Either a FResponse)
enterFocus [(Bool
True,Path
tag)]) (SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
-> SP
(Path, Either FRequest FResponse)
(Path, Either FRequest FResponse))
-> SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
-> SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
forall a b. (a -> b) -> a -> b
$
Bool
-> [(Bool, Path)]
-> [EventMask]
-> [(Path, XEvent -> Maybe XEvent)]
-> [Path]
-> [(Bool, Path)]
-> SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
focusK Bool
inw ((Bool -> Bool
not Bool
stag,Path
tag)(Bool, Path) -> [(Bool, Path)] -> [(Bool, Path)]
forall a. a -> [a] -> [a]
:[(Bool, Path)]
grab)
[EventMask]
mask [(Path, XEvent -> Maybe XEvent)]
tt [Path]
shellTags [(Bool, Path)]
etags
XCommand
UngrabEvents -> [(Bool, Path)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Bool, Path)]
grab' Bool -> Bool -> Bool
&& Bool
inw Bool
-> (SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
-> SP
(Path, Either FRequest FResponse)
(Path, Either FRequest FResponse))
-> SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
-> SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
forall a. Bool -> (a -> a) -> a -> a
`thenC` [(Bool, Path)]
-> SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
-> SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
forall a a a.
[(Bool, a)]
-> SP a (a, Either a FResponse) -> SP a (a, Either a FResponse)
enterFocus [(Bool, Path)]
etags (SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
-> SP
(Path, Either FRequest FResponse)
(Path, Either FRequest FResponse))
-> SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
-> SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
forall a b. (a -> b) -> a -> b
$
SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
-> SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
forall a.
SP a (Path, Either FRequest FResponse)
-> SP a (Path, Either FRequest FResponse)
pass (SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
-> SP
(Path, Either FRequest FResponse)
(Path, Either FRequest FResponse))
-> SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
-> SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
forall a b. (a -> b) -> a -> b
$ Bool
-> [(Bool, Path)]
-> [EventMask]
-> [(Path, XEvent -> Maybe XEvent)]
-> [Path]
-> [(Bool, Path)]
-> SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
focusK Bool
inw [(Bool, Path)]
grab' [EventMask]
mask [(Path, XEvent -> Maybe XEvent)]
tt [Path]
shellTags [(Bool, Path)]
etags
where grab' :: [(Bool, Path)]
grab' = Int -> [(Bool, Path)] -> [(Bool, Path)]
forall a. Int -> [a] -> [a]
drop Int
1 [(Bool, Path)]
grab
TranslateEvent XEvent -> Maybe XEvent
t [EventMask]
tmask -> (Path, Either FRequest FResponse)
-> SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
-> SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
forall b a. b -> SP a b -> SP a b
putSP (Path
kernelTag,
FRequest -> Either FRequest FResponse
forall a b. a -> Either a b
Left (XCommand -> FRequest
XCmd (XCommand -> FRequest) -> XCommand -> FRequest
forall a b. (a -> b) -> a -> b
$ [WindowAttributes] -> XCommand
ChangeWindowAttributes [[EventMask] -> WindowAttributes
CWEventMask [EventMask]
umask])) (SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
-> SP
(Path, Either FRequest FResponse)
(Path, Either FRequest FResponse))
-> SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
-> SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
forall a b. (a -> b) -> a -> b
$
Bool
-> [(Bool, Path)]
-> [EventMask]
-> [(Path, XEvent -> Maybe XEvent)]
-> [Path]
-> [(Bool, Path)]
-> SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
focusK Bool
inw [(Bool, Path)]
grab [EventMask]
umask ((Path
tag,XEvent -> Maybe XEvent
t)(Path, XEvent -> Maybe XEvent)
-> [(Path, XEvent -> Maybe XEvent)]
-> [(Path, XEvent -> Maybe XEvent)]
forall a. a -> [a] -> [a]
:[(Path, XEvent -> Maybe XEvent)]
tt) [Path]
shellTags [(Bool, Path)]
etags
where umask :: [EventMask]
umask = [EventMask] -> [EventMask] -> [EventMask]
forall a. Eq a => [a] -> [a] -> [a]
union [EventMask]
mask [EventMask]
tmask
ChangeWindowAttributes [WindowAttributes]
cwa | Bool
ctt Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
ktag Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
stag ->
case [WindowAttributes] -> Maybe [EventMask]
getEventMask [WindowAttributes]
cwa of
Just [EventMask]
em -> if [EventMask] -> [EventMask] -> Bool
forall (t1 :: * -> *) (t2 :: * -> *) a.
(Foldable t1, Foldable t2, Eq a) =>
t1 a -> t2 a -> Bool
issubset [EventMask]
entrymask [EventMask]
em then
(Path, Either FRequest FResponse)
-> SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
-> SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
forall b a. b -> SP a b -> SP a b
putSP (Path
tag, FRequest -> Either FRequest FResponse
forall a b. a -> Either a b
Left (XCommand -> FRequest
XCmd (XCommand -> FRequest) -> XCommand -> FRequest
forall a b. (a -> b) -> a -> b
$ [WindowAttributes] -> XCommand
ChangeWindowAttributes
([EventMask] -> [WindowAttributes] -> [WindowAttributes]
setEventMask ((EventMask
ButtonPressMaskEventMask -> [EventMask] -> [EventMask]
forall a. a -> [a] -> [a]
:
[EventMask]
em) [EventMask] -> [EventMask] -> [EventMask]
forall a. Eq a => [a] -> [a] -> [a]
\\ [EventMask]
entrymask) [WindowAttributes]
cwa))) (SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
-> SP
(Path, Either FRequest FResponse)
(Path, Either FRequest FResponse))
-> SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
-> SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
forall a b. (a -> b) -> a -> b
$
[(Bool, Path)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Bool, Path)]
etags Bool
-> (SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
-> SP
(Path, Either FRequest FResponse)
(Path, Either FRequest FResponse))
-> SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
-> SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
forall a. Bool -> (a -> a) -> a -> a
`thenC` [(Bool, Path)]
-> SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
-> SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
forall a a a.
[(Bool, a)]
-> SP a (a, Either a FResponse) -> SP a (a, Either a FResponse)
enterFocus [(Bool, Path)]
etags' (SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
-> SP
(Path, Either FRequest FResponse)
(Path, Either FRequest FResponse))
-> SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
-> SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
forall a b. (a -> b) -> a -> b
$
[Path]
-> [(Bool, Path)]
-> SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
focusm [Path]
shellTags [(Bool, Path)]
etags'
else SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
passame
where etags' :: [(Bool, Path)]
etags' = ((Bool, Path) -> (Bool, Path) -> Ordering)
-> [(Bool, Path)] -> [(Bool, Path)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (\(Bool
_,Path
x) (Bool
_,Path
y)-> Path -> Path -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Path
x Path
y)
((Bool
False,Path
tag)(Bool, Path) -> [(Bool, Path)] -> [(Bool, Path)]
forall a. a -> [a] -> [a]
:[(Bool, Path)]
etags)
Maybe [EventMask]
Nothing -> SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
passame
XCommand
DestroyWindow -> SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
-> SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
forall a.
SP a (Path, Either FRequest FResponse)
-> SP a (Path, Either FRequest FResponse)
pass (SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
-> SP
(Path, Either FRequest FResponse)
(Path, Either FRequest FResponse))
-> SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
-> SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
forall a b. (a -> b) -> a -> b
$
[(Bool, Path)]
-> SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
-> SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
forall a a a.
[(Bool, a)]
-> SP a (a, Either a FResponse) -> SP a (a, Either a FResponse)
enterFocus [(Bool, Path)]
etags' (SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
-> SP
(Path, Either FRequest FResponse)
(Path, Either FRequest FResponse))
-> SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
-> SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
forall a b. (a -> b) -> a -> b
$
Bool
-> [(Bool, Path)]
-> [EventMask]
-> [(Path, XEvent -> Maybe XEvent)]
-> [Path]
-> [(Bool, Path)]
-> SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
focusK Bool
inw [(Bool, Path)]
grab [EventMask]
mask [(Path, XEvent -> Maybe XEvent)]
tt' [Path]
shellTags' ([(Bool, Path)]
etags' :: [(Bool,Path)])
where keep :: Path -> Bool
keep = Bool -> Bool
not (Bool -> Bool) -> (Path -> Bool) -> Path -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path -> Path -> Bool
subPath Path
tag
etags' :: [(Bool, Path)]
etags' = ((Bool, Path) -> Bool) -> [(Bool, Path)] -> [(Bool, Path)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Path -> Bool
keep(Path -> Bool) -> ((Bool, Path) -> Path) -> (Bool, Path) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Bool, Path) -> Path
forall a b. (a, b) -> b
snd) [(Bool, Path)]
etags
shellTags' :: [Path]
shellTags' = (Path -> Bool) -> [Path] -> [Path]
forall a. (a -> Bool) -> [a] -> [a]
filter Path -> Bool
keep [Path]
shellTags
tt' :: [(Path, XEvent -> Maybe XEvent)]
tt' = ((Path, XEvent -> Maybe XEvent) -> Bool)
-> [(Path, XEvent -> Maybe XEvent)]
-> [(Path, XEvent -> Maybe XEvent)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Path -> Bool
keep(Path -> Bool)
-> ((Path, XEvent -> Maybe XEvent) -> Path)
-> (Path, XEvent -> Maybe XEvent)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Path, XEvent -> Maybe XEvent) -> Path
forall a b. (a, b) -> a
fst) [(Path, XEvent -> Maybe XEvent)]
tt
XCommand
MapRaised -> Path
-> Bool
-> SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
changeMapping Path
tag Bool
True
XCommand
UnmapWindow -> Path
-> Bool
-> SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
changeMapping Path
tag Bool
False
XCommand
_ -> SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
passame
XReq (CreateMyWindow Rect
_) -> Path
-> Bool
-> SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
changeMapping Path
tag Bool
False
XReq (CreateRootWindow Rect
_ [Char]
_) ->
SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
-> SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
forall a.
SP a (Path, Either FRequest FResponse)
-> SP a (Path, Either FRequest FResponse)
pass (SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
-> SP
(Path, Either FRequest FResponse)
(Path, Either FRequest FResponse))
-> SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
-> SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
forall a b. (a -> b) -> a -> b
$ [Path]
-> [(Bool, Path)]
-> SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
focusm (Path -> Path
forall a. [a] -> [a]
autumnize Path
tagPath -> [Path] -> [Path]
forall a. a -> [a] -> [a]
: [Path]
shellTags) [(Bool, Path)]
etags
XReq (CreateSimpleWindow Path
rchild Rect
_) ->
Path
-> Bool
-> SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
changeMapping (Path -> Path -> Path
absPath (Path -> Path
forall a. [a] -> [a]
autumnize Path
tag) Path
rchild) Bool
False
FRequest
_ -> SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
passame
where changeMapping :: Path
-> Bool
-> SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
changeMapping Path
tag Bool
raised = [Char]
-> (Bool, Path)
-> SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
-> SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
forall a1 a2. Show a1 => [Char] -> a1 -> a2 -> a2
ctrace [Char]
"focus1" (Bool
raised,Path
tag) (SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
-> SP
(Path, Either FRequest FResponse)
(Path, Either FRequest FResponse))
-> SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
-> SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
forall a b. (a -> b) -> a -> b
$ SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
-> SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
forall a.
SP a (Path, Either FRequest FResponse)
-> SP a (Path, Either FRequest FResponse)
pass (SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
-> SP
(Path, Either FRequest FResponse)
(Path, Either FRequest FResponse))
-> SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
-> SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
forall a b. (a -> b) -> a -> b
$ Path
-> Bool
-> SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
modMapped Path
tag Bool
raised
Right (XEvt XEvent
ev) ->
if Bool
stag then SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
passame
else case XEvent
ev of
ButtonEvent {state :: XEvent -> ModState
state=ModState
mods,type' :: XEvent -> Pressed
type'=Pressed
Pressed,button :: XEvent -> Button
button=Button
bno} | Bool
ctt Bool -> Bool -> Bool
&& ModState
mods ModState -> ModState -> Bool
forall a. Eq a => a -> a -> Bool
== ModState
forall a. [a]
focusMods
Bool -> Bool -> Bool
&& Button
bno Button -> Button -> Bool
forall a. Eq a => a -> a -> Bool
== Button
focusBtn Bool -> Bool -> Bool
&& Bool
etag -> (SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
-> SP
(Path, Either FRequest FResponse)
(Path, Either FRequest FResponse))
-> [(Bool, Path)]
-> SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
forall a a.
(SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
-> SP a (Path, Either a FResponse))
-> [(Bool, Path)] -> SP a (Path, Either a FResponse)
changeFocusc SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
-> SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
forall a.
SP a (Path, Either FRequest FResponse)
-> SP a (Path, Either FRequest FResponse)
pass ([(Bool, Path)]
aft[(Bool, Path)] -> [(Bool, Path)] -> [(Bool, Path)]
forall a. [a] -> [a] -> [a]
++[(Bool, Path)]
bef)
where ([(Bool, Path)]
bef,[(Bool, Path)]
aft) = ((Bool, Path) -> Bool)
-> [(Bool, Path)] -> ([(Bool, Path)], [(Bool, Path)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break ((Path -> Path -> Bool) -> Path -> Path -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Path -> Path -> Bool
subPath Path
tag(Path -> Bool) -> ((Bool, Path) -> Path) -> (Bool, Path) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Path -> Path
forall a. [a] -> [a]
autumnize(Path -> Path) -> ((Bool, Path) -> Path) -> (Bool, Path) -> Path
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Bool, Path) -> Path
forall a b. (a, b) -> b
snd) [(Bool, Path)]
etags
XEvent
_ -> case XEvent -> [(Path, XEvent -> Maybe XEvent)] -> Maybe (Path, XEvent)
forall t a b. t -> [(a, t -> Maybe b)] -> Maybe (a, b)
flookup XEvent
ev [(Path, XEvent -> Maybe XEvent)]
tt of
Just (Path
t,XEvent
e) -> (Path, Either FRequest FResponse)
-> SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
-> SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
forall b a. b -> SP a b -> SP a b
putSP (Path
t,FResponse -> Either FRequest FResponse
forall a b. b -> Either a b
Right (XEvent -> FResponse
XEvt XEvent
e)) SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
same
Maybe (Path, XEvent)
Nothing -> if Bool -> Bool
not Bool
ctt then SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
passame else
case XEvent
ev of
KeyEvent {state :: XEvent -> ModState
state=ModState
mods,type' :: XEvent -> Pressed
type'=Pressed
Pressed,keySym :: XEvent -> [Char]
keySym=[Char]
ks} | [Char]
ks [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
rotKs Bool -> Bool -> Bool
&& Bool
ktag ->
if (Modifiers
ShiftModifiers -> ModState -> ModState
forall a. a -> [a] -> [a]
:ModState
rotMods) ModState -> ModState -> Bool
forall (t1 :: * -> *) (t2 :: * -> *) a.
(Foldable t1, Foldable t2, Eq a) =>
t1 a -> t2 a -> Bool
`issubset` ModState
mods then [(Bool, Path)]
-> SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
changeFocus [(Bool, Path)]
prevtag
else if ModState
rotMods ModState -> ModState -> Bool
forall (t1 :: * -> *) (t2 :: * -> *) a.
(Foldable t1, Foldable t2, Eq a) =>
t1 a -> t2 a -> Bool
`issubset` ModState
mods then [(Bool, Path)]
-> SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
changeFocus [(Bool, Path)]
nexttag
else SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
passame
KeyEvent {} |Path
tagPath -> Path -> Bool
forall a. Eq a => a -> a -> Bool
==Path
kernelTag Bool -> Bool -> Bool
|| Bool
gtag' -> SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
-> SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
forall a a.
SP a (Path, Either a FResponse) -> SP a (Path, Either a FResponse)
toFocus SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
same
EnterNotify {detail :: XEvent -> Detail
detail=Detail
d,focus :: XEvent -> Bool
focus=Bool
True} | Path
tagPath -> Path -> Bool
forall a. Eq a => a -> a -> Bool
==Path
kernelTag -> Bool
-> Detail
-> Bool
-> SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
handleEL Bool
False Detail
d Bool
True
LeaveNotify {detail :: XEvent -> Detail
detail=Detail
d,focus :: XEvent -> Bool
focus=Bool
True} | Path
tagPath -> Path -> Bool
forall a. Eq a => a -> a -> Bool
==Path
kernelTag -> Bool
-> Detail
-> Bool
-> SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
handleEL Bool
False Detail
d Bool
False
FocusIn {detail :: XEvent -> Detail
detail=Detail
d} | Path
tagPath -> Path -> Bool
forall a. Eq a => a -> a -> Bool
==Path
kernelTag Bool -> Bool -> Bool
|| Bool
gtag' -> Bool
-> Detail
-> Bool
-> SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
handleEL Bool
True Detail
d Bool
True
FocusOut {detail :: XEvent -> Detail
detail=Detail
d} | Path
tagPath -> Path -> Bool
forall a. Eq a => a -> a -> Bool
==Path
kernelTag Bool -> Bool -> Bool
|| Bool
gtag' -> Bool
-> Detail
-> Bool
-> SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
handleEL Bool
True Detail
d Bool
False
XEvent
_ -> SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
passame
where toFocus :: SP a (Path, Either a FResponse) -> SP a (Path, Either a FResponse)
toFocus = [(Bool, Path)]
-> XEvent
-> SP a (Path, Either a FResponse)
-> SP a (Path, Either a FResponse)
forall a a a.
[(Bool, a)]
-> XEvent
-> SP a (a, Either a FResponse)
-> SP a (a, Either a FResponse)
putFocus' [(Bool, Path)]
etags XEvent
ev
handleEL :: Bool
-> Detail
-> Bool
-> SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
handleEL Bool
isFocusEv Detail
d Bool
e = if Detail
d Detail -> Detail -> Bool
forall a. Eq a => a -> a -> Bool
== Detail
NotifyInferior
Bool -> Bool -> Bool
|| (Bool -> Bool
not Bool
isFocusEv Bool -> Bool -> Bool
&& Bool
focusin)
then SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
passame else
(case [(Bool, Path)]
grab of
(my,t):_ -> if Bool
my then if Bool
ktag then SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
-> SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
forall a a.
SP a (Path, Either a FResponse) -> SP a (Path, Either a FResponse)
focusEvToFocus
else SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
-> SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
forall a.
SP a (Path, Either FRequest FResponse)
-> SP a (Path, Either FRequest FResponse)
pass
else if Bool
ktag then
(Path, Either FRequest FResponse)
-> SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
-> SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
forall b a. b -> SP a b -> SP a b
putSP (Path
t,FResponse -> Either FRequest FResponse
forall a b. b -> Either a b
Right (XEvent -> FResponse
XEvt XEvent
ev))
else SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
-> SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
forall a.
SP a (Path, Either FRequest FResponse)
-> SP a (Path, Either FRequest FResponse)
pass
[] -> if Bool
ktag then SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
-> SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
forall a a.
SP a (Path, Either a FResponse) -> SP a (Path, Either a FResponse)
focusEvToFocus else SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
-> SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
forall a.
SP a (Path, Either FRequest FResponse)
-> SP a (Path, Either FRequest FResponse)
pass ) (SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
-> SP
(Path, Either FRequest FResponse)
(Path, Either FRequest FResponse))
-> SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
-> SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
forall a b. (a -> b) -> a -> b
$
Bool
-> PathTree Bool
-> Bool
-> [(Bool, Path)]
-> [EventMask]
-> [(Path, XEvent -> Maybe XEvent)]
-> [Path]
-> [(Bool, Path)]
-> SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
focusK' Bool
focusin' PathTree Bool
mapped Bool
inw' [(Bool, Path)]
grab [EventMask]
mask [(Path, XEvent -> Maybe XEvent)]
tt [Path]
shellTags [(Bool, Path)]
etags
where inw' :: Bool
inw' = if Bool
ktag then Bool
e else Bool
inw
focusin' :: Bool
focusin' = if Bool
ktag Bool -> Bool -> Bool
&& Bool
isFocusEv then Bool
e else Bool
focusin
focusEvToFocus :: SP a (Path, Either a FResponse) -> SP a (Path, Either a FResponse)
focusEvToFocus = [(Bool, Path)]
-> (Detail -> Mode -> XEvent)
-> SP a (Path, Either a FResponse)
-> SP a (Path, Either a FResponse)
forall a a a.
[(Bool, a)]
-> (Detail -> Mode -> XEvent)
-> SP a (a, Either a FResponse)
-> SP a (a, Either a FResponse)
putFocus [(Bool, Path)]
etags (if Bool
e then Detail -> Mode -> XEvent
FocusIn else Detail -> Mode -> XEvent
FocusOut)
Right FResponse
_ -> SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
passame
where pass :: SP a (Path, Either FRequest FResponse)
-> SP a (Path, Either FRequest FResponse)
pass = (Path, Either FRequest FResponse)
-> SP a (Path, Either FRequest FResponse)
-> SP a (Path, Either FRequest FResponse)
forall b a. b -> SP a b -> SP a b
putSP (Path, Either FRequest FResponse)
tmsg
passame :: SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
passame = SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
-> SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
forall a.
SP a (Path, Either FRequest FResponse)
-> SP a (Path, Either FRequest FResponse)
pass SP
(Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
same
ktag :: Bool
ktag = Path
tag Path -> Path -> Bool
forall a. Eq a => a -> a -> Bool
== Path
kernelTag Bool -> Bool -> Bool
|| Bool
gtag
stag :: Bool
stag = [Path] -> Bool
forall (t :: * -> *). Foldable t => t Path -> Bool
inGroup [Path]
shellTags
etag :: Bool
etag = [Path] -> Bool
forall (t :: * -> *). Foldable t => t Path -> Bool
inGroup (((Bool, Path) -> Path) -> [(Bool, Path)] -> [Path]
forall a b. (a -> b) -> [a] -> [b]
map (Path -> Path
forall a. [a] -> [a]
autumnize(Path -> Path) -> ((Bool, Path) -> Path) -> (Bool, Path) -> Path
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Bool, Path) -> Path
forall a b. (a, b) -> b
snd) [(Bool, Path)]
etags)
gtag :: Bool
gtag = case [(Bool, Path)]
grab of (_,t):_ -> Path
t Path -> Path -> Bool
forall a. Eq a => a -> a -> Bool
== Path
tag; [] -> Bool
False
gtag' :: Bool
gtag' = case [(Bool, Path)]
grab of (True,t):_ -> Path
t Path -> Path -> Bool
forall a. Eq a => a -> a -> Bool
== Path
tag; [] -> Bool
False
inGroup :: t Path -> Bool
inGroup t Path
tags = (Path -> Bool) -> t Path -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((Path -> Path -> Bool) -> Path -> Path -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Path -> Path -> Bool
subPath Path
tag) t Path
tags
flookup :: t -> [(a, t -> Maybe b)] -> Maybe (a, b)
flookup t
index' [] = Maybe (a, b)
forall a. Maybe a
Nothing
flookup t
index' ((a
t, t -> Maybe b
p) : [(a, t -> Maybe b)]
table') =
case t -> Maybe b
p t
index' of
Maybe b
Nothing -> t -> [(a, t -> Maybe b)] -> Maybe (a, b)
flookup t
index' [(a, t -> Maybe b)]
table'
Just b
e -> (a, b) -> Maybe (a, b)
forall a. a -> Maybe a
Just (a
t, b
e)