-- |
-- Module      :  XMonad.Util.StickyWindows
-- Description :  Make windows sticky to a screen across workspace changes.
-- Copyright   :  (c) Yecine Megdiche <yecine.megdiche@gmail.com>
-- License     :  BSD3-style (see LICENSE)
--
-- Maintainer  :  Yecine Megdiche <yecine.megdiche@gmail.com>
-- Stability   :  unstable
-- Portability :  unportable
--
-- This module provides functionality to make windows \"sticky\" to a particular
-- screen. When a window is marked as sticky on a screen, it will automatically
-- follow that screen across workspace changes, staying visible even when you
-- switch to a different workspace.
--
-- This is particularly useful for windows you want to keep visible at all times
-- on a specific monitor, such as Picture-in-Picture videos, music players,
-- communication apps, or reference documentation.
module XMonad.Util.StickyWindows (
    -- * Usage
    -- $usage
    sticky,
    stick,
    unstick,
) where

import qualified Data.Map as M
import qualified Data.Set as S
import XMonad
import XMonad.Prelude
import qualified XMonad.StackSet as W
import qualified XMonad.Util.ExtensibleState as XS

-- $usage
-- You can use this module with the following in your @xmonad.hs@:
--
-- > import XMonad.Util.StickyWindows
--
-- To enable sticky windows, wrap your config with 'sticky':
--
-- > main = xmonad $ … . sticky . … $ def { ... }
--
-- This adds the necessary hooks to manage sticky windows. Next, add keybindings
-- to stick and unstick windows:
--
-- > , ((modMask, xK_s), withFocused stick)
-- > , ((modMask .|. shiftMask, xK_s), withFocused unstick)
--
-- Now you can:
--
--   1. Focus a window and press @Mod-s@ to make it sticky to the current screen
--   2. Switch workspaces on that screen, and the sticky window will follow
--   3. Press @Mod-Shift-s@ to unstick the window
--
-- Note that windows are sticky to a /specific screen/, not to all screens. If you
-- have multiple monitors, a window marked sticky on screen 0 will only follow
-- workspace changes on screen 0, not on other screens.
--
-- The sticky state persists across XMonad restarts.

data StickyState = SS
    { StickyState -> Map ScreenId WorkspaceId
lastWs :: !(M.Map ScreenId WorkspaceId)
    , StickyState -> Map ScreenId (Set Window)
stickies :: !(M.Map ScreenId (S.Set Window))
    }
    deriving (Int -> StickyState -> ShowS
[StickyState] -> ShowS
StickyState -> WorkspaceId
forall a.
(Int -> a -> ShowS)
-> (a -> WorkspaceId) -> ([a] -> ShowS) -> Show a
showList :: [StickyState] -> ShowS
$cshowList :: [StickyState] -> ShowS
show :: StickyState -> WorkspaceId
$cshow :: StickyState -> WorkspaceId
showsPrec :: Int -> StickyState -> ShowS
$cshowsPrec :: Int -> StickyState -> ShowS
Show, ReadPrec [StickyState]
ReadPrec StickyState
Int -> ReadS StickyState
ReadS [StickyState]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StickyState]
$creadListPrec :: ReadPrec [StickyState]
readPrec :: ReadPrec StickyState
$creadPrec :: ReadPrec StickyState
readList :: ReadS [StickyState]
$creadList :: ReadS [StickyState]
readsPrec :: Int -> ReadS StickyState
$creadsPrec :: Int -> ReadS StickyState
Read)

instance ExtensionClass StickyState where
    initialValue :: StickyState
initialValue = Map ScreenId WorkspaceId
-> Map ScreenId (Set Window) -> StickyState
SS forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty
    extensionType :: StickyState -> StateExtension
extensionType = forall a. (Read a, Show a, ExtensionClass a) => a -> StateExtension
PersistentExtension

modifySticky ::
    (S.Set Window -> S.Set Window) -> ScreenId -> StickyState -> StickyState
modifySticky :: (Set Window -> Set Window)
-> ScreenId -> StickyState -> StickyState
modifySticky Set Window -> Set Window
f ScreenId
sid (SS Map ScreenId WorkspaceId
ws Map ScreenId (Set Window)
ss) =
    Map ScreenId WorkspaceId
-> Map ScreenId (Set Window) -> StickyState
SS Map ScreenId WorkspaceId
ws forall a b. (a -> b) -> a -> b
$ forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
M.alter (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set Window -> Set Window
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a -> a
fromMaybe forall a. Set a
S.empty) ScreenId
sid Map ScreenId (Set Window)
ss

modifyStickyM :: (S.Set Window -> S.Set Window) -> ScreenId -> X ()
modifyStickyM :: (Set Window -> Set Window) -> ScreenId -> X ()
modifyStickyM Set Window -> Set Window
f ScreenId
sid = forall a (m :: * -> *).
(ExtensionClass a, XLike m) =>
(a -> a) -> m ()
XS.modify ((Set Window -> Set Window)
-> ScreenId -> StickyState -> StickyState
modifySticky Set Window -> Set Window
f ScreenId
sid)

stick' :: Window -> ScreenId -> X ()
stick' :: Window -> ScreenId -> X ()
stick' = (Set Window -> Set Window) -> ScreenId -> X ()
modifyStickyM forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => a -> Set a -> Set a
S.insert

unstick' :: Window -> ScreenId -> X ()
unstick' :: Window -> ScreenId -> X ()
unstick' = (Set Window -> Set Window) -> ScreenId -> X ()
modifyStickyM forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => a -> Set a -> Set a
S.delete

-- | Remove the sticky status from the given window on the current screen.
-- The window will no longer automatically follow workspace changes.
--
-- Typically used with 'withFocused':
--
-- > , ((modMask .|. shiftMask, xK_s), withFocused unstick)
unstick :: Window -> X ()
unstick :: Window -> X ()
unstick Window
w = Window -> ScreenId -> X ()
unstick' Window
w forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< X ScreenId
currentScreen

-- | Mark the given window as sticky to the current screen. The window will
-- automatically follow this screen across workspace changes until explicitly
-- unstuck with 'unstick' or until the window is destroyed.
--
-- Typically used with 'withFocused':
--
-- > , ((modMask, xK_s), withFocused stick)
stick :: Window -> X ()
stick :: Window -> X ()
stick Window
w = Window -> ScreenId -> X ()
stick' Window
w forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< X ScreenId
currentScreen

currentScreen :: X ScreenId
currentScreen :: X ScreenId
currentScreen = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall a b. (a -> b) -> a -> b
$ forall i l a sid sd. Screen i l a sid sd -> sid
W.screen forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState -> WindowSet
windowset

-- | Incorporates sticky window functionality into an 'XConfig'. This adds
-- the necessary log hook and event hook to:
--
--   * Automatically move sticky windows when workspaces change on their screen
--   * Clean up sticky state when windows are destroyed
--
-- Example usage:
--
-- > main = xmonad $ … . sticky .  … $ def { ... }
sticky :: XConfig l -> XConfig l
sticky :: forall (l :: * -> *). XConfig l -> XConfig l
sticky XConfig l
xconf =
    XConfig l
xconf
        { logHook :: X ()
logHook = forall (l :: * -> *). XConfig l -> X ()
logHook XConfig l
xconf forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> X ()
stickyLogHook
        , handleEventHook :: Event -> X All
handleEventHook = forall (l :: * -> *). XConfig l -> Event -> X All
handleEventHook XConfig l
xconf forall a. Semigroup a => a -> a -> a
<> Event -> X All
stickyEventHook
        }

stickyLogHook :: X ()
stickyLogHook :: X ()
stickyLogHook = do
    Map ScreenId WorkspaceId
lastWS_ <- forall a (m :: * -> *) b.
(ExtensionClass a, XLike m) =>
(a -> b) -> m b
XS.gets StickyState -> Map ScreenId WorkspaceId
lastWs
    [(ScreenId, WorkspaceId)]
screens <- forall a. (WindowSet -> X a) -> X a
withWindowSet forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (\Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
s -> (forall i l a sid sd. Screen i l a sid sd -> sid
W.screen Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
s, forall i l a. Workspace i l a -> i
W.tag forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace forall a b. (a -> b) -> a -> b
$ Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
s)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a s sd. StackSet i l a s sd -> [Screen i l a s sd]
W.screens
    forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [(ScreenId, WorkspaceId)]
screens forall a b. (a -> b) -> a -> b
$ \(ScreenId
sid, WorkspaceId
wsTag) -> do
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup ScreenId
sid Map ScreenId WorkspaceId
lastWS_ forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just WorkspaceId
wsTag) forall a b. (a -> b) -> a -> b
$
            -- We need to update the last workspace before moving windows to avoid
            -- getting stuck in a loop: This is a log hook, and calling moveWindows
            -- (which in turn calls 'windows') would trigger another log hook.
            forall a (m :: * -> *).
(ExtensionClass a, XLike m) =>
(a -> a) -> m ()
XS.modify (\(SS Map ScreenId WorkspaceId
ws Map ScreenId (Set Window)
ss) -> Map ScreenId WorkspaceId
-> Map ScreenId (Set Window) -> StickyState
SS (forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert ScreenId
sid WorkspaceId
wsTag Map ScreenId WorkspaceId
ws) Map ScreenId (Set Window)
ss)
                forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a (m :: * -> *) b.
(ExtensionClass a, XLike m) =>
(a -> b) -> m b
XS.gets (forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup ScreenId
sid forall b c a. (b -> c) -> (a -> b) -> a -> c
. StickyState -> Map ScreenId (Set Window)
stickies)
                forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty (WorkspaceId -> Set Window -> X ()
moveWindows WorkspaceId
wsTag)

moveWindows :: WorkspaceId -> S.Set Window -> X ()
moveWindows :: WorkspaceId -> Set Window -> X ()
moveWindows WorkspaceId
wsTag = forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (\Window
w -> (WindowSet -> WindowSet) -> X ()
windows forall a b. (a -> b) -> a -> b
$ forall i l a s sd. StackSet i l a s sd -> StackSet i l a s sd
W.focusDown forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a s i l sd.
(Ord a, Eq s, Eq i) =>
i -> a -> StackSet i l a s sd -> StackSet i l a s sd
W.shiftWin WorkspaceId
wsTag Window
w)

stickyEventHook :: Event -> X All
stickyEventHook :: Event -> X All
stickyEventHook DestroyWindowEvent{ev_window :: Event -> Window
ev_window = Window
w} =
    forall a (m :: * -> *).
(ExtensionClass a, XLike m) =>
(a -> a) -> m ()
XS.modify (\(SS Map ScreenId WorkspaceId
ws Map ScreenId (Set Window)
ss) -> Map ScreenId WorkspaceId
-> Map ScreenId (Set Window) -> StickyState
SS Map ScreenId WorkspaceId
ws (forall a b k. (a -> b) -> Map k a -> Map k b
M.map (forall a. Ord a => a -> Set a -> Set a
S.delete Window
w) Map ScreenId (Set Window)
ss)) forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Bool -> All
All Bool
True
stickyEventHook Event
_ = forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> All
All Bool
True)