{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses #-}

-----------------------------------------------------------------------------
-- |
-- Module       : XMonad.Layout.MagicFocus
-- Description :  Automagically put the focused window in the master area.
-- Copyright    : (c) Peter De Wachter <pdewacht@gmail.com>
-- License      : BSD
--
-- Maintainer   : Peter De Wachter <pdewacht@gmail.com>
-- Stability    : unstable
-- Portability  : unportable
--
-- Automagically put the focused window in the master area.
-----------------------------------------------------------------------------

module XMonad.Layout.MagicFocus
    (-- * Usage
     -- $usage
     magicFocus,
     promoteWarp,
     promoteWarp',
     followOnlyIf,
     disableFollowOnWS,
     MagicFocus,
    ) where

import XMonad
import qualified XMonad.StackSet as W
import XMonad.Layout.LayoutModifier

import XMonad.Actions.UpdatePointer (updatePointer)
import XMonad.Prelude(All(..))
import qualified Data.Map as M

-- $usage
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
--
-- > import XMonad.Layout.MagicFocus
--
-- Then edit your @layoutHook@ by adding the magicFocus layout
-- modifier:
--
-- > myLayout = magicFocus (Tall 1 (3/100) (1/2)) ||| Full ||| etc..
-- > main = xmonad def { layoutHook = myLayout,
-- >                     handleEventHook = promoteWarp }
--
-- For more detailed instructions on editing the layoutHook see:
--
-- "XMonad.Doc.Extending#Editing_the_layout_hook"

-- | Create a new layout which automagically puts the focused window
--   in the master area.
magicFocus :: l a -> ModifiedLayout MagicFocus l a
magicFocus :: l a -> ModifiedLayout MagicFocus l a
magicFocus = MagicFocus a -> l a -> ModifiedLayout MagicFocus l a
forall (m :: * -> *) (l :: * -> *) a.
m a -> l a -> ModifiedLayout m l a
ModifiedLayout MagicFocus a
forall a. MagicFocus a
MagicFocus

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

instance LayoutModifier MagicFocus Window where
  modifyLayout :: MagicFocus Window
-> Workspace String (l Window) Window
-> Rectangle
-> X ([(Window, Rectangle)], Maybe (l Window))
modifyLayout MagicFocus Window
MagicFocus (W.Workspace String
i l Window
l Maybe (Stack Window)
s) Rectangle
r =
    (WindowSet -> X ([(Window, Rectangle)], Maybe (l Window)))
-> X ([(Window, Rectangle)], Maybe (l Window))
forall a. (WindowSet -> X a) -> X a
withWindowSet ((WindowSet -> X ([(Window, Rectangle)], Maybe (l Window)))
 -> X ([(Window, Rectangle)], Maybe (l Window)))
-> (WindowSet -> X ([(Window, Rectangle)], Maybe (l Window)))
-> X ([(Window, Rectangle)], Maybe (l Window))
forall a b. (a -> b) -> a -> b
$ \WindowSet
wset ->
      Workspace String (l Window) Window
-> Rectangle -> X ([(Window, Rectangle)], Maybe (l Window))
forall (layout :: * -> *) a.
LayoutClass layout a =>
Workspace String (layout a) a
-> Rectangle -> X ([(a, Rectangle)], Maybe (layout a))
runLayout (String
-> l Window
-> Maybe (Stack Window)
-> Workspace String (l Window) Window
forall i l a. i -> l -> Maybe (Stack a) -> Workspace i l a
W.Workspace String
i l Window
l (Maybe (Stack Window)
s Maybe (Stack Window)
-> (Stack Window -> Maybe (Stack Window)) -> Maybe (Stack Window)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Stack Window
st -> Stack Window -> Maybe (Stack Window)
forall a. a -> Maybe a
Just (Stack Window -> Maybe (Stack Window))
-> Stack Window -> Maybe (Stack Window)
forall a b. (a -> b) -> a -> b
$ Stack Window -> Maybe Window -> Stack Window
forall a. Eq a => Stack a -> Maybe a -> Stack a
swap Stack Window
st (WindowSet -> Maybe Window
forall i l a s sd. StackSet i l a s sd -> Maybe a
W.peek WindowSet
wset))) Rectangle
r

swap :: (Eq a) => W.Stack a -> Maybe a -> W.Stack a
swap :: Stack a -> Maybe a -> Stack a
swap (W.Stack a
f [a]
u [a]
d) Maybe a
focused
    | a -> Maybe a
forall a. a -> Maybe a
Just a
f Maybe a -> Maybe a -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe a
focused = a -> [a] -> [a] -> Stack a
forall a. a -> [a] -> [a] -> Stack a
W.Stack a
f [] ([a] -> [a]
forall a. [a] -> [a]
reverse [a]
u [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
d)
    | Bool
otherwise         = a -> [a] -> [a] -> Stack a
forall a. a -> [a] -> [a] -> Stack a
W.Stack a
f [a]
u [a]
d

-- | An eventHook that overrides the normal focusFollowsMouse. When the mouse
-- it moved to another window, that window is replaced as the master, and the
-- mouse is warped to inside the new master.
--
-- It prevents infinite loops when focusFollowsMouse is true (the default), and
-- MagicFocus is in use when changing focus with the mouse.
--
-- This eventHook does nothing when there are floating windows on the current
-- workspace.
promoteWarp :: Event -> X All
promoteWarp :: Event -> X All
promoteWarp = (Rational, Rational) -> (Rational, Rational) -> Event -> X All
promoteWarp' (Rational
0.5, Rational
0.5) (Rational
0.85, Rational
0.85)

-- | promoteWarp' allows you to specify an arbitrary pair of arguments to
-- pass to 'updatePointer' when the mouse enters another window.
promoteWarp' :: (Rational, Rational) -> (Rational, Rational) -> Event -> X All
promoteWarp' :: (Rational, Rational) -> (Rational, Rational) -> Event -> X All
promoteWarp' (Rational, Rational)
refPos (Rational, Rational)
ratio e :: Event
e@CrossingEvent{ev_window :: Event -> Window
ev_window = Window
w, ev_event_type :: Event -> EventType
ev_event_type = EventType
t}
    | EventType
t EventType -> EventType -> Bool
forall a. Eq a => a -> a -> Bool
== EventType
enterNotify Bool -> Bool -> Bool
&& Event -> NotifyMode
ev_mode   Event
e NotifyMode -> NotifyMode -> Bool
forall a. Eq a => a -> a -> Bool
== NotifyMode
notifyNormal = do
        WindowSet
ws <- (XState -> WindowSet) -> X WindowSet
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> WindowSet
windowset
        let foc :: Maybe Window
foc = WindowSet -> Maybe Window
forall i l a s sd. StackSet i l a s sd -> Maybe a
W.peek WindowSet
ws
            st :: [Window]
st = Maybe (Stack Window) -> [Window]
forall a. Maybe (Stack a) -> [a]
W.integrate' (Maybe (Stack Window) -> [Window])
-> (Screen String (Layout Window) Window ScreenId ScreenDetail
    -> Maybe (Stack Window))
-> Screen String (Layout Window) Window ScreenId ScreenDetail
-> [Window]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Workspace String (Layout Window) Window -> Maybe (Stack Window)
forall i l a. Workspace i l a -> Maybe (Stack a)
W.stack (Workspace String (Layout Window) Window -> Maybe (Stack Window))
-> (Screen String (Layout Window) Window ScreenId ScreenDetail
    -> Workspace String (Layout Window) Window)
-> Screen String (Layout Window) Window ScreenId ScreenDetail
-> Maybe (Stack Window)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Screen String (Layout Window) Window ScreenId ScreenDetail
-> Workspace String (Layout Window) Window
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace (Screen String (Layout Window) Window ScreenId ScreenDetail
 -> [Window])
-> Screen String (Layout Window) Window ScreenId ScreenDetail
-> [Window]
forall a b. (a -> b) -> a -> b
$ WindowSet
-> Screen String (Layout Window) Window ScreenId ScreenDetail
forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current WindowSet
ws
            wsFloats :: Map Window RationalRect
wsFloats = (Window -> RationalRect -> Bool)
-> Map Window RationalRect -> Map Window RationalRect
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
M.filterWithKey (\Window
k RationalRect
_ -> Window
k Window -> [Window] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Window]
st) (Map Window RationalRect -> Map Window RationalRect)
-> Map Window RationalRect -> Map Window RationalRect
forall a b. (a -> b) -> a -> b
$ WindowSet -> Map Window RationalRect
forall i l a sid sd. StackSet i l a sid sd -> Map a RationalRect
W.floating WindowSet
ws
        if 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
