{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
module XMonad.Layout.ButtonDecoration
(
buttonDeco,
ButtonDecoration,
) where
import XMonad
import XMonad.Layout.Decoration
import XMonad.Layout.DecorationAddons
buttonDeco :: (Eq a, Shrinker s) => s -> Theme
-> l a -> ModifiedLayout (Decoration ButtonDecoration s) l a
buttonDeco :: forall a s (l :: * -> *).
(Eq a, Shrinker s) =>
s
-> Theme
-> l a
-> ModifiedLayout (Decoration ButtonDecoration s) l a
buttonDeco s
s Theme
c = 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
c forall a b. (a -> b) -> a -> b
$ forall a. Bool -> ButtonDecoration a
NFD Bool
True
newtype ButtonDecoration a = NFD Bool deriving (Int -> ButtonDecoration a -> ShowS
forall a. Int -> ButtonDecoration a -> ShowS
forall a. [ButtonDecoration a] -> ShowS
forall a. ButtonDecoration a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ButtonDecoration a] -> ShowS
$cshowList :: forall a. [ButtonDecoration a] -> ShowS
show :: ButtonDecoration a -> String
$cshow :: forall a. ButtonDecoration a -> String
showsPrec :: Int -> ButtonDecoration a -> ShowS
$cshowsPrec :: forall a. Int -> ButtonDecoration a -> ShowS
Show, ReadPrec [ButtonDecoration a]
ReadPrec (ButtonDecoration a)
ReadS [ButtonDecoration a]
forall a. ReadPrec [ButtonDecoration a]
forall a. ReadPrec (ButtonDecoration a)
forall a. Int -> ReadS (ButtonDecoration a)
forall a. ReadS [ButtonDecoration a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ButtonDecoration a]
$creadListPrec :: forall a. ReadPrec [ButtonDecoration a]
readPrec :: ReadPrec (ButtonDecoration a)
$creadPrec :: forall a. ReadPrec (ButtonDecoration a)
readList :: ReadS [ButtonDecoration a]
$creadList :: forall a. ReadS [ButtonDecoration a]
readsPrec :: Int -> ReadS (ButtonDecoration a)
$creadsPrec :: forall a. Int -> ReadS (ButtonDecoration a)
Read)
instance Eq a => DecorationStyle ButtonDecoration a where
describeDeco :: ButtonDecoration a -> String
describeDeco ButtonDecoration a
_ = String
"ButtonDeco"
decorationCatchClicksHook :: ButtonDecoration a -> Window -> Int -> Int -> X Bool
decorationCatchClicksHook ButtonDecoration a
_ = Window -> Int -> Int -> X Bool
titleBarButtonHandler
decorationAfterDraggingHook :: ButtonDecoration a -> (Window, Rectangle) -> Window -> X ()
decorationAfterDraggingHook ButtonDecoration a
_ (Window
mainw, Rectangle
_) Window
decoWin = Window -> X ()
focus Window
mainw forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Window -> Window -> X Bool
handleScreenCrossing Window
mainw Window
decoWin forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ()