{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TupleSections #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Hooks.ScreenCorners
-- Description :  Run X () actions by touching the edge of your screen with your mouse.
-- Copyright   :  (c) 2009 Nils Schweinsberg, 2015 Evgeny Kurnevsky, 2024 Yuanle Song
-- License     :  BSD3-style (see LICENSE)
--
-- Maintainer  :  Nils Schweinsberg <mail@n-sch.de>
-- Stability   :  unstable
-- Portability :  unportable
--
-- Run @X ()@ actions by touching the edge of your screen with your mouse.
--
-----------------------------------------------------------------------------

module XMonad.Hooks.ScreenCorners
    (
    -- * Usage
    -- $usage

    -- * Adding screen corners
      ScreenCorner (..)
    , addScreenCorner
    , addScreenCorners

    -- * Event hook
    , screenCornerEventHook

    -- * Layout hook
    , 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ScreenCorner -> ScreenCorner -> Bool
$c/= :: ScreenCorner -> ScreenCorner -> Bool
== :: ScreenCorner -> ScreenCorner -> Bool
$c== :: ScreenCorner -> ScreenCorner -> Bool
Eq, Eq 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
min :: ScreenCorner -> ScreenCorner -> ScreenCorner
$cmin :: ScreenCorner -> ScreenCorner -> ScreenCorner
max :: ScreenCorner -> ScreenCorner -> ScreenCorner
$cmax :: ScreenCorner -> ScreenCorner -> ScreenCorner
>= :: ScreenCorner -> ScreenCorner -> Bool
$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
compare :: ScreenCorner -> ScreenCorner -> Ordering
$ccompare :: ScreenCorner -> ScreenCorner -> Ordering
Ord, Int -> ScreenCorner -> ShowS
[ScreenCorner] -> ShowS
ScreenCorner -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ScreenCorner] -> ShowS
$cshowList :: [ScreenCorner] -> ShowS
show :: ScreenCorner -> String
$cshow :: ScreenCorner -> String
showsPrec :: Int -> ScreenCorner -> ShowS
$cshowsPrec :: Int -> ScreenCorner -> ShowS
Show)

--------------------------------------------------------------------------------
-- ExtensibleState modifications
--------------------------------------------------------------------------------

newtype ScreenCornerState = ScreenCornerState (M.Map Window (ScreenCorner, X ()))

instance ExtensionClass ScreenCornerState where
    initialValue :: ScreenCornerState
initialValue = Map Window (ScreenCorner, X ()) -> ScreenCornerState
ScreenCornerState forall k a. Map k a
M.empty

-- | Add one single @X ()@ action to a screen corner
addScreenCorner :: ScreenCorner -> X () -> X ()
addScreenCorner :: ScreenCorner -> X () -> X ()
addScreenCorner ScreenCorner
corner X ()
xF = do

    ScreenCornerState Map Window (ScreenCorner, X ())
m <- forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
XS.get
    (Window
win,X ()
xFunc) <- case forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\(Window
_,(ScreenCorner
sc,X ()
_)) -> ScreenCorner
sc forall a. Eq a => a -> a -> Bool
== ScreenCorner
corner) (forall k a. Map k a -> [(k, a)]
M.toList Map Window (ScreenCorner, X ())
m) of

                        Just (Window
w, (ScreenCorner
_,X ()
xF')) -> forall (m :: * -> *) a. Monad m => a -> m a
return (Window
w, X ()
xF' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> X ()
xF) -- chain X actions
                        Maybe (Window, (ScreenCorner, X ()))
Nothing           -> (, X ()
xF) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ScreenCorner -> X Window
createWindowAt ScreenCorner
corner

    forall a (m :: * -> *).
(ExtensionClass a, XLike m) =>
(a -> a) -> m ()
XS.modify forall a b. (a -> b) -> a -> b
$ \(ScreenCornerState Map Window (ScreenCorner, X ())
m') -> Map Window (ScreenCorner, X ()) -> ScreenCornerState
ScreenCornerState forall a b. (a -> b) -> a -> b
$ 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'

-- | Add a list of @(ScreenCorner, X ())@ tuples
addScreenCorners :: [ (ScreenCorner, X ()) ] -> X ()
addScreenCorners :: [(ScreenCorner, X ())] -> X ()
addScreenCorners = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ScreenCorner -> X () -> X ()
addScreenCorner)


--------------------------------------------------------------------------------
-- Xlib functions
--------------------------------------------------------------------------------

-- "Translate" a ScreenCorner to real (x,y) Positions with proper width and
-- height.
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 = forall a. (Display -> X a) -> X a
withDisplay forall a b. (a -> b) -> a -> b
$ \Display
dpy ->
    let w :: CInt
w = Display -> Dimension -> CInt
displayWidth  Display
dpy (Display -> Dimension
defaultScreen Display
dpy) forall a. Num a => a -> a -> a
- CInt
1
    in Position -> Position -> Dimension -> Dimension -> X Window
createWindowAt' (forall a b. (Integral a, Num b) => a -> b
fi CInt
w) Position
0 Dimension
1 Dimension
1

createWindowAt ScreenCorner
SCLowerLeft = forall a. (Display -> X a) -> X a
withDisplay forall a b. (a -> b) -> a -> b
$ \Display
dpy ->
    let h :: CInt
h = Display -> Dimension -> CInt
displayHeight Display
dpy (Display -> Dimension
defaultScreen Display
dpy) forall a. Num a => a -> a -> a
- CInt
1
    in Position -> Position -> Dimension -> Dimension -> X Window
createWindowAt' Position
0 (forall a b. (Integral a, Num b) => a -> b
fi CInt
h) Dimension
1 Dimension
1

createWindowAt ScreenCorner
SCLowerRight = forall a. (Display -> X a) -> X a
withDisplay forall a b. (a -> b) -> a -> b
$ \Display
dpy ->
    let w :: CInt
w = Display -> Dimension -> CInt
displayWidth  Display
dpy (Display -> Dimension
defaultScreen Display
dpy) forall a. Num a => a -> a -> a
- CInt
1
        h :: CInt
h = Display -> Dimension -> CInt
displayHeight Display
dpy (Display -> Dimension
defaultScreen Display
dpy) forall a. Num a => a -> a -> a
- CInt
1
    in Position -> Position -> Dimension -> Dimension -> X Window
createWindowAt' (forall a b. (Integral a, Num b) => a -> b
fi CInt
w) (forall a b. (Integral a, Num b) => a -> b
fi CInt
h) Dimension
1 Dimension
1

