-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Actions.UpdateFocus
-- Description :  Updates the focus on mouse move in unfocused windows.
-- Copyright   :  (c) Daniel Schoepe
-- License     :  BSD3-style (see LICENSE)
--
-- Maintainer  :  Daniel Schoepe <asgaroth_@gmx.de>
-- Stability   :  unstable
-- Portability :  unportable
--
-- Updates the focus on mouse move in unfocused windows.
--
-----------------------------------------------------------------------------

module XMonad.Actions.UpdateFocus (
    -- * Usage
    -- $usage
    focusOnMouseMove,
    adjustEventInput,
    focusUnderPointer,
) where

import XMonad
import XMonad.Prelude
import qualified XMonad.StackSet as W

-- $usage
-- To make the focus update on mouse movement within an unfocused window, add the
-- following to your @~\/.xmonad\/xmonad.hs@:
--
-- > import XMonad.Actions.UpdateFocus
-- > xmonad $ def {
-- >   ..
-- >   startupHook = adjustEventInput
-- >   handleEventHook = focusOnMouseMove
-- >   ..
-- > }
--
-- This module is probably only useful when focusFollowsMouse is set to True(default).

-- | Changes the focus if the mouse is moved within an unfocused window.
focusOnMouseMove :: Event -> X All
focusOnMouseMove :: Event -> X All
focusOnMouseMove MotionEvent{ ev_x :: Event -> CInt
ev_x = CInt
x, ev_y :: Event -> CInt
ev_y = CInt
y, ev_window :: Event -> Window
ev_window = Window
root } = do
    -- check only every 15 px to avoid excessive calls to translateCoordinates
    Bool -> X () -> X ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CInt
x CInt -> CInt -> CInt
forall a. Integral a => a -> a -> a
`mod` CInt
15 CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
0 Bool -> Bool -> Bool
|| CInt
y CInt -> CInt -> CInt
forall a. Integral a => a -> a -> a
`mod` CInt
15 CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
0) (X () -> X ()) -> X () -> X ()
forall a b. (a -> b) -> a -> b
$ do
      Display
dpy <- (XConf -> Display) -> X Display
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Display
display
      Maybe Window
foc <- (WindowSet -> X (Maybe Window)) -> X (Maybe Window)
forall a. (WindowSet -> X a) -> X a
withWindowSet ((WindowSet -> X (Maybe Window)) -> X (Maybe Window))
-> (WindowSet -> X (Maybe Window)) -> X (Maybe Window)
forall a b. (a -> b) -> a -> b
$ Maybe Window -> X (Maybe Window)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Window -> X (Maybe Window))
-> (WindowSet -> Maybe Window) -> WindowSet -> X (Maybe Window)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowSet -> Maybe Window
forall i l a s sd. StackSet i l a s sd -> Maybe a
W.peek
      -- get the window under the pointer:
      (Bool
_,Position
_,Position
_,Window
w) <- IO (Bool, Position, Position, Window)
-> X (Bool, Position, Position, Window)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO (Bool, Position, Position, Window)
 -> X (Bool, Position, Position, Window))
-> IO (Bool, Position, Position, Window)
-> X (Bool, Position, Position, Window)
forall a b. (a -> b) -> a -> b
$ Display
-> Window
-> Window
-> Position
-> Position
-> IO (Bool, Position, Position, Window)
translateCoordinates Display
dpy Window
root Window
root (CInt -> Position
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
x) (CInt -> Position
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
y)
      Bool -> X () -> X ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe Window
foc Maybe Window -> Maybe Window -> Bool
forall a. Eq a => a -> a -> Bool
/= Window -> Maybe Window
forall a. a -> Maybe a
Just Window
w) (X () -> X ()) -> X () -> X ()
forall a b. (a -> b) -> a -> b
$ Window -> X ()
focus Window
w
    All -> X All
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> All
All Bool
True)
focusOnMouseMove Event
_ = All -> X All
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> All
All Bool
True)

-- | Adjusts the event mask to pick up pointer movements.
adjustEventInput :: X ()
adjustEventInput :: X ()
adjustEventInput = (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
  Window
rootw <- (XConf -> Window) -> X Window
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Window
theRoot
  IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO () -> X ()) -> IO () -> X ()
