module FocusMgr(focusMgr) where
import Data.List((\\),sortBy)
import Data.Maybe(listToMaybe)
import Command
--import Direction
import Dlayout(invisibleGroupF)
import Event
--import Font(FontStruct)
import Fudget
import FRequest
--import Geometry(origin) --Line(..), Point(..), Rect(..), Size(..), origin)
--import LayoutRequest(LayoutRequest)
import LoopLow
import HbcUtils(union)
--import Message(Message(..))
import Path
import PathTree hiding (pos)
--import SP
import Spops
import CompSP
import Utils
import CmdLineEnv(argKey,argReadKey)
import WindowF(kernelTag,autumnize)
import Xtypes
--import List2(sort)

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
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' :: PathTree Bool ->  Bool ->  [(Bool,Path)] -> [EventMask] -> [(Path,(XEvent -> Maybe XEvent))] -> [Path] -> [(Bool,Path)] -> SP (Path,Either Command Event) (Path,Either Command Event) 
  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
$ 
		 -- not (null etags) && not (keep (head etags)) `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
$
	       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]
_) {-  | not ktag -} ->
	     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) -- focus events have priority over crossing events
                       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 -- event grabbed by something in my shell
          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)