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 [] = forall a. Maybe a
Nothing
getEventMask (CWEventMask [EventMask]
m : [WindowAttributes]
_) = 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 forall a. a -> [a] -> [a]
: [WindowAttributes]
l
setEventMask [EventMask]
em (WindowAttributes
wa : [WindowAttributes]
l) = WindowAttributes
wa 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 = 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 = 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 = forall {hi} {ho}.
Sizing -> [FRequest] -> [WindowAttributes] -> F hi ho -> F hi ho
invisibleGroupF Sizing
sizing [] [[EventMask] -> WindowAttributes
CWEventMask [EventMask]
mask] F i o
f
  focusK0 :: SP (Either TCommand TEvent) (Either TCommand TEvent)
focusK0 = forall {t1} {a} {t2} {b}.
(t1 -> a) -> (t2 -> b) -> SP a t2 -> SP t1 b
prepostMapSP forall {a} {a} {b}. Either (a, a) (a, b) -> (a, Either a b)
pre 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 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,forall a b. a -> Either a b
Left a
m)
      pre (Right (a
t,b
m)) = (a
t,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) = forall a b. a -> Either a b
Left (a
t,b
m)
      post (a
t,Right b
m) = 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 = 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' forall a. a -> a
id 
         [(forall (t :: * -> *). Foldable t => t Bool -> Bool
and (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' = forall {t}.
(t -> t) -> t -> PathTree t -> Path -> (t -> t) -> PathTree t
updateNode forall a. a -> a
id Bool
True PathTree Bool
mapped (forall {a}. [a] -> [a]
autumnize Path
tag) (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
&& forall a. [a] -> Maybe a
listToMaybe (forall {a}. [(Bool, a)] -> [a]
mappedtags [(Bool, Path)]
etags) forall a. Eq a => a -> a -> Bool
/= forall a. [a] -> Maybe a
listToMaybe (forall {a}. [(Bool, a)] -> [a]
mappedtags [(Bool, Path)]
netags)
         forall {a}. Bool -> (a -> a) -> a -> a
`thenC` (forall {a} {a} {a}.
[(Bool, a)]
-> SP a (a, Either a FResponse) -> SP a (a, Either a FResponse)
leaveFocus [(Bool, Path)]
etags forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a} {a} {a}.
[(Bool, a)]
-> SP a (a, Either a FResponse) -> SP a (a, Either a FResponse)
enterFocus [(Bool, Path)]
netags) forall a b. (a -> b) -> a -> b
$ 
       SP
  (Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
-> SP a (Path, Either a FResponse)
c 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 = 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 = 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 forall a. a -> a
id
   rotate :: [(Bool, b)] -> [(Bool, b)]
rotate [(Bool, b)]
ts = case forall a. (a -> Bool) -> [a] -> ([a], [a])
break 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 forall a. [a] -> [a] -> [a]
++ [(Bool, b)]
unmapped forall a. [a] -> [a] -> [a]
++ [(Bool, b)
t]
   nexttag :: [(Bool, Path)]
nexttag = forall {b}. [(Bool, b)] -> [(Bool, b)]
rotate [(Bool, Path)]
etags
   prevtag :: [(Bool, Path)]
prevtag = forall {a}. [a] -> [a]
reverse (forall {b}. [(Bool, b)] -> [(Bool, b)]
rotate (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 = 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 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 = 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 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 = forall {a} {a} {a}.
[(Bool, a)]
-> XEvent
-> SP a (a, Either a FResponse)
-> SP a (a, Either a FResponse)
putFocus' [(Bool, a)]
et (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 forall {a}. [(Bool, a)] -> [a]
mappedtags [(Bool, a)]
et of 
	 [] -> forall a. a -> a
id
	 (a
t:[a]
_) -> forall b a. b -> SP a b -> SP a b
putSP (a
t, forall a b. b -> Either a b
Right (XEvent -> FResponse
XEvt XEvent
ev))
   same :: SP
  (Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
same = 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 -> forall b a. b -> SP a b -> SP a b
putSP (Path
tag, forall a b. a -> Either a b
Left (XCommand -> FRequest
XCmd forall a b. (a -> b) -> a -> b
$ Bool -> XCommand
GrabEvents (Bool
t Bool -> Bool -> Bool
|| Bool
stag))) forall a b. (a -> b) -> a -> b
$
			    Bool
stag forall {a}. Bool -> (a -> a) -> a -> a
`thenC` (forall {a} {a} {a}.
[(Bool, a)]
-> SP a (a, Either a FResponse) -> SP a (a, Either a FResponse)
leaveFocus [(Bool, Path)]
etags forall b c a. (b -> c) -> (a -> b) -> a -> c
.
					  forall {a} {a} {a}.
[(Bool, a)]
-> SP a (a, Either a FResponse) -> SP a (a, Either a FResponse)
enterFocus [(Bool
True,Path
tag)]) 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)forall a. a -> [a] -> [a]
:[(Bool, Path)]
grab) 
					   [EventMask]
mask [(Path, XEvent -> Maybe XEvent)]
tt [Path]
shellTags [(Bool, Path)]
etags
	    XCommand
UngrabEvents -> forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Bool, Path)]
grab' Bool -> Bool -> Bool
&& Bool
inw forall {a}. Bool -> (a -> a) -> a -> a
`thenC` forall {a} {a} {a}.
[(Bool, a)]
-> SP a (a, Either a FResponse) -> SP a (a, Either a FResponse)
enterFocus [(Bool, Path)]
etags forall a b. (a -> b) -> a -> b
$
			    forall {a}.
SP a (Path, Either FRequest FResponse)
-> SP a (Path, Either FRequest FResponse)
pass 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' = forall a. Int -> [a] -> [a]
drop Int
1 [(Bool, Path)]
grab
	    TranslateEvent XEvent -> Maybe XEvent
t [EventMask]
tmask ->  forall b a. b -> SP a b -> SP a b
putSP (Path
kernelTag, 
	       forall a b. a -> Either a b
Left (XCommand -> FRequest
XCmd forall a b. (a -> b) -> a -> b
$ [WindowAttributes] -> XCommand
ChangeWindowAttributes [[EventMask] -> WindowAttributes
CWEventMask [EventMask]
umask])) 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)forall a. a -> [a] -> [a]
:[(Path, XEvent -> Maybe XEvent)]
tt) [Path]
shellTags [(Bool, Path)]
etags 
	      where umask :: [EventMask]
umask = 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 forall {t1 :: * -> *} {t2 :: * -> *} {a}.
(Foldable t1, Foldable t2, Eq a) =>
t1 a -> t2 a -> Bool
issubset [EventMask]
entrymask [EventMask]
em then
				forall b a. b -> SP a b -> SP a b
putSP (Path
tag, forall a b. a -> Either a b
Left (XCommand -> FRequest
XCmd forall a b. (a -> b) -> a -> b
$ [WindowAttributes] -> XCommand
ChangeWindowAttributes 
				       ([EventMask] -> [WindowAttributes] -> [WindowAttributes]
setEventMask ((EventMask
ButtonPressMaskforall a. a -> [a] -> [a]
:
					      [EventMask]
em) forall a. Eq a => [a] -> [a] -> [a]
\\ [EventMask]
entrymask) [WindowAttributes]
cwa))) forall a b. (a -> b) -> a -> b
$
				forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Bool, Path)]