foc Bool -> Bool -> Bool
&& Map Window RationalRect -> Bool
forall k a. Map k a -> Bool
M.null Map Window RationalRect
wsFloats then do
            (WindowSet -> WindowSet) -> X ()
windows (WindowSet -> WindowSet
forall i l a s sd. StackSet i l a s sd -> StackSet i l a s sd
W.swapMaster (WindowSet -> WindowSet)
-> (WindowSet -> WindowSet) -> WindowSet -> WindowSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Window -> WindowSet -> WindowSet
forall s a i l sd.
(Eq s, Eq a, Eq i) =>
a -> StackSet i l a s sd -> StackSet i l a s sd
W.focusWindow Window
w)
            (Rational, Rational) -> (Rational, Rational) -> X ()
updatePointer (Rational, Rational)
refPos (Rational, Rational)
ratio
            All -> X All
forall (m :: * -> *) a. Monad m => a -> m a
return (All -> X All) -> All -> X All
forall a b. (a -> b) -> a -> b
$ Bool -> All
All Bool
False
          else All -> X All
forall (m :: * -> *) a. Monad m => a -> m a
return (All -> X All) -> All -> X All
forall a b. (a -> b) -> a -> b
$ Bool -> All
All Bool
True
promoteWarp' (Rational, Rational)
_ (Rational, Rational)
_ Event
_ = All -> X All
forall (m :: * -> *) a. Monad m => a -> m a
return (All -> X All) -> All -> X All
forall a b. (a -> b) -> a -> b
$ Bool -> All
All Bool
True