forall a b. (a -> b) -> a -> b
$ Display -> Window -> Window -> IO ()
selectInput Display
dpy Window
rootw (Window -> IO ()) -> Window -> IO ()
forall a b. (a -> b) -> a -> b
$  Window
substructureRedirectMask Window -> Window -> Window
forall a. Bits a => a -> a -> a
.|. Window
substructureNotifyMask
                                Window -> Window -> Window
forall a. Bits a => a -> a -> a
.|. Window
enterWindowMask Window -> Window -> Window
forall a. Bits a => a -> a -> a
.|. Window
leaveWindowMask Window -> Window -> Window
forall a. Bits a => a -> a -> a
.|. Window
structureNotifyMask
                                Window -> Window -> Window
forall a. Bits a => a -> a -> a
.|. Window
buttonPressMask Window -> Window -> Window
forall a. Bits a => a -> a -> a
.|. Window
pointerMotionMask

-- | Focus the window under the mouse pointer, unless we're currently changing
-- focus with the mouse or dragging. This is the inverse to
-- "XMonad.Actions.UpdatePointer": instead of moving the mouse pointer to
-- match the focus, we change the focus to match the mouse pointer.
--
-- This is meant to be used together with
-- 'XMonad.Actions.UpdatePointer.updatePointer' in individual key bindings.
-- Bindings that change focus should invoke
-- 'XMonad.Actions.UpdatePointer.updatePointer' at the end, bindings that
-- switch workspaces or change layouts should call 'focusUnderPointer' at the
-- end. Neither should go to 'logHook', as that would override the other.
--
-- This is more finicky to set up than 'focusOnMouseMove', but ensures that
-- focus is updated immediately, without having to touch the mouse.
focusUnderPointer :: X ()
focusUnderPointer :: X ()
focusUnderPointer = X Bool -> X () -> X ()
whenX (Bool -> Bool
not (Bool -> Bool) -> X Bool -> X Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((XConf -> Bool) -> X Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Bool
mouseFocused X Bool -> X Bool -> X Bool
forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
<||> (XState -> Bool) -> X Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Maybe (Position -> Position -> X (), X ()) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (Position -> Position -> X (), X ()) -> Bool)
-> (XState -> Maybe (Position -> Position -> X (), X ()))
-> XState
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState -> Maybe (Position -> Position -> X (), X ())
dragging))) (X () -> X ()) -> X () -> X ()
forall a b. (a -> b) -> a -> b
$ do
  Display
dpy <- (XConf -> Display) -> X Display
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Display
display
  Window
root <- (XConf -> Window) -> X Window
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Window
theRoot
  (Bool
_, Window
_, Window
w', CInt
_, CInt
_, CInt
_, CInt
_, Modifier
_) <- IO (Bool, Window, Window, CInt, CInt, CInt, CInt, Modifier)
-> X (Bool, Window, Window, CInt, CInt, CInt, CInt, Modifier)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO (Bool, Window, Window, CInt, CInt, CInt, CInt, Modifier)
 -> X (Bool, Window, Window, CInt, CInt, CInt, CInt, Modifier))
-> IO (Bool, Window, Window, CInt, CInt, CInt, CInt, Modifier)
-> X (Bool, Window, Window, CInt, CInt, CInt, CInt, Modifier)
forall a b. (a -> b) -> a -> b
$ Display
-> Window
-> IO (Bool, Window, Window, CInt, CInt, CInt, CInt, Modifier)
queryPointer Display
dpy Window
root
  Maybe Window
w <- (XState -> Maybe Window) -> X (Maybe Window)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (WindowSet -> Maybe Window
forall i l a s sd. StackSet i l a s sd -> Maybe a
W.peek (WindowSet -> Maybe Window)
-> (XState -> WindowSet) -> XState -> Maybe Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState -> WindowSet
windowset)
  Bool -> X () -> X ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Window
w' Window -> Window -> Bool
forall a. Eq a => a -> a -> Bool
/= Window
none Bool -> Bool -> Bool
&& Window -> Maybe Window
forall a. a -> Maybe a
Just Window
w' Maybe Window -> Maybe Window -> Bool
forall a. Eq a => a -> a -> Bool
/= Maybe Window
w) (Window -> X ()
focus Window
w')