|
| 1 | +----------------------------------------------------------------------------- |
| 2 | +-- | |
| 3 | +-- Module : XMonad.Util.StickyWindows |
| 4 | +-- Description : TODO |
| 5 | +-- Copyright : (c) Yecine Megdiche <[email protected]> |
| 6 | +-- License : BSD3-style (see LICENSE) |
| 7 | +-- |
| 8 | +-- Maintainer : Yecine Megdiche <[email protected]> |
| 9 | +-- Stability : unstable |
| 10 | +-- Portability : unportable |
| 11 | +-- |
| 12 | +-- TODO |
| 13 | +-- |
| 14 | +----------------------------------------------------------------------------- |
| 15 | +module XMonad.Util.StickyWindows ( |
| 16 | + sticky, |
| 17 | + stick, |
| 18 | + unstick |
| 19 | + ) where |
| 20 | + |
| 21 | +import qualified Data.Map as M |
| 22 | +import qualified Data.Set as S |
| 23 | +import XMonad |
| 24 | +import XMonad.Prelude |
| 25 | +import qualified XMonad.StackSet as W |
| 26 | +import qualified XMonad.Util.ExtensibleState as XS |
| 27 | + |
| 28 | +data StickyState = SS |
| 29 | + { lastWs :: WorkspaceId |
| 30 | + , stickies :: M.Map ScreenId (S.Set Window) |
| 31 | + } |
| 32 | + deriving (Show, Read) |
| 33 | + |
| 34 | +instance ExtensionClass StickyState where |
| 35 | + initialValue = SS mempty M.empty |
| 36 | + extensionType = PersistentExtension |
| 37 | + |
| 38 | +modifySticky |
| 39 | + :: (S.Set Window -> S.Set Window) -> ScreenId -> StickyState -> StickyState |
| 40 | +modifySticky f sid (SS ws ss) = |
| 41 | + SS ws $ M.alter (Just . f . fromMaybe S.empty) sid ss |
| 42 | + |
| 43 | +modifyStickyM :: (S.Set Window -> S.Set Window) -> ScreenId -> X () |
| 44 | +modifyStickyM f sid = XS.modify (modifySticky f sid) |
| 45 | + |
| 46 | +stick' :: Window -> ScreenId -> X () |
| 47 | +stick' = modifyStickyM . S.insert |
| 48 | + |
| 49 | +unstick' :: Window -> ScreenId -> X () |
| 50 | +unstick' = modifyStickyM . S.delete |
| 51 | + |
| 52 | +unstick :: Window -> X () |
| 53 | +unstick w = unstick' w =<< currentScreen |
| 54 | + |
| 55 | +stick :: Window -> X () |
| 56 | +stick w = stick' w =<< currentScreen |
| 57 | + |
| 58 | +currentScreen :: X ScreenId |
| 59 | +currentScreen = gets $ W.screen . W.current . windowset |
| 60 | + |
| 61 | +sticky :: XConfig l -> XConfig l |
| 62 | +sticky xconf = xconf |
| 63 | + { logHook = logHook xconf >> stickyLogHook |
| 64 | + , handleEventHook = handleEventHook xconf <> stickyEventHook |
| 65 | + } |
| 66 | + |
| 67 | +stickyLogHook :: X () |
| 68 | +stickyLogHook = do |
| 69 | + ws <- gets $ W.current . windowset |
| 70 | + let sid = W.screen ws |
| 71 | + wsTag = W.tag . W.workspace $ ws |
| 72 | + lastWS_ <- XS.gets lastWs |
| 73 | + unless (wsTag == lastWS_) |
| 74 | + $ XS.gets (M.lookup sid . stickies) |
| 75 | + >>= maybe mempty (moveWindows wsTag) |
| 76 | + >> XS.modify (\(SS _ ws') -> SS wsTag ws') |
| 77 | + |
| 78 | +moveWindows :: WorkspaceId -> S.Set Window -> X () |
| 79 | +moveWindows wsTag = traverse_ (\w -> windows $ W.focusDown . W.shiftWin wsTag w ) |
| 80 | + |
| 81 | +stickyEventHook :: Event -> X All |
| 82 | +stickyEventHook DestroyWindowEvent { ev_window = w } = |
| 83 | + XS.modify (\(SS ws ss) -> SS ws (M.map (S.delete w) ss)) $> All True |
| 84 | +stickyEventHook _ = return (All True) |
0 commit comments