createWindowAt ScreenCorner
SCTop = forall a. (Display -> X a) -> X a
withDisplay forall a b. (a -> b) -> a -> b
$ \Display
dpy ->
    let w :: CInt
w = Display -> Dimension -> CInt
displayWidth  Display
dpy (Display -> Dimension
defaultScreen Display
dpy) forall a. Num a => a -> a -> a
- CInt
1
        -- leave some gap so corner and edge can work nicely when they overlap
        threshold :: Position
threshold = Position
150
    in Position -> Position -> Dimension -> Dimension -> X Window
createWindowAt' Position
threshold Position
0 (forall a b. (Integral a, Num b) => a -> b
fi forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fi CInt
w forall a. Num a => a -> a -> a
- Position
threshold forall a. Num a => a -> a -> a
* Position
2) Dimension
1

createWindowAt ScreenCorner
SCBottom = forall a. (Display -> X a) -> X a
withDisplay forall a b. (a -> b) -> a -> b
$ \Display
dpy ->
    let w :: CInt
w = Display -> Dimension -> CInt
displayWidth  Display
dpy (Display -> Dimension
defaultScreen Display
dpy) forall a. Num a => a -> a -> a
- CInt
1
        h :: CInt
h = Display -> Dimension -> CInt
displayHeight Display
dpy (Display -> Dimension
defaultScreen Display
dpy) forall a. Num a => a -> a -> a
- CInt
1
        threshold :: Position
threshold = Position
150
    in Position -> Position -> Dimension -> Dimension -> X Window
createWindowAt' Position
threshold (forall a b. (Integral a, Num b) => a -> b
fi CInt
h) (forall a b. (Integral a, Num b) => a -> b
fi forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fi CInt
w forall a. Num a => a -> a -> a
- Position
threshold forall a. Num a => a -> a -> a
* Position
2) Dimension
1

createWindowAt ScreenCorner
SCLeft = forall a. (Display -> X a) -> X a
withDisplay forall a b. (a -> b) -> a -> b
$ \Display
dpy ->
    let h :: CInt
h = Display -> Dimension -> CInt
displayHeight Display
dpy (Display -> Dimension
defaultScreen Display
dpy) 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 (forall a b. (Integral a, Num b) => a -> b
fi forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fi CInt
h forall a. Num a => a -> a -> a
- Position
threshold forall a. Num a => a -> a -> a
* Position
2)

createWindowAt ScreenCorner
SCRight = forall a. (Display -> X a) -> X a
withDisplay forall a b. (a -> b) -> a -> b
$ \Display
dpy ->
    let w :: CInt
w = Display -> Dimension -> CInt
displayWidth  Display
dpy (Display -> Dimension
defaultScreen Display
dpy) forall a. Num a => a -> a -> a
- CInt
1
        h :: CInt
h = Display -> Dimension -> CInt
displayHeight Display
dpy (Display -> Dimension
defaultScreen Display
dpy) forall a. Num a => a -> a -> a
- CInt
1
        threshold :: Position
threshold = Position
150
    in Position -> Position -> Dimension -> Dimension -> X Window
createWindowAt' (forall a b. (Integral a, Num b) => a -> b
fi CInt
w) Position
threshold Dimension
1 (forall a b. (Integral a, Num b) => a -> b
fi forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fi CInt
h forall a. Num a => a -> a -> a
- Position
threshold forall a. Num a => a -> a -> a
* Position
2)

