{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TupleSections #-}
module XMonad.Hooks.ScreenCorners
(
ScreenCorner (..)
, addScreenCorner
, addScreenCorners
, screenCornerEventHook
, screenCornerLayoutHook
) where
import XMonad.Prelude
import XMonad
import XMonad.Layout.LayoutModifier
import qualified Data.Map as M
import qualified XMonad.Util.ExtensibleState as XS
data ScreenCorner = SCUpperLeft
| SCUpperRight
| SCLowerLeft
| SCLowerRight
| SCTop
| SCBottom
| SCLeft
| SCRight
deriving (ScreenCorner -> ScreenCorner -> Bool
(ScreenCorner -> ScreenCorner -> Bool)
-> (ScreenCorner -> ScreenCorner -> Bool) -> Eq ScreenCorner
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ScreenCorner -> ScreenCorner -> Bool
== :: ScreenCorner -> ScreenCorner -> Bool
$c/= :: ScreenCorner -> ScreenCorner -> Bool
/= :: ScreenCorner -> ScreenCorner -> Bool
Eq, Eq ScreenCorner
Eq ScreenCorner =>
(ScreenCorner -> ScreenCorner -> Ordering)
-> (ScreenCorner -> ScreenCorner -> Bool)
-> (ScreenCorner -> ScreenCorner -> Bool)
-> (ScreenCorner -> ScreenCorner -> Bool)
-> (ScreenCorner -> ScreenCorner -> Bool)
-> (ScreenCorner -> ScreenCorner -> ScreenCorner)
-> (ScreenCorner -> ScreenCorner -> ScreenCorner)
-> Ord ScreenCorner
ScreenCorner -> ScreenCorner -> Bool
ScreenCorner -> ScreenCorner -> Ordering
ScreenCorner -> ScreenCorner -> ScreenCorner
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ScreenCorner -> ScreenCorner -> Ordering
compare :: ScreenCorner -> ScreenCorner -> Ordering
$c< :: ScreenCorner -> ScreenCorner -> Bool
< :: ScreenCorner -> ScreenCorner -> Bool
$c<= :: ScreenCorner -> ScreenCorner -> Bool
<= :: ScreenCorner -> ScreenCorner -> Bool
$c> :: ScreenCorner -> ScreenCorner -> Bool
> :: ScreenCorner -> ScreenCorner -> Bool
$c>= :: ScreenCorner -> ScreenCorner -> Bool
>= :: ScreenCorner -> ScreenCorner -> Bool
$cmax :: ScreenCorner -> ScreenCorner -> ScreenCorner
max :: ScreenCorner -> ScreenCorner -> ScreenCorner
$cmin :: ScreenCorner -> ScreenCorner -> ScreenCorner
min :: ScreenCorner -> ScreenCorner -> ScreenCorner
Ord, Int -> ScreenCorner -> ShowS
[ScreenCorner] -> ShowS
ScreenCorner -> String
(Int -> ScreenCorner -> ShowS)
-> (ScreenCorner -> String)
-> ([ScreenCorner] -> ShowS)
-> Show ScreenCorner
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ScreenCorner -> ShowS
showsPrec :: Int -> ScreenCorner -> ShowS
$cshow :: ScreenCorner -> String
show :: ScreenCorner -> String
$cshowList :: [ScreenCorner] -> ShowS
showList :: [ScreenCorner] -> ShowS
Show)
newtype ScreenCornerState = ScreenCornerState (M.Map Window (ScreenCorner, X ()))
instance ExtensionClass ScreenCornerState where
initialValue :: ScreenCornerState
initialValue = Map Window (ScreenCorner, X ()) -> ScreenCornerState
ScreenCornerState Map Window (ScreenCorner, X ())
forall k a. Map k a
M.empty
addScreenCorner :: ScreenCorner -> X () -> X ()
addScreenCorner :: ScreenCorner -> X () -> X ()
addScreenCorner ScreenCorner
corner X ()
xF = do
ScreenCornerState Map Window (ScreenCorner, X ())
m <- X ScreenCornerState
forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
XS.get
(Window
win,X ()
xFunc) <- case ((Window, (ScreenCorner, X ())) -> Bool)
-> [(Window, (ScreenCorner, X ()))]
-> Maybe (Window, (ScreenCorner, X ()))
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\(Window
_,(ScreenCorner
sc,X ()
_)) -> ScreenCorner
sc ScreenCorner -> ScreenCorner -> Bool
forall a. Eq a => a -> a -> Bool
== ScreenCorner
corner) (Map Window (ScreenCorner, X ()) -> [(Window, (ScreenCorner, X ()))]
forall k a. Map k a -> [(k, a)]
M.toList Map Window (ScreenCorner, X ())
m) of
Just (Window
w, (ScreenCorner
_,X ()
xF')) -> (Window, X ()) -> X (Window, X ())
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return (Window
w, X ()
xF' X () -> X () -> X ()
forall a b. X a -> X b -> X b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> X ()
xF)
Maybe (Window, (ScreenCorner, X ()))
Nothing -> (, X ()
xF) (Window -> (Window, X ())) -> X Window -> X (Window, X ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ScreenCorner -> X Window
createWindowAt ScreenCorner
corner
(ScreenCornerState -> ScreenCornerState) -> X ()
forall a (m :: * -> *).
(ExtensionClass a, XLike m) =>
(a -> a) -> m ()
XS.modify ((ScreenCornerState -> ScreenCornerState) -> X ())
-> (ScreenCornerState -> ScreenCornerState) -> X ()
forall a b. (a -> b) -> a -> b
$ \(ScreenCornerState Map Window (ScreenCorner, X ())
m') -> Map Window (ScreenCorner, X ()) -> ScreenCornerState
ScreenCornerState (Map Window (ScreenCorner, X ()) -> ScreenCornerState)
-> Map Window (ScreenCorner, X ()) -> ScreenCornerState
forall a b. (a -> b) -> a -> b
$ Window
-> (ScreenCorner, X ())
-> Map Window (ScreenCorner, X ())
-> Map Window (ScreenCorner, X ())
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Window
win (ScreenCorner
corner,X ()
xFunc) Map Window (ScreenCorner, X ())
m'
addScreenCorners :: [ (ScreenCorner, X ()) ] -> X ()
addScreenCorners :: [(ScreenCorner, X ())] -> X ()
addScreenCorners = ((ScreenCorner, X ()) -> X ()) -> [(ScreenCorner, X ())] -> X ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((ScreenCorner -> X () -> X ()) -> (ScreenCorner, X ()) -> X ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ScreenCorner -> X () -> X ()
addScreenCorner)
createWindowAt :: ScreenCorner -> X Window
createWindowAt :: ScreenCorner -> X Window
createWindowAt ScreenCorner
SCUpperLeft = Position -> Position -> Dimension -> Dimension -> X Window
createWindowAt' Position
0 Position
0 Dimension
1 Dimension
1
createWindowAt ScreenCorner
SCUpperRight = (Display -> X Window) -> X Window
forall a. (Display -> X a) -> X a
withDisplay ((Display -> X Window) -> X Window)
-> (Display -> X Window) -> X Window
forall a b. (a -> b) -> a -> b
$ \Display
dpy ->
let w :: CInt
w = Display -> Dimension -> CInt
displayWidth Display
dpy (Display -> Dimension
defaultScreen Display
dpy) CInt -> CInt -> CInt
forall a. Num a => a -> a -> a
- CInt
1
in Position -> Position -> Dimension -> Dimension -> X Window
createWindowAt' (CInt -> Position
forall a b. (Integral a, Num b) => a -> b
fi CInt
w) Position
0 Dimension
1 Dimension
1
createWindowAt ScreenCorner
SCLowerLeft = (Display -> X Window) -> X Window
forall a. (Display -> X a) -> X a
withDisplay ((Display -> X Window) -> X Window)
-> (Display -> X Window) -> X Window
forall a b. (a -> b) -> a -> b
$ \Display
dpy ->
let h :: CInt
h = Display -> Dimension -> CInt
displayHeight Display
dpy (Display -> Dimension
defaultScreen Display
dpy) CInt -> CInt -> CInt
forall a. Num a => a -> a -> a
- CInt
1
in Position -> Position -> Dimension -> Dimension -> X Window
createWindowAt' Position
0 (CInt -> Position
forall a b. (Integral a, Num b) => a -> b
fi CInt
h) Dimension
1 Dimension
1
createWindowAt ScreenCorner
SCLowerRight = (Display -> X Window) -> X Window
forall a. (Display -> X a) -> X a
withDisplay ((Display -> X Window) -> X Window)
-> (Display -> X Window) -> X Window
forall a b. (a -> b) -> a -> b
$ \Display
dpy ->
let w :: CInt
w = Display -> Dimension -> CInt
displayWidth Display
dpy (Display -> Dimension
defaultScreen Display
dpy) CInt -> CInt -> CInt
forall a. Num a => a -> a -> a
- CInt
1
h :: CInt
h = Display -> Dimension -> CInt
displayHeight Display
dpy (Display -> Dimension
defaultScreen Display
dpy) CInt -> CInt -> CInt
forall a. Num a => a -> a -> a
- CInt
1
in Position -> Position -> Dimension -> Dimension -> X Window
createWindowAt' (CInt -> Position
forall a b. (Integral a, Num b) => a -> b
fi CInt
w) (CInt -> Position
forall a b. (Integral a, Num b) => a -> b
fi CInt
h) Dimension
1 Dimension
1
createWindowAt ScreenCorner
SCTop = (Display -> X Window) -> X Window
forall a. (Display -> X a) -> X a
withDisplay ((Display -> X Window) -> X Window)
-> (Display -> X Window) -> X Window
forall a b. (a -> b) -> a -> b
$ \Display
dpy ->
let w :: CInt
w = Display -> Dimension -> CInt
displayWidth Display
dpy (Display -> Dimension
defaultScreen Display
dpy) CInt -> CInt -> CInt
forall a. Num a => a -> a -> a
- CInt
1
threshold :: Position
threshold = Position
150
in Position -> Position -> Dimension -> Dimension -> X Window
createWindowAt' Position
threshold Position
0 (Position -> Dimension
forall a b. (Integral a, Num b) => a -> b
fi (Position -> Dimension) -> Position -> Dimension
forall a b. (a -> b) -> a -> b
$ CInt -> Position
forall a b. (Integral a, Num b) => a -> b
fi CInt
w Position -> Position -> Position
forall a. Num a => a -> a -> a
- Position
threshold Position -> Position -> Position
forall a. Num a => a -> a -> a
* Position
2) Dimension
1
createWindowAt ScreenCorner
SCBottom = (Display -> X Window) -> X Window
forall a. (Display -> X a) -> X a
withDisplay ((Display -> X Window) -> X Window)
-> (Display -> X Window) -> X Window
forall a b. (a -> b) -> a -> b
$ \Display
dpy ->
let w :: CInt
w = Display -> Dimension -> CInt
displayWidth Display
dpy (Display -> Dimension
defaultScreen Display
dpy) CInt -> CInt -> CInt
forall a. Num a => a -> a -> a
- CInt
1
h :: CInt
h = Display -> Dimension -> CInt
displayHeight Display
dpy (Display -> Dimension
defaultScreen Display
dpy) CInt -> CInt -> CInt
forall a. Num a => a -> a -> a
- CInt
1
threshold :: Position
threshold = Position
150
in Position -> Position -> Dimension -> Dimension -> X Window
createWindowAt' Position
threshold (CInt -> Position
forall a b. (Integral a, Num b) => a -> b
fi CInt
h) (Position -> Dimension
forall a b. (Integral a, Num b) => a -> b
fi (Position -> Dimension) -> Position -> Dimension
forall a b. (a -> b) -> a -> b
$ CInt -> Position
forall a b. (Integral a, Num b) => a -> b
fi CInt
w Position -> Position -> Position
forall a. Num a => a -> a -> a
- Position
threshold Position -> Position -> Position
forall a. Num a => a -> a -> a
* Position
2) Dimension
1
createWindowAt ScreenCorner
SCLeft = (Display -> X Window) -> X Window
forall a. (Display -> X a) -> X a
withDisplay ((Display -> X Window) -> X Window)
-> (Display -> X Window) -> X Window
forall a b. (a -> b) -> a -> b
$ \Display
dpy ->
let h :: CInt
h = Display -> Dimension -> CInt
displayHeight Display
dpy (Display -> Dimension
defaultScreen Display
dpy) CInt -> CInt -> CInt
forall a. Num a => a -> a -> a
- CInt
1
threshold :: Position
threshold = Position
150
in Position -> Position -> Dimension -> Dimension -> X Window
createWindowAt' Position
0 Position
threshold Dimension
1 (Position -> Dimension
forall a b. (Integral a, Num b) => a -> b
fi (Position -> Dimension) -> Position -> Dimension
forall a b. (a -> b) -> a -> b
$ CInt -> Position
forall a b. (Integral a, Num b) => a -> b
fi CInt
h Position -> Position -> Position
forall a. Num a => a -> a -> a
- Position
threshold Position -> Position -> Position
forall a. Num a => a -> a -> a
* Position
2)
createWindowAt ScreenCorner
SCRight = (Display -> X Window) -> X Window
forall a. (Display -> X a) -> X a
withDisplay ((Display -> X Window) -> X Window)
-> (Display -> X Window) -> X Window
forall a b. (a -> b) -> a -> b
$ \Display
dpy ->
let w :: CInt
w = Display -> Dimension -> CInt
displayWidth Display
dpy (Display -> Dimension
defaultScreen Display
dpy) CInt -> CInt -> CInt
forall a. Num a => a -> a -> a
- CInt
1
h :: CInt
h = Display -> Dimension -> CInt
displayHeight Display
dpy (Display -> Dimension
defaultScreen Display
dpy) CInt -> CInt -> CInt
forall a. Num a => a -> a -> a
- CInt
1
threshold :: Position
threshold = Position
150
in Position -> Position -> Dimension -> Dimension -> X Window
createWindowAt' (CInt -> Position
forall a b. (Integral a, Num b) => a -> b
fi CInt
w) Position
threshold Dimension
1 (Position -> Dimension
forall a b. (Integral a, Num b) => a -> b
fi (Position -> Dimension) -> Position -> Dimension
forall a b. (a -> b) -> a -> b
$ CInt -> Position
forall a b. (Integral a, Num b) => a -> b
fi CInt
h Position -> Position -> Position
forall a. Num a => a -> a -> a
- Position
threshold Position -> Position -> Position
forall a. Num a => a -> a -> a
* Position
2)
createWindowAt' :: Position -> Position -> Dimension -> Dimension -> X Window
createWindowAt' :: Position -> Position -> Dimension -> Dimension -> X Window
createWindowAt' Position
x Position
y Dimension
width Dimension
height = (Display -> X Window) -> X Window
forall a. (Display -> X a) -> X a
withDisplay ((Display -> X Window) -> X Window)
-> (Display -> X Window) -> X Window
forall a b. (a -> b) -> a -> b
$ \Display
dpy -> IO Window -> X Window
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO Window -> X Window) -> IO Window -> X Window
forall a b. (a -> b) -> a -> b
$ do
Window
rootw <- Display -> Dimension -> IO Window
rootWindow Display
dpy (Display -> Dimension
defaultScreen Display
dpy)
let
visual :: Visual
visual = Screen -> Visual
defaultVisualOfScreen (Screen -> Visual) -> Screen -> Visual
forall a b. (a -> b) -> a -> b
$ Display -> Screen
defaultScreenOfDisplay Display
dpy
attrmask :: Window
attrmask = Window
cWOverrideRedirect
Window
w <- (Ptr SetWindowAttributes -> IO Window) -> IO Window
forall a. (Ptr SetWindowAttributes -> IO a) -> IO a
allocaSetWindowAttributes ((Ptr SetWindowAttributes -> IO Window) -> IO Window)
-> (Ptr SetWindowAttributes -> IO Window) -> IO Window
forall a b. (a -> b) -> a -> b
$ \Ptr SetWindowAttributes
attributes -> do
Ptr SetWindowAttributes -> Bool -> IO ()
set_override_redirect Ptr SetWindowAttributes
attributes Bool
True
Display
-> Window
-> Position
-> Position
-> Dimension
-> Dimension
-> CInt
-> CInt
-> CInt
-> Visual
-> Window
-> Ptr SetWindowAttributes
-> IO Window
createWindow Display
dpy
Window
rootw
Position
x
Position
y
Dimension
width
Dimension
height
CInt
0
CInt
0
CInt
inputOnly
Visual
visual
Window
attrmask
Ptr SetWindowAttributes
attributes
Display -> Window -> Window -> IO ()
selectInput Display
dpy Window
w Window
enterWindowMask
Display -> Window -> IO ()
mapWindow Display
dpy Window
w
Display -> Bool -> IO ()
sync Display
dpy Bool
False
Window -> IO Window
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Window
w
screenCornerEventHook :: Event -> X All
screenCornerEventHook :: Event -> X All
screenCornerEventHook CrossingEvent { ev_window :: Event -> Window
ev_window = Window
win } = do
ScreenCornerState Map Window (ScreenCorner, X ())
m <- X ScreenCornerState
forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
XS.get
case Window
-> Map Window (ScreenCorner, X ()) -> Maybe (ScreenCorner, X ())
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Window
win Map Window (ScreenCorner, X ())
m of
Just (ScreenCorner
_, X ()
xF) -> X ()
xF
Maybe (ScreenCorner, X ())
Nothing -> () -> X ()
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
All -> X All
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> All
All Bool
True)
screenCornerEventHook Event
_ = All -> X All
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> All
All Bool
True)
data ScreenCornerLayout a = ScreenCornerLayout
deriving ( ReadPrec [ScreenCornerLayout a]
ReadPrec (ScreenCornerLayout a)
Int -> ReadS (ScreenCornerLayout a)
ReadS [ScreenCornerLayout a]
(Int -> ReadS (ScreenCornerLayout a))
-> ReadS [ScreenCornerLayout a]
-> ReadPrec (ScreenCornerLayout a)
-> ReadPrec [ScreenCornerLayout a]
-> Read (ScreenCornerLayout a)
forall a. ReadPrec [ScreenCornerLayout a]
forall a. ReadPrec (ScreenCornerLayout a)
forall a. Int -> ReadS (ScreenCornerLayout a)
forall a. ReadS [ScreenCornerLayout a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: forall a. Int -> ReadS (ScreenCornerLayout a)
readsPrec :: Int -> ReadS (ScreenCornerLayout a)
$creadList :: forall a. ReadS [ScreenCornerLayout a]
readList :: ReadS [ScreenCornerLayout a]
$creadPrec :: forall a. ReadPrec (ScreenCornerLayout a)
readPrec :: ReadPrec (ScreenCornerLayout a)
$creadListPrec :: forall a. ReadPrec [ScreenCornerLayout a]
readListPrec :: ReadPrec [ScreenCornerLayout a]
Read, Int -> ScreenCornerLayout a -> ShowS
[ScreenCornerLayout a] -> ShowS
ScreenCornerLayout a -> String
(Int -> ScreenCornerLayout a -> ShowS)
-> (ScreenCornerLayout a -> String)
-> ([ScreenCornerLayout a] -> ShowS)
-> Show (ScreenCornerLayout a)
forall a. Int -> ScreenCornerLayout a -> ShowS
forall a. [ScreenCornerLayout a] -> ShowS
forall a. ScreenCornerLayout a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Int -> ScreenCornerLayout a -> ShowS
showsPrec :: Int -> ScreenCornerLayout a -> ShowS
$cshow :: forall a. ScreenCornerLayout a -> String
show :: ScreenCornerLayout a -> String
$cshowList :: forall a. [ScreenCornerLayout a] -> ShowS
showList :: [ScreenCornerLayout a] -> ShowS
Show )
instance LayoutModifier ScreenCornerLayout a where
hook :: ScreenCornerLayout a -> X ()
hook ScreenCornerLayout a
ScreenCornerLayout = (Display -> X ()) -> X ()
forall a. (Display -> X a) -> X a
withDisplay ((Display -> X ()) -> X ()) -> (Display -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ \Display
dpy -> do
ScreenCornerState Map Window (ScreenCorner, X ())
m <- X ScreenCornerState
forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
XS.get
IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO () -> X ()) -> IO () -> X ()
forall a b. (a -> b) -> a -> b
$ (Window -> IO ()) -> [Window] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Display -> Window -> IO ()
raiseWindow Display
dpy) ([Window] -> IO ()) -> [Window] -> IO ()
forall a b. (a -> b) -> a -> b
$ Map Window (ScreenCorner, X ()) -> [Window]
forall k a. Map k a -> [k]
M.keys Map Window (ScreenCorner, X ())
m
unhook :: ScreenCornerLayout a -> X ()
unhook = ScreenCornerLayout a -> X ()
forall (m :: * -> *) a. LayoutModifier m a => m a -> X ()
hook
screenCornerLayoutHook :: l a -> ModifiedLayout ScreenCornerLayout l a
screenCornerLayoutHook :: forall (l :: * -> *) a.
l a -> ModifiedLayout ScreenCornerLayout l a
screenCornerLayoutHook = ScreenCornerLayout a
-> l a -> ModifiedLayout ScreenCornerLayout l a
forall (m :: * -> *) (l :: * -> *) a.
m a -> l a -> ModifiedLayout m l a
ModifiedLayout ScreenCornerLayout a
forall a. ScreenCornerLayout a
ScreenCornerLayout