{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE TupleSections #-}
module XMonad.Layout.Decoration
(
decoration
, Theme (..), def
, Decoration
, DecorationMsg (..)
, DecorationStyle (..)
, DefaultDecoration (..)
, Shrinker (..), DefaultShrinker
, shrinkText, CustomShrink ( CustomShrink ), shrinkWhile
, isInStack, isVisible, isInvisible, isWithin, fi
, findWindowByDecoration
, module XMonad.Layout.LayoutModifier
, DecorationState, OrigWin
) where
import Foreign.C.Types(CInt)
import XMonad
import XMonad.Prelude
import qualified XMonad.StackSet as W
import XMonad.Hooks.UrgencyHook
import XMonad.Layout.LayoutModifier
import XMonad.Layout.WindowArranger (WindowArrangerMsg (..), diff, listFromList)
import XMonad.Util.NamedWindows (getName)
import XMonad.Util.Invisible
import XMonad.Util.XUtils
import XMonad.Util.Font
import XMonad.Util.Image
decoration :: (DecorationStyle ds a, Shrinker s) => s -> Theme -> ds a
-> l a -> ModifiedLayout (Decoration ds s) l a
decoration :: forall (ds :: * -> *) a s (l :: * -> *).
(DecorationStyle ds a, Shrinker s) =>
s -> Theme -> ds a -> l a -> ModifiedLayout (Decoration ds s) l a
decoration s
s Theme
t ds a
ds = forall (m :: * -> *) (l :: * -> *) a.
m a -> l a -> ModifiedLayout m l a
ModifiedLayout (forall (ds :: * -> *) s a.
Invisible Maybe DecorationState
-> s -> Theme -> ds a -> Decoration ds s a
Decoration (forall (m :: * -> *) a. m a -> Invisible m a
I forall a. Maybe a
Nothing) s
s Theme
t ds a
ds)
data Theme =
Theme { Theme -> String
activeColor :: String
, Theme -> String
inactiveColor :: String
, Theme -> String
urgentColor :: String
, Theme -> String
activeBorderColor :: String
, Theme -> String
inactiveBorderColor :: String
, Theme -> String
urgentBorderColor :: String
, Theme -> Dimension
activeBorderWidth :: Dimension
, Theme -> Dimension
inactiveBorderWidth :: Dimension
, Theme -> Dimension
urgentBorderWidth :: Dimension
, Theme -> String
activeTextColor :: String
, Theme -> String
inactiveTextColor :: String
, Theme -> String
urgentTextColor :: String
, Theme -> String
fontName :: String
, Theme -> Dimension
decoWidth :: Dimension
, Theme -> Dimension
decoHeight :: Dimension
, Theme -> [(String, Align)]
windowTitleAddons :: [(String, Align)]
, Theme -> [([[Bool]], Placement)]
windowTitleIcons :: [([[Bool]], Placement)]
} deriving (Int -> Theme -> ShowS
[Theme] -> ShowS
Theme -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Theme] -> ShowS
$cshowList :: [Theme] -> ShowS
show :: Theme -> String
$cshow :: Theme -> String
showsPrec :: Int -> Theme -> ShowS
$cshowsPrec :: Int -> Theme -> ShowS
Show, ReadPrec [Theme]
ReadPrec Theme
Int -> ReadS Theme
ReadS [Theme]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Theme]
$creadListPrec :: ReadPrec [Theme]
readPrec :: ReadPrec Theme
$creadPrec :: ReadPrec Theme
readList :: ReadS [Theme]
$creadList :: ReadS [Theme]
readsPrec :: Int -> ReadS Theme
$creadsPrec :: Int -> ReadS Theme
Read)
instance Default Theme where
def :: Theme
def =
Theme { activeColor :: String
activeColor = String
"#999999"
, inactiveColor :: String
inactiveColor = String
"#666666"
, urgentColor :: String
urgentColor = String
"#FFFF00"
, activeBorderColor :: String
activeBorderColor = String
"#FFFFFF"
, inactiveBorderColor :: String
inactiveBorderColor = String
"#BBBBBB"
, urgentBorderColor :: String
urgentBorderColor = String
"##00FF00"
, activeBorderWidth :: Dimension
activeBorderWidth = Dimension
1
, inactiveBorderWidth :: Dimension
inactiveBorderWidth = Dimension
1
, urgentBorderWidth :: Dimension
urgentBorderWidth = Dimension
1
, activeTextColor :: String
activeTextColor = String
"#FFFFFF"
, inactiveTextColor :: String
inactiveTextColor = String
"#BFBFBF"
, urgentTextColor :: String
urgentTextColor = String
"#FF0000"
#ifdef XFT
, fontName :: String
fontName = String
"xft:monospace"
#else
, fontName = "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*"
#endif
, decoWidth :: Dimension
decoWidth = Dimension
200
, decoHeight :: Dimension
decoHeight = Dimension
20
, windowTitleAddons :: [(String, Align)]
windowTitleAddons = []
, windowTitleIcons :: [([[Bool]], Placement)]
windowTitleIcons = []
}
newtype DecorationMsg = SetTheme Theme
instance Message DecorationMsg
data DecorationState =
DS { DecorationState -> [(OrigWin, DecoWin)]
decos :: [(OrigWin,DecoWin)]
, DecorationState -> XMonadFont
font :: XMonadFont
}
type DecoWin = (Maybe Window, Maybe Rectangle)
type OrigWin = (Window,Rectangle)
data Decoration ds s a =
Decoration (Invisible Maybe DecorationState) s Theme (ds a)
deriving (Int -> Decoration ds s a -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (ds :: * -> *) s a.
(Show s, Show (ds a)) =>
Int -> Decoration ds s a -> ShowS
forall (ds :: * -> *) s a.
(Show s, Show (ds a)) =>
[Decoration ds s a] -> ShowS
forall (ds :: * -> *) s a.
(Show s, Show (ds a)) =>
Decoration ds s a -> String
showList :: [Decoration ds s a] -> ShowS
$cshowList :: forall (ds :: * -> *) s a.
(Show s, Show (ds a)) =>
[Decoration ds s a] -> ShowS
show :: Decoration ds s a -> String
$cshow :: forall (ds :: * -> *) s a.
(Show s, Show (ds a)) =>
Decoration ds s a -> String
showsPrec :: Int -> Decoration ds s a -> ShowS
$cshowsPrec :: forall (ds :: * -> *) s a.
(Show s, Show (ds a)) =>
Int -> Decoration ds s a -> ShowS
Show, ReadPrec [Decoration ds s a]
ReadPrec (Decoration ds s a)
ReadS [Decoration ds s a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall (ds :: * -> *) s a.
(Read s, Read (ds a)) =>
ReadPrec [Decoration ds s a]
forall (ds :: * -> *) s a.
(Read s, Read (ds a)) =>
ReadPrec (Decoration ds s a)
forall (ds :: * -> *) s a.
(Read s, Read (ds a)) =>
Int -> ReadS (Decoration ds s a)
forall (ds :: * -> *) s a.
(Read s, Read (ds a)) =>
ReadS [Decoration ds s a]
readListPrec :: ReadPrec [Decoration ds s a]
$creadListPrec :: forall (ds :: * -> *) s a.
(Read s, Read (ds a)) =>
ReadPrec [Decoration ds s a]
readPrec :: ReadPrec (Decoration ds s a)
$creadPrec :: forall (ds :: * -> *) s a.
(Read s, Read (ds a)) =>
ReadPrec (Decoration ds s a)
readList :: ReadS [Decoration ds s a]
$creadList :: forall (ds :: * -> *) s a.
(Read s, Read (ds a)) =>
ReadS [Decoration ds s a]
readsPrec :: Int -> ReadS (Decoration ds s a)
$creadsPrec :: forall (ds :: * -> *) s a.
(Read s, Read (ds a)) =>
Int -> ReadS (Decoration ds s a)
Read)
class (Read (ds a), Show (ds a), Eq a) => DecorationStyle ds a where
describeDeco :: ds a -> String
describeDeco = forall a. Show a => a -> String
show
shrink :: ds a -> Rectangle -> Rectangle -> Rectangle
shrink ds a
_ (Rectangle Position
_ Position
_ Dimension
_ Dimension
dh) (Rectangle Position
x Position
y Dimension
w Dimension
h) = Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
x (Position
y forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fi Dimension
dh) Dimension
w (Dimension
h forall a. Num a => a -> a -> a
- Dimension
dh)
decorationEventHook :: ds a -> DecorationState -> Event -> X ()
decorationEventHook = forall (ds :: * -> *) a.
DecorationStyle ds a =>
ds a -> DecorationState -> Event -> X ()
handleMouseFocusDrag
decorationCatchClicksHook :: ds a
-> Window
-> Int
-> Int
-> X Bool
decorationCatchClicksHook ds a
_ Window
_ Int
_ Int
_ = forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
decorationWhileDraggingHook :: ds a -> CInt -> CInt -> (Window, Rectangle) -> Position -> Position -> X ()
decorationWhileDraggingHook ds a
_ = CInt -> CInt -> OrigWin -> Position -> Position -> X ()
handleDraggingInProgress
decorationAfterDraggingHook :: ds a -> (Window, Rectangle) -> Window -> X ()
decorationAfterDraggingHook ds a
_ds (Window
mainw, Rectangle
_r) Window
_decoWin = Window -> X ()
focus Window
mainw
pureDecoration :: ds a -> Dimension -> Dimension -> Rectangle
-> W.Stack a -> [(a,Rectangle)] -> (a,Rectangle) -> Maybe Rectangle
pureDecoration ds a
_ Dimension
_ Dimension
ht Rectangle
_ Stack a
s [(a, Rectangle)]
_ (a
w,Rectangle Position
x Position
y Dimension
wh Dimension
ht') = if forall a. Eq a => Stack a -> a -> Bool
isInStack Stack a
s a
w Bool -> Bool -> Bool
&& (Dimension
ht forall a. Ord a => a -> a -> Bool
< Dimension
ht')
then forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
x Position
y Dimension
wh Dimension
ht
else forall a. Maybe a
Nothing
decorate :: ds a -> Dimension -> Dimension -> Rectangle
-> W.Stack a -> [(a,Rectangle)] -> (a,Rectangle) -> X (Maybe Rectangle)
decorate ds a
ds Dimension
w Dimension
h Rectangle
r Stack a
s [(a, Rectangle)]
wrs (a, Rectangle)
wr = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (ds :: * -> *) a.
DecorationStyle ds a =>
ds a
-> Dimension
-> Dimension
-> Rectangle
-> Stack a
-> [(a, Rectangle)]
-> (a, Rectangle)
-> Maybe Rectangle
pureDecoration ds a
ds Dimension
w Dimension
h Rectangle
r Stack a
s [(a, Rectangle)]
wrs (a, Rectangle)
wr
data DefaultDecoration a = DefaultDecoration deriving ( ReadPrec [DefaultDecoration a]
ReadPrec (DefaultDecoration a)
ReadS [DefaultDecoration a]
forall a. ReadPrec [DefaultDecoration a]
forall a. ReadPrec (DefaultDecoration a)
forall a. Int -> ReadS (DefaultDecoration a)
forall a. ReadS [DefaultDecoration a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DefaultDecoration a]
$creadListPrec :: forall a. ReadPrec [DefaultDecoration a]
readPrec :: ReadPrec (DefaultDecoration a)
$creadPrec :: forall a. ReadPrec (DefaultDecoration a)
readList :: ReadS [DefaultDecoration a]
$creadList :: forall a. ReadS [DefaultDecoration a]
readsPrec :: Int -> ReadS (DefaultDecoration a)
$creadsPrec :: forall a. Int -> ReadS (DefaultDecoration a)
Read, Int -> DefaultDecoration a -> ShowS
forall a. Int -> DefaultDecoration a -> ShowS
forall a. [DefaultDecoration a] -> ShowS
forall a. DefaultDecoration a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DefaultDecoration a] -> ShowS
$cshowList :: forall a. [DefaultDecoration a] -> ShowS
show :: DefaultDecoration a -> String
$cshow :: forall a. DefaultDecoration a -> String
showsPrec :: Int -> DefaultDecoration a -> ShowS
$cshowsPrec :: forall a. Int -> DefaultDecoration a -> ShowS
Show )
instance Eq a => DecorationStyle DefaultDecoration a
instance (DecorationStyle ds Window, Shrinker s) => LayoutModifier (Decoration ds s) Window where
redoLayout :: Decoration ds s Window
-> Rectangle
-> Maybe (Stack Window)
-> [OrigWin]
-> X ([OrigWin], Maybe (Decoration ds s Window))
redoLayout (Decoration (I (Just DecorationState
s)) s
sh Theme
t ds Window
ds) Rectangle
_ Maybe (Stack Window)
Nothing [OrigWin]
_ = do
DecorationState -> X ()
releaseResources DecorationState
s
forall (m :: * -> *) a. Monad m => a -> m a
return ([], forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (ds :: * -> *) s a.
Invisible Maybe DecorationState
-> s -> Theme -> ds a -> Decoration ds s a
Decoration (forall (m :: * -> *) a. m a -> Invisible m a
I forall a. Maybe a
Nothing) s
sh Theme
t ds Window
ds)
redoLayout Decoration ds s Window
_ Rectangle
_ Maybe (Stack Window)
Nothing [OrigWin]
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ([], forall a. Maybe a
Nothing)
redoLayout (Decoration Invisible Maybe DecorationState
st s
sh Theme
t ds Window
ds) Rectangle
sc (Just Stack Window
stack) [OrigWin]
wrs
| I Maybe DecorationState
Nothing <- Invisible Maybe DecorationState
st = forall (ds :: * -> *).
DecorationStyle ds Window =>
Theme
-> ds Window
-> Rectangle
-> Stack Window
-> [OrigWin]
-> X DecorationState
initState Theme
t ds Window
ds Rectangle
sc Stack Window
stack [OrigWin]
wrs forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DecorationState -> X ([OrigWin], Maybe (Decoration ds s Window))
processState
| I (Just DecorationState
s) <- Invisible Maybe DecorationState
st = do let dwrs :: [(OrigWin, DecoWin)]
dwrs = DecorationState -> [(OrigWin, DecoWin)]
decos DecorationState
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 (forall {b} {b} {b}. [((b, b), b)] -> [b]
get_ws [(OrigWin, DecoWin)]
dwrs) [Window]
ws
toDel :: [(OrigWin, DecoWin)]
toDel = forall {t :: * -> *} {b} {b} {b}.
(Foldable t, Eq b) =>
t b -> [((b, b), b)] -> [((b, b), b)]
todel [Window]
d [(OrigWin, DecoWin)]
dwrs
toAdd :: [OrigWin]
toAdd = forall {t :: * -> *} {b} {b}.
(Foldable t, Eq b) =>
t b -> [(b, b)] -> [(b, b)]
toadd [Window]
a [OrigWin]
wrs
[DecoWin] -> X ()
deleteDecos (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(OrigWin, DecoWin)]
toDel)
let ndwrs :: [(OrigWin, (Maybe a, Maybe a))]
ndwrs = forall a b. (a -> b) -> [a] -> [b]
map (, (forall a. Maybe a
Nothing,forall a. Maybe a
Nothing)) [OrigWin]
toAdd
[(OrigWin, DecoWin)]
ndecos <- forall {b} {b}.
[((Window, b), (Maybe Window, b))]
-> [OrigWin] -> X [(OrigWin, DecoWin)]
resync (forall {a} {a}. [(OrigWin, (Maybe a, Maybe a))]
ndwrs forall a. [a] -> [a] -> [a]
++ forall {b} {b}.
[Window] -> [((Window, b), b)] -> [((Window, b), b)]
del_dwrs [Window]
d [(OrigWin, DecoWin)]
dwrs) [OrigWin]
wrs
DecorationState -> X ([OrigWin], Maybe (Decoration ds s Window))
processState (DecorationState
s {decos :: [(OrigWin, DecoWin)]
decos = [(OrigWin, DecoWin)]
ndecos })
where
ws :: [Window]
ws = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [OrigWin]
wrs
get_w :: ((c, b), b) -> c
get_w = forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst
get_ws :: [((b, b), b)] -> [b]
get_ws = forall a b. (a -> b) -> [a] -> [b]
map forall {c} {b} {b}. ((c, b), b) -> c
get_w
del_dwrs :: [Window] -> [((Window, b), b)] -> [((Window, b), b)]
del_dwrs = forall b c a. (b -> c) -> (c -> [a] -> Bool) -> [a] -> [b] -> [b]
listFromList forall {c} {b} {b}. ((c, b), b) -> c
get_w forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
notElem
find_dw :: Int -> [(a, (c, b))] -> c
find_dw Int
i = forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. [a] -> Int -> a
(!!) Int
i
todel :: t b -> [((b, b), b)] -> [((b, b), b)]
todel t b
d = forall a. (a -> Bool) -> [a] -> [a]
filter (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem t b
d forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {c} {b} {b}. ((c, b), b) -> c
get_w)
toadd :: t b -> [(b, b)] -> [(b, b)]
toadd t b
a = forall a. (a -> Bool) -> [a] -> [a]
filter (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem t b
a forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst )
check_dwr :: DecoWin -> X DecoWin
check_dwr DecoWin
dwr = case DecoWin
dwr of
(Maybe Window
Nothing, Just Rectangle
dr) -> do Window
dw <- Theme -> Rectangle -> X Window
createDecoWindow Theme
t Rectangle
dr
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just Window
dw, forall a. a -> Maybe a
Just Rectangle
dr)
DecoWin
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return DecoWin
dwr
resync :: [((Window, b), (Maybe Window, b))]
-> [OrigWin] -> X [(OrigWin, DecoWin)]
resync [((Window, b), (Maybe Window, b))]
_ [] = forall (m :: * -> *) a. Monad m => a -> m a
return []
resync [((Window, b), (Maybe Window, b))]
d ((Window
w,Rectangle
r):[OrigWin]
xs) = case Window
w forall a. Eq a => a -> [a] -> Maybe Int
`elemIndex` forall {b} {b} {b}. [((b, b), b)] -> [b]
get_ws [((Window, b), (Maybe Window, b))]
d of
Just Int
i -> do Maybe Rectangle
dr <- forall (ds :: * -> *) a.
DecorationStyle ds a =>
ds a
-> Dimension
-> Dimension
-> Rectangle
-> Stack a
-> [(a, Rectangle)]
-> (a, Rectangle)
-> X (Maybe Rectangle)
decorate ds Window
ds (Theme -> Dimension
decoWidth Theme
t) (Theme -> Dimension
decoHeight Theme
t) Rectangle
sc Stack Window
stack [OrigWin]
wrs (Window
w,Rectangle
r)
DecoWin
dwr <- DecoWin -> X DecoWin
check_dwr (forall {a} {c} {b}. Int -> [(a, (c, b))] -> c
find_dw Int
i [((Window, b), (Maybe Window, b))]
d, Maybe Rectangle
dr)
[(OrigWin, DecoWin)]
dwrs <- [((Window, b), (Maybe Window, b))]
-> [OrigWin] -> X [(OrigWin, DecoWin)]
resync [((Window, b), (Maybe Window, b))]
d [OrigWin]
xs
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ((Window
w,Rectangle
r),DecoWin
dwr) forall a. a -> [a] -> [a]
: [(OrigWin, DecoWin)]
dwrs
Maybe Int
Nothing -> [((Window, b), (Maybe Window, b))]
-> [OrigWin] -> X [(OrigWin, DecoWin)]
resync [((Window, b), (Maybe Window, b))]
d [OrigWin]
xs
remove_stacked :: [b] -> [(a, b)] -> [(a, b)]
remove_stacked [b]
rs ((a
w,b
r):[(a, b)]
xs)
| b
r forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [b]
rs = [b] -> [(a, b)] -> [(a, b)]
remove_stacked [b]
rs [(a, b)]
xs
| Bool
otherwise = (a
w,b
r) forall a. a -> [a] -> [a]
: [b] -> [(a, b)] -> [(a, b)]
remove_stacked (b
rforall a. a -> [a] -> [a]
:[b]
rs) [(a, b)]
xs
remove_stacked [b]
_ [] = []
insert_dwr :: ((a, Rectangle), (Maybe a, Maybe Rectangle))
-> [(a, Rectangle)] -> [(a, Rectangle)]
insert_dwr ((a
w,Rectangle
r),(Just a
dw,Just Rectangle
dr)) [(a, Rectangle)]
xs = (a
dw,Rectangle
dr)forall a. a -> [a] -> [a]
:(a
w, forall (ds :: * -> *) a.
DecorationStyle ds a =>
ds a -> Rectangle -> Rectangle -> Rectangle
shrink ds Window
ds Rectangle
dr Rectangle
r)forall a. a -> [a] -> [a]
:[(a, Rectangle)]
xs
insert_dwr ((a, Rectangle)
x ,( Maybe a
_ , Maybe Rectangle
_ )) [(a, Rectangle)]
xs = (a, Rectangle)
xforall a. a -> [a] -> [a]
:[(a, Rectangle)]
xs
dwrs_to_wrs :: [((a, Rectangle), (Maybe a, Maybe Rectangle))] -> [(a, Rectangle)]
dwrs_to_wrs = forall {b} {a}. Eq b => [b] -> [(a, b)] -> [(a, b)]
remove_stacked [] forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall {a}.
((a, Rectangle), (Maybe a, Maybe Rectangle))
-> [(a, Rectangle)] -> [(a, Rectangle)]
insert_dwr []
processState :: DecorationState -> X ([OrigWin], Maybe (Decoration ds s Window))
processState DecorationState
s = do let ndwrs :: [(OrigWin, DecoWin)]
ndwrs = DecorationState -> [(OrigWin, DecoWin)]
decos DecorationState
s
[DecoWin] -> X ()
showDecos (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(OrigWin, DecoWin)]
ndwrs)
forall s.
Shrinker s =>
s -> Theme -> XMonadFont -> [(OrigWin, DecoWin)] -> X ()
updateDecos s
sh Theme
t (DecorationState -> XMonadFont
font DecorationState
s) [(OrigWin, DecoWin)]
ndwrs
forall (m :: * -> *) a. Monad m => a -> m a
return (forall {a}.
[((a, Rectangle), (Maybe a, Maybe Rectangle))] -> [(a, Rectangle)]
dwrs_to_wrs [(OrigWin, DecoWin)]
ndwrs, forall a. a -> Maybe a
Just (forall (ds :: * -> *) s a.
Invisible Maybe DecorationState
-> s -> Theme -> ds a -> Decoration ds s a
Decoration (forall (m :: * -> *) a. m a -> Invisible m a
I (forall a. a -> Maybe a
Just (DecorationState
s {decos :: [(OrigWin, DecoWin)]
decos = [(OrigWin, DecoWin)]
ndwrs}))) s
sh Theme
t ds Window
ds))
handleMess :: Decoration ds s Window
-> SomeMessage -> X (Maybe (Decoration ds s Window))
handleMess (Decoration (I (Just s :: DecorationState
s@DS{decos :: DecorationState -> [(OrigWin, DecoWin)]
decos = [(OrigWin, DecoWin)]
dwrs})) s
sh Theme
t ds Window
ds) SomeMessage
m
| Just Event
e <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m = do forall (ds :: * -> *) a.
DecorationStyle ds a =>
ds a -> DecorationState -> Event -> X ()
decorationEventHook ds Window
ds DecorationState
s Event
e
forall s.
Shrinker s =>
s -> Theme -> DecorationState -> Event -> X ()
handleEvent s
sh Theme
t DecorationState
s Event
e
forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
| Just LayoutMessages
Hide <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m = do [DecoWin] -> X ()
hideDecos (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(OrigWin, DecoWin)]
dwrs)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
| Just (SetTheme Theme
nt) <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m = do DecorationState -> X ()
releaseResources DecorationState
s
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 (ds :: * -> *) s a.
Invisible Maybe DecorationState
-> s -> Theme -> ds a -> Decoration ds s a
Decoration (forall (m :: * -> *) a. m a -> Invisible m a
I forall a. Maybe a
Nothing) s
sh Theme
nt ds Window
ds
| Just LayoutMessages
ReleaseResources <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m = do DecorationState -> X ()
releaseResources DecorationState
s
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 (ds :: * -> *) s a.
Invisible Maybe DecorationState
-> s -> Theme -> ds a -> Decoration ds s a
Decoration (forall (m :: * -> *) a. m a -> Invisible m a
I forall a. Maybe a
Nothing) s
sh Theme
t ds Window
ds
handleMess Decoration ds s Window
_ SomeMessage
_ = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
modifierDescription :: Decoration ds s Window -> String
modifierDescription (Decoration Invisible Maybe DecorationState
_ s
_ Theme
_ ds Window
ds) = forall (ds :: * -> *) a. DecorationStyle ds a => ds a -> String
describeDeco ds Window
ds
handleEvent :: Shrinker s => s -> Theme -> DecorationState -> Event -> X ()
handleEvent :: forall s.
Shrinker s =>
s -> Theme -> DecorationState -> Event -> X ()
handleEvent s
sh Theme
t (DS [(OrigWin, DecoWin)]
dwrs XMonadFont
fs) Event
e
| PropertyEvent {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 -> b) -> [a] -> [b]
map (forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(OrigWin, DecoWin)]
dwrs = forall s.
Shrinker s =>
s -> Theme -> XMonadFont -> (OrigWin, DecoWin) -> X ()
updateDeco s
sh Theme
t XMonadFont
fs ([(OrigWin, DecoWin)]
dwrs forall a. [a] -> Int -> a
!! Int
i)
| 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 (forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(OrigWin, DecoWin)]
dwrs = forall s.
Shrinker s =>
s -> Theme -> XMonadFont -> (OrigWin, DecoWin) -> X ()
updateDeco s
sh Theme
t XMonadFont
fs ([(OrigWin, DecoWin)]
dwrs forall a. [a] -> Int -> a
!! Int
i)
handleEvent s
_ Theme
_ DecorationState
_ Event
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()
handleMouseFocusDrag :: (DecorationStyle ds a) => ds a -> DecorationState -> Event -> X ()
handleMouseFocusDrag :: forall (ds :: * -> *) a.
DecorationStyle ds a =>
ds a -> DecorationState -> Event -> X ()
handleMouseFocusDrag ds a
ds (DS [(OrigWin, DecoWin)]
dwrs XMonadFont
_) ButtonEvent { ev_window :: Event -> Window
ev_window = Window
ew
, ev_event_type :: Event -> Dimension
ev_event_type = Dimension
et
, ev_x_root :: Event -> CInt
ev_x_root = CInt
ex
, ev_y_root :: Event -> CInt
ev_y_root = CInt
ey }
| Dimension
et forall a. Eq a => a -> a -> Bool
== Dimension
buttonPress
, Just ((Window
mainw,Rectangle
r), (Window
_, Maybe Rectangle
decoRectM)) <- Window
-> [(OrigWin, DecoWin)]
-> Maybe (OrigWin, (Window, Maybe Rectangle))
lookFor Window
ew [(OrigWin, DecoWin)]
dwrs = do
let Rectangle Position
dx Position
_ Dimension
dwh Dimension
_ = forall a. HasCallStack => Maybe a -> a
fromJust Maybe Rectangle
decoRectM
distFromLeft :: CInt
distFromLeft = CInt
ex forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fi Position
dx
distFromRight :: CInt
distFromRight = forall a b. (Integral a, Num b) => a -> b
fi Dimension
dwh forall a. Num a => a -> a -> a
- (CInt
ex forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fi Position
dx)
Bool
dealtWith <- forall (ds :: * -> *) a.
DecorationStyle ds a =>
ds a -> Window -> Int -> Int -> X Bool
decorationCatchClicksHook ds a
ds Window
mainw (forall a b. (Integral a, Num b) => a -> b
fi CInt
distFromLeft) (forall a b. (Integral a, Num b) => a -> b
fi CInt
distFromRight)
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
dealtWith forall a b. (a -> b) -> a -> b
$
(Position -> Position -> X ()) -> X () -> X ()
mouseDrag (\Position
x Position
y -> Window -> X ()
focus Window
mainw forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (ds :: * -> *) a.
DecorationStyle ds a =>
ds a -> CInt -> CInt -> OrigWin -> Position -> Position -> X ()
decorationWhileDraggingHook ds a
ds CInt
ex CInt
ey (Window
mainw, Rectangle
r) Position
x Position
y)
(forall (ds :: * -> *) a.
DecorationStyle ds a =>
ds a -> OrigWin -> Window -> X ()
decorationAfterDraggingHook ds a
ds (Window
mainw, Rectangle
r) Window
ew)
handleMouseFocusDrag ds a
_ DecorationState
_ Event
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()
handleDraggingInProgress :: CInt -> CInt -> (Window, Rectangle) -> Position -> Position -> X ()
handleDraggingInProgress :: CInt -> CInt -> OrigWin -> Position -> Position -> X ()
handleDraggingInProgress CInt
ex CInt
ey (Window
_, Rectangle
r) Position
x Position
y = do
let rect :: Rectangle
rect = Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle (Position
x forall a. Num a => a -> a -> a
- (forall a b. (Integral a, Num b) => a -> b
fi CInt
ex forall a. Num a => a -> a -> a
- Rectangle -> Position
rect_x Rectangle
r))
(Position
y forall a. Num a => a -> a -> a
- (forall a b. (Integral a, Num b) => a -> b
fi CInt
ey forall a. Num a => a -> a -> a
- Rectangle -> Position
rect_y Rectangle
r))
(Rectangle -> Dimension
rect_width Rectangle
r)
(Rectangle -> Dimension
rect_height Rectangle
r)
forall a. Message a => a -> X ()
sendMessage forall a b. (a -> b) -> a -> b
$ Rectangle -> WindowArrangerMsg
SetGeometry Rectangle
rect
lookFor :: Window -> [(OrigWin,DecoWin)] -> Maybe (OrigWin,(Window,Maybe Rectangle))
lookFor :: Window
-> [(OrigWin, DecoWin)]
-> Maybe (OrigWin, (Window, Maybe Rectangle))
lookFor Window
w ((OrigWin
wr,(Just Window
dw,Maybe Rectangle
dr)):[(OrigWin, DecoWin)]
dwrs) | Window
w forall a. Eq a => a -> a -> Bool
== Window
dw = forall a. a -> Maybe a
Just (OrigWin
wr,(Window
dw,Maybe Rectangle
dr))
| Bool
otherwise = Window
-> [(OrigWin, DecoWin)]
-> Maybe (OrigWin, (Window, Maybe Rectangle))
lookFor Window
w [(OrigWin, DecoWin)]
dwrs
lookFor Window
w ((OrigWin
_, (Maybe Window
Nothing, Maybe Rectangle
_)):[(OrigWin, DecoWin)]
dwrs) = Window
-> [(OrigWin, DecoWin)]
-> Maybe (OrigWin, (Window, Maybe Rectangle))
lookFor Window
w [(OrigWin, DecoWin)]
dwrs
lookFor Window
_ [] = forall a. Maybe a
Nothing
findWindowByDecoration :: Window -> DecorationState -> Maybe (OrigWin,(Window,Maybe Rectangle))
findWindowByDecoration :: Window
-> DecorationState -> Maybe (OrigWin, (Window, Maybe Rectangle))
findWindowByDecoration Window
w DecorationState
ds = Window
-> [(OrigWin, DecoWin)]
-> Maybe (OrigWin, (Window, Maybe Rectangle))
lookFor Window
w (DecorationState -> [(OrigWin, DecoWin)]
decos DecorationState
ds)
initState :: DecorationStyle ds Window => Theme -> ds Window -> Rectangle
-> W.Stack Window -> [(Window,Rectangle)] -> X DecorationState
initState :: forall (ds :: * -> *).
DecorationStyle ds Window =>
Theme
-> ds Window
-> Rectangle
-> Stack Window
-> [OrigWin]
-> X DecorationState
initState Theme
t ds Window
ds Rectangle
sc Stack Window
s [OrigWin]
wrs = do
XMonadFont
fs <- String -> X XMonadFont
initXMF (Theme -> String
fontName Theme
t)
[(OrigWin, DecoWin)]
dwrs <- forall (ds :: * -> *).
DecorationStyle ds Window =>
Theme
-> ds Window
-> Rectangle
-> Stack Window
-> [OrigWin]
-> [OrigWin]
-> X [(OrigWin, DecoWin)]
createDecos Theme
t ds Window
ds Rectangle
sc Stack Window
s [OrigWin]
wrs [OrigWin]
wrs
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [(OrigWin, DecoWin)] -> XMonadFont -> DecorationState
DS [(OrigWin, DecoWin)]
dwrs XMonadFont
fs
releaseResources :: DecorationState -> X ()
releaseResources :: DecorationState -> X ()
releaseResources DecorationState
s = do
[DecoWin] -> X ()
deleteDecos (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ DecorationState -> [(OrigWin, DecoWin)]
decos DecorationState
s)
XMonadFont -> X ()
releaseXMF (DecorationState -> XMonadFont
font DecorationState
s)
createDecos :: DecorationStyle ds Window => Theme -> ds Window -> Rectangle -> W.Stack Window
-> [(Window,Rectangle)] -> [(Window,Rectangle)] -> X [(OrigWin,DecoWin)]
createDecos :: forall (ds :: * -> *).
DecorationStyle ds Window =>
Theme
-> ds Window
-> Rectangle
-> Stack Window
-> [OrigWin]
-> [OrigWin]
-> X [(OrigWin, DecoWin)]
createDecos Theme
t ds Window
ds Rectangle
sc Stack Window
s [OrigWin]
wrs ((Window
w,Rectangle
r):[OrigWin]
xs) = do
Maybe Rectangle
deco <- forall (ds :: * -> *) a.
DecorationStyle ds a =>
ds a
-> Dimension
-> Dimension
-> Rectangle
-> Stack a
-> [(a, Rectangle)]
-> (a, Rectangle)
-> X (Maybe Rectangle)
decorate ds Window
ds (Theme -> Dimension
decoWidth Theme
t) (Theme -> Dimension
decoHeight Theme
t) Rectangle
sc Stack Window
s [OrigWin]
wrs (Window
w,Rectangle
r)
case Maybe Rectangle
deco of
Just Rectangle
dr -> do Window
dw <- Theme -> Rectangle -> X Window
createDecoWindow Theme
t Rectangle
dr
[(OrigWin, DecoWin)]
dwrs <- forall (ds :: * -> *).
DecorationStyle ds Window =>
Theme
-> ds Window
-> Rectangle
-> Stack Window
-> [OrigWin]
-> [OrigWin]
-> X [(OrigWin, DecoWin)]
createDecos Theme
t ds Window
ds Rectangle
sc Stack Window
s [OrigWin]
wrs [OrigWin]
xs
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ((Window
w,Rectangle
r), (forall a. a -> Maybe a
Just Window
dw, forall a. a -> Maybe a
Just Rectangle
dr)) forall a. a -> [a] -> [a]
: [(OrigWin, DecoWin)]
dwrs
Maybe Rectangle
Nothing -> do [(OrigWin, DecoWin)]
dwrs <- forall (ds :: * -> *).
DecorationStyle ds Window =>
Theme
-> ds Window
-> Rectangle
-> Stack Window
-> [OrigWin]
-> [OrigWin]
-> X [(OrigWin, DecoWin)]
createDecos Theme
t ds Window
ds Rectangle
sc Stack Window
s [OrigWin]
wrs [OrigWin]
xs
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ((Window
w,Rectangle
r), (forall a. Maybe a
Nothing, forall a. Maybe a
Nothing)) forall a. a -> [a] -> [a]
: [(OrigWin, DecoWin)]
dwrs
createDecos Theme
_ ds Window
_ Rectangle
_ Stack Window
_ [OrigWin]
_ [] = forall (m :: * -> *) a. Monad m => a -> m a
return []
createDecoWindow :: Theme -> Rectangle -> X Window
createDecoWindow :: Theme -> Rectangle -> X Window
createDecoWindow Theme
t Rectangle
r = do
let mask :: Maybe Window
mask = forall a. a -> Maybe a
Just (Window
exposureMask forall a. Bits a => a -> a -> a
.|. Window
buttonPressMask)
Window
w <- Rectangle -> Maybe Window -> String -> Bool -> X Window
createNewWindow Rectangle
r Maybe Window
mask (Theme -> String
inactiveColor Theme
t) 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 (f :: * -> *) a. Applicative f => a -> f a
pure Window
w
showDecos :: [DecoWin] -> X ()
showDecos :: [DecoWin] -> X ()
showDecos = [Window] -> X ()
showWindows forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Maybe a -> Bool
isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd)
hideDecos :: [DecoWin] -> X ()
hideDecos :: [DecoWin] -> X ()
hideDecos = [Window] -> X ()
hideWindows forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall a b. (a, b) -> a
fst
deleteDecos :: [DecoWin] -> X ()
deleteDecos :: [DecoWin] -> X ()
deleteDecos = [Window] -> X ()
deleteWindows forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall a b. (a, b) -> a
fst
updateDecos :: Shrinker s => s -> Theme -> XMonadFont -> [(OrigWin,DecoWin)] -> X ()
updateDecos :: forall s.
Shrinker s =>
s -> Theme -> XMonadFont -> [(OrigWin, DecoWin)] -> X ()
updateDecos s
s Theme
t XMonadFont
f = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall a b. (a -> b) -> a -> b
$ forall s.
Shrinker s =>
s -> Theme -> XMonadFont -> (OrigWin, DecoWin) -> X ()
updateDeco s
s Theme
t XMonadFont
f
updateDeco :: Shrinker s => s -> Theme -> XMonadFont -> (OrigWin,DecoWin) -> X ()
updateDeco :: forall s.
Shrinker s =>
s -> Theme -> XMonadFont -> (OrigWin, DecoWin) -> X ()
updateDeco s
sh Theme
t XMonadFont
fs ((Window
w,Rectangle
_),(Just Window
dw,Just (Rectangle Position
_ Position
_ Dimension
wh Dimension
ht))) = do
String
nw <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Int -> [a] -> [a]
take Int
2048 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
takeWhile (forall a. Eq a => a -> a -> Bool
/= Char
'\n') forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) (Window -> X NamedWindow
getName Window
w)
[Window]
ur <- X [Window]
readUrgents
Display
dpy <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Display
display
let focusColor :: Window -> b -> b -> b -> f b
focusColor Window
win b
ic b
ac b
uc = forall b a. b -> (a -> b) -> Maybe a -> b
maybe b
ic (\Window
focusw -> case () of
()
_ | Window
focusw forall a. Eq a => a -> a -> Bool
== Window
win -> b
ac
| Window
win forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Window]
ur -> b
uc
| Bool
otherwise -> b
ic) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a s sd. StackSet i l a s sd -> Maybe a
W.peek
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
windowset
(String
bc,String
borderc,Dimension
borderw,String
tc) <-
forall {f :: * -> *} {b}.
MonadState XState f =>
Window -> b -> b -> b -> f b
focusColor Window
w (Theme -> String
inactiveColor Theme
t, Theme -> String
inactiveBorderColor Theme
t, Theme -> Dimension
inactiveBorderWidth Theme
t, Theme -> String
inactiveTextColor Theme
t)
(Theme -> String
activeColor Theme
t, Theme -> String
activeBorderColor Theme
t, Theme -> Dimension
activeBorderWidth Theme
t, Theme -> String
activeTextColor Theme
t)
(Theme -> String
urgentColor Theme
t, Theme -> String
urgentBorderColor Theme
t, Theme -> Dimension
urgentBorderWidth Theme
t, Theme -> String
urgentTextColor Theme
t)
let s :: String -> [String]
s = forall s. Shrinker s => s -> String -> [String]
shrinkIt s
sh
String
name <- (String -> [String]) -> (String -> X Bool) -> String -> X String
shrinkWhile String -> [String]
s (\String
n -> do Int
size <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
MonadIO m =>
Display -> XMonadFont -> String -> m Int
textWidthXMF Display
dpy XMonadFont
fs String
n
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Int
size forall a. Ord a => a -> a -> Bool
> forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
wh forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fromIntegral (Dimension
ht forall a. Integral a => a -> a -> a
`div` Dimension
2)) String
nw
let als :: [Align]
als = Align
AlignCenter forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd (Theme -> [(String, Align)]
windowTitleAddons Theme
t)
strs :: [String]
strs = String
name forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst (Theme -> [(String, Align)]
windowTitleAddons Theme
t)
i_als :: [Placement]
i_als = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd (Theme -> [([[Bool]], Placement)]
windowTitleIcons Theme
t)
icons :: [[[Bool]]]
icons = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst (Theme -> [([[Bool]], Placement)]
windowTitleIcons Theme
t)
Window
-> XMonadFont
-> Dimension
-> Dimension
-> Dimension
-> String
-> String
-> String
-> String
-> [Align]
-> [String]
-> [Placement]
-> [[[Bool]]]
-> X ()
paintTextAndIcons Window
dw XMonadFont
fs Dimension
wh Dimension
ht Dimension
borderw String
bc String
borderc String
tc String
bc [Align]
als [String]
strs [Placement]
i_als [[[Bool]]]
icons
updateDeco s
_ Theme
_ XMonadFont
_ (OrigWin
_,(Just Window
w,Maybe Rectangle
Nothing)) = Window -> X ()
hideWindow Window
w
updateDeco s
_ Theme
_ XMonadFont
_ (OrigWin, DecoWin)
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()
isInStack :: Eq a => W.Stack a -> a -> Bool
isInStack :: forall a. Eq a => Stack a -> a -> Bool
isInStack Stack a
s = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (forall a. Stack a -> [a]
W.integrate Stack a
s)
isVisible :: Rectangle -> [Rectangle] -> Bool
isVisible :: Rectangle -> [Rectangle] -> Bool
isVisible Rectangle
r = forall (t :: * -> *). Foldable t => t Bool -> Bool
and forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Rectangle -> [Bool] -> [Bool]
f []
where f :: Rectangle -> [Bool] -> [Bool]
f Rectangle
x [Bool]
xs = if Rectangle
r Rectangle -> Rectangle -> Bool
`isWithin` Rectangle
x then Bool
False forall a. a -> [a] -> [a]
: [Bool]
xs else Bool
True forall a. a -> [a] -> [a]
: [Bool]
xs
isInvisible :: Rectangle -> [Rectangle] -> Bool
isInvisible :: Rectangle -> [Rectangle] -> Bool
isInvisible Rectangle
r = Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rectangle -> [Rectangle] -> Bool
isVisible Rectangle
r
isWithin :: Rectangle -> Rectangle -> Bool
isWithin :: Rectangle -> Rectangle -> Bool
isWithin (Rectangle Position
x Position
y Dimension
w Dimension
h) (Rectangle Position
rx Position
ry Dimension
rw Dimension
rh)
| Position
x forall a. Ord a => a -> a -> Bool
>= Position
rx, Position
x forall a. Ord a => a -> a -> Bool
<= Position
rx forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fi Dimension
rw
, Position
y forall a. Ord a => a -> a -> Bool
>= Position
ry, Position
y forall a. Ord a => a -> a -> Bool
<= Position
ry forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fi Dimension
rh
, Position
x forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fi Dimension
w forall a. Ord a => a -> a -> Bool
<= Position
rx forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fi Dimension
rw
, Position
y forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fi Dimension
h forall a. Ord a => a -> a -> Bool
<= Position
ry forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fi Dimension
rh = Bool
True
| Bool
otherwise = Bool
False
shrinkWhile :: (String -> [String]) -> (String -> X Bool) -> String -> X String
shrinkWhile :: (String -> [String]) -> (String -> X Bool) -> String -> X String
shrinkWhile String -> [String]
sh String -> X Bool
p String
x = [String] -> X String
sw forall a b. (a -> b) -> a -> b
$ String -> [String]
sh String
x
where sw :: [String] -> X String
sw [String
n] = forall (m :: * -> *) a. Monad m => a -> m a
return String
n
sw [] = forall (m :: * -> *) a. Monad m => a -> m a
return String
""
sw (String
n:[String]
ns) = do
Bool
cond <- String -> X Bool
p String
n
if Bool
cond
then [String] -> X String
sw [String]
ns
else forall (m :: * -> *) a. Monad m => a -> m a
return String
n
data CustomShrink = CustomShrink
instance Show CustomShrink where show :: CustomShrink -> String
show CustomShrink
_ = String
""
instance Read CustomShrink where readsPrec :: Int -> ReadS CustomShrink
readsPrec Int
_ String
s = [(CustomShrink
CustomShrink,String
s)]
class (Read s, Show s) => Shrinker s where
shrinkIt :: s -> String -> [String]
data DefaultShrinker = DefaultShrinker
instance Show DefaultShrinker where show :: DefaultShrinker -> String
show DefaultShrinker
_ = String
""
instance Read DefaultShrinker where readsPrec :: Int -> ReadS DefaultShrinker
readsPrec Int
_ String
s = [(DefaultShrinker
DefaultShrinker,String
s)]
instance Shrinker DefaultShrinker where
shrinkIt :: DefaultShrinker -> String -> [String]
shrinkIt DefaultShrinker
_ String
"" = [String
""]
shrinkIt DefaultShrinker
s String
cs = String
cs forall a. a -> [a] -> [a]
: forall s. Shrinker s => s -> String -> [String]
shrinkIt DefaultShrinker
s (forall a. [a] -> [a]
init String
cs)
shrinkText :: DefaultShrinker
shrinkText :: DefaultShrinker
shrinkText = DefaultShrinker
DefaultShrinker