{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE UndecidableInstances #-}
module XMonad.Layout.DecorationEx.LayoutModifier (
decorationEx,
DecorationEx
) where
import XMonad
import XMonad.Prelude
import qualified XMonad.StackSet as W
import XMonad.Layout.LayoutModifier
import XMonad.Layout.WindowArranger (diff, listFromList)
import XMonad.Util.Invisible
import XMonad.Util.XUtils hiding (paintTextAndIcons)
import XMonad.Layout.DecorationEx.Common
import XMonad.Layout.DecorationEx.Engine
import XMonad.Layout.DecorationEx.Geometry
data DecorationEx engine widget geom shrinker a =
DecorationEx (Invisible Maybe (DecorationLayoutState engine)) shrinker (Theme engine widget) (engine widget a) (geom a)
deriving instance (Show (Theme engine widget), Show shrinker, Show (engine widget a), Show (geom a)) => Show (DecorationEx engine widget geom shrinker a)
deriving instance (Read (Theme engine widget), Read shrinker, Read (engine widget a), Read (geom a)) => Read (DecorationEx engine widget geom shrinker a)
instance (DecorationEngine engine widget Window, DecorationGeometry geom Window, Shrinker shrinker) => LayoutModifier (DecorationEx engine widget geom shrinker) Window where
redoLayout :: DecorationEx engine widget geom shrinker Window
-> Rectangle
-> Maybe (Stack Window)
-> [(Window, Rectangle)]
-> X ([(Window, Rectangle)],
Maybe (DecorationEx engine widget geom shrinker Window))
redoLayout (DecorationEx (I (Just DecorationLayoutState engine
decoState)) shrinker
shrinker Theme engine widget
theme engine widget Window
engine geom Window
geom) Rectangle
_ Maybe (Stack Window)
Nothing [(Window, Rectangle)]
_ = do
forall (engine :: * -> * -> *) widget.
DecorationEngine engine widget Window =>
engine widget Window -> DecorationLayoutState engine -> X ()
releaseResources engine widget Window
engine DecorationLayoutState engine
decoState
forall (m :: * -> *) a. Monad m => a -> m a
return ([], forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (engine :: * -> * -> *) widget (geom :: * -> *) shrinker a.
Invisible Maybe (DecorationLayoutState engine)
-> shrinker
-> Theme engine widget
-> engine widget a
-> geom a
-> DecorationEx engine widget geom shrinker a
DecorationEx (forall (m :: * -> *) a. m a -> Invisible m a
I forall a. Maybe a
Nothing) shrinker
shrinker Theme engine widget
theme engine widget Window
engine geom Window
geom)
redoLayout DecorationEx engine widget geom shrinker Window
_ Rectangle
_ Maybe (Stack Window)
Nothing [(Window, Rectangle)]
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ([], forall a. Maybe a
Nothing)
redoLayout (DecorationEx Invisible Maybe (DecorationLayoutState engine)
invState shrinker
shrinker Theme engine widget
theme engine widget Window
engine geom Window
geom) Rectangle
screenRect (Just Stack Window
stack) [(Window, Rectangle)]
srcPairs
| I Maybe (DecorationLayoutState engine)
Nothing <- Invisible Maybe (DecorationLayoutState engine)
invState = forall (engine :: * -> * -> *) widget (geom :: * -> *) shrinker.
(DecorationEngine engine widget Window,
DecorationGeometry geom Window, Shrinker shrinker) =>
Theme engine widget
-> engine widget Window
-> geom Window
-> shrinker
-> Rectangle
-> Stack Window
-> [(Window, Rectangle)]
-> X (DecorationLayoutState engine)
initState Theme engine widget
theme engine widget Window
engine geom Window
geom shrinker
shrinker Rectangle
screenRect Stack Window
stack [(Window, Rectangle)]
srcPairs forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DecorationLayoutState engine
-> X ([(Window, Rectangle)],
Maybe (DecorationEx engine widget geom shrinker Window))
processState
| I (Just DecorationLayoutState engine
s) <- Invisible Maybe (DecorationLayoutState engine)
invState = do
let decorations :: [WindowDecoration]
decorations = forall (engine :: * -> * -> *).
DecorationLayoutState engine -> [WindowDecoration]
dsDecorations DecorationLayoutState engine
s
([Window]
d,[Window]
a) = forall a b c. ((a, b) -> c) -> a -> b -> c
curry forall a. Eq a => ([a], [a]) -> ([a], [a])
diff ([WindowDecoration] -> [Window]
getOrigWindows [WindowDecoration]
decorations) [Window]
srcWindows
toDel :: [WindowDecoration]
toDel = [Window] -> [WindowDecoration] -> [WindowDecoration]
todel [Window]
d [WindowDecoration]
decorations
toAdd :: [(Window, Rectangle)]
toAdd = [Window] -> [(Window, Rectangle)] -> [(Window, Rectangle)]
toadd [Window]
a [(Window, Rectangle)]
srcPairs
[WindowDecoration] -> X ()
deleteDecos [WindowDecoration]
toDel
let decosToBeAdded :: [WindowDecoration]
decosToBeAdded = [Window
-> Rectangle
-> Maybe Window
-> Maybe Rectangle
-> [WidgetPlace]
-> WindowDecoration
WindowDecoration Window
win Rectangle
rect forall a. Maybe a
Nothing forall a. Maybe a
Nothing [] | (Window
win, Rectangle
rect) <- [(Window, Rectangle)]
toAdd]
[WindowDecoration]
newDecorations <- DecorationEngineState engine
-> [WindowDecoration]
-> [(Window, Rectangle)]
-> X [WindowDecoration]
resync (forall (engine :: * -> * -> *).
DecorationLayoutState engine -> DecorationEngineState engine
dsStyleState DecorationLayoutState engine
s) ([WindowDecoration]
decosToBeAdded forall a. [a] -> [a] -> [a]
++ [Window] -> [WindowDecoration] -> [WindowDecoration]
del_dwrs [Window]
d [WindowDecoration]
decorations) [(Window, Rectangle)]
srcPairs
DecorationLayoutState engine
-> X ([(Window, Rectangle)],
Maybe (DecorationEx engine widget geom shrinker Window))
processState (DecorationLayoutState engine
s {dsDecorations :: [WindowDecoration]
dsDecorations = [WindowDecoration]
newDecorations})
where
srcWindows :: [Window]
srcWindows = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(Window, Rectangle)]
srcPairs
getOrigWindows :: [WindowDecoration] -> [Window]
getOrigWindows :: [WindowDecoration] -> [Window]
getOrigWindows = forall a b. (a -> b) -> [a] -> [b]
map WindowDecoration -> Window
wdOrigWindow
del_dwrs :: [Window] -> [WindowDecoration] -> [WindowDecoration]
del_dwrs :: [Window] -> [WindowDecoration] -> [WindowDecoration]
del_dwrs = forall b c a. (b -> c) -> (c -> [a] -> Bool) -> [a] -> [b] -> [b]
listFromList WindowDecoration -> Window
wdOrigWindow forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
notElem
findDecoWindow :: Int -> [WindowDecoration] -> Maybe Window
findDecoWindow :: Int -> [WindowDecoration] -> Maybe Window
findDecoWindow Int
i [WindowDecoration]
d = WindowDecoration -> Maybe Window
wdDecoWindow forall a b. (a -> b) -> a -> b
$ [WindowDecoration]
d forall a. [a] -> Int -> a
!! Int
i
todel :: [Window] -> [WindowDecoration] -> [WindowDecoration]
todel :: [Window] -> [WindowDecoration] -> [WindowDecoration]
todel [Window]
d = forall a. (a -> Bool) -> [a] -> [a]
filter (\WindowDecoration
dd -> WindowDecoration -> Window
wdOrigWindow WindowDecoration
dd forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Window]
d)
toadd :: [Window] -> [(Window, Rectangle)] -> [(Window, Rectangle)]
toadd :: [Window] -> [(Window, Rectangle)] -> [(Window, Rectangle)]
toadd [Window]
a = forall a. (a -> Bool) -> [a] -> [a]
filter (\(Window, Rectangle)
p -> forall a b. (a, b) -> a
fst (Window, Rectangle)
p forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Window]
a)
createDecoWindowIfNeeded :: Maybe Window -> Maybe Rectangle -> X (Maybe Window)
createDecoWindowIfNeeded :: Maybe Window -> Maybe Rectangle -> X (Maybe Window)
createDecoWindowIfNeeded Maybe Window
mbDecoWindow Maybe Rectangle
mbDecoRect =
case (Maybe Window
mbDecoWindow, Maybe Rectangle
mbDecoRect) of
(Maybe Window
Nothing, Just Rectangle
decoRect) -> do
Window
decoWindow <- forall (engine :: * -> * -> *) widget.
DecorationEngine engine widget Window =>
engine widget Window
-> Theme engine widget -> Rectangle -> X Window
createDecoWindow engine widget Window
engine Theme engine widget
theme Rectangle
decoRect
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Window
decoWindow
(Maybe Window, Maybe Rectangle)
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Window
mbDecoWindow
resync :: DecorationEngineState engine -> [WindowDecoration] -> [(Window,Rectangle)] -> X [WindowDecoration]
resync :: DecorationEngineState engine
-> [WindowDecoration]
-> [(Window, Rectangle)]
-> X [WindowDecoration]
resync DecorationEngineState engine
_ [WindowDecoration]
_ [] = forall (m :: * -> *) a. Monad m => a -> m a
return []
resync DecorationEngineState engine
decoState [WindowDecoration]
dd ((Window
window,Rectangle
rect):[(Window, Rectangle)]
xs) =
case Window
window forall a. Eq a => a -> [a] -> Maybe Int
`elemIndex` [WindowDecoration] -> [Window]
getOrigWindows [WindowDecoration]
dd of
Just Int
i -> do
Maybe Rectangle
mbDecoRect <- forall (geom :: * -> *) a.
DecorationGeometry geom a =>
geom a
-> Rectangle
-> Stack a
-> [(a, Rectangle)]
-> (a, Rectangle)
-> X (Maybe Rectangle)
decorateWindow geom Window
geom Rectangle
screenRect Stack Window
stack [(Window, Rectangle)]
srcPairs (Window
window,Rectangle
rect)
WidgetLayout WidgetPlace
widgetPlaces <- case Maybe Rectangle
mbDecoRect of
Maybe Rectangle
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a] -> [a] -> WidgetLayout a
WidgetLayout [] [] []
Just Rectangle
decoRect -> forall (engine :: * -> * -> *) widget a shrinker.
(DecorationEngine engine widget a, Shrinker shrinker) =>
engine widget a
-> Theme engine widget
-> shrinker
-> DecorationEngineState engine
-> Rectangle
-> Window
-> WidgetLayout widget
-> X (WidgetLayout WidgetPlace)
placeWidgets engine widget Window
engine Theme engine widget
theme shrinker
shrinker DecorationEngineState engine
decoState Rectangle
decoRect Window
window (forall (theme :: * -> *) widget.
HasWidgets theme widget =>
theme widget -> WidgetLayout widget
themeWidgets Theme engine widget
theme)
Maybe Window
mbDecoWindow <- Maybe Window -> Maybe Rectangle -> X (Maybe Window)
createDecoWindowIfNeeded (Int -> [WindowDecoration] -> Maybe Window
findDecoWindow Int
i [WindowDecoration]
dd) Maybe Rectangle
mbDecoRect
let newDd :: WindowDecoration
newDd = Window
-> Rectangle
-> Maybe Window
-> Maybe Rectangle
-> [WidgetPlace]
-> WindowDecoration
WindowDecoration Window
window Rectangle
rect Maybe Window
mbDecoWindow Maybe Rectangle
mbDecoRect (forall widget. WidgetLayout widget -> [widget]
widgetLayout WidgetLayout WidgetPlace
widgetPlaces)
[WindowDecoration]
restDd <- DecorationEngineState engine
-> [WindowDecoration]
-> [(Window, Rectangle)]
-> X [WindowDecoration]
resync DecorationEngineState engine
decoState [WindowDecoration]
dd [(Window, Rectangle)]
xs
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ WindowDecoration
newDd forall a. a -> [a] -> [a]
: [WindowDecoration]
restDd
Maybe Int
Nothing -> DecorationEngineState engine
-> [WindowDecoration]
-> [(Window, Rectangle)]
-> X [WindowDecoration]
resync DecorationEngineState engine
decoState [WindowDecoration]
dd [(Window, Rectangle)]
xs
removeTabbed :: [Rectangle] -> [(Window, Rectangle)] -> [(Window, Rectangle)]
removeTabbed :: [Rectangle] -> [(Window, Rectangle)] -> [(Window, Rectangle)]
removeTabbed [Rectangle]
_ [] = []
removeTabbed [Rectangle]
rs ((Window
w,Rectangle
r):[(Window, Rectangle)]
xs)
| Rectangle
r forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Rectangle]
rs = [Rectangle] -> [(Window, Rectangle)] -> [(Window, Rectangle)]
removeTabbed [Rectangle]
rs [(Window, Rectangle)]
xs
| Bool
otherwise = (Window
w,Rectangle
r) forall a. a -> [a] -> [a]
: [Rectangle] -> [(Window, Rectangle)] -> [(Window, Rectangle)]
removeTabbed (Rectangle
rforall a. a -> [a] -> [a]
:[Rectangle]
rs) [(Window, Rectangle)]
xs
insertDwr :: WindowDecoration -> [(Window, Rectangle)] -> [(Window, Rectangle)]
insertDwr :: WindowDecoration -> [(Window, Rectangle)] -> [(Window, Rectangle)]
insertDwr WindowDecoration
dd [(Window, Rectangle)]
wrs =
case (WindowDecoration -> Maybe Window
wdDecoWindow WindowDecoration
dd, WindowDecoration -> Maybe Rectangle
wdDecoRect WindowDecoration
dd) of
(Just Window
decoWindow, Just Rectangle
decoRect) -> (Window
decoWindow, Rectangle
decoRect) forall a. a -> [a] -> [a]
: (WindowDecoration -> Window
wdOrigWindow WindowDecoration
dd, forall (geom :: * -> *) a.
DecorationGeometry geom a =>
geom a -> Rectangle -> Rectangle -> Rectangle
shrinkWindow geom Window
geom Rectangle
decoRect (WindowDecoration -> Rectangle
wdOrigWinRect WindowDecoration
dd)) forall a. a -> [a] -> [a]
: [(Window, Rectangle)]
wrs
(Maybe Window, Maybe Rectangle)
_ -> (WindowDecoration -> Window
wdOrigWindow WindowDecoration
dd, WindowDecoration -> Rectangle
wdOrigWinRect WindowDecoration
dd) forall a. a -> [a] -> [a]
: [(Window, Rectangle)]
wrs
dwrs_to_wrs :: [WindowDecoration] -> [(Window, Rectangle)]
dwrs_to_wrs :: [WindowDecoration] -> [(Window, Rectangle)]
dwrs_to_wrs = [Rectangle] -> [(Window, Rectangle)] -> [(Window, Rectangle)]
removeTabbed [] forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr WindowDecoration -> [(Window, Rectangle)] -> [(Window, Rectangle)]
insertDwr []
processState :: DecorationLayoutState engine -> X ([(Window, Rectangle)], Maybe (DecorationEx engine widget geom shrinker Window))
processState :: DecorationLayoutState engine
-> X ([(Window, Rectangle)],
Maybe (DecorationEx engine widget geom shrinker Window))
processState DecorationLayoutState engine
st = do
let decorations :: [WindowDecoration]
decorations = forall (engine :: * -> * -> *).
DecorationLayoutState engine -> [WindowDecoration]
dsDecorations DecorationLayoutState engine
st
[WindowDecoration] -> X ()
showDecos [WindowDecoration]
decorations
forall shrinker (engine :: * -> * -> *) widget.
(Shrinker shrinker, DecorationEngine engine widget Window) =>
engine widget Window
-> shrinker
-> Theme engine widget
-> DecorationEngineState engine
-> [WindowDecoration]
-> X ()
updateDecos engine widget Window
engine shrinker
shrinker Theme engine widget
theme (forall (engine :: * -> * -> *).
DecorationLayoutState engine -> DecorationEngineState engine
dsStyleState DecorationLayoutState engine
st) [WindowDecoration]
decorations
forall (m :: * -> *) a. Monad m => a -> m a
return ([WindowDecoration] -> [(Window, Rectangle)]
dwrs_to_wrs [WindowDecoration]
decorations, forall a. a -> Maybe a
Just (forall (engine :: * -> * -> *) widget (geom :: * -> *) shrinker a.
Invisible Maybe (DecorationLayoutState engine)
-> shrinker
-> Theme engine widget
-> engine widget a
-> geom a
-> DecorationEx engine widget geom shrinker a
DecorationEx (forall (m :: * -> *) a. m a -> Invisible m a
I (forall a. a -> Maybe a
Just (DecorationLayoutState engine
st {dsDecorations :: [WindowDecoration]
dsDecorations = [WindowDecoration]
decorations}))) shrinker
shrinker Theme engine widget
theme engine widget Window
engine geom Window
geom))
handleMess :: DecorationEx engine widget geom shrinker Window
-> SomeMessage
-> X (Maybe (DecorationEx engine widget geom shrinker Window))
handleMess (DecorationEx (I (Just DecorationLayoutState engine
st)) shrinker
shrinker Theme engine widget
theme engine widget Window
engine geom Window
geom) SomeMessage
m
| Just LayoutMessages
Hide <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m = do
[WindowDecoration] -> X ()
hideDecos forall a b. (a -> b) -> a -> b
$ forall (engine :: * -> * -> *).
DecorationLayoutState engine -> [WindowDecoration]
dsDecorations DecorationLayoutState engine
st
forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
| Just LayoutMessages
ReleaseResources <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m = do
forall (engine :: * -> * -> *) widget.
DecorationEngine engine widget Window =>
engine widget Window -> DecorationLayoutState engine -> X ()
releaseResources engine widget Window
engine DecorationLayoutState engine
st
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (engine :: * -> * -> *) widget (geom :: * -> *) shrinker a.
Invisible Maybe (DecorationLayoutState engine)
-> shrinker
-> Theme engine widget
-> engine widget a
-> geom a
-> DecorationEx engine widget geom shrinker a
DecorationEx (forall (m :: * -> *) a. m a -> Invisible m a
I forall a. Maybe a
Nothing) shrinker
shrinker Theme engine widget
theme engine widget Window
engine geom Window
geom
| Just Event
e <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m = do
forall (engine :: * -> * -> *) widget a shrinker.
(DecorationEngine engine widget a, Shrinker shrinker) =>
engine widget a
-> Theme engine widget
-> DecorationLayoutState engine
-> shrinker
-> Event
-> X ()
decorationEventHookEx engine widget Window
engine Theme engine widget
theme DecorationLayoutState engine
st shrinker
shrinker Event
e
forall shrinker (engine :: * -> * -> *) widget.
(Shrinker shrinker, DecorationEngine engine widget Window) =>
engine widget Window
-> shrinker
-> Theme engine widget
-> DecorationLayoutState engine
-> Event
-> X ()
handleEvent engine widget Window
engine shrinker
shrinker Theme engine widget
theme DecorationLayoutState engine
st Event
e
forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
handleMess DecorationEx engine widget geom shrinker Window
_ SomeMessage
_ = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
modifierDescription :: DecorationEx engine widget geom shrinker Window -> String
modifierDescription (DecorationEx Invisible Maybe (DecorationLayoutState engine)
_ shrinker
_ Theme engine widget
_ engine widget Window
engine geom Window
geom) = forall (engine :: * -> * -> *) widget a.
DecorationEngine engine widget a =>
engine widget a -> String
describeEngine engine widget Window
engine forall a. [a] -> [a] -> [a]
++ forall (geom :: * -> *) a.
DecorationGeometry geom a =>
geom a -> String
describeGeometry geom Window
geom
handleEvent :: (Shrinker shrinker, DecorationEngine engine widget Window) => engine widget Window -> shrinker -> Theme engine widget -> DecorationLayoutState engine -> Event -> X ()
handleEvent :: forall shrinker (engine :: * -> * -> *) widget.
(Shrinker shrinker, DecorationEngine engine widget Window) =>
engine widget Window
-> shrinker
-> Theme engine widget
-> DecorationLayoutState engine
-> Event
-> X ()
handleEvent engine widget Window
engine shrinker
shrinker Theme engine widget
theme (DecorationLayoutState {[WindowDecoration]
DecorationEngineState engine
dsDecorations :: [WindowDecoration]
dsStyleState :: DecorationEngineState engine
dsStyleState :: forall (engine :: * -> * -> *).
DecorationLayoutState engine -> DecorationEngineState engine
dsDecorations :: forall (engine :: * -> * -> *).
DecorationLayoutState engine -> [WindowDecoration]
..}) Event
e
| PropertyEvent {ev_window :: Event -> Window
ev_window = Window
w, ev_atom :: Event -> Window
ev_atom = Window
atom} <- Event
e
, Just Int
i <- Window
w forall a. Eq a => a -> [a] -> Maybe Int
`elemIndex` forall a b. (a -> b) -> [a] -> [b]
map WindowDecoration -> Window
wdOrigWindow [WindowDecoration]
dsDecorations = do
[Window]
supportedAtoms <- forall (engine :: * -> * -> *) widget a.
DecorationEngine engine widget a =>
engine widget a -> X [Window]
propsToRepaintDecoration engine widget Window
engine
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Window
atom forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Window]
supportedAtoms) forall a b. (a -> b) -> a -> b
$ do
forall shrinker (engine :: * -> * -> *) widget.
(Shrinker shrinker, DecorationEngine engine widget Window) =>
engine widget Window
-> shrinker
-> Theme engine widget
-> DecorationEngineState engine
-> WindowDecoration
-> Bool
-> X ()
updateDeco engine widget Window
engine shrinker
shrinker Theme engine widget
theme DecorationEngineState engine
dsStyleState ([WindowDecoration]
dsDecorations forall a. [a] -> Int -> a
!! Int
i) Bool
False
| ExposeEvent {ev_window :: Event -> Window
ev_window = Window
w} <- Event
e
, Just Int
i <- Window
w forall a. Eq a => a -> [a] -> Maybe Int
`elemIndex` forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe WindowDecoration -> Maybe Window
wdDecoWindow [WindowDecoration]
dsDecorations = do
forall shrinker (engine :: * -> * -> *) widget.
(Shrinker shrinker, DecorationEngine engine widget Window) =>
engine widget Window
-> shrinker
-> Theme engine widget
-> DecorationEngineState engine
-> WindowDecoration
-> Bool
-> X ()
updateDeco engine widget Window
engine shrinker
shrinker Theme engine widget
theme DecorationEngineState engine
dsStyleState ([WindowDecoration]
dsDecorations forall a. [a] -> Int -> a
!! Int
i) Bool
True
handleEvent engine widget Window
_ shrinker
_ Theme engine widget
_ DecorationLayoutState engine
_ Event
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()
initState :: (DecorationEngine engine widget Window, DecorationGeometry geom Window, Shrinker shrinker)
=> Theme engine widget
-> engine widget Window
-> geom Window
-> shrinker
-> Rectangle
-> W.Stack Window
-> [(Window,Rectangle)] -> X (DecorationLayoutState engine)
initState :: forall (engine :: * -> * -> *) widget (geom :: * -> *) shrinker.
(DecorationEngine engine widget Window,
DecorationGeometry geom Window, Shrinker shrinker) =>
Theme engine widget
-> engine widget Window
-> geom Window
-> shrinker
-> Rectangle
-> Stack Window
-> [(Window, Rectangle)]
-> X (DecorationLayoutState engine)
initState Theme engine widget
theme engine widget Window
engine geom Window
geom shrinker
shrinker Rectangle
screenRect Stack Window
stack [(Window, Rectangle)]
wrs = do
DecorationEngineState engine
styleState <- forall (engine :: * -> * -> *) widget a (geom :: * -> *).
DecorationEngine engine widget a =>
engine widget a
-> geom a
-> Theme engine widget
-> X (DecorationEngineState engine)
initializeState engine widget Window
engine geom Window
geom Theme engine widget
theme
[WindowDecoration]
decorations <- forall (engine :: * -> * -> *) widget (geom :: * -> *) shrinker.
(DecorationEngine engine widget Window,
DecorationGeometry geom Window, Shrinker shrinker) =>
Theme engine widget
-> engine widget Window
-> geom Window
-> shrinker
-> DecorationEngineState engine
-> Rectangle
-> Stack Window
-> [(Window, Rectangle)]
-> [(Window, Rectangle)]
-> X [WindowDecoration]
createDecos Theme engine widget
theme engine widget Window
engine geom Window
geom shrinker
shrinker DecorationEngineState engine
styleState Rectangle
screenRect Stack Window
stack [(Window, Rectangle)]
wrs [(Window, Rectangle)]
wrs
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (engine :: * -> * -> *).
DecorationEngineState engine
-> [WindowDecoration] -> DecorationLayoutState engine
DecorationLayoutState DecorationEngineState engine
styleState [WindowDecoration]
decorations
releaseResources :: DecorationEngine engine widget Window => engine widget Window -> DecorationLayoutState engine -> X ()
releaseResources :: forall (engine :: * -> * -> *) widget.
DecorationEngine engine widget Window =>
engine widget Window -> DecorationLayoutState engine -> X ()
releaseResources engine widget Window
engine DecorationLayoutState engine
st = do
[WindowDecoration] -> X ()
deleteDecos (forall (engine :: * -> * -> *).
DecorationLayoutState engine -> [WindowDecoration]
dsDecorations DecorationLayoutState engine
st)
forall (engine :: * -> * -> *) widget a.
DecorationEngine engine widget a =>
engine widget a -> DecorationEngineState engine -> X ()
releaseStateResources engine widget Window
engine (forall (engine :: * -> * -> *).
DecorationLayoutState engine -> DecorationEngineState engine
dsStyleState DecorationLayoutState engine
st)
createDecos :: (DecorationEngine engine widget Window, DecorationGeometry geom Window, Shrinker shrinker)
=> Theme engine widget
-> engine widget Window
-> geom Window
-> shrinker
-> DecorationEngineState engine
-> Rectangle
-> W.Stack Window
-> [(Window,Rectangle)] -> [(Window,Rectangle)] -> X [WindowDecoration]
createDecos :: forall (engine :: * -> * -> *) widget (geom :: * -> *) shrinker.
(DecorationEngine engine widget Window,
DecorationGeometry geom Window, Shrinker shrinker) =>
Theme engine widget
-> engine widget Window
-> geom Window
-> shrinker
-> DecorationEngineState engine
-> Rectangle
-> Stack Window
-> [(Window, Rectangle)]
-> [(Window, Rectangle)]
-> X [WindowDecoration]
createDecos Theme engine widget
theme engine widget Window
engine geom Window
geom shrinker
shrinker DecorationEngineState engine
decoState Rectangle
screenRect Stack Window
stack [(Window, Rectangle)]
wrs ((Window
w,Rectangle
r):[(Window, Rectangle)]
xs) = do
Maybe Rectangle
mbDecoRect <- forall (geom :: * -> *) a.
DecorationGeometry geom a =>
geom a
-> Rectangle
-> Stack a
-> [(a, Rectangle)]
-> (a, Rectangle)
-> X (Maybe Rectangle)
decorateWindow geom Window
geom Rectangle
screenRect Stack Window
stack [(Window, Rectangle)]
wrs (Window
w,Rectangle
r)
case Maybe Rectangle
mbDecoRect of
Just Rectangle
decoRect -> do
Window
decoWindow <- forall (engine :: * -> * -> *) widget.
DecorationEngine engine widget Window =>
engine widget Window
-> Theme engine widget -> Rectangle -> X Window
createDecoWindow engine widget Window
engine Theme engine widget
theme Rectangle
decoRect
WidgetLayout WidgetPlace
widgetPlaces <- forall (engine :: * -> * -> *) widget a shrinker.
(DecorationEngine engine widget a, Shrinker shrinker) =>
engine widget a
-> Theme engine widget
-> shrinker
-> DecorationEngineState engine
-> Rectangle
-> Window
-> WidgetLayout widget
-> X (WidgetLayout WidgetPlace)
placeWidgets engine widget Window
engine Theme engine widget
theme shrinker
shrinker DecorationEngineState engine
decoState Rectangle
decoRect Window
w (forall (theme :: * -> *) widget.
HasWidgets theme widget =>
theme widget -> WidgetLayout widget
themeWidgets Theme engine widget
theme)
[WindowDecoration]
restDd <- forall (engine :: * -> * -> *) widget (geom :: * -> *) shrinker.
(DecorationEngine engine widget Window,
DecorationGeometry geom Window, Shrinker shrinker) =>
Theme engine widget
-> engine widget Window
-> geom Window
-> shrinker
-> DecorationEngineState engine
-> Rectangle
-> Stack Window
-> [(Window, Rectangle)]
-> [(Window, Rectangle)]
-> X [WindowDecoration]
createDecos Theme engine widget
theme engine widget Window
engine geom Window
geom shrinker
shrinker DecorationEngineState engine
decoState Rectangle
screenRect Stack Window
stack [(Window, Rectangle)]
wrs [(Window, Rectangle)]
xs
let newDd :: WindowDecoration
newDd = Window
-> Rectangle
-> Maybe Window
-> Maybe Rectangle
-> [WidgetPlace]
-> WindowDecoration
WindowDecoration Window
w Rectangle
r (forall a. a -> Maybe a
Just Window
decoWindow) (forall a. a -> Maybe a
Just Rectangle
decoRect) forall a b. (a -> b) -> a -> b
$ forall widget. WidgetLayout widget -> [widget]
widgetLayout WidgetLayout WidgetPlace
widgetPlaces
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ WindowDecoration
newDd forall a. a -> [a] -> [a]
: [WindowDecoration]
restDd
Maybe Rectangle
Nothing -> do
[WindowDecoration]
restDd <- forall (engine :: * -> * -> *) widget (geom :: * -> *) shrinker.
(DecorationEngine engine widget Window,
DecorationGeometry geom Window, Shrinker shrinker) =>
Theme engine widget
-> engine widget Window
-> geom Window
-> shrinker
-> DecorationEngineState engine
-> Rectangle
-> Stack Window
-> [(Window, Rectangle)]
-> [(Window, Rectangle)]
-> X [WindowDecoration]
createDecos Theme engine widget
theme engine widget Window
engine geom Window
geom shrinker
shrinker DecorationEngineState engine
decoState Rectangle
screenRect Stack Window
stack [(Window, Rectangle)]
wrs [(Window, Rectangle)]
xs
let newDd :: WindowDecoration
newDd = Window
-> Rectangle
-> Maybe Window
-> Maybe Rectangle
-> [WidgetPlace]
-> WindowDecoration
WindowDecoration Window
w Rectangle
r forall a. Maybe a
Nothing forall a. Maybe a
Nothing []
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ WindowDecoration
newDd forall a. a -> [a] -> [a]
: [WindowDecoration]
restDd
createDecos Theme engine widget
_ engine widget Window
_ geom Window
_ shrinker
_ DecorationEngineState engine
_ Rectangle
_ Stack Window
_ [(Window, Rectangle)]
_ [] = forall (m :: * -> *) a. Monad m => a -> m a
return []
createDecoWindow :: (DecorationEngine engine widget Window) => engine widget Window -> Theme engine widget -> Rectangle -> X Window
createDecoWindow :: forall (engine :: * -> * -> *) widget.
DecorationEngine engine widget Window =>
engine widget Window
-> Theme engine widget -> Rectangle -> X Window
createDecoWindow engine widget Window
engine Theme engine widget
theme Rectangle
rect = do
let mask :: Maybe Window
mask = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (engine :: * -> * -> *) widget a.
DecorationEngine engine widget a =>
engine widget a -> Window
decorationXEventMask engine widget Window
engine
Window
w <- Rectangle -> Maybe Window -> String -> Bool -> X Window
createNewWindow Rectangle
rect Maybe Window
mask (forall theme. ThemeAttributes theme => theme -> String
defaultBgColor Theme engine widget
theme) Bool
True
Display
d <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Display
display
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display -> Window -> ClassHint -> IO ()
setClassHint Display
d Window
w (String -> String -> ClassHint
ClassHint String
"xmonad-decoration" String
"xmonad")
forall (m :: * -> *) a. Monad m => a -> m a
return Window
w
showDecos :: [WindowDecoration] -> X ()
showDecos :: [WindowDecoration] -> X ()
showDecos [WindowDecoration]
dd =
[Window] -> X ()
showWindows forall a b. (a -> b) -> a -> b
$ forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe WindowDecoration -> Maybe Window
wdDecoWindow forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Maybe a -> Bool
isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowDecoration -> Maybe Rectangle
wdDecoRect) [WindowDecoration]
dd
hideDecos :: [WindowDecoration] -> X ()
hideDecos :: [WindowDecoration] -> X ()
hideDecos = [Window] -> X ()
hideWindows forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe WindowDecoration -> Maybe Window
wdDecoWindow
deleteDecos :: [WindowDecoration] -> X ()
deleteDecos :: [WindowDecoration] -> X ()
deleteDecos = [Window] -> X ()
deleteWindows forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe WindowDecoration -> Maybe Window
wdDecoWindow
updateDecos :: (Shrinker shrinker, DecorationEngine engine widget Window)
=> engine widget Window -> shrinker -> Theme engine widget -> DecorationEngineState engine -> [WindowDecoration] -> X ()
updateDecos :: forall shrinker (engine :: * -> * -> *) widget.
(Shrinker shrinker, DecorationEngine engine widget Window) =>
engine widget Window
-> shrinker
-> Theme engine widget
-> DecorationEngineState engine
-> [WindowDecoration]
-> X ()
updateDecos engine widget Window
engine shrinker
shrinker Theme engine widget
theme DecorationEngineState engine
decoState = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\WindowDecoration
wd -> forall shrinker (engine :: * -> * -> *) widget.
(Shrinker shrinker, DecorationEngine engine widget Window) =>
engine widget Window
-> shrinker
-> Theme engine widget
-> DecorationEngineState engine
-> WindowDecoration
-> Bool
-> X ()
updateDeco engine widget Window
engine shrinker
shrinker Theme engine widget
theme DecorationEngineState engine
decoState WindowDecoration
wd Bool
False)
updateDeco :: (Shrinker shrinker, DecorationEngine engine widget Window) => engine widget Window -> shrinker -> Theme engine widget -> DecorationEngineState engine -> WindowDecoration -> Bool -> X ()
updateDeco :: forall shrinker (engine :: * -> * -> *) widget.
(Shrinker shrinker, DecorationEngine engine widget Window) =>
engine widget Window
-> shrinker
-> Theme engine widget
-> DecorationEngineState engine
-> WindowDecoration
-> Bool
-> X ()
updateDeco engine widget Window
engine shrinker
shrinker Theme engine widget
theme DecorationEngineState engine
decoState WindowDecoration
wd Bool
isExpose =
case (WindowDecoration -> Maybe Window
wdDecoWindow WindowDecoration
wd, WindowDecoration -> Maybe Rectangle
wdDecoRect WindowDecoration
wd) of
(Just Window
decoWindow, Just decoRect :: Rectangle
decoRect@(Rectangle Position
_ Position
_ Dimension
wh Dimension
ht)) -> do
let origWin :: Window
origWin = WindowDecoration -> Window
wdOrigWindow WindowDecoration
wd
DrawData engine widget
drawData <- forall (engine :: * -> * -> *) widget a.
(DecorationEngine engine widget a,
ThemeAttributes (Theme engine widget),
HasWidgets (Theme engine) widget) =>
engine widget a
-> Theme engine widget
-> DecorationEngineState engine
-> Window
-> Rectangle
-> X (DrawData engine widget)
mkDrawData engine widget Window
engine Theme engine widget
theme DecorationEngineState engine
decoState Window
origWin Rectangle
decoRect
WidgetLayout WidgetPlace
widgetPlaces <- forall (engine :: * -> * -> *) widget a shrinker.
(DecorationEngine engine widget a, Shrinker shrinker) =>
engine widget a
-> Theme engine widget
-> shrinker
-> DecorationEngineState engine
-> Rectangle
-> Window
-> WidgetLayout widget
-> X (WidgetLayout WidgetPlace)
placeWidgets engine widget Window
engine Theme engine widget
theme shrinker
shrinker DecorationEngineState engine
decoState Rectangle
decoRect (WindowDecoration -> Window
wdOrigWindow WindowDecoration
wd) (forall (theme :: * -> *) widget.
HasWidgets theme widget =>
theme widget -> WidgetLayout widget
themeWidgets Theme engine widget
theme)
forall (engine :: * -> * -> *) widget a shrinker.
(DecorationEngine engine widget a, Shrinker shrinker) =>
engine widget a
-> a
-> Dimension
-> Dimension
-> shrinker
-> DrawData engine widget
-> Bool
-> X ()
paintDecoration engine widget Window
engine Window
decoWindow Dimension
wh Dimension
ht shrinker
shrinker (DrawData engine widget
drawData {ddWidgetPlaces :: WidgetLayout WidgetPlace
ddWidgetPlaces = WidgetLayout WidgetPlace
widgetPlaces}) Bool
isExpose
(Just Window
decoWindow, Maybe Rectangle
Nothing) -> Window -> X ()
hideWindow Window
decoWindow
(Maybe Window, Maybe Rectangle)
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
decorationEx :: (DecorationEngine engine widget a, DecorationGeometry geom a, Shrinker shrinker)
=> shrinker
-> Theme engine widget
-> engine widget a
-> geom a
-> l a
-> ModifiedLayout (DecorationEx engine widget geom shrinker) l a
decorationEx :: forall (engine :: * -> * -> *) widget a (geom :: * -> *) shrinker
(l :: * -> *).
(DecorationEngine engine widget a, DecorationGeometry geom a,
Shrinker shrinker) =>
shrinker
-> Theme engine widget
-> engine widget a
-> geom a
-> l a
-> ModifiedLayout (DecorationEx engine widget geom shrinker) l a
decorationEx shrinker
shrinker Theme engine widget
theme engine widget a
engine geom a
geom = forall (m :: * -> *) (l :: * -> *) a.
m a -> l a -> ModifiedLayout m l a
ModifiedLayout (forall (engine :: * -> * -> *) widget (geom :: * -> *) shrinker a.
Invisible Maybe (DecorationLayoutState engine)
-> shrinker
-> Theme engine widget
-> engine widget a
-> geom a
-> DecorationEx engine widget geom shrinker a
DecorationEx (forall (m :: * -> *) a. m a -> Invisible m a
I forall a. Maybe a
Nothing) shrinker
shrinker Theme engine widget
theme engine widget a
engine geom a
geom)