etags forall {a}. Bool -> (a -> a) -> a -> a
`thenC` forall {a} {a} {a}.
[(Bool, a)]
-> SP a (a, Either a FResponse) -> SP a (a, Either a FResponse)
enterFocus [(Bool, Path)]
etags' 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' = forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (\(Bool
_,Path
x) (Bool
_,Path
y)-> forall a. Ord a => a -> a -> Ordering
compare Path
x Path
y)
					      ((Bool
False,Path
tag)forall a. a -> [a] -> [a]
:[(Bool, Path)]
etags)
		  Maybe [EventMask]
Nothing -> SP
  (Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
passame
	    XCommand
DestroyWindow -> forall {a}.
SP a (Path, Either FRequest FResponse)
-> SP a (Path, Either FRequest FResponse)
pass forall a b. (a -> b) -> a -> b
$ 
		 -- not (null etags) && not (keep (head etags)) `thenC`
	       forall {a} {a} {a}.
[(Bool, a)]
-> SP a (a, Either a FResponse) -> SP a (a, Either a FResponse)
enterFocus [(Bool, Path)]
etags' 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path -> Path -> Bool
subPath Path
tag
		    etags' :: [(Bool, Path)]
etags' = forall a. (a -> Bool) -> [a] -> [a]
filter (Path -> Bool
keepforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. (a, b) -> b
snd) [(Bool, Path)]
etags
		    shellTags' :: [Path]
shellTags' = forall a. (a -> Bool) -> [a] -> [a]
filter Path -> Bool
keep [Path]
shellTags
		    tt' :: [(Path, XEvent -> Maybe XEvent)]
tt' = forall a. (a -> Bool) -> [a] -> [a]
filter (Path -> Bool
keepforall b c a. (b -> c) -> (a -> b) -> a -> c
.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 -} ->
	     forall {a}.
SP a (Path, Either FRequest FResponse)
-> SP a (Path, Either FRequest FResponse)
pass forall a b. (a -> b) -> a -> b
$ [Path]
-> [(Bool, Path)]
-> SP
     (Path, Either FRequest FResponse) (Path, Either FRequest FResponse)
focusm (forall {a}. [a] -> [a]
autumnize Path
tagforall 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 (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 = forall {a1} {a2}. Show a1 => [Char] -> a1 -> a2 -> a2
ctrace [Char]
"focus1" (Bool
raised,Path
tag) forall a b. (a -> b) -> a -> b
$ forall {a}.
SP a (Path, Either FRequest FResponse)
-> SP a (Path, Either FRequest FResponse)
pass 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 forall a. Eq a => a -> a -> Bool
== forall a. [a]
focusMods 
	      Bool -> Bool -> Bool
&& Button
bno forall a. Eq a => a -> a -> Bool
== Button
focusBtn Bool -> Bool -> Bool
&& Bool
etag -> 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 forall {a}.
SP a (Path, Either FRequest FResponse)
-> SP a (Path, Either FRequest FResponse)
pass ([(Bool, Path)]
aftforall a. [a] -> [a] -> [a]
++[(Bool, Path)]
bef)
 	      where ([(Bool, Path)]
bef,[(Bool, Path)]
aft) = forall a. (a -> Bool) -> [a] -> ([a], [a])
break (forall a b c. (a -> b -> c) -> b -> a -> c
flip Path -> Path -> Bool
subPath Path
tagforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall {a}. [a] -> [a]
autumnizeforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. (a, b) -> b
snd) [(Bool, Path)]
etags
	   XEvent
_ -> case 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) -> forall b a. b -> SP a b -> SP a b
putSP (Path
t,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 forall a. Eq a => a -> a -> Bool
== [Char]
rotKs Bool -> Bool -> Bool
&& Bool
ktag ->
		    if (Modifiers
Shiftforall a. a -> [a] -> [a]
:ModState
rotMods) 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    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
tagforall a. Eq a => a -> a -> Bool
==Path
kernelTag Bool -> Bool -> Bool
|| Bool
gtag' -> 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
tagforall 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
tagforall 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
tagforall 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
tagforall 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 = 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 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
			  (Bool
my,Path
t):[(Bool, Path)]
_ -> if Bool
my then if Bool
ktag then forall {a} {a}.
SP a (Path, Either a FResponse) -> SP a (Path, Either a FResponse)
focusEvToFocus
						 else forall {a}.
SP a (Path, Either FRequest FResponse)
-> SP a (Path, Either FRequest FResponse)
pass
				      else if Bool
ktag then 
					     forall b a. b -> SP a b -> SP a b
putSP (Path
t,forall a b. b -> Either a b
Right (XEvent -> FResponse
XEvt XEvent
ev))
					    else forall {a}.
SP a (Path, Either FRequest FResponse)
-> SP a (Path, Either FRequest FResponse)
pass
			  [] -> if Bool
ktag then forall {a} {a}.
SP a (Path, Either a FResponse) -> SP a (Path, Either a FResponse)
focusEvToFocus else forall {a}.
SP a (Path, Either FRequest FResponse)
-> SP a (Path, Either FRequest FResponse)
pass ) 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 = 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 = 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 = 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 forall a. Eq a => a -> a -> Bool
== Path
kernelTag Bool -> Bool -> Bool
|| Bool
gtag
	  stag :: Bool
stag = forall {t :: * -> *}. Foldable t => t Path -> Bool
inGroup [Path]
shellTags
	  etag :: Bool
etag = forall {t :: * -> *}. Foldable t => t Path -> Bool
inGroup (forall a b. (a -> b) -> [a] -> [b]
map (forall {a}. [a] -> [a]
autumnizeforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. (a, b) -> b
snd) [(Bool, Path)]
etags)
	  gtag :: Bool
gtag = case [(Bool, Path)]
grab of (Bool
_,Path
t):[(Bool, Path)]
_ -> Path
t forall a. Eq a => a -> a -> Bool
== Path
tag; [] -> Bool
False
	  gtag' :: Bool
gtag' = case [(Bool, Path)]
grab of (Bool
True,Path
t):[(Bool, Path)]
_ -> Path
t 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 = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (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' [] = 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 -> forall a. a -> Maybe a
Just (a
t, b
e)