-- Create a new X window at a (x,y) Position, with given width and height.
createWindowAt' :: Position -> Position -> Dimension -> Dimension -> X Window
createWindowAt' :: Position -> Position -> Dimension -> Dimension -> X Window
createWindowAt' Position
x Position
y Dimension
width Dimension
height = forall a. (Display -> X a) -> X a
withDisplay forall a b. (a -> b) -> a -> b
$ \Display
dpy -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
io 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 forall a b. (a -> b) -> a -> b
$ Display -> Screen
defaultScreenOfDisplay Display
dpy
        attrmask :: Window
attrmask = Window
cWOverrideRedirect

    Window
w <- forall a. (Ptr SetWindowAttributes -> IO a) -> IO a
allocaSetWindowAttributes 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        -- display
                     Window
rootw      -- parent window
                     Position
x          -- x
                     Position
y          -- y
                     Dimension
width      -- width
                     Dimension
height     -- height
                     CInt
0          -- border width
                     CInt
0          -- depth
                     CInt
inputOnly  -- class
                     Visual
visual     -- visual
                     Window
attrmask   -- valuemask
                     Ptr SetWindowAttributes
attributes -- attributes

    -- we only need mouse entry events
    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
    forall (m :: * -> *) a. Monad m => a -> m a
return Window
w

--------------------------------------------------------------------------------
-- Event hook
--------------------------------------------------------------------------------

-- | Handle screen corner events
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 <- forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
XS.get

    case 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      -> forall (m :: * -> *) a. Monad m => a -> m a
return ()

    forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> All
All Bool
True)

screenCornerEventHook Event
_ = forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> All
All Bool
True)


--------------------------------------------------------------------------------
-- Layout hook
--------------------------------------------------------------------------------

data ScreenCornerLayout a = ScreenCornerLayout
    deriving ( ReadPrec [ScreenCornerLayout a]
ReadPrec (ScreenCornerLayout a)
ReadS [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
readListPrec :: ReadPrec [ScreenCornerLayout a]
$creadListPrec :: forall a. ReadPrec [ScreenCornerLayout a]
readPrec :: ReadPrec (ScreenCornerLayout a)
$creadPrec :: forall a. ReadPrec (ScreenCornerLayout a)
readList :: ReadS [ScreenCornerLayout a]
$creadList :: forall a. ReadS [ScreenCornerLayout a]
readsPrec :: Int -> ReadS (ScreenCornerLayout a)
$creadsPrec :: forall a. Int -> ReadS (ScreenCornerLayout a)
Read, Int -> ScreenCornerLayout a -> ShowS
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
showList :: [ScreenCornerLayout a] -> ShowS
$cshowList :: forall a. [ScreenCornerLayout a] -> ShowS
show :: ScreenCornerLayout a -> String
$cshow :: forall a. ScreenCornerLayout a -> String
showsPrec :: Int -> ScreenCornerLayout a -> ShowS
$cshowsPrec :: forall a. Int -> ScreenCornerLayout a -> ShowS
Show )

instance LayoutModifier ScreenCornerLayout a where
    hook :: ScreenCornerLayout a -> X ()
hook ScreenCornerLayout a
ScreenCornerLayout = forall a. (Display -> X a) -> X a
withDisplay forall a b. (a -> b) -> a -> b
$ \Display
dpy -> do
        ScreenCornerState Map Window (ScreenCorner, X ())
m <- forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
XS.get
        forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Display -> Window -> IO ()
raiseWindow Display
dpy) forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [k]
M.keys Map Window (ScreenCorner, X ())
m
    unhook :: ScreenCornerLayout a -> X ()
unhook = 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 = forall (m :: * -> *) (l :: * -> *) a.
m a -> l a -> ModifiedLayout m l a
ModifiedLayout forall a. ScreenCornerLayout a
ScreenCornerLayout


--------------------------------------------------------------------------------
-- $usage
--
-- This extension adds KDE-like screen corners and GNOME Hot Edge like
-- features to XMonad. By moving your cursor into one of your screen corners
-- or edges, you can trigger an @X ()@ action, for example
-- @"XMonad.Actions.GridSelect".goToSelected@ or
-- @"XMonad.Actions.CycleWS".nextWS@ etc.
--
-- To use it, import it on top of your @xmonad.hs@:
--
-- > import XMonad.Hooks.ScreenCorners
--
-- Then add your screen corners in our startup hook:
--
-- > myStartupHook = do
-- >     ...
-- >     addScreenCorner SCUpperRight (goToSelected def { gs_cellwidth = 200})
-- >     addScreenCorner SCBottom (goToSelected def)
-- >     addScreenCorners [ (SCLowerRight, nextWS)
-- >                      , (SCLowerLeft,  prevWS)
-- >                      ]
--
-- Then add layout hook:
--
-- > myLayout = screenCornerLayoutHook $ tiled ||| Mirror tiled ||| Full where
-- >     tiled   = Tall nmaster delta ratio
-- >     nmaster = 1
-- >     ratio   = 1 / 2
-- >     delta   = 3 / 100
--
-- And finally wait for screen corner events in your event hook:
--
-- > myEventHook e = do
-- >     ...
-- >     screenCornerEventHook e