{-# LANGUAGE FlexibleContexts, MultiParamTypeClasses, FlexibleInstances #-}
{-# OPTIONS_GHC -Wno-deprecations #-}
module XMonad.Layout.Fullscreen
(
fullscreenSupport
,fullscreenSupportBorder
,fullscreenFull
,fullscreenFocus
,fullscreenFullRect
,fullscreenFocusRect
,fullscreenFloat
,fullscreenFloatRect
,fullscreenEventHook
,fullscreenManageHook
,fullscreenManageHookWith
,FullscreenMessage(..)
,FullscreenFloat, FullscreenFocus, FullscreenFull
) where
import XMonad
import XMonad.Prelude
import XMonad.Layout.LayoutModifier
import XMonad.Layout.NoBorders (SmartBorder, smartBorders)
import XMonad.Hooks.EwmhDesktops (fullscreenStartup)
import XMonad.Hooks.ManageHelpers (isFullscreen)
import XMonad.Util.WindowProperties
import qualified XMonad.Util.Rectangle as R
import qualified XMonad.StackSet as W
import qualified Data.Map as M
import Control.Arrow (second)
fullscreenSupport :: LayoutClass l Window =>
XConfig l -> XConfig (ModifiedLayout FullscreenFull l)
fullscreenSupport :: forall (l :: * -> *).
LayoutClass l Window =>
XConfig l -> XConfig (ModifiedLayout FullscreenFull l)
fullscreenSupport XConfig l
c = XConfig l
c {
layoutHook :: ModifiedLayout FullscreenFull l Window
layoutHook = l Window -> ModifiedLayout FullscreenFull l Window
forall (l :: * -> *) a.
LayoutClass l a =>
l a -> ModifiedLayout FullscreenFull l a
fullscreenFull (l Window -> ModifiedLayout FullscreenFull l Window)
-> l Window -> ModifiedLayout FullscreenFull l Window
forall a b. (a -> b) -> a -> b
$ XConfig l -> l Window
forall (l :: * -> *). XConfig l -> l Window
layoutHook XConfig l
c,
handleEventHook :: Event -> X All
handleEventHook = XConfig l -> Event -> X All
forall (l :: * -> *). XConfig l -> Event -> X All
handleEventHook XConfig l
c (Event -> X All) -> (Event -> X All) -> Event -> X All
forall a. Semigroup a => a -> a -> a
<> Event -> X All
fullscreenEventHook,
manageHook :: Query (Endo WindowSet)
manageHook = XConfig l -> Query (Endo WindowSet)
forall (l :: * -> *). XConfig l -> Query (Endo WindowSet)
manageHook XConfig l
c Query (Endo WindowSet)
-> Query (Endo WindowSet) -> Query (Endo WindowSet)
forall a. Semigroup a => a -> a -> a
<> Query (Endo WindowSet)
fullscreenManageHook,
startupHook :: X ()
startupHook = XConfig l -> X ()
forall (l :: * -> *). XConfig l -> X ()
startupHook XConfig l
c X () -> X () -> X ()
forall a. Semigroup a => a -> a -> a
<> X ()
fullscreenStartup
}
fullscreenSupportBorder :: LayoutClass l Window =>
XConfig l -> XConfig (ModifiedLayout FullscreenFull
(ModifiedLayout SmartBorder (ModifiedLayout FullscreenFull l)))
fullscreenSupportBorder :: forall (l :: * -> *).
LayoutClass l Window =>
XConfig l
-> XConfig
(ModifiedLayout
FullscreenFull
(ModifiedLayout SmartBorder (ModifiedLayout FullscreenFull l)))
fullscreenSupportBorder XConfig l
c =
XConfig
(ModifiedLayout SmartBorder (ModifiedLayout FullscreenFull l))
-> XConfig
(ModifiedLayout
FullscreenFull
(ModifiedLayout SmartBorder (ModifiedLayout FullscreenFull l)))
forall (l :: * -> *).
LayoutClass l Window =>
XConfig l -> XConfig (ModifiedLayout FullscreenFull l)
fullscreenSupport XConfig l
c { layoutHook :: ModifiedLayout SmartBorder (ModifiedLayout FullscreenFull l) Window
layoutHook = ModifiedLayout FullscreenFull l Window
-> ModifiedLayout
SmartBorder (ModifiedLayout FullscreenFull l) Window
forall (l :: * -> *) a.
LayoutClass l a =>
l a -> ModifiedLayout SmartBorder l a
smartBorders
(ModifiedLayout FullscreenFull l Window
-> ModifiedLayout
SmartBorder (ModifiedLayout FullscreenFull l) Window)
-> ModifiedLayout FullscreenFull l Window
-> ModifiedLayout
SmartBorder (ModifiedLayout FullscreenFull l) Window
forall a b. (a -> b) -> a -> b
$ l Window -> ModifiedLayout FullscreenFull l Window
forall (l :: * -> *) a.
LayoutClass l a =>
l a -> ModifiedLayout FullscreenFull l a
fullscreenFull
(l Window -> ModifiedLayout FullscreenFull l Window)
-> l Window -> ModifiedLayout FullscreenFull l Window
forall a b. (a -> b) -> a -> b
$ XConfig l -> l Window
forall (l :: * -> *). XConfig l -> l Window
layoutHook XConfig l
c
}
data FullscreenMessage = AddFullscreen Window
| RemoveFullscreen Window
| FullscreenChanged
instance Message FullscreenMessage
data FullscreenFull a = FullscreenFull W.RationalRect [a]
deriving (ReadPrec [FullscreenFull a]
ReadPrec (FullscreenFull a)
Int -> ReadS (FullscreenFull a)
ReadS [FullscreenFull a]
(Int -> ReadS (FullscreenFull a))
-> ReadS [FullscreenFull a]
-> ReadPrec (FullscreenFull a)
-> ReadPrec [FullscreenFull a]
-> Read (FullscreenFull a)
forall a. Read a => ReadPrec [FullscreenFull a]
forall a. Read a => ReadPrec (FullscreenFull a)
forall a. Read a => Int -> ReadS (FullscreenFull a)
forall a. Read a => ReadS [FullscreenFull a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FullscreenFull a]
$creadListPrec :: forall a. Read a => ReadPrec [FullscreenFull a]
readPrec :: ReadPrec (FullscreenFull a)
$creadPrec :: forall a. Read a => ReadPrec (FullscreenFull a)
readList :: ReadS [FullscreenFull a]
$creadList :: forall a. Read a => ReadS [FullscreenFull a]
readsPrec :: Int -> ReadS (FullscreenFull a)
$creadsPrec :: forall a. Read a => Int -> ReadS (FullscreenFull a)
Read, Int -> FullscreenFull a -> ShowS
[FullscreenFull a] -> ShowS
FullscreenFull a -> String
(Int -> FullscreenFull a -> ShowS)
-> (FullscreenFull a -> String)
-> ([FullscreenFull a] -> ShowS)
-> Show (FullscreenFull a)
forall a. Show a => Int -> FullscreenFull a -> ShowS
forall a. Show a => [FullscreenFull a] -> ShowS
forall a. Show a => FullscreenFull a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FullscreenFull a] -> ShowS
$cshowList :: forall a. Show a => [FullscreenFull a] -> ShowS
show :: FullscreenFull a -> String
$cshow :: forall a. Show a => FullscreenFull a -> String
showsPrec :: Int -> FullscreenFull a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> FullscreenFull a -> ShowS
Show)
data FullscreenFocus a = FullscreenFocus W.RationalRect [a]
deriving (ReadPrec [FullscreenFocus a]
ReadPrec (FullscreenFocus a)
Int -> ReadS (FullscreenFocus a)
ReadS [FullscreenFocus a]
(Int -> ReadS (FullscreenFocus a))
-> ReadS [FullscreenFocus a]
-> ReadPrec (FullscreenFocus a)
-> ReadPrec [FullscreenFocus a]
-> Read (FullscreenFocus a)
forall a. Read a => ReadPrec [FullscreenFocus a]
forall a. Read a => ReadPrec (FullscreenFocus a)
forall a. Read a => Int -> ReadS (FullscreenFocus a)
forall a. Read a => ReadS [FullscreenFocus a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FullscreenFocus a]
$creadListPrec :: forall a. Read a => ReadPrec [FullscreenFocus a]
readPrec :: ReadPrec (FullscreenFocus a)
$creadPrec :: forall a. Read a => ReadPrec (FullscreenFocus a)
readList :: ReadS [FullscreenFocus a]
$creadList :: forall a. Read a => ReadS [FullscreenFocus a]
readsPrec :: Int -> ReadS (FullscreenFocus a)
$creadsPrec :: forall a. Read a => Int -> ReadS (FullscreenFocus a)
Read, Int -> FullscreenFocus a -> ShowS
[FullscreenFocus a] -> ShowS
FullscreenFocus a -> String
(Int -> FullscreenFocus a -> ShowS)
-> (FullscreenFocus a -> String)
-> ([FullscreenFocus a] -> ShowS)
-> Show (FullscreenFocus a)
forall a. Show a => Int -> FullscreenFocus a -> ShowS
forall a. Show a => [FullscreenFocus a] -> ShowS
forall a. Show a => FullscreenFocus a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FullscreenFocus a] -> ShowS
$cshowList :: forall a. Show a => [FullscreenFocus a] -> ShowS
show :: FullscreenFocus a -> String
$cshow :: forall a. Show a => FullscreenFocus a -> String
showsPrec :: Int -> FullscreenFocus a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> FullscreenFocus a -> ShowS
Show)
data FullscreenFloat a = FullscreenFloat W.RationalRect (M.Map a (W.RationalRect, Bool))
deriving (ReadPrec [FullscreenFloat a]
ReadPrec (FullscreenFloat a)
Int -> ReadS (FullscreenFloat a)
ReadS [FullscreenFloat a]
(Int -> ReadS (FullscreenFloat a))
-> ReadS [FullscreenFloat a]
-> ReadPrec (FullscreenFloat a)
-> ReadPrec [FullscreenFloat a]
-> Read (FullscreenFloat a)
forall a. (Ord a, Read a) => ReadPrec [FullscreenFloat a]
forall a. (Ord a, Read a) => ReadPrec (FullscreenFloat a)
forall a. (Ord a, Read a) => Int -> ReadS (FullscreenFloat a)
forall a. (Ord a, Read a) => ReadS [FullscreenFloat a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FullscreenFloat a]
$creadListPrec :: forall a. (Ord a, Read a) => ReadPrec [FullscreenFloat a]
readPrec :: ReadPrec (FullscreenFloat a)
$creadPrec :: forall a. (Ord a, Read a) => ReadPrec (FullscreenFloat a)
readList :: ReadS [FullscreenFloat a]
$creadList :: forall a. (Ord a, Read a) => ReadS [FullscreenFloat a]
readsPrec :: Int -> ReadS (FullscreenFloat a)
$creadsPrec :: forall a. (Ord a, Read a) => Int -> ReadS (FullscreenFloat a)
Read, Int -> FullscreenFloat a -> ShowS
[FullscreenFloat a] -> ShowS
FullscreenFloat a -> String
(Int -> FullscreenFloat a -> ShowS)
-> (FullscreenFloat a -> String)
-> ([FullscreenFloat a] -> ShowS)
-> Show (FullscreenFloat a)
forall a. Show a => Int -> FullscreenFloat a -> ShowS
forall a. Show a => [FullscreenFloat a] -> ShowS
forall a. Show a => FullscreenFloat a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FullscreenFloat a] -> ShowS
$cshowList :: forall a. Show a => [FullscreenFloat a] -> ShowS
show :: FullscreenFloat a -> String
$cshow :: forall a. Show a => FullscreenFloat a -> String
showsPrec :: Int -> FullscreenFloat a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> FullscreenFloat a -> ShowS
Show)
instance LayoutModifier FullscreenFull Window where
pureMess :: FullscreenFull Window
-> SomeMessage -> Maybe (FullscreenFull Window)
pureMess ff :: FullscreenFull Window
ff@(FullscreenFull RationalRect
frect [Window]
fulls) SomeMessage
m = case SomeMessage -> Maybe FullscreenMessage
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m of
Just (AddFullscreen Window
win) -> FullscreenFull Window -> Maybe (FullscreenFull Window)
forall a. a -> Maybe a
Just (FullscreenFull Window -> Maybe (FullscreenFull Window))
-> FullscreenFull Window -> Maybe (FullscreenFull Window)
forall a b. (a -> b) -> a -> b
$ RationalRect -> [Window] -> FullscreenFull Window
forall a. RationalRect -> [a] -> FullscreenFull a
FullscreenFull RationalRect
frect ([Window] -> FullscreenFull Window)
-> [Window] -> FullscreenFull Window
forall a b. (a -> b) -> a -> b
$ [Window] -> [Window]
forall a. Eq a => [a] -> [a]
nub ([Window] -> [Window]) -> [Window] -> [Window]
forall a b. (a -> b) -> a -> b
$ Window
winWindow -> [Window] -> [Window]
forall a. a -> [a] -> [a]
:[Window]
fulls
Just (RemoveFullscreen Window
win) -> FullscreenFull Window -> Maybe (FullscreenFull Window)
forall a. a -> Maybe a
Just (FullscreenFull Window -> Maybe (FullscreenFull Window))
-> FullscreenFull Window -> Maybe (FullscreenFull Window)
forall a b. (a -> b) -> a -> b
$ RationalRect -> [Window] -> FullscreenFull Window
forall a. RationalRect -> [a] -> FullscreenFull a
FullscreenFull RationalRect
frect ([Window] -> FullscreenFull Window)
-> [Window] -> FullscreenFull Window
forall a b. (a -> b) -> a -> b
$ Window -> [Window] -> [Window]
forall a. Eq a => a -> [a] -> [a]
delete Window
win [Window]
fulls
Just FullscreenMessage
FullscreenChanged -> FullscreenFull Window -> Maybe (FullscreenFull Window)
forall a. a -> Maybe a
Just FullscreenFull Window
ff
Maybe FullscreenMessage
_ -> Maybe (FullscreenFull Window)
forall a. Maybe a
Nothing
pureModifier :: FullscreenFull Window
-> Rectangle
-> Maybe (Stack Window)
-> [(Window, Rectangle)]
-> ([(Window, Rectangle)], Maybe (FullscreenFull Window))
pureModifier (FullscreenFull RationalRect
frect [Window]
fulls) Rectangle
rect Maybe (Stack Window)
_ [(Window, Rectangle)]
list =
([(Window, Rectangle)]
visfulls' [(Window, Rectangle)]
-> [(Window, Rectangle)] -> [(Window, Rectangle)]
forall a. [a] -> [a] -> [a]
++ [(Window, Rectangle)]
rest', Maybe (FullscreenFull Window)
forall a. Maybe a
Nothing)
where ([(Window, Rectangle)]
visfulls,[(Window, Rectangle)]
rest) = ((Window, Rectangle) -> Bool)
-> [(Window, Rectangle)]
-> ([(Window, Rectangle)], [(Window, Rectangle)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition ((Window -> [Window] -> Bool) -> [Window] -> Window -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Window -> [Window] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem [Window]
fulls (Window -> Bool)
-> ((Window, Rectangle) -> Window) -> (Window, Rectangle) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Window, Rectangle) -> Window
forall a b. (a, b) -> a
fst) [(Window, Rectangle)]
list
visfulls' :: [(Window, Rectangle)]
visfulls' = ((Window, Rectangle) -> (Window, Rectangle))
-> [(Window, Rectangle)] -> [(Window, Rectangle)]
forall a b. (a -> b) -> [a] -> [b]
map ((Rectangle -> Rectangle)
-> (Window, Rectangle) -> (Window, Rectangle)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second ((Rectangle -> Rectangle)
-> (Window, Rectangle) -> (Window, Rectangle))
-> (Rectangle -> Rectangle)
-> (Window, Rectangle)
-> (Window, Rectangle)
forall a b. (a -> b) -> a -> b
$ Rectangle -> Rectangle -> Rectangle
forall a b. a -> b -> a
const Rectangle
rect') [(Window, Rectangle)]
visfulls
rest' :: [(Window, Rectangle)]
rest' = if [(Window, Rectangle)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Window, Rectangle)]
visfulls'
then [(Window, Rectangle)]
rest
else ((Window, Rectangle) -> Bool)
-> [(Window, Rectangle)] -> [(Window, Rectangle)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> ((Window, Rectangle) -> Bool) -> (Window, Rectangle) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rectangle -> Rectangle -> Bool
R.supersetOf Rectangle
rect' (Rectangle -> Bool)
-> ((Window, Rectangle) -> Rectangle)
-> (Window, Rectangle)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Window, Rectangle) -> Rectangle
forall a b. (a, b) -> b
snd) [(Window, Rectangle)]
rest
rect' :: Rectangle
rect' = Rectangle -> RationalRect -> Rectangle
scaleRationalRect Rectangle
rect RationalRect
frect
instance LayoutModifier FullscreenFocus Window where
pureMess :: FullscreenFocus Window
-> SomeMessage -> Maybe (FullscreenFocus Window)
pureMess ff :: FullscreenFocus Window
ff@(FullscreenFocus RationalRect
frect [Window]
fulls) SomeMessage
m = case SomeMessage -> Maybe FullscreenMessage
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m of
Just (AddFullscreen Window
win) -> FullscreenFocus Window -> Maybe (FullscreenFocus Window)
forall a. a -> Maybe a
Just (FullscreenFocus Window -> Maybe (FullscreenFocus Window))
-> FullscreenFocus Window -> Maybe (FullscreenFocus Window)
forall a b. (a -> b) -> a -> b
$ RationalRect -> [Window] -> FullscreenFocus Window
forall a. RationalRect -> [a] -> FullscreenFocus a
FullscreenFocus RationalRect
frect ([Window] -> FullscreenFocus Window)
-> [Window] -> FullscreenFocus Window
forall a b. (a -> b) -> a -> b
$ [Window] -> [Window]
forall a. Eq a => [a] -> [a]
nub ([Window] -> [Window]) -> [Window] -> [Window]
forall a b. (a -> b) -> a -> b
$ Window
winWindow -> [Window] -> [Window]
forall a. a -> [a] -> [a]
:[Window]
fulls
Just (RemoveFullscreen Window
win) -> FullscreenFocus Window -> Maybe (FullscreenFocus Window)
forall a. a -> Maybe a
Just (FullscreenFocus Window -> Maybe (FullscreenFocus Window))
-> FullscreenFocus Window -> Maybe (FullscreenFocus Window)
forall a b. (a -> b) -> a -> b
$ RationalRect -> [Window] -> FullscreenFocus Window
forall a. RationalRect -> [a] -> FullscreenFocus a
FullscreenFocus RationalRect
frect ([Window] -> FullscreenFocus Window)
-> [Window] -> FullscreenFocus Window
forall a b. (a -> b) -> a -> b
$ Window -> [Window] -> [Window]
forall a. Eq a => a -> [a] -> [a]
delete Window
win [Window]
fulls
Just FullscreenMessage
FullscreenChanged -> FullscreenFocus Window -> Maybe (FullscreenFocus Window)
forall a. a -> Maybe a
Just FullscreenFocus Window
ff
Maybe FullscreenMessage
_ -> Maybe (FullscreenFocus Window)
forall a. Maybe a
Nothing
pureModifier :: FullscreenFocus Window
-> Rectangle
-> Maybe (Stack Window)
-> [(Window, Rectangle)]
-> ([(Window, Rectangle)], Maybe (FullscreenFocus Window))
pureModifier (FullscreenFocus RationalRect
frect [Window]
fulls) Rectangle
rect (Just W.Stack {focus :: forall a. Stack a -> a
W.focus = Window
f}) [(Window, Rectangle)]
list
| Window
f Window -> [Window] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Window]
fulls = ((Window
f, Rectangle
rect') (Window, Rectangle)
-> [(Window, Rectangle)] -> [(Window, Rectangle)]
forall a. a -> [a] -> [a]
: [(Window, Rectangle)]
rest, Maybe (FullscreenFocus Window)
forall a. Maybe a
Nothing)
| Bool
otherwise = ([(Window, Rectangle)]
list, Maybe (FullscreenFocus Window)
forall a. Maybe a
Nothing)
where rest :: [(Window, Rectangle)]
rest = ((Window, Rectangle) -> Bool)
-> [(Window, Rectangle)] -> [(Window, Rectangle)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> ((Window, Rectangle) -> Bool) -> (Window, Rectangle) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Window -> Bool)
-> (Rectangle -> Bool) -> (Window, Rectangle) -> Bool
forall a b. (a -> Bool) -> (b -> Bool) -> (a, b) -> Bool
orP (Window -> Window -> Bool
forall a. Eq a => a -> a -> Bool
== Window
f) (Rectangle -> Rectangle -> Bool
R.supersetOf Rectangle
rect')) [(Window, Rectangle)]
list
rect' :: Rectangle
rect' = Rectangle -> RationalRect -> Rectangle
scaleRationalRect Rectangle
rect RationalRect
frect
pureModifier FullscreenFocus Window
_ Rectangle
_ Maybe (Stack Window)
Nothing [(Window, Rectangle)]
list = ([(Window, Rectangle)]
list, Maybe (FullscreenFocus Window)
forall a. Maybe a
Nothing)
instance LayoutModifier FullscreenFloat Window where
handleMess :: FullscreenFloat Window
-> SomeMessage -> X (Maybe (FullscreenFloat Window))
handleMess (FullscreenFloat RationalRect
frect Map Window (RationalRect, Bool)
fulls) SomeMessage
m = case SomeMessage -> Maybe FullscreenMessage
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m of
Just (AddFullscreen Window
win) -> do
Maybe RationalRect
mrect <- Window -> Map Window RationalRect -> Maybe RationalRect
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Window
win (Map Window RationalRect -> Maybe RationalRect)
-> (WindowSet -> Map Window RationalRect)
-> WindowSet
-> Maybe RationalRect
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowSet -> Map Window RationalRect
forall i l a sid sd. StackSet i l a sid sd -> Map a RationalRect
W.floating (WindowSet -> Maybe RationalRect)
-> X WindowSet -> X (Maybe RationalRect)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (XState -> WindowSet) -> X WindowSet
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> WindowSet
windowset
Maybe (FullscreenFloat Window)
-> X (Maybe (FullscreenFloat Window))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (FullscreenFloat Window)
-> X (Maybe (FullscreenFloat Window)))
-> Maybe (FullscreenFloat Window)
-> X (Maybe (FullscreenFloat Window))
forall a b. (a -> b) -> a -> b
$ case Maybe RationalRect
mrect of
Just RationalRect
rect -> FullscreenFloat Window -> Maybe (FullscreenFloat Window)
forall a. a -> Maybe a
Just (FullscreenFloat Window -> Maybe (FullscreenFloat Window))
-> FullscreenFloat Window -> Maybe (FullscreenFloat Window)
forall a b. (a -> b) -> a -> b
$ RationalRect
-> Map Window (RationalRect, Bool) -> FullscreenFloat Window
forall a.
RationalRect -> Map a (RationalRect, Bool) -> FullscreenFloat a
FullscreenFloat RationalRect
frect (Map Window (RationalRect, Bool) -> FullscreenFloat Window)
-> Map Window (RationalRect, Bool) -> FullscreenFloat Window
forall a b. (a -> b) -> a -> b
$ Window
-> (RationalRect, Bool)
-> Map Window (RationalRect, Bool)
-> Map Window (RationalRect, Bool)
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Window
win (RationalRect
rect,Bool
True) Map Window (RationalRect, Bool)
fulls
Maybe RationalRect
Nothing -> Maybe (FullscreenFloat Window)
forall a. Maybe a
Nothing
Just (RemoveFullscreen Window
win) ->
Maybe (FullscreenFloat Window)
-> X (Maybe (FullscreenFloat Window))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (FullscreenFloat Window)
-> X (Maybe (FullscreenFloat Window)))
-> Maybe (FullscreenFloat Window)
-> X (Maybe (FullscreenFloat Window))
forall a b. (a -> b) -> a -> b
$ FullscreenFloat Window -> Maybe (FullscreenFloat Window)
forall a. a -> Maybe a
Just (FullscreenFloat Window -> Maybe (FullscreenFloat Window))
-> FullscreenFloat Window -> Maybe (FullscreenFloat Window)
forall a b. (a -> b) -> a -> b
$ RationalRect
-> Map Window (RationalRect, Bool) -> FullscreenFloat Window
forall a.
RationalRect -> Map a (RationalRect, Bool) -> FullscreenFloat a
FullscreenFloat RationalRect
frect (Map Window (RationalRect, Bool) -> FullscreenFloat Window)
-> Map Window (RationalRect, Bool) -> FullscreenFloat Window
forall a b. (a -> b) -> a -> b
$ ((RationalRect, Bool) -> (RationalRect, Bool))
-> Window
-> Map Window (RationalRect, Bool)
-> Map Window (RationalRect, Bool)
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
M.adjust ((Bool -> Bool) -> (RationalRect, Bool) -> (RationalRect, Bool)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second ((Bool -> Bool) -> (RationalRect, Bool) -> (RationalRect, Bool))
-> (Bool -> Bool) -> (RationalRect, Bool) -> (RationalRect, Bool)
forall a b. (a -> b) -> a -> b
$ Bool -> Bool -> Bool
forall a b. a -> b -> a
const Bool
False) Window
win Map Window (RationalRect, Bool)
fulls
Just FullscreenMessage
FullscreenChanged -> do
XState
st <- X XState
forall s (m :: * -> *). MonadState s m => m s
get
let ws :: WindowSet
ws = XState -> WindowSet
windowset XState
st
flt :: Map Window RationalRect
flt = WindowSet -> Map Window RationalRect
forall i l a sid sd. StackSet i l a sid sd -> Map a RationalRect
W.floating WindowSet
ws
flt' :: Map Window RationalRect
flt' = ((RationalRect, Bool) -> RationalRect -> RationalRect)
-> Map Window (RationalRect, Bool)
-> Map Window RationalRect
-> Map Window RationalRect
forall k a b c.
Ord k =>
(a -> b -> c) -> Map k a -> Map k b -> Map k c
M.intersectionWith (RationalRect, Bool) -> RationalRect -> RationalRect
forall {p}. (RationalRect, Bool) -> p -> RationalRect
doFull Map Window (RationalRect, Bool)
fulls Map Window RationalRect
flt
XState -> X ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put XState
st {windowset :: WindowSet
windowset = WindowSet
ws {floating :: Map Window RationalRect
W.floating = Map Window RationalRect
-> Map Window RationalRect -> Map Window RationalRect
forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union Map Window RationalRect
flt' Map Window RationalRect
flt}}
Maybe (FullscreenFloat Window)
-> X (Maybe (FullscreenFloat Window))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (FullscreenFloat Window)
-> X (Maybe (FullscreenFloat Window)))
-> Maybe (FullscreenFloat Window)
-> X (Maybe (FullscreenFloat Window))
forall a b. (a -> b) -> a -> b
$ FullscreenFloat Window -> Maybe (FullscreenFloat Window)
forall a. a -> Maybe a
Just (FullscreenFloat Window -> Maybe (FullscreenFloat Window))
-> FullscreenFloat Window -> Maybe (FullscreenFloat Window)
forall a b. (a -> b) -> a -> b
$ RationalRect
-> Map Window (RationalRect, Bool) -> FullscreenFloat Window
forall a.
RationalRect -> Map a (RationalRect, Bool) -> FullscreenFloat a
FullscreenFloat RationalRect
frect (Map Window (RationalRect, Bool) -> FullscreenFloat Window)
-> Map Window (RationalRect, Bool) -> FullscreenFloat Window
forall a b. (a -> b) -> a -> b
$ ((RationalRect, Bool) -> Bool)
-> Map Window (RationalRect, Bool)
-> Map Window (RationalRect, Bool)
forall a k. (a -> Bool) -> Map k a -> Map k a
M.filter (RationalRect, Bool) -> Bool
forall a b. (a, b) -> b
snd Map Window (RationalRect, Bool)
fulls
where doFull :: (RationalRect, Bool) -> p -> RationalRect
doFull (RationalRect
_, Bool
True) p
_ = RationalRect
frect
doFull (RationalRect
rect, Bool
False) p
_ = RationalRect
rect
Maybe FullscreenMessage
Nothing -> Maybe (FullscreenFloat Window)
-> X (Maybe (FullscreenFloat Window))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (FullscreenFloat Window)
forall a. Maybe a
Nothing
fullscreenFull :: LayoutClass l a =>
l a -> ModifiedLayout FullscreenFull l a
fullscreenFull :: forall (l :: * -> *) a.
LayoutClass l a =>
l a -> ModifiedLayout FullscreenFull l a
fullscreenFull = RationalRect -> l a -> ModifiedLayout FullscreenFull l a
forall (l :: * -> *) a.
LayoutClass l a =>
RationalRect -> l a -> ModifiedLayout FullscreenFull l a
fullscreenFullRect (RationalRect -> l a -> ModifiedLayout FullscreenFull l a)
-> RationalRect -> l a -> ModifiedLayout FullscreenFull l a
forall a b. (a -> b) -> a -> b
$ Rational -> Rational -> Rational -> Rational -> RationalRect
W.RationalRect Rational
0 Rational
0 Rational
1 Rational
1
fullscreenFullRect :: LayoutClass l a =>
W.RationalRect -> l a -> ModifiedLayout FullscreenFull l a
fullscreenFullRect :: forall (l :: * -> *) a.
LayoutClass l a =>
RationalRect -> l a -> ModifiedLayout FullscreenFull l a
fullscreenFullRect RationalRect
r = FullscreenFull a -> l a -> ModifiedLayout FullscreenFull l a
forall (m :: * -> *) (l :: * -> *) a.
m a -> l a -> ModifiedLayout m l a
ModifiedLayout (FullscreenFull a -> l a -> ModifiedLayout FullscreenFull l a)
-> FullscreenFull a -> l a -> ModifiedLayout FullscreenFull l a
forall a b. (a -> b) -> a -> b
$ RationalRect -> [a] -> FullscreenFull a
forall a. RationalRect -> [a] -> FullscreenFull a
FullscreenFull RationalRect
r []
fullscreenFocus :: LayoutClass l a =>
l a -> ModifiedLayout FullscreenFocus l a
fullscreenFocus :: forall (l :: * -> *) a.
LayoutClass l a =>
l a -> ModifiedLayout FullscreenFocus l a
fullscreenFocus = RationalRect -> l a -> ModifiedLayout FullscreenFocus l a
forall (l :: * -> *) a.
LayoutClass l a =>
RationalRect -> l a -> ModifiedLayout FullscreenFocus l a
fullscreenFocusRect (RationalRect -> l a -> ModifiedLayout FullscreenFocus l a)
-> RationalRect -> l a -> ModifiedLayout FullscreenFocus l a
forall a b. (a -> b) -> a -> b
$ Rational -> Rational -> Rational -> Rational -> RationalRect
W.RationalRect Rational
0 Rational
0 Rational
1 Rational
1
fullscreenFocusRect :: LayoutClass l a =>
W.RationalRect -> l a -> ModifiedLayout FullscreenFocus l a
fullscreenFocusRect :: forall (l :: * -> *) a.
LayoutClass l a =>
RationalRect -> l a -> ModifiedLayout FullscreenFocus l a
fullscreenFocusRect RationalRect
r = FullscreenFocus a -> l a -> ModifiedLayout FullscreenFocus l a
forall (m :: * -> *) (l :: * -> *) a.
m a -> l a -> ModifiedLayout m l a
ModifiedLayout (FullscreenFocus a -> l a -> ModifiedLayout FullscreenFocus l a)
-> FullscreenFocus a -> l a -> ModifiedLayout FullscreenFocus l a
forall a b. (a -> b) -> a -> b
$ RationalRect -> [a] -> FullscreenFocus a
forall a. RationalRect -> [a] -> FullscreenFocus a
FullscreenFocus RationalRect
r []
fullscreenFloat :: LayoutClass l a =>
l a -> ModifiedLayout FullscreenFloat l a
fullscreenFloat :: forall (l :: * -> *) a.
LayoutClass l a =>
l a -> ModifiedLayout FullscreenFloat l a
fullscreenFloat = RationalRect -> l a -> ModifiedLayout FullscreenFloat l a
forall (l :: * -> *) a.
LayoutClass l a =>
RationalRect -> l a -> ModifiedLayout FullscreenFloat l a
fullscreenFloatRect (RationalRect -> l a -> ModifiedLayout FullscreenFloat l a)
-> RationalRect -> l a -> ModifiedLayout FullscreenFloat l a
forall a b. (a -> b) -> a -> b
$ Rational -> Rational -> Rational -> Rational -> RationalRect
W.RationalRect Rational
0 Rational
0 Rational
1 Rational
1
fullscreenFloatRect :: LayoutClass l a =>
W.RationalRect -> l a -> ModifiedLayout FullscreenFloat l a
fullscreenFloatRect :: forall (l :: * -> *) a.
LayoutClass l a =>
RationalRect -> l a -> ModifiedLayout FullscreenFloat l a
fullscreenFloatRect RationalRect
r = FullscreenFloat a -> l a -> ModifiedLayout FullscreenFloat l a
forall (m :: * -> *) (l :: * -> *) a.
m a -> l a -> ModifiedLayout m l a
ModifiedLayout (FullscreenFloat a -> l a -> ModifiedLayout FullscreenFloat l a)
-> FullscreenFloat a -> l a -> ModifiedLayout FullscreenFloat l a
forall a b. (a -> b) -> a -> b
$ RationalRect -> Map a (RationalRect, Bool) -> FullscreenFloat a
forall a.
RationalRect -> Map a (RationalRect, Bool) -> FullscreenFloat a
FullscreenFloat RationalRect
r Map a (RationalRect, Bool)
forall k a. Map k a
M.empty
fullscreenEventHook :: Event -> X All
fullscreenEventHook :: Event -> X All
fullscreenEventHook (ClientMessageEvent EventType
_ CULong
_ Bool
_ Display
dpy Window
win Window
typ (CInt
action:[CInt]
dats)) = do
Window
wmstate <- String -> X Window
getAtom String
"_NET_WM_STATE"
Window
fullsc <- String -> X Window
getAtom String
"_NET_WM_STATE_FULLSCREEN"
[CLong]
wstate <- [CLong] -> Maybe [CLong] -> [CLong]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [CLong] -> [CLong]) -> X (Maybe [CLong]) -> X [CLong]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Window -> Window -> X (Maybe [CLong])
getProp32 Window
wmstate Window
win
let isFull :: Bool
isFull = Window -> CLong
forall a b. (Integral a, Num b) => a -> b
fi Window
fullsc CLong -> [CLong] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CLong]
wstate
remove :: CInt
remove = CInt
0
add :: CInt
add = CInt
1
toggle :: CInt
toggle = CInt
2
chWState :: ([CLong] -> [CLong]) -> m ()
chWState [CLong] -> [CLong]
f = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Display -> Window -> Window -> Window -> CInt -> [CLong] -> IO ()
changeProperty32 Display
dpy Window
win Window
wmstate Window
aTOM CInt
propModeReplace ([CLong] -> [CLong]
f [CLong]
wstate)
Bool -> X () -> X ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Window
typ Window -> Window -> Bool
forall a. Eq a => a -> a -> Bool
== Window
wmstate Bool -> Bool -> Bool
&& Window -> CInt
forall a b. (Integral a, Num b) => a -> b
fi Window
fullsc CInt -> [CInt] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CInt]
dats) (X () -> X ()) -> X () -> X ()
forall a b. (a -> b) -> a -> b
$ do
Bool -> X () -> X ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CInt
action CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
add Bool -> Bool -> Bool
|| (CInt
action CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
toggle Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
isFull)) (X () -> X ()) -> X () -> X ()
forall a b. (a -> b) -> a -> b
$ do
([CLong] -> [CLong]) -> X ()
forall {m :: * -> *}. MonadIO m => ([CLong] -> [CLong]) -> m ()
chWState (Window -> CLong
forall a b. (Integral a, Num b) => a -> b
fi Window
fullscCLong -> [CLong] -> [CLong]
forall a. a -> [a] -> [a]
:)
FullscreenMessage -> X ()
forall a. Message a => a -> X ()
broadcastMessage (FullscreenMessage -> X ()) -> FullscreenMessage -> X ()
forall a b. (a -> b) -> a -> b
$ Window -> FullscreenMessage
AddFullscreen Window
win
FullscreenMessage -> X ()
forall a. Message a => a -> X ()
sendMessage FullscreenMessage
FullscreenChanged
Bool -> X () -> X ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CInt
action CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
remove Bool -> Bool -> Bool
|| (CInt
action CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
toggle Bool -> Bool -> Bool
&& Bool
isFull)) (X () -> X ()) -> X () -> X ()
forall a b. (a -> b) -> a -> b
$ do
([CLong] -> [CLong]) -> X ()
forall {m :: * -> *}. MonadIO m => ([CLong] -> [CLong]) -> m ()
chWState (([CLong] -> [CLong]) -> X ()) -> ([CLong] -> [CLong]) -> X ()
forall a b. (a -> b) -> a -> b
$ CLong -> [CLong] -> [CLong]
forall a. Eq a => a -> [a] -> [a]
delete (Window -> CLong
forall a b. (Integral a, Num b) => a -> b
fi Window
fullsc)
FullscreenMessage -> X ()
forall a. Message a => a -> X ()
broadcastMessage (FullscreenMessage -> X ()) -> FullscreenMessage -> X ()
forall a b. (a -> b) -> a -> b
$ Window -> FullscreenMessage
RemoveFullscreen Window
win
FullscreenMessage -> X ()
forall a. Message a => a -> X ()
sendMessage FullscreenMessage
FullscreenChanged
All -> X All
forall (m :: * -> *) a. Monad m => a -> m a
return (All -> X All) -> All -> X All
forall a b. (a -> b) -> a -> b
$ Bool -> All
All Bool
True
fullscreenEventHook DestroyWindowEvent{ev_window :: Event -> Window
ev_window = Window
w} = do
FullscreenMessage -> X ()
forall a. Message a => a -> X ()
broadcastMessage (FullscreenMessage -> X ()) -> FullscreenMessage -> X ()
forall a b. (a -> b) -> a -> b
$ Window -> FullscreenMessage
RemoveFullscreen Window
w
Workspace String (Layout Window) Window
cw <- Screen String (Layout Window) Window ScreenId ScreenDetail
-> Workspace String (Layout Window) Window
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace (Screen String (Layout Window) Window ScreenId ScreenDetail
-> Workspace String (Layout Window) Window)
-> (WindowSet
-> Screen String (Layout Window) Window ScreenId ScreenDetail)
-> WindowSet
-> Workspace String (Layout Window) Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowSet
-> Screen String (Layout Window) Window ScreenId ScreenDetail
forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current (WindowSet -> Workspace String (Layout Window) Window)
-> X WindowSet -> X (Workspace String (Layout Window) Window)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (XState -> WindowSet) -> X WindowSet
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> WindowSet
windowset
FullscreenMessage
-> Workspace String (Layout Window) Window -> X ()
forall a.
Message a =>
a -> Workspace String (Layout Window) Window -> X ()
sendMessageWithNoRefresh FullscreenMessage
FullscreenChanged Workspace String (Layout Window) Window
cw
All -> X All
forall (m :: * -> *) a. Monad m => a -> m a
return (All -> X All) -> All -> X All
forall a b. (a -> b) -> a -> b
$ Bool -> All
All Bool
True
fullscreenEventHook Event
_ = All -> X All
forall (m :: * -> *) a. Monad m => a -> m a
return (All -> X All) -> All -> X All
forall a b. (a -> b) -> a -> b
$ Bool -> All
All Bool
True
fullscreenManageHook :: ManageHook
fullscreenManageHook :: Query (Endo WindowSet)
fullscreenManageHook = Query Bool -> Query (Endo WindowSet)
fullscreenManageHook' Query Bool
isFullscreen
fullscreenManageHookWith :: Query Bool -> ManageHook
fullscreenManageHookWith :: Query Bool -> Query (Endo WindowSet)
fullscreenManageHookWith Query Bool
h = Query Bool -> Query (Endo WindowSet)
fullscreenManageHook' (Query Bool -> Query (Endo WindowSet))
-> Query Bool -> Query (Endo WindowSet)
forall a b. (a -> b) -> a -> b
$ Query Bool
isFullscreen Query Bool -> Query Bool -> Query Bool
forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
<||> Query Bool
h
fullscreenManageHook' :: Query Bool -> ManageHook
fullscreenManageHook' :: Query Bool -> Query (Endo WindowSet)
fullscreenManageHook' Query Bool
isFull = Query Bool
isFull Query Bool -> Query (Endo WindowSet) -> Query (Endo WindowSet)
forall (m :: * -> *) a. (Monad m, Monoid a) => m Bool -> m a -> m a
--> do
Window
w <- Query Window
forall r (m :: * -> *). MonadReader r m => m r
ask
X () -> Query ()
forall a. X a -> Query a
liftX (X () -> Query ()) -> X () -> Query ()
forall a b. (a -> b) -> a -> b
$ do
FullscreenMessage -> X ()
forall a. Message a => a -> X ()
broadcastMessage (FullscreenMessage -> X ()) -> FullscreenMessage -> X ()
forall a b. (a -> b) -> a -> b
$ Window -> FullscreenMessage
AddFullscreen Window
w
Workspace String (Layout Window) Window
cw <- Screen String (Layout Window) Window ScreenId ScreenDetail
-> Workspace String (Layout Window) Window
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace (Screen String (Layout Window) Window ScreenId ScreenDetail
-> Workspace String (Layout Window) Window)
-> (WindowSet
-> Screen String (Layout Window) Window ScreenId ScreenDetail)
-> WindowSet
-> Workspace String (Layout Window) Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowSet
-> Screen String (Layout Window) Window ScreenId ScreenDetail
forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current (WindowSet -> Workspace String (Layout Window) Window)
-> X WindowSet -> X (Workspace String (Layout Window) Window)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (XState -> WindowSet) -> X WindowSet
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> WindowSet
windowset
FullscreenMessage
-> Workspace String (Layout Window) Window -> X ()
forall a.
Message a =>
a -> Workspace String (Layout Window) Window -> X ()
sendMessageWithNoRefresh FullscreenMessage
FullscreenChanged Workspace String (Layout Window) Window
cw
Query (Endo WindowSet)
forall m. Monoid m => m
idHook
orP :: (a -> Bool) -> (b -> Bool) -> (a, b) -> Bool
orP :: forall a b. (a -> Bool) -> (b -> Bool) -> (a, b) -> Bool
orP a -> Bool
f b -> Bool
g (a
x, b
y) = a -> Bool
f a
x Bool -> Bool -> Bool
|| b -> Bool
g b
y