-- | Another event hook to override the focusFollowsMouse and make the pointer
-- only follow if a given condition is satisfied. This could be used to disable
-- focusFollowsMouse only for given workspaces or layouts.
-- Beware that your focusFollowsMouse setting is ignored if you use this event hook.
followOnlyIf :: X Bool -> Event -> X All
followOnlyIf :: X Bool -> Event -> X All
followOnlyIf X Bool
cond e :: Event
e@CrossingEvent{ev_window :: Event -> Window
ev_window = Window
w, ev_event_type :: Event -> EventType
ev_event_type = EventType
t}
    | EventType
t EventType -> EventType -> Bool
forall a. Eq a => a -> a -> Bool
== EventType
enterNotify Bool -> Bool -> Bool
&& Event -> NotifyMode
ev_mode Event
e NotifyMode -> NotifyMode -> Bool
forall a. Eq a => a -> a -> Bool
== NotifyMode
notifyNormal
    = X Bool -> X () -> X ()
whenX X Bool
cond (Window -> X ()
focus Window
w) X () -> X All -> X All
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> All -> X All
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> All
All Bool
False)
followOnlyIf X Bool
_ Event
_ = All -> X All
forall (m :: * -> *) a. Monad m => a -> m a
return (All -> X All) -> All -> X All
forall a b. (a -> b) -> a -> b
$ Bool -> All
All Bool
True

-- | Disables focusFollow on the given workspaces:
disableFollowOnWS :: [WorkspaceId] -> X Bool
disableFollowOnWS :: [String] -> X Bool
disableFollowOnWS [String]
wses = (String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [String]
wses) (String -> Bool) -> X String -> X Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (XState -> String) -> X String
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (WindowSet -> String
forall i l a s sd. StackSet i l a s sd -> i
W.currentTag (WindowSet -> String) -> (XState -> WindowSet) -> XState -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState -> WindowSet
windowset)